From 8a3f51e83353bfa5d21a7473716d9bcf383e17c1 Mon Sep 17 00:00:00 2001 From: alex-eg Date: Tue, 29 Sep 2026 21:07:16 +0300 Subject: [PATCH] implement closures --- Makefile | 2 +- example/lambdas.sex | 18 +- semen.scm | 399 ++++++++++++++++++++++++++++++-- sexc.scm | 25 +- tests/codegen.scm | 57 ++++- tests/modules/Makefile | 7 +- tests/modules/greet-app.sex | 7 + tests/modules/greet.sex | 13 ++ tests/sex-programs/closures.sex | 80 +++++++ tests/sex-programs/fixpoint.sex | 55 +++++ 10 files changed, 622 insertions(+), 41 deletions(-) create mode 100644 tests/sex-programs/closures.sex create mode 100644 tests/sex-programs/fixpoint.sex diff --git a/Makefile b/Makefile index 56e9a9f..759bb42 100644 --- a/Makefile +++ b/Makefile @@ -94,7 +94,7 @@ sextest: cp ./tools/sextest/sextest . SEX_TEST_PROGRAMS = hello-world lists comments unicode serialize features \ - feature-flags lambdas compound-literals + feature-flags lambdas compound-literals closures fixpoint # Multi-module linking is checked end to end; see tests/modules/Makefile. check-modules: sexc diff --git a/example/lambdas.sex b/example/lambdas.sex index 676eef2..25e337f 100644 --- a/example/lambdas.sex +++ b/example/lambdas.sex @@ -3,6 +3,12 @@ (fn sum ((a int) (b int)) int (return (+ a b))) +;;; A lambda captures nothing and is a bare function pointer; a closure +;;; captures and is a value carrying its own environment +(fn make-adder ((a int)) (closure ((int)) int) + (return (closure ((b int)) int (a) + (return (+ a b))))) + (pub fn main () int (var a int 10) (var b int 20) @@ -36,13 +42,7 @@ (return (+ 600 (l-2 a))))) (printf "Calling nested lambdas: %d\n" (l-1 6)) - ;; Not supported yet -- captures belong to `closure' now, see - ;; Function-values.org - ;; (fn make-adder ((a int)) (closure ((int)) int) - ;; (return (closure ((b int)) int (a) - ;; (return (+ a b))))) - ;; - ;; (var add-10 (closure ((int)) int) (make-adder 10)) - ;; (var add-20 (closure ((int)) int) (make-adder 20)) - ;; (printf "Calling closures: %d %d\n" (add-10 24) (add-20 24)) + (var add-10 (closure ((int)) int) (make-adder 10)) + (var add-20 (closure ((int)) int) (make-adder 20)) + (printf "Calling closures: %d %d\n" (add-10 24) (add-20 24)) (return 0)) diff --git a/semen.scm b/semen.scm index 0872ff5..7c79852 100644 --- a/semen.scm +++ b/semen.scm @@ -17,6 +17,7 @@ ) (export/rename (process semen-process)) +(export closure-env-declaration) ;;; for lambda extraction, docstring processing, macro expansion, ;;; injection of module headers, i.e. all things that rearrange code @@ -37,8 +38,18 @@ (macroexpand (car forms) (cdr forms)) acc)) (else - (process-rec (cdr forms) - (match-sex-form (car forms) acc))))) + ;; A closure type's struct is emitted before the toplevel form that + ;; first mentioned it, which is why the new forms are lifted off and + ;; the structs slide underneath them + (let* ((processed (match-sex-form (car forms) acc)) + (new (take-until processed acc))) + (process-rec (cdr forms) + (append new (flush-closure-structs!) acc)))))) + +(define (take-until forms tail) + (if (eq? forms tail) + (list) + (cons (car forms) (take-until (cdr forms) tail)))) (define (macroexpand macro-form rest-forms) ;; We want to replace macro with its expansion. The problem is, @@ -225,7 +236,7 @@ (extract-fn-docstring (strip-fn-header-comments sex-fn-raw)))) (let* ((expanded (macro-expand sex-fn)) (env (make-hash-table)) - (processed + (lifted (walk-form expanded fn-walker @@ -233,25 +244,133 @@ (set! (hash-table-ref env :fn-name) (sex-fn-name expanded)) (set! (hash-table-ref env :lambda-counter) 0) (set! (hash-table-ref env :lambda-aux-code) (list)) - env)))) + (set! (hash-table-ref env :var-types) + (declared-types (sex-fn-arglist expanded))) + env))) + (processed (rewrite-closure-calls-in-body lifted env))) (with-docstring doc processed (append (hash-table-ref env :lambda-aux-code) acc))))) +(define (declared-types arglist) + (let ((types (make-hash-table))) + (for-each (lambda (param) + (when (and (pair? param) (pair? (cdr param))) + (hash-table-set! types (first param) (second param)))) + arglist) + types)) + +(define (aux-name! env make) + (let ((counter (hash-table-ref env :lambda-counter))) + (set! (hash-table-ref env :lambda-counter) (+ counter 1)) + (make (hash-table-ref env :fn-name) counter))) + +(define (add-aux-code! env forms) + (set! (hash-table-ref env :lambda-aux-code) + (append forms (hash-table-ref env :lambda-aux-code)))) + (define (fn-walker form env) - (if (eq? 'lambda (car form)) - (let ((lambda-name (make-lambda-name (hash-table-ref env :fn-name) - (hash-table-ref env :lambda-counter)))) - (set! (hash-table-ref env :lambda-aux-code) - (append (lift-lambda lambda-name form) - (hash-table-ref env :lambda-aux-code))) - (set! (hash-table-ref env :lambda-counter) - (+ (hash-table-ref env :lambda-counter) 1)) - lambda-name) - form)) + (let ((head (car form))) + (cond + ((eq? 'lambda head) + (let ((name (aux-name! env make-lambda-name))) + (add-aux-code! env (lift-lambda name form)) + name)) + + ;; a type, not an expression -- becomes the struct for its signature + ((closure-type? form) + (copy-form-source! form `(struct ,(register-closure-type! form form)))) + + ((eq? 'closure head) + (let ((base (aux-name! env make-closure-name))) + (let-values (((construct forms) (lift-closure base form env))) + (add-aux-code! env (fold match-sex-form (list) forms)) + (copy-form-source! form `(,construct ,@(fourth form)))))) + + ;; every binding site is written, so tracking the declarations is + ;; enough to know a receiver's type without inference + ((and (eq? 'var head) (>= (length form) 3)) + (hash-table-set! (hash-table-ref env :var-types) (second form) (third form)) + form) + + (else form)))) + +(define (rewrite-closure-calls-in-body fn-form env) + (let ((header (fn-header-length fn-form))) + (append (take fn-form header) + (map (lambda (form) (rewrite-closure-calls form env)) + (drop fn-form header))))) + +(define (rewrite-closure-calls form env) + (if (not (list? form)) + form + (let ((type (and (pair? form) (receiver-closure-type (car form) env))) + (rewrite (lambda (sub) (rewrite-closure-calls sub env)))) + (copy-form-source! + form + (if type + `(,(register-closure-call! type form) + ,(rewrite (car form)) + ,@(map rewrite (cdr form))) + (map rewrite form)))))) + +;;; A closure type has two spellings: `(closure ...)' as written, and +;;; `(struct ƛ...)' once resolved -- which is what a struct +;;; field holds, since the type database is populated after resolution. +;;; Both name the same thing, so a receiver is recognised either way. +(define (as-closure-type type) + (cond + ((closure-type? type) type) + ((and (list? type) (= 2 (length type)) (eq? 'struct (car type))) + (hash-table-ref/default +closure-structs+ (second type) #f)) + (else #f))) + +(define (receiver-closure-type expr env) + (as-closure-type (expression-type expr env))) + +;;; The type of an lvalue path, from known declarations -- a name, and +;;; what can be reached from one by subscripting, dereferencing and +;;; member access. +(define (expression-type expr env) + (cond + ((symbol? expr) + (hash-table-ref/default (hash-table-ref env :var-types) expr #f)) + ((not (and (list? expr) (>= (length expr) 2))) #f) + (else + (case (car expr) + ((¤) (let ((base (expression-type (second expr) env))) + (and (list? base) (>= (length base) 2) (eq? '¤ (car base)) + (second base)))) + ((*) (and (= 2 (length expr)) + (let ((base (expression-type (second expr) env))) + (and (list? base) (= 2 (length base)) (eq? '* (car base)) + (second base))))) + ((dot-access) (member-path-type (expression-type (second expr) env) + (cddr expr))) + ((->) (let ((base (expression-type (second expr) env))) + (and (list? base) (= 2 (length base)) (eq? '* (car base)) + (member-path-type (second base) (cddr expr))))) + (else #f))))) + +(define (member-path-type type fields) + (if (null? fields) + type + (member-path-type (field-type type (car fields)) (cdr fields)))) + +(define (field-type type field) + (let ((name (cond ((symbol? type) type) + ((and (list? type) + (= 2 (length type)) + (memq (car type) '(struct union))) + (second type)) + (else #f)))) + (and name + (let* ((fields (get-fields name)) + (entry (and fields (assq field fields)))) + (and entry (second entry)))))) (define (make-lambda-name enclosing-fn-name counter) (string->symbol - (fmt #f "__lambda_" counter "_" enclosing-fn-name))) + (fmt #f "λ" counter "_" enclosing-fn-name))) (define (lift-lambda name form) (match form @@ -260,13 +379,255 @@ (list))) (else (sex-error form "malformed lambda" form)))) +;;; Closures +;;; +;;; A closure is a function pointer and an inline environment, so the +;;; value owns its captures and nothing is allocated. The type +;;; `(closure ((int)) int)' becomes one struct per signature, shared by +;;; every closure with that signature. The captures live in `env' as a record +;;; only the lifted body knows the shape of, which is why `env' is +;;; max_align_t rather than char -- it has to be aligned for whatever +;;; ends up in it. +;;; +;;; The expression becomes three hoisted definitions -- the capture +;;; struct, the lifted body, and a constructor -- and is replaced by a +;;; call to the constructor, so the captures are evaluated as ordinary +;;; arguments at the point the closure is written. + +;;; How much of a closure is environment, in bytes. Counted in bytes +;;; so a closure that fits where it was written will also fit +;;; elsewhere. Captures are only by value, and never allocated on +;;; heap. Anything that is more than 16 bytes should be stored as a +;;; pointer, and memory management is entirely up to caller + +(define +closure-env-bytes+ 16) + +;;; +closure-env-bytes+ for maximum capacity, max-align-t for +;;; effectiveness, hence union +(define +closure-env-type+ 'ƛenv) + +(define (closure-env-declaration) + `(union ,+closure-env-type+ ((align max-align-t) + (bytes (¤ char ,+closure-env-bytes+))))) + +(define +closure-structs+ (make-hash-table)) +(define +closure-forwards+ (make-hash-table)) +(define *pending-closure-structs* (list)) + +(define (closure-type? form) + (and (pair? form) + (eq? 'closure (car form)) + (= 3 (length form)))) + +;;; A type spelling becomes an identifier deterministically, so two +;;; translation units have the same signatures for the same closure +;;; types: (* const char) -> p_const_char, (closure ((int)) int) -> +;;; closure_int_int. +(define (mangle-type type) + (cond + ((symbol? type) (mangle-word (symbol->string type))) + ((number? type) (number->string type)) + ((null? type) "void") + ((pair? type) (string-intersperse (map mangle-type (mangle-head type)) "_")) + (else (sex-error type "cannot mangle type" type)))) + +(define (mangle-head type) + (case (car type) + ((*) (cons 'p (cdr type))) + ((¤) (cons 'a (cdr type))) + (else type))) + +(define (mangle-word word) + (list->string + (map (lambda (c) + (if (or (char-alphabetic? c) (char-numeric? c)) c #\_)) + (string->list word)))) + +(define (aggregates-in type) + (cond + ((not (list? type)) (list)) + ((and (= 2 (length type)) + (memq (car type) '(struct union)) + (symbol? (second type))) + (list type)) + (else (append-map aggregates-in type)))) + +;;; Extract aggregate types from the closure's signature to forward +;;; declare them before the closure, so they can be referenced in the +;;; closure. Particularly useful for complex cases like fixed point +;;; combinator, etc. +(define (forward-declare-aggregates! type src-form) + (for-each + (lambda (aggregate) + (let ((name (second aggregate))) + (unless (or (hash-table-exists? +closure-forwards+ name) + (get-tag-info name)) + (hash-table-set! +closure-forwards+ name #t) + (set! *pending-closure-structs* + (cons (copy-form-source! src-form aggregate) + *pending-closure-structs*))))) + (delete-duplicates (aggregates-in type)))) + +(define (closure-struct-name type) + ;; the glyph says `closure' already, so the tag is just the signature + (string->symbol (string-append "ƛ" + (mangle-type (second type)) + "_" + (mangle-type (third type))))) + +;;; The code pointer takes the environment first; everything else is +;;; the closure's own signature. +(define (closure-code-type type) + `(fn (((* void)) ,@(second type)) ,(third type))) + +;;; Emitted once per signature, before the toplevel form that first +;;; needed it. +(define (register-closure-type! type src-form) + (let ((name (closure-struct-name type))) + (unless (hash-table-exists? +closure-structs+ name) + (forward-declare-aggregates! type src-form) + (hash-table-set! +closure-structs+ name type) + (let ((form (copy-form-source! + src-form + `(struct ,name ((code ,(closure-code-type type)) + (env (union ,+closure-env-type+))))))) + (register-aggregate! form) + (set! *pending-closure-structs* + (cons form *pending-closure-structs*)))) + name)) + +;;; Every closure type in FORM becomes the struct for its signature, +;;; registering it on the way. The walker does this for function bodies +;;; and headers; globals come through here instead. +(define (resolve-closure-types form) + (cond + ((closure-type? form) + (copy-form-source! form `(struct ,(register-closure-type! form form)))) + ((list? form) + (copy-form-source! form (map resolve-closure-types form))) + (else form))) + +(define +closure-calls+ (make-hash-table)) + +;;; The helper a closure call is routed through: `(f 1)' becomes +;;; `ƛint_int_call(f, 1)', which unpacks the receiver into +;;; `ƛc.code(&ƛc.env, ƛa0)' inside. The receiver arrives as an argument, +;;; so it is evaluated once: unpacked at the call site instead, +;;; `([table (++ i)] 10)' would read +;;; `table[++i].code(&table[++i].env, 10)' and bump `i' twice. +(define (register-closure-call! type src-form) + (let* ((closure (closure-struct-name type)) + (helper (suffixed closure "_call")) + (returns (third type)) + (params (map (lambda (arg index) + (list (string->symbol (fmt #f "ƛa" index)) + (unwrap-type arg))) + (second type) + (iota (length (second type)))))) + (unless (hash-table-ref/default +closure-calls+ helper #f) + (hash-table-set! +closure-calls+ helper #t) + (let ((call `((dot-access ƛc code) + (& (dot-access ƛc env)) + ,@(map first params)))) + (set! *pending-closure-structs* + (cons (copy-form-source! + src-form + `(fn ,helper ((ƛc (struct ,closure)) ,@params) ,returns + ,(if (eq? 'void returns) call `(return ,call)))) + *pending-closure-structs*)))) + helper)) + +;;; An argument type is written wrapped: `(int)' in `((int) (float))' +(define (unwrap-type type) + (if (and (list? type) (= 1 (length type))) + (car type) + type)) + +(define (flush-closure-structs!) + (let ((pending *pending-closure-structs*)) + (set! *pending-closure-structs* (list)) + pending)) + +;;; Lowering + +(define (make-closure-name enclosing-fn-name counter) + (string->symbol (fmt #f "ƛ" counter "_" enclosing-fn-name))) + +(define (suffixed name suffix) + (string->symbol (string-append (symbol->string name) suffix))) + +;;; A capture is a plain name, whose type comes from the declarations +;;; the walker has passed. `(name expr)' captures want the type of an +;;; expression, which is inference, and wait for it. +(define (capture-binding capture form env) + (unless (symbol? capture) + (sex-error form "a closure capture must be a plain name for now" capture)) + (let ((type (hash-table-ref/default (hash-table-ref env :var-types) capture #f))) + (unless type + (sex-error form "closure captures an undeclared name" capture)) + (list capture type))) + +(define (lift-closure base form env) + (match form + (('closure arglist ret-type captures . body) + (let* ((caps (map (lambda (c) (capture-binding c form env)) captures)) + (record (suffixed base "_captures")) + (code (suffixed base "_code")) + (construct (suffixed base "_make")) + (type `(closure ,(map (lambda (p) (list (second p))) arglist) + ,ret-type)) + (closure (register-closure-type! type form))) + (values + construct + (map (lambda (f) (copy-form-source! form f)) + ;; C has no empty struct, and a closure over nothing needs + ;; no record to point at + (append + (if (null? caps) + (list) + (list `(struct ,record ,caps))) + + (list + `(fn ,code ((ƛe (* void)) ,@arglist) ,ret-type + ,@(if (null? caps) + (list) + `((var ƛcaptures (* (struct ,record)) ƛe) + ,@(map (lambda (cap) + `(var ,(first cap) ,(second cap) + (-> ƛcaptures ,(first cap)))) + caps))) + ,@body) + + `(fn ,construct ,caps (struct ,closure) + (var ƛc (struct ,closure)) + ,@(if (null? caps) + (list) + `((static-assert + (<= (sizeof (struct ,record)) + (sizeof (dot-access ƛc env))) + "closure captures do not fit the inline environment"))) + (= (dot-access ƛc code) ,code) + ,@(if (null? caps) + (list) + `((var ƛcaptures (* (struct ,record)) + (cast (& (dot-access ƛc env)) (* (struct ,record)))) + ,@(map (lambda (cap) + `(= (-> ƛcaptures ,(first cap)) ,(first cap))) + caps))) + (return ƛc)))))))) + (else (sex-error form "malformed closure" form)))) + ;;; Structs ;;; Record the named structs, unions and enums in the type database (define (process-struct sex-struct acc) (let-values (((doc form) (extract-aggregate-docstring sex-struct))) - (register-aggregate! form) - (with-docstring doc form acc))) + ;; Resolve before registering: a field of closure type has to reach + ;; the type database as the struct it becomes, or member access + ;; through it finds nothing + (let ((form (resolve-closure-types form))) + (register-aggregate! form) + (with-docstring doc form acc)))) (define (register-aggregate! form) (let* ((f (if (eq? (car form) 'pub) (cdr form) form)) @@ -280,7 +641,9 @@ ((enum) (add-enum name form)))))) (define (process-global-var sex-var acc) - (cons sex-var acc)) + ;; A global is not walked for lambdas, but its type still has to stop + ;; saying `closure' before the writer sees it + (cons (resolve-closure-types sex-var) acc)) ;;; Utils (define (non-empty-list? form) diff --git a/sexc.scm b/sexc.scm index 3bb54ae..ac612a0 100644 --- a/sexc.scm +++ b/sexc.scm @@ -175,17 +175,22 @@ status, which is ours to pass on." (semen-process raw-forms)))) (define prelude - '((include inttypes.h) - (include stdbool.h) + (append + '((include inttypes.h) + (include stdbool.h) + (include stddef.h) ; max_align_t, for closure environments + (typedef u8 uint8-t) + (typedef i8 int8-t) + (typedef u16 uint16-t) + (typedef i16 int16-t) + (typedef u32 uint32-t) + (typedef i32 int32-t) + (typedef u64 uint64-t) + (typedef i64 int64-t)) - (typedef u8 uint8-t) - (typedef i8 int8-t) - (typedef u16 uint16-t) - (typedef i16 int16-t) - (typedef u32 uint32-t) - (typedef i32 int32-t) - (typedef u64 uint64-t) - (typedef i64 int64-t))) + ;; The closure environment is the part of the ABI, so include it in + ;; every module + (list (closure-env-declaration)))) (define (main) (let* ((argv (command-line-arguments)) diff --git a/tests/codegen.scm b/tests/codegen.scm index f43a255..d103dd4 100644 --- a/tests/codegen.scm +++ b/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)")))) diff --git a/tests/modules/Makefile b/tests/modules/Makefile index bd1e966..5ff1468 100644 --- a/tests/modules/Makefile +++ b/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 diff --git a/tests/modules/greet-app.sex b/tests/modules/greet-app.sex index 6229e91..5903f81 100644 --- a/tests/modules/greet-app.sex +++ b/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)) diff --git a/tests/modules/greet.sex b/tests/modules/greet.sex index 50c1aa0..43da31e 100644 --- a/tests/modules/greet.sex +++ b/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")) diff --git a/tests/sex-programs/closures.sex b/tests/sex-programs/closures.sex new file mode 100644 index 0000000..815d8c9 --- /dev/null +++ b/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)) diff --git a/tests/sex-programs/fixpoint.sex b/tests/sex-programs/fixpoint.sex new file mode 100644 index 0000000..84d8f4f --- /dev/null +++ b/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))