Jonathan Graveline pushed to branch graveline at Stefan / Typer

Commits: fe78c2da by Jonathan Graveline at 2018-05-31T18:55:38Z Change to sexp_dispatch and added parse_default - - - - -

1 changed file:

- src/eval.ml

Changes:

===================================== src/eval.ml ===================================== --- a/src/eval.ml +++ b/src/eval.ml @@ -281,9 +281,16 @@ let make_float loc depth args_val = match args_val with | _ -> error loc "Sexp.float expects one float as argument"

let make_block loc depth args_val = match args_val with + (* From what would we like to make a block? *) | [Vstring str] -> Vsexp (Block (loc, (Prelexer.prelex_string str), loc)) | _ -> error loc "Sexp.block expects one string as argument"

+let parse_default loc depth args_val = match args_val with + | [Vsexp (Block (_,toks,_))] -> + o2v_list (sexp_parse_all_to_list default_grammar (Lexer.lex default_stt toks) (Some ";")) + | [s] -> (warning loc "Parser.default do nothing without a Block"; s) + | _ -> error loc "Parser.default expects a Block as argument" + let string_eq loc depth args_val = match args_val with | [Vstring s1; Vstring s2] -> o2v_bool (s1 = s2) | _ -> error loc "String.= expects 2 strings" @@ -573,13 +580,13 @@ and sexp_dispatch loc depth args = | Float (_ , f) -> let rctx = ctx_flt in eval flt (add_rte_variable None (Vfloat f) rctx) - | Block (_ , s, _) -> + | Block (_ , _, _) as b -> (* I think this code breaks what Blocks are. *) (* We delay parsing but parse with default_stt and default_grammar... *) + (*let toks = Lexer.lex default_stt s in + let s = sexp_parse_all_to_list default_grammar toks (Some ";") in*) let rctx = ctx_blk in - let toks = Lexer.lex default_stt s in - let s = sexp_parse_all_to_list default_grammar toks (Some ";") in - eval blk (add_rte_variable None (o2v_list s) rctx) + eval blk (add_rte_variable None (Vsexp b) rctx) | _ -> print_string "match error\n"; flush stdout; error loc "sexp_dispatch error" @@ -702,6 +709,7 @@ let register_builtin_functions () = ("Sexp.float" , make_float, 1); ("Sexp.node" , make_node, 2); ("Sexp.dispatch" , sexp_dispatch, 7); + ("Parser.default", parse_default,1); ("String.=" , string_eq, 2); ("String.concat" , string_concat, 2); ("String.sub" , string_sub, 2);

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