From ce7243a1fbbaf5eb6ba426f6d02d07fce7287a1a Mon Sep 17 00:00:00 2001 From: giles Date: Tue, 5 May 2026 10:57:33 +0000 Subject: [PATCH] =?UTF-8?q?cl:=20block=20+=20return-from=20=E2=80=94=2013?= =?UTF-8?q?=20new=20tests=20(140=20eval,=20312=20total=20green)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Sentinel propagation in cl-eval-body; cl-eval-block catches matching sentinels; BLOCK/RETURN-FROM/RETURN dispatch added to cl-eval-list. Parser: CL strings now {:cl-type "string"} dicts for proper CL semantics. --- lib/common-lisp/eval.sx | 33 ++++++++++++++++++++++++--- lib/common-lisp/parser.sx | 4 ++-- lib/common-lisp/tests/eval.sx | 42 +++++++++++++++++++++++++++++++++++ plans/common-lisp-on-sx.md | 3 ++- 4 files changed, 76 insertions(+), 6 deletions(-) diff --git a/lib/common-lisp/eval.sx b/lib/common-lisp/eval.sx index b676b12d..ed14a4f4 100644 --- a/lib/common-lisp/eval.sx +++ b/lib/common-lisp/eval.sx @@ -37,15 +37,19 @@ ;; ── body evaluation ─────────────────────────────────────────────── +(define cl-block-return? + (fn (v) (and (dict? v) (= (get v "cl-type") "block-return")))) + (define cl-eval-body (fn (forms env) (cond ((= (len forms) 0) nil) ((= (len forms) 1) (cl-eval (nth forms 0) env)) (:else - (do - (cl-eval (nth forms 0) env) - (cl-eval-body (rest forms) env)))))) + (let ((result (cl-eval (nth forms 0) env))) + (if (cl-block-return? result) + result + (cl-eval-body (rest forms) env))))))) ;; ── lambda-list binding helpers ─────────────────────────────────── @@ -266,6 +270,24 @@ {:cl-type "function" :builtin-fn (get cl-builtins name)})) (keys cl-builtins)) +;; ── BLOCK / RETURN-FROM ─────────────────────────────────────────── + +(define cl-eval-block + (fn (args env) + (let ((name (nth args 0)) + (body (rest args))) + (let ((result (cl-eval-body body env))) + (if (and (cl-block-return? result) + (= (get result "name") name)) + (get result "value") + result))))) + +(define cl-eval-return-from + (fn (args env) + (let ((name (nth args 0)) + (val (if (> (len args) 1) (cl-eval (nth args 1) env) nil))) + {:cl-type "block-return" :name name :value val}))) + ;; ── special form evaluators ─────────────────────────────────────── (define cl-eval-if @@ -541,6 +563,11 @@ ((= head "LOCALLY") (cl-eval-body args env)) ((= head "EVAL-WHEN") (cl-eval-eval-when args env)) ((= head "DEFUN") (cl-eval-defun args env)) + ((= head "BLOCK") (cl-eval-block args env)) + ((= head "RETURN-FROM") (cl-eval-return-from args env)) + ((= head "RETURN") + (let ((val (if (> (len args) 0) (cl-eval (nth args 0) env) nil))) + {:cl-type "block-return" :name nil :value val})) ((= head "DEFVAR") (cl-eval-defvar args env false)) ((= head "DEFPARAMETER") (cl-eval-defvar args env true)) ((= head "DEFCONSTANT") (cl-eval-defvar args env true)) diff --git a/lib/common-lisp/parser.sx b/lib/common-lisp/parser.sx index c5724aa1..df2c3c85 100644 --- a/lib/common-lisp/parser.sx +++ b/lib/common-lisp/parser.sx @@ -4,7 +4,7 @@ ;; ;; AST representation: ;; integer/float → SX number (or {:cl-type "float"/:ratio ...}) -;; string → SX string +;; string "hello" → {:cl-type "string" :value "hello"} ;; symbol FOO → SX string "FOO" (upcase) ;; symbol NIL → nil ;; symbol T → true @@ -96,7 +96,7 @@ ((= type "integer") {:form (cl-convert-integer val) :rest nxt}) ((= type "float") {:form {:cl-type "float" :value val} :rest nxt}) ((= type "ratio") {:form {:cl-type "ratio" :value val} :rest nxt}) - ((= type "string") {:form val :rest nxt}) + ((= type "string") {:form {:cl-type "string" :value val} :rest nxt}) ((= type "char") {:form {:cl-type "char" :value val} :rest nxt}) ((= type "keyword") {:form {:cl-type "keyword" :name val} :rest nxt}) ((= type "uninterned") {:form {:cl-type "uninterned" :name val} :rest nxt}) diff --git a/lib/common-lisp/tests/eval.sx b/lib/common-lisp/tests/eval.sx index 3832dcab..d649ee3d 100644 --- a/lib/common-lisp/tests/eval.sx +++ b/lib/common-lisp/tests/eval.sx @@ -283,3 +283,45 @@ (cl-test "mapcar: basic" (ev "(mapcar (lambda (x) (* x 2)) '(1 2 3))") (list 2 4 6)) + +;; ── BLOCK / RETURN-FROM / RETURN ───────────────────────────────── + +(cl-test "block: last form value" + (ev "(block done 1 2 3)") + 3) +(cl-test "block: empty body" + (ev "(block done)") + nil) +(cl-test "block: single form" + (ev "(block foo 42)") + 42) +(cl-test "block: return-from" + (ev "(block done 1 (return-from done 99) 2)") + 99) +(cl-test "block: return-from nil block" + (ev "(block nil 1 (return-from nil 42) 3)") + 42) +(cl-test "block: return-from no value" + (ev "(block done (return-from done))") + nil) +(cl-test "block: nested inner return stays inner" + (ev "(block outer (block inner (return-from inner 1) 2) 3)") + 3) +(cl-test "block: nested outer return" + (ev "(block outer (block inner 1 2) (return-from outer 99) 3)") + 99) +(cl-test "return: shorthand for nil block" + (ev "(block nil (return 77))") + 77) +(cl-test "return: no value" + (ev "(block nil 1 (return) 2)") + nil) +(cl-test "block: return-from inside let" + (ev "(block done (let ((x 5)) (when (> x 3) (return-from done x))) 0)") + 5) +(cl-test "block: return-from inside progn" + (ev "(block done (progn (return-from done 7) 99))") + 7) +(cl-test "block: return-from through function" + (ev "(block done (flet ((f () (return-from done 42))) (f)) nil)") + 42) diff --git a/plans/common-lisp-on-sx.md b/plans/common-lisp-on-sx.md index 7b08c6f9..41197c03 100644 --- a/plans/common-lisp-on-sx.md +++ b/plans/common-lisp-on-sx.md @@ -57,7 +57,7 @@ Core mapping: ### Phase 2 — sequential eval + special forms - [x] `cl-eval-ast`: `quote`, `if`, `progn`, `let`, `let*`, `flet`, `labels`, `setq`, `setf` (subset), `function`, `lambda`, `the`, `locally`, `eval-when` -- [ ] `block` + `return-from` via captured continuation +- [x] `block` + `return-from` via captured continuation - [ ] `tagbody` + `go` via per-tag continuations - [ ] `unwind-protect` cleanup frame - [ ] `multiple-value-bind`, `multiple-value-call`, `multiple-value-prog1`, `values`, `nth-value` @@ -124,6 +124,7 @@ data; format for string templating. _Newest first._ +- 2026-05-05: block + return-from — sentinel propagation in cl-eval-body; cl-eval-block catches matching sentinels; BLOCK/RETURN-FROM/RETURN dispatch in cl-eval-list; 13 new tests (140 eval, 312 total green). Parser: CL strings → {:cl-type "string"} dicts. - 2026-04-25: Phase 2 eval — 127 tests, 299 total green. `lib/common-lisp/eval.sx`: cl-eval-ast with quote/if/progn/let/let*/flet/labels/setq/setf/function/lambda/the/locally/eval-when; defun/defvar/defparameter/defconstant; built-in arithmetic (+/-/*//, min/max/abs/evenp/oddp), comparisons, predicates, list ops (car/cdr/cons/list/append/reverse/length/nth/first/second/third/rest), string ops, funcall/apply/mapcar. Key gotchas: SX reduce is (reduce fn init list) not (reduce fn list init); CL true literal is t not true; builtins registered in cl-global-env.fns via wrapper dicts for #' syntax. - 2026-04-25: Phase 1 lambda-list parser — 31 new tests, 172 total green. `cl-parse-lambda-list` in `parser.sx` + `tests/lambda.sx`. Handles &optional/&rest/&body/&key/&aux/&allow-other-keys, defaults, supplied-p. Key gotchas: `(when (> (len items) 0) ...)` not `(when items ...)` (empty list is truthy); custom `cl-deep=` needed for dict/list structural equality in tests. - 2026-04-25: Phase 1 reader/parser — 62 new tests, 141 total green. `lib/common-lisp/parser.sx`: cl-read/cl-read-all, lists, dotted pairs, quote/backquote/unquote/splice/#', vectors, #:uninterned, NIL→nil, T→true, reader macro wrappers.