implement closures

tests/codegen.scm

@@ -270,4 +270,59 @@ compiles."
               "_Static_assert(sizeof(int) == 4, \"int is four bytes\")"))
     (test-assert "and not the header macro"
       (not (emits? (in-fn "(static-assert (== (sizeof int) 4) \"x\")")
-                   "static_assert(")))))
+                   "static_assert("))))
+
+  ;; A closure is a code pointer beside its captures. The struct is
+  ;; named from the signature, so separate translation units agree on
+  ;; it, and calling one goes through `code' with `env' passed first.
+  ;;
+  ;; A closure struct, and the helper its calls go through, are each
+  ;; emitted once per signature; the registries deciding that are
+  ;; compile-time state like the type databases, and outlive a single
+  ;; `sex->c' here. So every case below that looks for a *definition*
+  ;; uses a signature of its own -- cases looking at a call site can
+  ;; share one.
+  (test-group "closures"
+    (test-assert "the type becomes a struct named for its signature"
+      (emits? "(fn f ((c (closure ((int)) int))) int (return (c 1)))"
+              "struct ƛint_int"))
+    ;; The environment is one shared union, declared in the prelude --
+    ;; its layout is part of the ABI two units agree on, so it cannot
+    ;; depend on what either file contains. `sex->c' has no prelude, so
+    ;; what is visible here is the member
+    (test-assert "whose environment is the shared union"
+      (emits? "(fn f ((c (closure ((float)) int))) int (return (c 1.0)))"
+              "union ƛenv env;"))
+    ;; The receiver goes through a helper rather than being written
+    ;; out twice, so that `[table (++ i)]' evaluates its index once,
+    ;; exactly as it would for an array of function pointers
+    (test-assert "a call passes the receiver to a helper"
+      (emits? "(fn f ((c (closure ((int)) int))) int (return (c 1)))"
+              "ƛint_int_call(c, 1)"))
+    (test-assert "and the helper is what dereferences it"
+      (emits? "(fn f ((c (closure ((long)) int))) int (return (c 1)))"
+              "ƛc.code(&ƛc.env, ƛa0)"))
+    (test-assert "a subscript receiver is evaluated once"
+      (emits? "(fn f ((t (¤ (closure ((int)) int) 4)) (i int)) int (return ((¤ t (++ i)) 1)))"
+              "ƛint_int_call(t[++i], 1)"))
+    (test-assert "so is a member receiver"
+      (emits? "(struct h ((cb (closure ((int)) int))))
+               (fn f ((s (struct h))) int (return ((. s cb) 1)))"
+              "ƛint_int_call(s.cb, 1)"))
+    (test-assert "a captured name is rebound in the lifted body"
+      (emits? "(fn f ((n int)) (closure ((char)) int) (return (closure ((x char)) int (n) (return n))))"
+              "int n = ƛcaptures->n;"))
+    (test-assert "captures are checked against the environment"
+      (emits? "(fn f ((n int)) (closure ((short)) int) (return (closure ((x short)) int (n) (return n))))"
+              "_Static_assert(sizeof(struct"))
+    ;; A closure over nothing has no record to point at, and C has no
+    ;; empty struct to declare for it
+    (test-assert "no captures means no capture record"
+      (not (emits? "(fn f () (closure () int) (return (closure () int () (return 7))))"
+                   "_captures {")))
+    ;; The receiver is written twice, so a name used as an argument
+    ;; must not be mistaken for a call of its own
+    (test-assert "a closure passed as an argument stays a value"
+      (emits? "(fn g ((c (closure ((int)) int))) int (return 0))
+               (fn f ((c (closure ((int)) int))) int (return (g c)))"
+              "g(c)"))))

tests/modules/Makefile

@@ -10,14 +10,17 @@
 #
 # It also checks what only a second translation unit can check: that an
 # imported type reaches the type database, by expanding a macro that
-# reads the imported struct's fields.
+# reads the imported struct's fields; and that a closure type crossing
+# the boundary works both ways -- one built in the module and called
+# here, one built here and called there, through a code pointer that is
+# static in the other object.
 #
 # The public forms carry comments in their headers, which the reduction
 # to a prototype and to an extern both have to look past.
 
 SEXC ?= ../../sexc
 
-EXPECTED = hello, world\nhello, sex\n2 greetings\ntext times \ntext times \nmood 1
+EXPECTED = hello, world\nhello, sex\n2 greetings\ntext times \ntext times \nmood 1\nclosure 15 21 201
 
 check:
 	@$(SEXC) greet.sex -c -o greet.o

tests/modules/greet-app.sex

@@ -26,4 +26,11 @@
   (printf "\n")
   (var m (enum mood) grumpy)
   (printf "mood %d\n" m)
+
+  (var add-10 (closure ((int)) int) (make-adder 10))
+  (printf "closure %d %d" (add-10 5) (apply-twice add-10 1))
+  (var base int 100)
+  (var here (closure ((int)) int)
+       (closure ((x int)) int (base) (return (+ base x))))
+  (printf " %d\n" (apply-twice here 1))
   (return 0))

tests/modules/greet.sex

@@ -35,6 +35,19 @@
   (++ greet-count)
   (printf "hello, %s\n" name))
 
+;;; A closure type crossing the boundary. Both units generate the
+;;; struct for this signature independently, so they have to agree on
+;;; its tag and its layout, or the value is passed wrong and nothing
+;;; says so.
+(pub fn make-adder ((n int)) (closure ((int)) int)
+  (return (closure ((b int)) int (n)
+            (return (+ n b)))))
+
+;;; The other direction: a closure built by the importer, whose code
+;;; pointer is static in *its* object, called from here
+(pub fn apply-twice ((f (closure ((int)) int)) (x int)) int
+  (return (f (f x))))
+
 ;;; Not `pub': invisible to importers, and static in the generated C.
 (fn unused-helper () void
   (printf "private\n"))

tests/sex-programs/closures.sex

@@ -0,0 +1,80 @@
+(input)
+(output "Adders: 15 25"
+        "Two captures: 47"
+        "No captures: 7"
+        "Through a parameter: 110"
+        "From an array: 1 2 3"
+        "Index evaluated once: 21 i 1"
+        "Through a struct member: 8"
+        "Nested: 33")
+(return 0)
+
+;;; A closure is a code pointer beside its captures, so what this
+;;; checks is that the captures survive the lifting -- that two
+;;; closures of one shape keep their own environments, that a closure
+;;; outlives the call that built it, and that calling one through a
+;;; parameter, an array element or a struct member resolves the same
+;;; way as through a local.
+;;;
+;;; A receiver is also an ordinary expression: `[table (++ i)]' has to
+;;; evaluate its index exactly once, the way it would for an array of
+;;; function pointers.
+
+(include stdio.h)
+
+(fn make-adder ((n int)) (closure ((int)) int)
+  (return (closure ((b int)) int (n)
+            (return (+ n b)))))
+
+(fn make-affine ((k int) (b int)) (closure ((int)) int)
+  (return (closure ((x int)) int (k b)
+            (return (+ (* k x) b)))))
+
+(fn make-const-7 () (closure () int)
+  (return (closure () int ()
+            (return 7))))
+
+;;; A closure arriving as a parameter: its type is written, so the call
+;;; resolves without knowing where it came from
+(fn apply-twice ((f (closure ((int)) int)) (x int)) int
+  (return (f (f x))))
+
+(struct handlers ((on-tick (closure ((int)) int))))
+
+(pub fn main () int
+  (var add-10 (closure ((int)) int) (make-adder 10))
+  (var add-20 (closure ((int)) int) (make-adder 20))
+  (printf "Adders: %d %d\n" (add-10 5) (add-20 5))
+
+  (var affine (closure ((int)) int) (make-affine 5 2))
+  (printf "Two captures: %d\n" (affine 9))
+
+  (var seven (closure () int) (make-const-7))
+  (printf "No captures: %d\n" (seven))
+
+  (printf "Through a parameter: %d\n" (apply-twice (make-adder 50) 10))
+
+  (var table (¤ (closure ((int)) int) 3))
+  (var i int 0)
+  (for (= i 0) (< i 3) (++ i)
+       (= (¤ table i) (make-adder i)))
+  (printf "From an array: %d %d %d\n"
+          ((¤ table 0) 1) ((¤ table 1) 1) ((¤ table 2) 1))
+
+  ;; the index must be evaluated once, so `i' ends at 1 and not 2 --
+  ;; read in a separate statement, since reading and bumping it in one
+  ;; printf would be unsequenced whatever the closure did
+  (= i 0)
+  (var once int ([table (++ i)] 20))
+  (printf "Index evaluated once: %d i %d\n" once i)
+
+  (var h (struct handlers) #((struct handlers) : .on-tick (make-adder 5)))
+  (printf "Through a struct member: %d\n" ((. h on-tick) 3))
+
+  ;; a closure built inside a closure, capturing that one's capture
+  (var outer (closure ((int)) int)
+       (closure ((x int)) int ()
+         (var inner (closure ((int)) int) (make-adder x))
+         (return (inner 3))))
+  (printf "Nested: %d\n" (outer 30))
+  (return 0))

tests/sex-programs/fixpoint.sex

@@ -0,0 +1,55 @@
+(input)
+(output "direct: 120"
+        "fac: 120 3628800"
+        "fib: 55 6765")
+(return 0)
+
+;;; A fixed point built out of closures, which is the hardest thing to
+;;; ask of them: recursion with no recursive function anywhere, only
+;;; self-application.
+;;;
+;;; Self-application needs `x x' and so a recursive type, which is
+;;; spelled here by routing it through a named struct whose field is a
+;;; closure whose own signature mentions that struct. The generated
+;;; closure struct is written before `struct rec' is, so this only
+;;; compiles because a forward declaration is emitted ahead of both.
+;;;
+;;; Note what `fix' captures: a *pointer* to the knot, not the knot. A
+;;; closure is a code pointer beside N bytes of environment, so
+;;; capturing one by value would need N >= 8 + N. No budget makes that
+;;; true, and the static assertion says so rather than letting it
+;;; corrupt anything.
+
+(include stdio.h)
+
+(struct rec ((f (closure (((* (struct rec))) (int)) int))))
+
+;;; Takes a step that expects itself, returns an ordinary closure with
+;;; the self-application hidden inside
+(fn fix ((step (* (struct rec)))) (closure ((int)) int)
+  (return (closure ((n int)) int (step)
+            (return ((-> step f) step n)))))
+
+(pub fn main () int
+  (var fac-knot (struct rec))
+  (= (. fac-knot f)
+     (closure ((self (* (struct rec))) (n int)) int ()
+       (if (<= n 1) (return 1))
+       (return (* n ((-> self f) self (- n 1))))))
+
+  ;; the knot applied to itself directly, without fix
+  (printf "direct: %d\n" ((. fac-knot f) (& fac-knot) 5))
+
+  (var fib-knot (struct rec))
+  (= (. fib-knot f)
+     (closure ((self (* (struct rec))) (n int)) int ()
+       (if (< n 2) (return n))
+       (return (+ ((-> self f) self (- n 1))
+                  ((-> self f) self (- n 2))))))
+
+  ;; one combinator, two different recursions
+  (var fac (closure ((int)) int) (fix (& fac-knot)))
+  (var fib (closure ((int)) int) (fix (& fib-knot)))
+  (printf "fac: %d %d\n" (fac 5) (fac 10))
+  (printf "fib: %d %d\n" (fib 10) (fib 20))
+  (return 0))