haxala1r/olisp
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

Making preparations for more of the standard library

Browse Source
This commit is contained in:
Emin Arslan
2025-11-11 22:34:22 +03:00
parent f342289cb3
commit aea0fe510f
2 changed files with 60 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
lib/env.ml
View File

@@ -34,7 +34,5 @@ let rec get_root (env : environment) =
let set_global (env : environment) s v = let set_global (env : environment) s v =
Hashtbl.replace (get_root env) s v Hashtbl.replace (get_root env) s v
let add_builtin s f = let set_default s v =
set_global default_env s (LBuiltinFunction (s, f)) set_global default_env s v
let add_special s f =
set_global default_env s (LBuiltinSpecial (s, f))

74
lib/interpreterStdlib.ml
View File

@@ -49,21 +49,13 @@ let rem _ = function
| _ -> invalid_arg "invalid argument list passed to (rem)" | _ -> invalid_arg "invalid argument list passed to (rem)"
let car _ vs = let car _ = function
match vs with | LCons (a, _) -> a
| LCons (LCons (a, _), LNil) -> a | _ -> invalid_arg "car: non-cons"
| _ -> raise (Invalid_argument "car: invalid argument") let cdr _ = function
| LCons (_, d) -> d
let cdr _ vs = | _ -> invalid_arg "cdr: non-cons"
match vs with let cons _ a b = LCons (a, b)
| LCons (LCons (_, b), LNil) -> b
| _ -> raise (Invalid_argument "cdr: invalid argument")
let cons _ vs =
match vs with
| LCons (a, LCons (b, LNil)) -> LCons (a, b)
| _ -> invalid_arg "invalid args to cons!"
let lisp_list _ vs = vs let lisp_list _ vs = vs
(* builtin function that updates an existing binding *) (* builtin function that updates an existing binding *)
@@ -118,6 +110,36 @@ let lisp_if env = function
open Env;; open Env;;
let bf s f = s, LBuiltinFunction (s, f)
let bf1 s f =
let aux e = function
| LCons (v, LNil) -> f e v
| _ -> invalid_arg ("invalid argument to " ^ s)
in bf s aux
let bf2 s f =
let aux e = function
| LCons (v1, LCons (v2, LNil)) -> f e v1 v2
| _ -> invalid_arg ("invalid argument to " ^ s)
in bf s aux
let sp s f = s, LBuiltinSpecial (s, f)
let sp1 s f =
let aux e = function
| LCons (v, LNil) -> f e v
| _ -> invalid_arg ("invalid argument to " ^ s)
in sp s aux
let sp2 s f =
let aux e = function
| LCons (v1, LCons (v2, LNil)) -> f e v1 v2
| _ -> invalid_arg ("invalid argument to " ^ s)
in sp s aux
let add_builtins bs =
List.iter (fun (s, f) -> set_default s f) bs
let init_script = " let init_script = "
(def defn (def defn
(fn-macro (name lm . body) (fn-macro (name lm . body)
@@ -140,6 +162,7 @@ let init_script = "
";; ";;
let init_default_env () = let init_default_env () =
(*
add_builtin "+" add; add_builtin "+" add;
add_builtin "-" sub; add_builtin "-" sub;
add_builtin "*" mul; add_builtin "*" mul;
@@ -159,7 +182,26 @@ let init_default_env () =
| _ -> invalid_arg "hmm"); | _ -> invalid_arg "hmm");
add_special "if" lisp_if; add_special "if" lisp_if;
add_builtin "nil?" lisp_not; add_builtin "nil?" lisp_not;
add_builtin "not" lisp_not; (* Yes, these are the same thing *) add_builtin "not" lisp_not; (* Yes, these are the same thing *) *)
add_builtins [
bf "+" add; bf "-" sub;
bf "*" mul; bf "/" div;
bf1 "car" car;
bf1 "cdr" cdr;
bf2 "cons" cons;
bf "rem" rem;
bf "set" lisp_set;
bf "list" lisp_list;
bf "nil?" lisp_not;
bf "not" lisp_not;
sp "fn" lambda;
sp "fn-macro" lambda_macro;
sp "let-one" bind_local;
sp "def" lisp_define;
sp1 "quote" (fun _ x -> x);
sp "if" lisp_if;
];
(*let () = add_builtin "print" lisp_prin *) (*let () = add_builtin "print" lisp_prin *)