From 52a6f8656e8a600a2c59fa2802fb46fafb30de45 Mon Sep 17 00:00:00 2001
From: Vladimir Azarov <avm@intermediate-node.net>
Date: Mon, 12 May 2025 01:51:27 +0200
Subject: Object-like macros

---
 common.sml | 92 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 90 insertions(+), 2 deletions(-)

(limited to 'common.sml')

diff --git a/common.sml b/common.sml
index cb4652a..d3643c7 100644
--- a/common.sml
+++ b/common.sml
@@ -1,9 +1,35 @@
-exception Unreachable
+exception Unreachable and Unimplemented
 
 fun $ (x, y) = x y
 infixr 0 $
 
-fun printLn s = (print s; print "\n")
+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
@@ -30,3 +56,65 @@ in
     | Evaluated v => v
     | Exn e => raise e
 end
+
+structure FRU = struct
+  fun fold (a, f) g = g (a, f)
+  fun step0 h (a, f) = fold (h a, f)
+  fun step2 h (a, f) b c = fold (h (b, c, a), f)
+
+  fun next g (f, z) x = g (f x, z)
+  fun f1 (f, z) x = f (z x)
+  fun f2 z = next f1 z
+  fun f3 z = next f2 z
+  fun f4 z = next f3 z
+  fun f5 z = next f4 z
+  fun f6 z = next f5 z
+  fun f7 z = next f6 z
+  fun f8 z = next f7 z
+  fun f9 z = next f8 z
+
+  fun c0 from = from
+  fun c1 from = c0 from f1
+  fun c2 from = c1 from f2
+  fun c3 from = c2 from f3
+  fun c4 from = c3 from f4
+  fun c5 from = c4 from f5
+  fun c6 from = c5 from f6
+  fun c7 from = c6 from f7
+  fun c8 from = c7 from f8
+  fun c9 from = c8 from f9
+
+  fun makeUpdate cX (from, from', to) record =
+    let
+       fun ops () = cX from'
+       fun vars f = to f record
+    in
+       fold ((vars, ops), fn (vars, _) => vars from)
+    end
+  fun makeUpdate0 z = makeUpdate c0 z
+  fun makeUpdate1 z = makeUpdate c1 z
+  fun makeUpdate2 z = makeUpdate c2 z
+  fun makeUpdate3 z = makeUpdate c3 z
+  fun makeUpdate4 z = makeUpdate c4 z
+  fun makeUpdate5 z = makeUpdate c5 z
+  fun makeUpdate6 z = makeUpdate c6 z
+  fun makeUpdate7 z = makeUpdate c7 z
+  fun makeUpdate8 z = makeUpdate c8 z
+  fun makeUpdate9 z = makeUpdate c9 z
+
+  fun upd z = step2
+    (fn (s, f, (vars, ops)) =>
+      (fn out => vars (s (ops ()) (out, f)), ops)) z
+  fun set z = step2
+    (fn (s, v, (vars, ops)) =>
+      (fn out => vars (s (ops ()) (out, fn _ => v)), ops)) z
+
+ fun set2 s v = step0
+   (fn (vars, ops) => (fn out => vars (s (ops ()) (out, fn _ => v)), ops))
+ fun upd2 s f = 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
-- 
cgit v1.2.3