Jonathan Graveline pushed to branch graveline at Stefan / Typer

Commits: 6045d6aa by Jonathan Graveline at 2018-05-30T20:22:24Z Added make_block and Sexp_dispatch for Block - - - - -

1 changed file:

- src/eval.ml

Changes:

===================================== src/eval.ml ===================================== --- a/src/eval.ml +++ b/src/eval.ml @@ -45,6 +45,9 @@ open Env open Printf (* IO Monad *) module OL = Opslexp

+module Lexer = Lexer (* lex *) +module Prelexer = Prelexer (* prelex_string *) +

type eval_debug_info = elexp list * elexp list

@@ -277,9 +280,9 @@ let make_float loc depth args_val = match args_val with | [Vfloat x] -> Vsexp (Float (loc, x)) | _ -> error loc "Sexp.float expects one float as argument"

-(* let make_block loc depth args_val = match args_val with - * | [Vblock b] -> Vsexp (Block (loc, b)) - * | _ -> error loc "Sexp.block expects one block as argument" *) +let make_block loc depth args_val = match args_val with + | [Vstring str] -> Vsexp (Block (loc, (Prelexer.prelex_string str), loc)) + | _ -> error loc "Sexp.block expects one string as argument"

let string_eq loc depth args_val = match args_val with | [Vstring s1; Vstring s2] -> o2v_bool (s1 = s2) @@ -570,8 +573,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, _) -> - eval blk (add_rte_variable None (o2v_list s))*) + | Block (_ , s, _) -> + (* I think this code breaks what Blocks are. *) + (* We delay parsing but parse with default_stt and default_grammar... *) + 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) | _ -> print_string "match error\n"; flush stdout; error loc "sexp_dispatch error" @@ -687,7 +695,7 @@ let nop_fun loc _ vs = match vs with let register_builtin_functions () = List.iter (fun (name, f, arity) -> add_builtin_function name f arity) [ - (* ("Sexp.block" , make_block, 1); *) + ("Sexp.block" , make_block, 1); ("Sexp.symbol" , make_symbol, 1); ("Sexp.string" , make_string, 1); ("Sexp.integer" , make_integer, 1);

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