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

Reorganized the standard library a little more, moved the initialization code for the standard environment into a function. Making way for more organization changes to come

Browse Source
This commit is contained in:
Emin Arslan
2025-11-05 23:55:21 +03:00
parent a45918d203
commit 2f9501450f
4 changed files with 97 additions and 91 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
lib/env.ml
View File

@@ -1,6 +1,13 @@
open Ast
(* the type `environment` is defined in Ast *)
let default_env: environment = [Hashtbl.create 1024];;
let copy (env : environment) : environment =
List.map Hashtbl.copy env
let make_env () = copy default_env
let new_lexical (env : environment) : environment =
let h = Hashtbl.create 16 in
h :: env
@@ -27,7 +34,7 @@ let rec get_root (env : environment) =
let set_global (env : environment) s v =
Hashtbl.replace (get_root env) s v
let copy (env : environment) : environment =
List.map Hashtbl.copy env
let add_builtin s f =
set_global default_env s (LBuiltinFunction (s, f))
let add_special s f =
set_global default_env s (LBuiltinSpecial (s, f))

86
lib/eval.ml
View File

@@ -1,16 +1,6 @@
open Ast;;
open InterpreterStdlib;;
let default_env: environment = [Hashtbl.create 1024];;
let add_builtin s f =
Env.set_global default_env s (LBuiltinFunction (s, f))
let add_special s f =
Env.set_global default_env s (LBuiltinSpecial (s, f))
let make_env () = Env.copy default_env
(* the type annotations are unnecessary, but help constrain us from a
potentially more general function here *)
let rec eval_sym (env: environment) (s: string) =
@@ -63,8 +53,6 @@ and eval_apply args = function
| v ->
invalid_arg ("Non-macro non-function value passed to eval_apply "
^ dbg_print_one v)
and eval_call env func args =
match func with
@@ -81,80 +69,8 @@ and eval_call env func args =
| v -> raise (Invalid_argument
(Printf.sprintf "eval_apply: cannot call non-function object %s" (dbg_print_one v)))
(* This only creates a *local* binding, contained to the body given. *)
let bind_local env = function
| LCons (LSymbol s, LCons (v, body)) ->
let e = Env.new_lexical env in
Env.set_local e s v;
eval_body e body
| _ -> invalid_arg "invalid argument to bind-local"
(* special form that creates a global binding *)
let lisp_define env = function
| LCons (LSymbol s, LCons (v, LNil)) ->
let evaluated = eval_one env v in
Env.set_global env s evaluated;
evaluated
| _ -> invalid_arg "invalid args to def"
let lisp_if env = function
| LCons (cond, LCons (if_true, LNil)) ->
(match eval_one env cond with
| LNil -> LNil
| _ -> eval_one env if_true)
| LCons (cond, LCons (if_true, LCons (if_false, LNil))) ->
(match eval_one env cond with
| LNil -> eval_one env if_false
| _ -> eval_one env if_true)
| _ -> invalid_arg "invalid argument list passed to if!"
let eval_all env vs =
let ev v = eval_one env v in
List.map ev vs
let () = add_builtin "+" add
let () = add_builtin "-" sub
let () = add_builtin "car" car
let () = add_builtin "cdr" cdr
let () = add_builtin "cons" cons
let () = add_special "def" lisp_define
let () = add_builtin "set" lisp_set
let () = add_builtin "list" lisp_list
let () = add_special "fn" lambda
let () = add_special "fn-macro" lambda_macro
let () = add_special "let-one" bind_local
let () = add_special "quote" (fun _ -> function
| LCons (x, LNil) -> x
| _ -> invalid_arg "hmm")
let () = add_special "if" lisp_if
let () = add_builtin "nil?" lisp_not
let () = add_builtin "not" lisp_not (* Yes, these are the same thing *)
(*let () = add_builtin "print" lisp_prin *)
(* I know this looks insane. please trust me.
Idea: maybe put this in a file instead of putting
literally the entire standard library in a constant string
*)
let _ = eval_all default_env (Read.parse_str
"
(def defn
(fn-macro (name lm . body)
(list 'def name (cons 'fn (cons lm body)))))
(def defmacro
(fn-macro (name lm . body)
(list 'def name (cons 'fn-macro (cons lm body)))))
(defmacro setq (sym val)
(list 'set (list 'quote sym) val))
(defmacro letfn (sym fun . body)
(cons 'let-one (cons sym (cons '() (cons (list 'setq sym fun) body)))))
List.map ev vs;;
(defn filter (f l)
(letfn helper
(fn (l acc)
(if (nil? l) acc (helper (cdr l) (if (f (car l)) (cons (car l) acc) acc))))
(helper l '())))
")

84
lib/interpreterStdlib.ml
View File

@@ -61,9 +61,89 @@ let lambda env = function
let lambda_macro env = function
| LCons (l, body) -> LUnnamedMacro (env, l, body)
| _ -> invalid_arg "invalid args to lambda-macro"
| _ -> invalid_arg "invalid args to lambda-macro";;
let lisp_not _ = function
| LCons (LNil, LNil) -> LSymbol "t"
| _ -> LNil
| _ -> LNil;;
(* This only creates a *local* binding, contained to the body given. *)
let bind_local env = function
| LCons (LSymbol s, LCons (v, body)) ->
let e = Env.new_lexical env in
Env.set_local e s v;
Eval.eval_body e body
| _ -> invalid_arg "invalid argument to bind-local"
(* special form that creates a global binding *)
let lisp_define env = function
| LCons (LSymbol s, LCons (v, LNil)) ->
let evaluated = Eval.eval_one env v in
Env.set_global env s evaluated;
evaluated
| _ -> invalid_arg "invalid args to def"
let lisp_if env = function
| LCons (cond, LCons (if_true, LNil)) ->
(match Eval.eval_one env cond with
| LNil -> LNil
| _ -> Eval.eval_one env if_true)
| LCons (cond, LCons (if_true, LCons (if_false, LNil))) ->
(match Eval.eval_one env cond with
| LNil -> Eval.eval_one env if_false
| _ -> Eval.eval_one env if_true)
| _ -> invalid_arg "invalid argument list passed to if!"
open Env;;
let init_script = "
(def defn
(fn-macro (name lm . body)
(list 'def name (cons 'fn (cons lm body)))))
(def defmacro
(fn-macro (name lm . body)
(list 'def name (cons 'fn-macro (cons lm body)))))
(defmacro setq (sym val)
(list 'set (list 'quote sym) val))
(defmacro letfn (sym fun . body)
(cons 'let-one (cons sym (cons '() (cons (list 'setq sym fun) body)))))
(defn filter (f l)
(letfn helper
(fn (l acc)
(if (nil? l) acc (helper (cdr l) (if (f (car l)) (cons (car l) acc) acc))))
(helper l '())))
";;
let init_default_env () =
add_builtin "+" add;
add_builtin "-" sub;
add_builtin "car" car;
add_builtin "cdr" cdr;
add_builtin "cons" cons;
add_special "def" lisp_define;
add_builtin "set" lisp_set;
add_builtin "list" lisp_list;
add_special "fn" lambda;
add_special "fn-macro" lambda_macro;
add_special "let-one" bind_local;
add_special "quote" (fun _ -> function
| LCons (x, LNil) -> x
| _ -> invalid_arg "hmm");
add_special "if" lisp_if;
add_builtin "nil?" lisp_not;
add_builtin "not" lisp_not; (* Yes, these are the same thing *)
(*let () = add_builtin "print" lisp_prin *)
(* I know this looks insane. please trust me.
Idea: maybe put this in a file instead of putting
literally the entire standard library in a constant string
*)
ignore (Eval.eval_all default_env (Read.parse_str init_script));
()