diff --git a/hosts/ocaml/bin/run_tests.ml b/hosts/ocaml/bin/run_tests.ml index c002aa24..37fc6620 100644 --- a/hosts/ocaml/bin/run_tests.ml +++ b/hosts/ocaml/bin/run_tests.ml @@ -1141,6 +1141,26 @@ let make_test_env () = Sx_ref.cek_call consumer (List spread) | _ -> raise (Eval_error "call-with-values: expected 2 args")); + bind "promise?" (fun args -> + match args with + | [v] -> Bool (Sx_ref.is_promise v) + | _ -> Bool false); + + bind "make-promise" (fun args -> + match args with + | [v] -> + let d = Hashtbl.create 4 in + Hashtbl.replace d "_promise" (Bool true); + Hashtbl.replace d "forced" (Bool true); + Hashtbl.replace d "value" v; + Dict d + | _ -> Nil); + + bind "force" (fun args -> + match args with + | [p] -> Sx_ref.force_promise p + | _ -> Nil); + env (* ====================================================================== *) diff --git a/hosts/ocaml/lib/sx_ref.ml b/hosts/ocaml/lib/sx_ref.ml index 2ede8ea6..bdb0988f 100644 --- a/hosts/ocaml/lib/sx_ref.ml +++ b/hosts/ocaml/lib/sx_ref.ml @@ -1161,4 +1161,59 @@ let () = ignore (register_special_form (String "define-values") | [args; env] -> sf_define_values args env | _ -> Nil))) +(* Phase 9: Promises — delay/force/delay-force/make-promise/promise? *) + +let make_promise_dict ?(iterative=false) thunk = + let d = Hashtbl.create 4 in + Hashtbl.replace d "_promise" (Bool true); + Hashtbl.replace d "forced" (Bool false); + Hashtbl.replace d "thunk" thunk; + Hashtbl.replace d "value" Nil; + if iterative then Hashtbl.replace d "_iterative" (Bool true); + Dict d + +let sf_delay args env_val = + let expr = match args with List (e :: _) -> e | _ -> Nil in + let thunk = make_lambda (List []) expr env_val in + make_promise_dict thunk + +let sf_delay_force args env_val = + let expr = match args with List (e :: _) -> e | _ -> Nil in + let thunk = make_lambda (List []) expr env_val in + make_promise_dict ~iterative:true thunk + +let is_promise v = + match v with + | Dict d -> (match Hashtbl.find_opt d "_promise" with Some (Bool true) -> true | _ -> false) + | _ -> false + +let rec force_promise p = + if not (is_promise p) then p + else match p with + | Dict d -> + (match Hashtbl.find_opt d "forced" with + | Some (Bool true) -> + (match Hashtbl.find_opt d "value" with Some v -> v | None -> Nil) + | _ -> + let thunk = (match Hashtbl.find_opt d "thunk" with Some t -> t | None -> Nil) in + let result = cek_call thunk (List []) in + let iterative = (match Hashtbl.find_opt d "_iterative" with Some (Bool true) -> true | _ -> false) in + let final_val = if iterative && is_promise result then force_promise result else result in + Hashtbl.replace d "forced" (Bool true); + Hashtbl.replace d "value" final_val; + final_val) + | _ -> p + +let () = ignore (register_special_form (String "delay") + (NativeFn ("delay", fun call_args -> + match call_args with + | [args; env] -> sf_delay args env + | _ -> Nil))) + +let () = ignore (register_special_form (String "delay-force") + (NativeFn ("delay-force", fun call_args -> + match call_args with + | [args; env] -> sf_delay_force args env + | _ -> Nil))) + diff --git a/shared/static/scripts/sx-browser.js b/shared/static/scripts/sx-browser.js index f5702e87..92b0cf3d 100644 --- a/shared/static/scripts/sx-browser.js +++ b/shared/static/scripts/sx-browser.js @@ -31,7 +31,7 @@ // ========================================================================= var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } }); - var SX_VERSION = "2026-05-01T07:58:35Z"; + var SX_VERSION = "2026-05-01T08:18:20Z"; function isNil(x) { return x === NIL || x === null || x === undefined; } function isSxTruthy(x) { return x !== false && !isNil(x); } @@ -2253,6 +2253,46 @@ PRIMITIVES["step-eval-list"] = stepEvalList; })(); }; PRIMITIVES["sf-define-type"] = sfDefineType; + // sf-delay + var sfDelay = function(args, env) { return (function() { + var thunk = makeLambda([], first(args), env); + return {"forced": false, "value": NIL, "thunk": thunk, "_promise": true}; +})(); }; +PRIMITIVES["sf-delay"] = sfDelay; + + // sf-delay-force + var sfDelayForce = function(args, env) { return (function() { + var thunk = makeLambda([], first(args), env); + return {"_iterative": true, "forced": false, "value": NIL, "thunk": thunk, "_promise": true}; +})(); }; +PRIMITIVES["sf-delay-force"] = sfDelayForce; + + // promise? + var promise_p = function(v) { return (isSxTruthy(isDict(v)) && get(v, "_promise", false)); }; +PRIMITIVES["promise?"] = promise_p; + + // make-promise + var makePromise = function(v) { return {"forced": true, "value": v, "_promise": true}; }; +PRIMITIVES["make-promise"] = makePromise; + + // force + var force = function(p) { return (isSxTruthy(!isSxTruthy(promise_p(p))) ? p : (isSxTruthy(get(p, "forced", false)) ? get(p, "value", NIL) : (function() { + var result = apply(get(p, "thunk", NIL), []); + return (function() { + var final_ = (isSxTruthy((isSxTruthy(get(p, "_iterative", false)) && promise_p(result))) ? force(result) : result); + p["forced"] = true; + p["value"] = final_; + return final_; +})(); +})())); }; +PRIMITIVES["force"] = force; + + // (register-special-form! ...) + registerSpecialForm("delay", sfDelay); + + // (register-special-form! ...) + registerSpecialForm("delay-force", sfDelayForce); + // values var values = function() { var vs = Array.prototype.slice.call(arguments, 0); return (isSxTruthy(sxEq(len(vs), 1)) ? first(vs) : {"_values": true, "_list": vs}); }; PRIMITIVES["values"] = values; diff --git a/spec/evaluator.sx b/spec/evaluator.sx index 7d072254..4bc83401 100644 --- a/spec/evaluator.sx +++ b/spec/evaluator.sx @@ -2037,8 +2037,10 @@ nil)))) (define - values - (fn (&rest vs) (if (= (len vs) 1) (first vs) {:_values true :_list vs}))) + sf-delay + (fn + (args env) + (let ((thunk (make-lambda (list) (first args) env))) {:forced false :value nil :thunk thunk :_promise true}))) ;; ═══════════════════════════════════════════════════════════════ ;; Part 11: Entry Points @@ -2047,6 +2049,42 @@ ;; eval-expr / trampoline: top-level bindings that override the ;; forward declarations from Part 5. ;; ═══════════════════════════════════════════════════════════════ +(define + sf-delay-force + (fn + (args env) + (let ((thunk (make-lambda (list) (first args) env))) {:_iterative true :forced false :value nil :thunk thunk :_promise true}))) + +(define promise? (fn (v) (and (dict? v) (get v :_promise false)))) + +(define make-promise (fn (v) {:forced true :value v :_promise true})) + +(define + force + (fn + (p) + (if + (not (promise? p)) + p + (if + (get p :forced false) + (get p :value nil) + (let + ((result (apply (get p :thunk nil) (list)))) + (let + ((final (if (and (get p :_iterative false) (promise? result)) (force result) result))) + (dict-set! p :forced true) + (dict-set! p :value final) + final)))))) + +(register-special-form! "delay" sf-delay) + +(register-special-form! "delay-force" sf-delay-force) + +(define + values + (fn (&rest vs) (if (= (len vs) 1) (first vs) {:_values true :_list vs}))) + (register-special-form! "define-type" sf-define-type) (define diff --git a/spec/tests/test-promises.sx b/spec/tests/test-promises.sx new file mode 100644 index 00000000..d830c60e --- /dev/null +++ b/spec/tests/test-promises.sx @@ -0,0 +1,150 @@ +(defsuite + "promises" + (deftest + "delay creates a promise" + (do (assert (promise? (delay 42))))) + (deftest + "delay does not evaluate immediately" + (do + (let + ((count 0)) + (let + ((p (delay (do (set! count (+ count 1)) count)))) + (assert= 0 count))))) + (deftest + "force evaluates the expression" + (do (assert= 42 (force (delay 42))))) + (deftest + "force with arithmetic" + (do (assert= 10 (force (delay (+ 3 7)))))) + (deftest + "force memoises result" + (do + (let + ((count 0)) + (let + ((p (delay (do (set! count (+ count 1)) count)))) + (force p) + (force p) + (assert= 1 count))))) + (deftest + "force returns same value on repeated calls" + (do + (let + ((p (delay (+ 1 2)))) + (assert= 3 (force p)) + (assert= 3 (force p))))) + (deftest + "make-promise creates an already-forced promise" + (do + (let + ((p (make-promise 99))) + (assert (promise? p)) + (assert= 99 (force p))))) + (deftest + "make-promise memoises without evaluating" + (do + (let + ((count 0)) + (let + ((p (make-promise 42))) + (force p) + (force p) + (assert= 0 count))))) + (deftest + "promise? returns true for delay" + (do (assert (promise? (delay 1))))) + (deftest + "promise? returns true for make-promise" + (do (assert (promise? (make-promise 1))))) + (deftest + "promise? returns false for non-promise" + (do + (assert= false (promise? 42)) + (assert= false (promise? "hello")) + (assert= false (promise? nil)) + (assert= false (promise? (list 1 2))))) + (deftest + "force non-promise returns value unchanged" + (do + (assert= 42 (force 42)) + (assert= "hi" (force "hi")) + (assert= nil (force nil)))) + (deftest + "delay captures environment" + (do + (let + ((x 10)) + (let + ((p (delay (+ x 5)))) + (assert= 15 (force p)))))) + (deftest + "delay-force basic" + (do (assert= 42 (force (delay-force (delay 42)))))) + (deftest + "delay-force chains" + (do + (assert= + 5 + (force (delay-force (delay-force (delay 5))))))) + (deftest + "delay with string" + (do (assert= "hello" (force (delay "hello"))))) + (deftest + "delay with list" + (do + (assert-equal + (list 1 2 3) + (force (delay (list 1 2 3)))))) + (deftest + "delay with function call" + (do (assert= 6 (force (delay (* 2 3)))))) + (deftest + "nested delay" + (do + (let + ((p (delay (delay 99)))) + (assert (promise? (force p)))))) + (deftest + "force already forced promise" + (do + (let + ((p (make-promise 7))) + (assert= 7 (force p)) + (assert= 7 (force p))))) + (deftest + "lazy stream first element" + (do + (define (stream-cons x s) (delay (list x s))) + (define (stream-car s) (first (force s))) + (define (stream-cdr s) (nth (force s) 1)) + (let + ((s (stream-cons 1 (stream-cons 2 (stream-cons 3 nil))))) + (assert= 1 (stream-car s)) + (assert= 2 (stream-car (stream-cdr s)))))) + (deftest + "delay-force is a promise" + (do (assert (promise? (delay-force (delay 1)))))) + (deftest + "force with side effects runs once" + (do + (let + ((log (list))) + (let + ((p (delay (do (set! log (cons 42 log)) 42)))) + (force p) + (force p) + (assert= 1 (len log)))))) + (deftest + "make-promise with nil" + (do + (let + ((p (make-promise nil))) + (assert (promise? p)) + (assert= nil (force p))))) + (deftest + "delay in let binding" + (do + (let + ((p (delay (+ 10 20)))) + (assert= 30 (force p)))))) \ No newline at end of file