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

3
bin/main.ml
View File

@@ -1,9 +1,12 @@
open Lisp.Ast;; open Lisp.Ast;;
open Printf;; open Printf;;
open Lisp;; open Lisp;;
open Env;;
open Eval;; open Eval;;
open Read;; open Read;;
let () = InterpreterStdlib.init_default_env ()
let rec repl env c = let rec repl env c =
let () = printf ">>> "; Out_channel.flush Out_channel.stdout; in let () = printf ">>> "; Out_channel.flush Out_channel.stdout; in
match In_channel.input_line c with match In_channel.input_line c with

15
lib/env.ml
View File

@@ -1,6 +1,13 @@
open Ast open Ast
(* the type `environment` is defined in 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 new_lexical (env : environment) : environment =
let h = Hashtbl.create 16 in let h = Hashtbl.create 16 in
h :: env h :: env
@@ -27,7 +34,7 @@ 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 copy (env : environment) : environment = let add_builtin s f =
List.map Hashtbl.copy env 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 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 (* the type annotations are unnecessary, but help constrain us from a
potentially more general function here *) potentially more general function here *)
let rec eval_sym (env: environment) (s: string) = let rec eval_sym (env: environment) (s: string) =
@@ -63,8 +53,6 @@ and eval_apply args = function
| v -> | v ->
invalid_arg ("Non-macro non-function value passed to eval_apply " invalid_arg ("Non-macro non-function value passed to eval_apply "
^ dbg_print_one v) ^ dbg_print_one v)
and eval_call env func args = and eval_call env func args =
match func with match func with
@@ -81,80 +69,8 @@ and eval_call env func args =
| v -> raise (Invalid_argument | v -> raise (Invalid_argument
(Printf.sprintf "eval_apply: cannot call non-function object %s" (dbg_print_one v))) (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 eval_all env vs =
let ev v = eval_one env v in let ev v = eval_one env v in
List.map ev vs 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)))))
(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 let lambda_macro env = function
| LCons (l, body) -> LUnnamedMacro (env, l, body) | 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 let lisp_not _ = function
| LCons (LNil, LNil) -> LSymbol "t" | 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));
()