diff options
Diffstat (limited to 'common.sml')
| -rw-r--r-- | common.sml | 60 |
1 files changed, 28 insertions, 32 deletions
@@ -5,32 +5,6 @@ infixr 0 $ fun assert truth = if not truth then raise Unreachable else () -local - val lastIsNL = ref true - - fun endsWith s = - String.sub (s, String.size s - 1) = #"\n" handle - Subscript => raise Unreachable - - val print' = print -in - fun print s = ( - lastIsNL := endsWith s; - print' s - ) - - fun printLn s = ( - lastIsNL := true; - print' s; print "\n" - ) - - fun printOnNL s = ( - if not $ !lastIsNL then print' "\n" else (); - print' s; - lastIsNL := endsWith s - ) -end - (* All global values which computations may raise an exception must be * wrapped in lazy, so that no exception is thrown before custom * top-level handler is set. @@ -57,11 +31,14 @@ in | Exn e => raise e end -structure FRU = struct +structure Fold = struct fun fold (a, f) g = g (a, f) fun step0 h (a, f) = fold (h a, f) + fun step1 h (a, f) b = fold (h (b, a), f) fun step2 h (a, f) b c = fold (h (b, c, a), f) +end +structure FRU = struct fun next g (f, z) x = g (f x, z) fun f1 (f, z) x = f (z x) fun f2 z = next f1 z @@ -89,7 +66,7 @@ structure FRU = struct fun ops () = cX from' fun vars f = to f record in - fold ((vars, ops), fn (vars, _) => vars from) + Fold.fold ((vars, ops), fn (vars, _) => vars from) end fun makeUpdate0 z = makeUpdate c0 z fun makeUpdate1 z = makeUpdate c1 z @@ -102,19 +79,38 @@ structure FRU = struct fun makeUpdate8 z = makeUpdate c8 z fun makeUpdate9 z = makeUpdate c9 z - fun upd z = step2 + fun upd z = Fold.step2 (fn (s, f, (vars, ops)) => (fn out => vars (s (ops ()) (out, f)), ops)) z - fun set z = step2 + fun set z = Fold.step2 (fn (s, v, (vars, ops)) => (fn out => vars (s (ops ()) (out, fn _ => v)), ops)) z - fun set2 s v = step0 + fun set2 s v = Fold.step0 (fn (vars, ops) => (fn out => vars (s (ops ()) (out, fn _ => v)), ops)) - fun upd2 s f = step0 + fun upd2 s f = Fold.step0 (fn (vars, ops) => (fn out => vars (s (ops ()) (out, f)), ops)) end fun % (a, f) = f a val s = FRU.set val u = FRU.upd + +fun output s = TextIO.output (TextIO.stdOut, s) +local + fun printBuffer _ [] = () + | printBuffer stream (s :: acc) = + (TextIO.output (stream, s); printBuffer stream acc) +in + fun fprintf stream f = Fold.fold + ((stream, []), fn (stream, acc) => printBuffer stream (rev acc)) f + fun printf f = fprintf TextIO.stdOut f + + fun ` z = Fold.step1 (fn (str, (s, acc)) => (s, str :: acc)) z + fun A0 z = Fold.step1 (fn (f, (s, a)) => (s, f () :: a)) z + fun A1 z = Fold.step2 (fn (f, v, (s, a)) => (s, f v :: a)) z + fun bind A f = fn z => Fold.fold z A f + + val C = fn z => bind A1 str z + val I = fn z => bind A1 Int.toString z +end |