ocaml: ADT support via bootstrap FIXUPS — define-type + match
Hand-write sf_define_type in bootstrap.py FIXUPS (skipped from transpile because the spec uses &rest params and empty-dict literals the transpiler can't emit). Registers define-type via register_special_form. Adds step_limit/step_count to PREAMBLE (referenced by sx_vm.ml/run_tests.ml). 172 assertions pass (test-adt). Full suite: 4280/1080 (was 4243/1117). Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -47,7 +47,9 @@ open Sx_runtime
|
|||||||
let trampoline_fn : (value -> value) ref = ref (fun v -> v)
|
let trampoline_fn : (value -> value) ref = ref (fun v -> v)
|
||||||
let trampoline v = !trampoline_fn v
|
let trampoline v = !trampoline_fn v
|
||||||
|
|
||||||
|
(* Step limit for timeout detection — set to 0 to disable *)
|
||||||
|
let step_limit : int ref = ref 0
|
||||||
|
let step_count : int ref = ref 0
|
||||||
|
|
||||||
(* === Mutable globals — backing refs for transpiler's !_ref / _ref := === *)
|
(* === Mutable globals — backing refs for transpiler's !_ref / _ref := === *)
|
||||||
let _strict_ref = ref (Bool false)
|
let _strict_ref = ref (Bool false)
|
||||||
@@ -126,6 +128,90 @@ let enhance_error_with_trace msg =
|
|||||||
_last_error_kont_ref := Nil;
|
_last_error_kont_ref := Nil;
|
||||||
msg ^ (format_comp_trace trace)
|
msg ^ (format_comp_trace trace)
|
||||||
|
|
||||||
|
(* Hand-written sf_define_type — skipped from transpile because the spec uses
|
||||||
|
&rest params and empty-dict literals that the transpiler can't emit cleanly.
|
||||||
|
Implements: (define-type Name (Ctor1 f1 f2) (Ctor2 f3) ...)
|
||||||
|
Creates constructor fns, Name?/Ctor? predicates, Ctor-field accessors,
|
||||||
|
and records ctors in *adt-registry*. *)
|
||||||
|
let sf_define_type args env_val =
|
||||||
|
let items = (match args with List l -> l | _ -> []) in
|
||||||
|
let type_sym = List.nth items 0 in
|
||||||
|
let type_name = value_to_string type_sym in
|
||||||
|
let ctor_specs = List.tl items in
|
||||||
|
let env_has_v k = sx_truthy (env_has env_val (String k)) in
|
||||||
|
let env_bind_v k v = ignore (env_bind env_val (String k) v) in
|
||||||
|
let env_get_v k = env_get env_val (String k) in
|
||||||
|
if not (env_has_v "*adt-registry*") then
|
||||||
|
env_bind_v "*adt-registry*" (Dict (Hashtbl.create 8));
|
||||||
|
let registry = env_get_v "*adt-registry*" in
|
||||||
|
let ctor_names = List.map (fun spec ->
|
||||||
|
(match spec with List (sym :: _) -> String (value_to_string sym) | _ -> Nil)
|
||||||
|
) ctor_specs in
|
||||||
|
(match registry with Dict d -> Hashtbl.replace d type_name (List ctor_names) | _ -> ());
|
||||||
|
env_bind_v (type_name ^ "?")
|
||||||
|
(NativeFn (type_name ^ "?", fun pargs ->
|
||||||
|
(match pargs with
|
||||||
|
| [v] ->
|
||||||
|
(match v with
|
||||||
|
| Dict d -> Bool (Hashtbl.mem d "_adt" &&
|
||||||
|
(match Hashtbl.find_opt d "_type" with Some (String t) -> t = type_name | _ -> false))
|
||||||
|
| _ -> Bool false)
|
||||||
|
| _ -> Bool false)));
|
||||||
|
List.iter (fun spec ->
|
||||||
|
(match spec with
|
||||||
|
| List (sym :: fields) ->
|
||||||
|
let cn = value_to_string sym in
|
||||||
|
let field_names = List.map value_to_string fields in
|
||||||
|
let arity = List.length fields in
|
||||||
|
env_bind_v cn
|
||||||
|
(NativeFn (cn, fun ctor_args ->
|
||||||
|
if List.length ctor_args <> arity then
|
||||||
|
raise (Eval_error (Printf.sprintf "%s: expected %d args, got %d"
|
||||||
|
cn arity (List.length ctor_args)))
|
||||||
|
else begin
|
||||||
|
let d = Hashtbl.create 4 in
|
||||||
|
Hashtbl.replace d "_adt" (Bool true);
|
||||||
|
Hashtbl.replace d "_type" (String type_name);
|
||||||
|
Hashtbl.replace d "_ctor" (String cn);
|
||||||
|
Hashtbl.replace d "_fields" (List ctor_args);
|
||||||
|
Dict d
|
||||||
|
end));
|
||||||
|
env_bind_v (cn ^ "?")
|
||||||
|
(NativeFn (cn ^ "?", fun pargs ->
|
||||||
|
(match pargs with
|
||||||
|
| [v] ->
|
||||||
|
(match v with
|
||||||
|
| Dict d -> Bool (Hashtbl.mem d "_adt" &&
|
||||||
|
(match Hashtbl.find_opt d "_ctor" with Some (String c) -> c = cn | _ -> false))
|
||||||
|
| _ -> Bool false)
|
||||||
|
| _ -> Bool false)));
|
||||||
|
List.iteri (fun idx fname ->
|
||||||
|
env_bind_v (cn ^ "-" ^ fname)
|
||||||
|
(NativeFn (cn ^ "-" ^ fname, fun pargs ->
|
||||||
|
(match pargs with
|
||||||
|
| [v] ->
|
||||||
|
(match v with
|
||||||
|
| Dict d ->
|
||||||
|
(match Hashtbl.find_opt d "_fields" with
|
||||||
|
| Some (List fs) ->
|
||||||
|
if idx < List.length fs then List.nth fs idx
|
||||||
|
else raise (Eval_error (cn ^ "-" ^ fname ^ ": index out of bounds"))
|
||||||
|
| _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": not an ADT")))
|
||||||
|
| _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": not a dict")))
|
||||||
|
| _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": expected 1 arg")))))
|
||||||
|
) field_names
|
||||||
|
| _ -> ())
|
||||||
|
) ctor_specs;
|
||||||
|
Nil
|
||||||
|
|
||||||
|
(* Register define-type via custom_special_forms so the CEK dispatch finds it.
|
||||||
|
The top-level (register-special-form! ...) in spec/evaluator.sx is not a
|
||||||
|
define and therefore is not transpiled; we wire it up here instead. *)
|
||||||
|
let () = ignore (register_special_form (String "define-type")
|
||||||
|
(NativeFn ("define-type", fun call_args ->
|
||||||
|
match call_args with
|
||||||
|
| [args; env] -> sf_define_type args env
|
||||||
|
| _ -> Nil)))
|
||||||
|
|
||||||
|
|
||||||
"""
|
"""
|
||||||
@@ -171,7 +257,10 @@ def compile_spec_to_ml(spec_dir: str | None = None) -> str:
|
|||||||
"debug-log", "debug_log", "range", "chunk-every", "zip-pairs",
|
"debug-log", "debug_log", "range", "chunk-every", "zip-pairs",
|
||||||
"string-contains?", "starts-with?", "ends-with?",
|
"string-contains?", "starts-with?", "ends-with?",
|
||||||
"string-replace", "trim", "split", "index-of",
|
"string-replace", "trim", "split", "index-of",
|
||||||
"pad-left", "pad-right", "char-at", "substring"}
|
"pad-left", "pad-right", "char-at", "substring",
|
||||||
|
# sf-define-type uses &rest + empty-dict literals that the transpiler
|
||||||
|
# can't emit as valid OCaml; hand-written implementation in FIXUPS.
|
||||||
|
"sf-define-type"}
|
||||||
defines = [(n, e) for n, e in defines if n not in skip]
|
defines = [(n, e) for n, e in defines if n not in skip]
|
||||||
|
|
||||||
# Deduplicate — keep last definition for each name (CEK overrides tree-walk)
|
# Deduplicate — keep last definition for each name (CEK overrides tree-walk)
|
||||||
|
|||||||
@@ -198,7 +198,7 @@ and make_or_frame remaining env =
|
|||||||
|
|
||||||
(* make-dynamic-wind-frame *)
|
(* make-dynamic-wind-frame *)
|
||||||
and make_dynamic_wind_frame phase body_thunk after_thunk env =
|
and make_dynamic_wind_frame phase body_thunk after_thunk env =
|
||||||
(CekFrame { cf_type = "dynamic-wind"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = phase; cf_extra2 = Nil })
|
(CekFrame { cf_type = "dynamic-wind"; cf_env = env; cf_name = Nil; cf_body = Nil; cf_remaining = Nil; cf_f = after_thunk; cf_args = Nil; cf_results = Nil; cf_extra = phase; cf_extra2 = Nil })
|
||||||
|
|
||||||
(* make-reactive-reset-frame *)
|
(* make-reactive-reset-frame *)
|
||||||
and make_reactive_reset_frame env update_fn first_render_p =
|
and make_reactive_reset_frame env update_fn first_render_p =
|
||||||
@@ -742,11 +742,11 @@ and match_find_clause val' clauses env =
|
|||||||
|
|
||||||
(* match-pattern *)
|
(* match-pattern *)
|
||||||
and match_pattern pattern value env =
|
and match_pattern pattern value env =
|
||||||
(if sx_truthy ((prim_call "=" [pattern; (Symbol "_")])) then (Bool true) else (if sx_truthy ((let _and = (list_p (pattern)) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(len (pattern)); (Number 2.0)]) in if not (sx_truthy _and) then _and else (prim_call "=" [(first (pattern)); (Symbol "?")])))) then (let pred = (eval_expr ((nth (pattern) ((Number 1.0)))) (env)) in (cek_call (pred) ((List [value])))) else (if sx_truthy ((let _and = (list_p (pattern)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((empty_p (pattern)))))) in if not (sx_truthy _and) then _and else (prim_call "=" [(first (pattern)); (Symbol "quote")])))) then (prim_call "=" [value; (nth (pattern) ((Number 1.0)))]) else (if sx_truthy ((symbol_p (pattern))) then (let () = ignore ((env_bind env (sx_to_string (symbol_name (pattern))) value)) in (Bool true)) else (if sx_truthy ((let _and = (dict_p (pattern)) in if not (sx_truthy _and) then _and else (dict_p (value)))) then (Bool (List.for_all (fun k -> sx_truthy ((match_pattern ((get (pattern) (k))) ((get (value) (k))) (env)))) (sx_to_list (prim_call "keys" [pattern])))) else (if sx_truthy ((let _and = (list_p (pattern)) in if not (sx_truthy _and) then _and else (let _and = (list_p (value)) in if not (sx_truthy _and) then _and else (prim_call "contains?" [pattern; (Symbol "&rest")])))) then (let rest_idx = (prim_call "index-of" [pattern; (Symbol "&rest")]) in (let _and = (prim_call ">=" [(len (value)); rest_idx]) in if not (sx_truthy _and) then _and else (let _and = (Bool (List.for_all (fun pair -> sx_truthy ((match_pattern ((first (pair))) ((nth (pair) ((Number 1.0)))) (env)))) (sx_to_list (prim_call "zip" [(prim_call "slice" [pattern; (Number 0.0); rest_idx]); (prim_call "slice" [value; (Number 0.0); rest_idx])])))) in if not (sx_truthy _and) then _and else (let rest_name = (nth (pattern) ((prim_call "+" [rest_idx; (Number 1.0)]))) in (let () = ignore ((env_bind env (sx_to_string (symbol_name (rest_name))) (prim_call "slice" [value; rest_idx]))) in (Bool true)))))) else (if sx_truthy ((let _and = (list_p (pattern)) in if not (sx_truthy _and) then _and else (list_p (value)))) then (if sx_truthy ((Bool (not (sx_truthy ((prim_call "=" [(len (pattern)); (len (value))])))))) then (Bool false) else (let pairs = (prim_call "zip" [pattern; value]) in (Bool (List.for_all (fun pair -> sx_truthy ((match_pattern ((first (pair))) ((nth (pair) ((Number 1.0)))) (env)))) (sx_to_list pairs))))) else (prim_call "=" [pattern; value]))))))))
|
(if sx_truthy ((prim_call "=" [pattern; (Symbol "_")])) then (Bool true) else (if sx_truthy ((let _and = (list_p (pattern)) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(len (pattern)); (Number 2.0)]) in if not (sx_truthy _and) then _and else (prim_call "=" [(first (pattern)); (Symbol "?")])))) then (let pred = (eval_expr ((nth (pattern) ((Number 1.0)))) (env)) in (cek_call (pred) ((List [value])))) else (if sx_truthy ((let _and = (list_p (pattern)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((empty_p (pattern)))))) in if not (sx_truthy _and) then _and else (prim_call "=" [(first (pattern)); (Symbol "quote")])))) then (prim_call "=" [value; (nth (pattern) ((Number 1.0)))]) else (if sx_truthy ((symbol_p (pattern))) then (let () = ignore ((env_bind env (sx_to_string (symbol_name (pattern))) value)) in (Bool true)) else (if sx_truthy ((let _and = (list_p (pattern)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((empty_p (pattern)))))) in if not (sx_truthy _and) then _and else (let _and = (symbol_p ((first (pattern)))) in if not (sx_truthy _and) then _and else (let _and = (dict_p (value)) in if not (sx_truthy _and) then _and else (get (value) ((String "_adt")))))))) then (let ctor_name = (symbol_name ((first (pattern)))) in let field_patterns = (rest (pattern)) in let fields = (get (value) ((String "_fields"))) in (let _and = (prim_call "=" [(get (value) ((String "_ctor"))); ctor_name]) in if not (sx_truthy _and) then _and else (let _and = (prim_call "=" [(len (field_patterns)); (len (fields))]) in if not (sx_truthy _and) then _and else (Bool (List.for_all (fun pair -> sx_truthy ((match_pattern ((first (pair))) ((nth (pair) ((Number 1.0)))) (env)))) (sx_to_list (prim_call "zip" [field_patterns; fields]))))))) else (if sx_truthy ((let _and = (dict_p (pattern)) in if not (sx_truthy _and) then _and else (dict_p (value)))) then (Bool (List.for_all (fun k -> sx_truthy ((match_pattern ((get (pattern) (k))) ((get (value) (k))) (env)))) (sx_to_list (prim_call "keys" [pattern])))) else (if sx_truthy ((let _and = (list_p (pattern)) in if not (sx_truthy _and) then _and else (let _and = (list_p (value)) in if not (sx_truthy _and) then _and else (prim_call "contains?" [pattern; (Symbol "&rest")])))) then (let rest_idx = (prim_call "index-of" [pattern; (Symbol "&rest")]) in (let _and = (prim_call ">=" [(len (value)); rest_idx]) in if not (sx_truthy _and) then _and else (let _and = (Bool (List.for_all (fun pair -> sx_truthy ((match_pattern ((first (pair))) ((nth (pair) ((Number 1.0)))) (env)))) (sx_to_list (prim_call "zip" [(prim_call "slice" [pattern; (Number 0.0); rest_idx]); (prim_call "slice" [value; (Number 0.0); rest_idx])])))) in if not (sx_truthy _and) then _and else (let rest_name = (nth (pattern) ((prim_call "+" [rest_idx; (Number 1.0)]))) in (let () = ignore ((env_bind env (sx_to_string (symbol_name (rest_name))) (prim_call "slice" [value; rest_idx]))) in (Bool true)))))) else (if sx_truthy ((let _and = (list_p (pattern)) in if not (sx_truthy _and) then _and else (list_p (value)))) then (if sx_truthy ((Bool (not (sx_truthy ((prim_call "=" [(len (pattern)); (len (value))])))))) then (Bool false) else (let pairs = (prim_call "zip" [pattern; value]) in (Bool (List.for_all (fun pair -> sx_truthy ((match_pattern ((first (pair))) ((nth (pair) ((Number 1.0)))) (env)))) (sx_to_list pairs))))) else (prim_call "=" [pattern; value])))))))))
|
||||||
|
|
||||||
(* step-sf-match *)
|
(* step-sf-match *)
|
||||||
and step_sf_match args env kont =
|
and step_sf_match args env kont =
|
||||||
(let val' = (trampoline ((eval_expr ((first (args))) (env)))) in let clauses = (rest (args)) in (let result' = (match_find_clause (val') (clauses) (env)) in (if sx_truthy ((is_nil (result'))) then (raise (Eval_error (value_to_str (String (sx_str [(String "match: no clause matched "); (inspect (val'))]))))) else (make_cek_state ((nth (result') ((Number 1.0)))) ((first (result'))) (kont)))))
|
(let val' = (trampoline ((eval_expr ((first (args))) (env)))) in let clauses = (rest (args)) in (let result' = (match_find_clause (val') (clauses) (env)) in (if sx_truthy ((is_nil (result'))) then (make_cek_value ((String (sx_str [(String "match: no clause matched "); (inspect (val'))]))) (env) ((kont_push ((make_raise_eval_frame (env) ((Bool false)))) (kont)))) else (make_cek_state ((nth (result') ((Number 1.0)))) ((first (result'))) (kont)))))
|
||||||
|
|
||||||
(* step-sf-handler-bind *)
|
(* step-sf-handler-bind *)
|
||||||
and step_sf_handler_bind args env kont =
|
and step_sf_handler_bind args env kont =
|
||||||
@@ -932,6 +932,10 @@ and eval_expr_cek expr env =
|
|||||||
and trampoline_cek val' =
|
and trampoline_cek val' =
|
||||||
(if sx_truthy ((is_thunk (val'))) then (eval_expr_cek ((thunk_expr (val'))) ((thunk_env (val')))) else val')
|
(if sx_truthy ((is_thunk (val'))) then (eval_expr_cek ((thunk_expr (val'))) ((thunk_env (val')))) else val')
|
||||||
|
|
||||||
|
(* make-coroutine *)
|
||||||
|
and make_coroutine thunk =
|
||||||
|
(CekFrame { cf_type = "coroutine"; cf_env = Nil; cf_name = Nil; cf_body = Nil; cf_remaining = Nil; cf_f = Nil; cf_args = Nil; cf_results = Nil; cf_extra = Nil; cf_extra2 = Nil })
|
||||||
|
|
||||||
(* eval-expr *)
|
(* eval-expr *)
|
||||||
and eval_expr expr env =
|
and eval_expr expr env =
|
||||||
(cek_run ((make_cek_state (expr) (env) ((List [])))))
|
(cek_run ((make_cek_state (expr) (env) ((List [])))))
|
||||||
@@ -1004,5 +1008,89 @@ let enhance_error_with_trace msg =
|
|||||||
_last_error_kont_ref := Nil;
|
_last_error_kont_ref := Nil;
|
||||||
msg ^ (format_comp_trace trace)
|
msg ^ (format_comp_trace trace)
|
||||||
|
|
||||||
|
(* Hand-written sf_define_type — skipped from transpile because the spec uses
|
||||||
|
&rest params and empty-dict literals that the transpiler can't emit cleanly.
|
||||||
|
Implements: (define-type Name (Ctor1 f1 f2) (Ctor2 f3) ...)
|
||||||
|
Creates constructor fns, Name?/Ctor? predicates, Ctor-field accessors,
|
||||||
|
and records ctors in *adt-registry*. *)
|
||||||
|
let sf_define_type args env_val =
|
||||||
|
let items = (match args with List l -> l | _ -> []) in
|
||||||
|
let type_sym = List.nth items 0 in
|
||||||
|
let type_name = value_to_string type_sym in
|
||||||
|
let ctor_specs = List.tl items in
|
||||||
|
let env_has_v k = sx_truthy (env_has env_val (String k)) in
|
||||||
|
let env_bind_v k v = ignore (env_bind env_val (String k) v) in
|
||||||
|
let env_get_v k = env_get env_val (String k) in
|
||||||
|
if not (env_has_v "*adt-registry*") then
|
||||||
|
env_bind_v "*adt-registry*" (Dict (Hashtbl.create 8));
|
||||||
|
let registry = env_get_v "*adt-registry*" in
|
||||||
|
let ctor_names = List.map (fun spec ->
|
||||||
|
(match spec with List (sym :: _) -> String (value_to_string sym) | _ -> Nil)
|
||||||
|
) ctor_specs in
|
||||||
|
(match registry with Dict d -> Hashtbl.replace d type_name (List ctor_names) | _ -> ());
|
||||||
|
env_bind_v (type_name ^ "?")
|
||||||
|
(NativeFn (type_name ^ "?", fun pargs ->
|
||||||
|
(match pargs with
|
||||||
|
| [v] ->
|
||||||
|
(match v with
|
||||||
|
| Dict d -> Bool (Hashtbl.mem d "_adt" &&
|
||||||
|
(match Hashtbl.find_opt d "_type" with Some (String t) -> t = type_name | _ -> false))
|
||||||
|
| _ -> Bool false)
|
||||||
|
| _ -> Bool false)));
|
||||||
|
List.iter (fun spec ->
|
||||||
|
(match spec with
|
||||||
|
| List (sym :: fields) ->
|
||||||
|
let cn = value_to_string sym in
|
||||||
|
let field_names = List.map value_to_string fields in
|
||||||
|
let arity = List.length fields in
|
||||||
|
env_bind_v cn
|
||||||
|
(NativeFn (cn, fun ctor_args ->
|
||||||
|
if List.length ctor_args <> arity then
|
||||||
|
raise (Eval_error (Printf.sprintf "%s: expected %d args, got %d"
|
||||||
|
cn arity (List.length ctor_args)))
|
||||||
|
else begin
|
||||||
|
let d = Hashtbl.create 4 in
|
||||||
|
Hashtbl.replace d "_adt" (Bool true);
|
||||||
|
Hashtbl.replace d "_type" (String type_name);
|
||||||
|
Hashtbl.replace d "_ctor" (String cn);
|
||||||
|
Hashtbl.replace d "_fields" (List ctor_args);
|
||||||
|
Dict d
|
||||||
|
end));
|
||||||
|
env_bind_v (cn ^ "?")
|
||||||
|
(NativeFn (cn ^ "?", fun pargs ->
|
||||||
|
(match pargs with
|
||||||
|
| [v] ->
|
||||||
|
(match v with
|
||||||
|
| Dict d -> Bool (Hashtbl.mem d "_adt" &&
|
||||||
|
(match Hashtbl.find_opt d "_ctor" with Some (String c) -> c = cn | _ -> false))
|
||||||
|
| _ -> Bool false)
|
||||||
|
| _ -> Bool false)));
|
||||||
|
List.iteri (fun idx fname ->
|
||||||
|
env_bind_v (cn ^ "-" ^ fname)
|
||||||
|
(NativeFn (cn ^ "-" ^ fname, fun pargs ->
|
||||||
|
(match pargs with
|
||||||
|
| [v] ->
|
||||||
|
(match v with
|
||||||
|
| Dict d ->
|
||||||
|
(match Hashtbl.find_opt d "_fields" with
|
||||||
|
| Some (List fs) ->
|
||||||
|
if idx < List.length fs then List.nth fs idx
|
||||||
|
else raise (Eval_error (cn ^ "-" ^ fname ^ ": index out of bounds"))
|
||||||
|
| _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": not an ADT")))
|
||||||
|
| _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": not a dict")))
|
||||||
|
| _ -> raise (Eval_error (cn ^ "-" ^ fname ^ ": expected 1 arg")))))
|
||||||
|
) field_names
|
||||||
|
| _ -> ())
|
||||||
|
) ctor_specs;
|
||||||
|
Nil
|
||||||
|
|
||||||
|
(* Register define-type via custom_special_forms so the CEK dispatch finds it.
|
||||||
|
The top-level (register-special-form! ...) in spec/evaluator.sx is not a
|
||||||
|
define and therefore is not transpiled; we wire it up here instead. *)
|
||||||
|
let () = ignore (register_special_form (String "define-type")
|
||||||
|
(NativeFn ("define-type", fun call_args ->
|
||||||
|
match call_args with
|
||||||
|
| [args; env] -> sf_define_type args env
|
||||||
|
| _ -> Nil)))
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user