Skip to content

Instantly share code, notes, and snippets.

let mutable section = ""
let mutable status = 0
let mutable count = 0
exception Fail of string
let run (name: string) test =
try
test ()
count <- count + 1
@t0yv0
t0yv0 / fixpoint.ml
Created August 13, 2011 22:34
Hashed fixpoint function, an example of parameterizing the algorithm by equality and hashing functions without exposing it as a functor, and still using the functorial interface of Hashtbl.
(** Packs typed values into boxes preserving equality and hashing. *)
module type HASHED =
sig
type t
val hash : t -> int
val equal : t -> t -> bool
val pack : ('a -> int) -> ('a -> 'a -> bool) -> 'a -> t
end
module Hashed : HASHED =
@t0yv0
t0yv0 / stream.ml
Created August 11, 2011 01:58
Guarded streams.
module type STREAM =
sig
type 'a delay
type 'a stream
val delay : 'a -> 'a delay
val next : ('a -> 'b) -> 'a delay -> 'b delay
val fix : ('a delay -> 'a) -> 'a
val unzip : ('a * 'b) delay -> 'a delay * 'b delay
val zip : ('a delay * 'b delay) -> ('a * 'b) delay
let mapReduce (map : 'T1 -> Async<'T2>)
(reduce : 'T2 -> 'T2 -> Async<'T2>)
(input : seq<'T1>) : Async<'T2> =
let run (a: Async<'T>) (k: 'T -> unit) =
Async.StartWithContinuations(a, k, ignore, ignore)
Async.FromContinuations <| fun (ok, _, _) ->
let k = ref 0
let agent =
new MailboxProcessor<_>(fun chan ->
async {
@t0yv0
t0yv0 / MapReduce.fs
Created August 7, 2011 03:40
F# map-reduce with fully asynchronous arbitrary-order mappers and reducers.
let mapReduce (map : 'T1 -> Async<'T2>)
(reduce : 'T2 -> 'T2 -> Async<'T2>)
(input : seq<'T1>) : Async<'T2> =
let run (a: Async<'T>) (k: 'T -> unit) =
Async.StartWithContinuations(a, k, ignore, ignore)
Async.FromContinuations <| fun (ok, _, _) ->
let k = ref 0
let agent =
new MailboxProcessor<_>(fun chan ->
async {
@t0yv0
t0yv0 / euler19.fs
Created July 29, 2011 20:22 — forked from dzyubam/euler19.py
Project Euler -- Problem 19
let euler19 () =
let mutable k = 0
for y in 1901 .. 2000 do
for m in 1 .. 12 do
let date = System.DateTime(y, m, 1)
if date.DayOfWeek = System.DayOfWeek.Sunday then
k <- k + 1
k
stdout.WriteLine(euler19 ())
@t0yv0
t0yv0 / Regex.fs
Created July 21, 2011 13:45
F# regex combinators take 2.
module My.Regex
exception StackError
type Stack =
| Branch of Stack * Stack
| Thread of list<obj>
member this.Evaluate<'T>() =
match this with
@t0yv0
t0yv0 / Fresh.hs
Created July 19, 2011 13:26
Fresh name generation in Haskell.
import Control.Monad.State
-- `Linear a b` reperesents `\x -> a * x + b`.
data Linear = Linear !Int !Int
-- Represents `\x -> x`.
idLinear :: Linear
idLinear = Linear 1 0
-- Interprets the `Linear` value.
testTNFA n =
let rep 0 p = pure 'a'
rep n p = rep (n - 1) p *> p
pat = rep n (char 'a' <|> pure 'a') *> rep n (char 'a')
in
run (compile pat) (take n (repeat 'a'))
@t0yv0
t0yv0 / Regex.fs
Created July 15, 2011 17:31
F# translation of a Haskell regex combinator exercise.
(*
See the Haskell source: https://gist.github.com/1082416
There exist a few problems:
(0) How correct is this? Non-termination, stack overflows? The kind
of grammars that are recognized here are obviously not simply
regular expressions, because of the fixpoints. Try for instance: