Stefan pushed to branch master at Stefan / Typer

Commits: 6cd88359 by Stefan Monnier at 2016-03-20T22:12:22-04:00 Make the code compile

* src/eval.ml (_eval): Eval body with the extra vars bound from the pattern match.

* src/main.ml (default_grammar, default_stt): Remove; use Grammar instead.

* tests/REPL.ml (ipexp_parse): Reduce duplication. Fix `nod' ref. (ilexp_parse): Get it to type-check. (ilexp_parse_all.loop, ieval_all.loop): Fix use of ::. (ieval): Get it to type-check. (repl.loop.print_e): Fix arg names.

- - - - -

4 changed files:

- src/eval.ml - src/grammar.ml - src/main.ml - tests/REPL.ml

Changes:

===================================== src/eval.ml ===================================== --- a/src/eval.ml +++ b/src/eval.ml @@ -88,7 +88,8 @@ type runtime_env = (string option * lexp) myers let make_runtime_ctx = nil;; let add_rte_variable name x l = (cons (name, x) l);;

-let get_rte_variable (idx: int) (l: runtime_env): lexp = +let get_rte_variable (idx: int) (l: runtime_env): lexp = + (* FIXME: Check that the variable's name is right! *) let (_, x) = (nth idx l) in x ;;

@@ -151,7 +152,10 @@ let rec _eval lxp ctx i: (value_type) = let n = List.length args in match lname with (* Hardcoded functions *) - + (* FIXME: These should not be hardcoded here, but should be + * stuffed into the "initial environment", i.e. the value of + * `ctx` used at top-level. *) + (* + is read as a nested binary operator *) | Var((_, name), _) when name = "_+_" -> let nctx = build_arg_list args ctx i in @@ -294,7 +298,7 @@ let rec _eval lxp ctx i: (value_type) =

ctx pat_args args in (* eval body *) - _eval exp ctx (i + 1) end + _eval exp nctx (i + 1) end

| _ -> Imm(String(dloc, "eval Not Implemented"))

===================================== src/grammar.ml ===================================== --- a/src/grammar.ml +++ b/src/grammar.ml @@ -48,6 +48,15 @@ let default_stt = stt.(Char.code ')') <- true; stt

+(* default_grammar is auto-generated from typer-smie-grammar via: + + (dolist (x typer-smie-grammar) + (when (stringp (car x)) + (insert "("" (car x) "", " + (if (numberp (nth 1 x)) (format "Some %d" (nth 1 x)) "None") ", " + (if (numberp (nth 2 x)) (format "Some %d" (nth 2 x)) "None") + ");\n"))) + *) let default_grammar : grammar = List.fold_left (fun g (n, ll, rl) -> SMap.add n (ll, rl) g) SMap.empty @@ -84,4 +93,4 @@ let default_grammar : grammar = ("let", None, Some 2); ("if", None, Some 1); ("(", None, Some 4); - ] \ No newline at end of file + ]

===================================== src/main.ml ===================================== --- a/src/main.ml +++ b/src/main.ml @@ -31,6 +31,7 @@ open Sexp (* open Lexp *) open Prelexer open Pexp +open Grammar

(* Overview. * @@ -80,62 +81,6 @@ open Pexp

(*************** The Top Level *********************)

-let default_stt = - let stt = Array.make 256 false - in stt.(Char.code ';') <- true; - stt.(Char.code ',') <- true; - stt.(Char.code '(') <- true; - stt.(Char.code ')') <- true; - stt - -(* default_grammar is auto-generated from typer-smie-grammar via: - - (dolist (x typer-smie-grammar) - (when (stringp (car x)) - (insert "("" (car x) "", " - (if (numberp (nth 1 x)) (format "Some %d" (nth 1 x)) "None") ", " - (if (numberp (nth 2 x)) (format "Some %d" (nth 2 x)) "None") - ");\n"))) - *) -let default_grammar : grammar - = List.fold_left (fun g (n, ll, rl) -> SMap.add n (ll, rl) g) - SMap.empty - [("^", Some 171, Some 159); - ("/", Some 148, Some 160); - ("-", Some 92, Some 110); - ("+", Some 93, Some 111); - ("!=", Some 94, Some 75); - (">=", Some 95, Some 76); - ("<=", Some 96, Some 77); - (">", Some 97, Some 78); - ("<", Some 98, Some 79); - ("&&", Some 64, Some 81); - ("||", Some 39, Some 51); - (",", Some 26, Some 26); - ("then", Some 1, Some 0); - ("=", Some 99, Some 80); - ("type", None, Some 27); - (";", Some 15, Some 15); - ("*", Some 137, Some 137); - (":", Some 173, Some 115); - ("]", Some 3, None); - ("->", Some 126, Some 114); - ("=>", Some 126, Some 113); - ("≡>", Some 126, Some 112); - ("in", Some 2, Some 53); - ("else", Some 0, Some 52); - ("|", Some 40, Some 40); - (")", Some 4, None); - ("[", None, Some 3); - ("case", None, Some 28); - ("lambda", None, Some 126); - ("letrec", None, Some 2); - ("let", None, Some 2); - ("if", None, Some 1); - ("(", None, Some 4); - ] - - let process_typer_file sourcename choppable_suffix venv = (* let targetbase = Filename.chop_suffix sourcename choppable_suffix in *) let pretokens = prelex_file sourcename in

===================================== tests/REPL.ml ===================================== --- a/tests/REPL.ml +++ b/tests/REPL.ml @@ -54,14 +54,11 @@ type ptop = let ipexp_parse p = match p with (* Declaration *) - | Node (Symbol (_, "_=_"), [Symbol s; t]) -> - let (a, b, c)::_ = pexp_p_decls nod in - Pdecl(a, b, c) - | Node (Symbol (_, "_:_"), [Symbol s; t]) -> - let (a, b, c)::_ = pexp_p_decls nod in + | Node (Symbol (_, ("_=_" | "_:_")), [Symbol s; t]) -> + let (a, b, c)::_ = pexp_p_decls p in Pdecl(a, b, c) (* Expression *) - | _ -> let a = pexp_parse nod in Pexpr(a) + | _ -> let a = pexp_parse p in Pexpr(a) ;;

let ipexp_parse_all ps = List.map ipexp_parse ps;; @@ -72,10 +69,10 @@ type ltop =

let ilexp_parse l lctx = match l with - | Pdecl(_, _, _) -> let (a, b, c), d = lexp_decls [l] ctx in + | Pdecl(x, v, t) -> let [(a, b, c)], d = lexp_decls [(x, v, t)] lctx in Ldecl(a, b, c), d - | Pexpr(x) -> let v, c = lexp_parse x lctx in - Lexpr(v), c + | Pexpr(x) -> let v = lexp_parse x lctx in + Lexpr(v), lctx

let ilexp_parse_all ls lctx = let rec loop lst acc ctx = @@ -83,8 +80,8 @@ let ilexp_parse_all ls lctx = | [] -> List.rev acc, ctx | hd::tl -> let x, c = ilexp_parse hd ctx in - let nacc = acc::x in - loop tl nacc c in + let nacc = x::acc in + loop tl nacc c in loop ls [] lctx

type ival = @@ -93,9 +90,9 @@ type ival =

let ieval xpr rctx = match xpr with - | Ldecl(_, _, _) -> let r = eval_decls xpr rctx in + | Ldecl(x, v, t) -> let r = eval_decls [(x, v, t)] rctx in Ivoid, rctx - | Lexpr(x) -> let v, _ = eval x rctx in + | Lexpr(x) -> let v = eval x rctx in Ival(v), rctx

let ieval_all xprs rctx = @@ -104,7 +101,7 @@ let ieval_all xprs rctx = | [] -> List.rev acc, ctx | hd::tl -> let x, c = ieval hd ctx in - let nacc = acc::x in + let nacc = x::acc in loop tl nacc c in loop xprs [] rctx

@@ -125,7 +122,7 @@ let rec repl () = let tenv = default_stt in let grm = default_grammar in let limit = (Some ";") in - let eval_string str clxp rctx = eval_string str tenv grm limit clxp rctx in + (* let eval_string str clxp rctx = eval_string str tenv grm limit clxp rctx in *) let lxp_ctx = make_lexp_context in (* Those are hardcoded operation *) let lxp_ctx = add_def "_+_" lxp_ctx in @@ -147,7 +144,7 @@ let rec repl () = else let (ret, clxp, rctx) = (ieval_string ipt clxp rctx) in

- let print_e j v = + let print_e _ b = match b with | Ivoid -> () | Ival(x) -> print_eval_result i x in @@ -173,4 +170,4 @@ let main () =

main () -;; \ No newline at end of file +;;

View it on GitLab: https://gitlab.com/monnier/typer/commit/6cd883591bc13c03681fd31b642bc04fa55a...