spec: promises — delay/force/delay-force/make-promise/promise?
25 tests pass on OCaml (4357 total) and JS. Promise represented as
mutable dict {:_promise true :forced :thunk :value}; delay-force
adds :_iterative for chain-following semantics.
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -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
|
||||
|
||||
(* ====================================================================== *)
|
||||
|
||||
@@ -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)))
|
||||
|
||||
|
||||
|
||||
@@ -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;
|
||||
|
||||
@@ -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
|
||||
|
||||
150
spec/tests/test-promises.sx
Normal file
150
spec/tests/test-promises.sx
Normal file
@@ -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))))))
|
||||
Reference in New Issue
Block a user