Jonathan Graveline pushed to branch graveline at Stefan / Typer
Commits: a7dfcc1b by Jonathan Graveline at 2018-05-14T22:17:48Z Added some built-in function for Int, Float, String - - - - -
1 changed file:
- src/eval.ml
Changes:
===================================== src/eval.ml ===================================== --- a/src/eval.ml +++ b/src/eval.ml @@ -141,7 +141,15 @@ let add_binary_iop name f = let _ = add_binary_iop "+" (+); add_binary_iop "-" (-); add_binary_iop "*" ( * ); - add_binary_iop "/" (/) + add_binary_iop "/" (/); + + add_binary_iop "mod" (mod); + add_binary_iop "and" (land); + add_binary_iop "or" (lor); + add_binary_iop "lsl" (lsl); + add_binary_iop "lsr" (lsr); + add_binary_iop "asr"(asr); + add_binary_iop "xor" (lxor)
let add_binary_bool_iop name f = let name = "Int." ^ name in @@ -157,6 +165,14 @@ let _ = add_binary_bool_iop "<" (<); add_binary_bool_iop ">=" (>=); add_binary_bool_iop "<=" (<=)
+let _ = + let name = "Int." ^ "not" in + let f loc (depth : eval_debug_info) (args_val: value_type list) = + match args_val with + | [Vint v] -> Vint(lnot v) + | _ -> error loc ("`" ^ name ^ "` expects 1 Int argument") in + add_builtin_function name f 1 + (* True integers (aka Z). *)
let add_binary_biop name f = @@ -209,6 +225,27 @@ let _ = add_binary_fop "+" (+.); add_binary_fop "*" ( *. ); add_binary_fop "/" (/.)
+let add_binary_bool_fop name f = + let name = "Float." ^ name in + let f loc (depth : eval_debug_info) (args_val: value_type list) = + match args_val with + | [Vfloat v; Vfloat w] -> o2v_bool (f v w) + | _ -> error loc ("`" ^ name ^ "` expects 2 Float arguments") in + add_builtin_function name f 2 + +let _ = add_binary_bool_fop "<" (<); + add_binary_bool_fop ">" (>); + add_binary_bool_fop "=" (=); + add_binary_bool_fop ">=" (>=); + add_binary_bool_fop "<=" (<=) + +let _ = let name = "Float." ^ "trunc" in + let f loc (depth : eval_debug_info) (args_val : value_type list) = + match args_val with + | [Vfloat v] -> Vfloat ( snd (modf v) ) + | _ -> error loc ("`" ^ name ^ "` expects 1 Float argument") in + add_builtin_function name f 1 + let make_symbol loc depth args_val = match args_val with | [Vstring str] -> Vsexp (Symbol (loc, str)) | _ -> error loc "Sexp.symbol expects one string as argument" @@ -248,6 +285,15 @@ 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"
+(* need either a character type or builtin string operation *) +let string_concat loc depth args_val = match args_val with + | [Vstring s1; Vstring s2] -> Vstring (s1 ^ s2) + | _ -> error loc "String.concat expects 2 strings" + +let string_sub loc depth args_val = match args_val with + | [Vstring s; Vint start; Vint len] -> Vstring (String.sub s start len) + | _ -> error loc "String.sub expects 1 string and 2 ints" + let sexp_eq loc depth args_val = match args_val with | [Vsexp (s1); Vsexp (s2)] -> o2v_bool (sexp_equal s1 s2) | _ -> error loc "Sexp.= expects 2 sexps" @@ -637,6 +683,8 @@ let register_builtin_functions () = ("Sexp.node" , make_node, 2); ("Sexp.dispatch" , sexp_dispatch, 7); ("String.=" , string_eq, 2); + ("String.concat" , string_concat, 2); + ("String.sub" , string_sub, 3); ("Sexp.=" , sexp_eq, 2); ("Float->String", float_to_string, 1); ("IO.bind" , io_bind, 2);
View it on GitLab: https://gitlab.com/monnier/typer/commit/a7dfcc1b8558dbfb6c3e6be359ea8e31f4ab...
Afficher les réponses par date