diff --git a/ast.ml b/ast.ml index e8cb85a..4ba9063 100644 --- a/ast.ml +++ b/ast.ml @@ -9,6 +9,7 @@ type t = | Nexternal of string | Var of string | Let of string * t + | Letin of string * t * t | Unary of operator * t | Binop of t * operator * t | If of t * t * t (* cond then else *) @@ -61,9 +62,12 @@ let print ast = List.iter (pr " %s") @@ List.tl args; pr ") "; aux e; pr ")" | Nexternal e -> pr "(extern %s)" e + | Var v -> pr "%s" v | Let (v, e) -> - pr "(let %s " v; aux e; pr ")" + pr "(define %s " v; aux e; pr ")" + | Letin (v, e, f) -> + pr "(let ((%s " v; aux e; pr "))"; aux f; pr ")" | Unary (op, t) -> let op = op_to_string op in pr "(%s " op; aux t; pr ")" diff --git a/eval.ml b/eval.ml index 42da438..aaea48f 100644 --- a/eval.ml +++ b/eval.ml @@ -7,7 +7,7 @@ type value = | Bool of bool | String of string | Symbol of string - | Function of string list * expr + | Function of string list * expr * env | External of string | Nop (* return of system operations (will be deprecated) *) @@ -58,7 +58,7 @@ module Value = struct | Bool b -> string_of_bool b | String s -> "\"" ^ s ^ "\"" | Symbol s -> "symbol " ^ s - | Function (vars, _) -> + | Function (vars, _, _) -> Printf.sprintf "function with %d arguments" @@ List.length vars | External f -> "external " ^ f | Nop -> "nop" @@ -268,12 +268,20 @@ let rec eval env ast : string * value = | Nbool b -> Bool b | Nstring s -> String s | Nsymbol s -> Symbol s - | Nfunction (args, e) -> Function (args, e) + | Nfunction (args, e) -> + let nenv = Env.make env in + Function (args, e, nenv) | Nexternal f -> External f + | Var v -> begin match Env.get_opt env v with | None -> raise @@ Unbound v | Some v -> v end + | Letin (v, e, f) -> + let nenv = Env.make env in + Env.set nenv v (aux e); + snd @@ eval nenv f + | Unary (op, t) -> let t = aux t in let op = Operator.get_unary op in @@ -289,7 +297,7 @@ let rec eval env ast : string * value = end | Apply (v, args) -> begin match aux v with - | Function (vars, e) -> + | Function (vars, e, env) -> assert_same_length vars args; let args = List.map aux args in let nenv = Env.make env in diff --git a/parser.ml b/parser.ml index 66d6569..96dd209 100644 --- a/parser.ml +++ b/parser.ml @@ -81,7 +81,7 @@ let token_is_operator tok = Hashtbl.mem operators tok let is_keyword = function - | "if" | "then" | "else" | "let" -> true + | "if" | "then" | "else" | "let" | "in" -> true | _ -> false (* common parsers *) @@ -155,17 +155,17 @@ let more f seq = let xs, seq = aux [] seq in List.rev xs, seq -(* decl := let_value +(* decl := let_global * | expr *) let rec decl seq = seq |> oneof [ - let_value; expr min_int; + let_global; ] -(* let_value := "let" ident "=" expr *) -and let_value seq = +(* let_global := "let" ident "=" expr *) +and let_global seq = let _, seq = ident "let" seq in let id, seq = any_ident seq in let _, seq = token Token.Equal seq in @@ -173,6 +173,7 @@ and let_value seq = Let (id, e), seq (* expr := level + * | let_value * | assoc * | apply * | value binop_right @@ -180,6 +181,7 @@ and let_value seq = and expr pre seq = seq |> oneof [ ifexpr; + let_value; oneof [apply; unary; value] @> binop pre; level; assoc; @@ -187,6 +189,16 @@ and expr pre seq = extern_value; ] +(* let_value := "let" id "=" expr "in" expr *) +and let_value seq = + let _, seq = ident "let" seq in + let id, seq = any_ident seq in + let _, seq = token Equal seq in + let e, seq = expr min_int seq in + let _, seq = ident "in" seq in + let f, seq = expr min_int seq in + Letin (id, e, f), seq + (* level := "level" {"get" | "set"} [op] *) and level seq = let _, seq = ident "level" seq in