diff --git a/pervasives.eff b/pervasives.eff index 140de554..14228e79 100644 --- a/pervasives.eff +++ b/pervasives.eff @@ -75,6 +75,10 @@ external ( ^ ) : string -> string -> string = "^" external string_length : string -> int = "string_length" +external trim : string -> string = "trim" + +external split_on_char : char -> string -> string list = "split_on_char" + external to_string : 'a -> string = "to_string" type 'a option = None | Some of 'a diff --git a/src/runtime/external.ml b/src/runtime/external.ml index 6a18d5c4..c1fd3545 100644 --- a/src/runtime/external.ml +++ b/src/runtime/external.ml @@ -1,5 +1,7 @@ module V = Value +let from_char c = V.Const (Const.of_char c) + let from_bool b = V.Const (Const.of_boolean b) let from_int n = V.Const (Const.of_integer n) @@ -10,6 +12,8 @@ let from_float f = V.Const (Const.of_float f) let from_fun f = V.Closure f +let value_list b = V.Value (Tuple b) + let value_bool b = V.Value (from_bool b) let value_int n = V.Value (from_int n) @@ -158,10 +162,19 @@ let arithmetic_operations = ; ("/.", float_float_to_float ( /. )) ] +let string_string_to_list f = + let ff v1 v2 = value_list (List.map from_str (f (V.to_char v1) (V.to_str v2))) in + binary_closure ff + + let string_operations = [ ("^", binary_closure (fun v1 v2 -> value_str (V.to_str v1 ^ V.to_str v2))) - ; ( "string_length" - , from_fun (fun v -> value_int (String.length (V.to_str v))) ) ] + ; ( "string_length", from_fun (fun v -> value_int (String.length (V.to_str v))) ) + ; ( "trim", from_fun (fun v -> value_str (String.trim (V.to_str v))) ) + ; ( "split_on_char", string_string_to_list String.split_on_char) + ] + + let conversion_functions = diff --git a/src/runtime/value.ml b/src/runtime/value.ml index b1ac5b36..40747f57 100644 --- a/src/runtime/value.ml +++ b/src/runtime/value.ml @@ -31,6 +31,10 @@ let to_out_channel = function | _ -> Error.runtime "A out_channel value expected." +let to_char = function + | Const Const.Char b -> b + | _ -> Error.runtime "A char value expected." + let to_bool = function | Const Const.Boolean b -> b | _ -> Error.runtime "A boolean value expected." diff --git a/src/runtime/value.mli b/src/runtime/value.mli index c04e944d..85e59116 100644 --- a/src/runtime/value.mli +++ b/src/runtime/value.mli @@ -20,6 +20,8 @@ val second : value -> value val to_out_channel : value -> out_channel val to_in_channel : value -> in_channel +val to_char : value -> char + val to_bool : value -> bool val to_int : value -> int diff --git a/src/typing/infer.ml b/src/typing/infer.ml index 9e075f7f..2c4b56d0 100644 --- a/src/typing/infer.ml +++ b/src/typing/infer.ml @@ -45,6 +45,7 @@ let ty_of_const = function | Const.Float _ -> Type.float_ty | Const.Out_channel _ -> Type.out_channel_ty | Const.In_channel _ -> Type.in_channel_ty + | Const.Char _ -> Type.char_ty (* [infer_pattern cstr pp] infers the type of pattern [pp]. It returns the list of diff --git a/src/typing/tctx.ml b/src/typing/tctx.ml index d8ab8a74..b12e036c 100644 --- a/src/typing/tctx.ml +++ b/src/typing/tctx.ml @@ -12,6 +12,7 @@ type tyctx = (OldUtils.tyname, Type.ty_param list * tydef) OldUtils.assoc let initial : tyctx = [ ("in_channel", ([], Inline T.in_channel_ty)) ; ("out_channel", ([], Inline T.out_channel_ty)) + ; ("char", ([], Inline T.char_ty)) ; ("bool", ([], Inline T.bool_ty)) ; ("unit", ([], Inline T.unit_ty)) ; ("int", ([], Inline T.int_ty)) diff --git a/src/typing/type.ml b/src/typing/type.ml index 9a127d8a..42625c11 100644 --- a/src/typing/type.ml +++ b/src/typing/type.ml @@ -29,6 +29,8 @@ let out_channel_ty = Basic "out_channel" let universal_ty = Basic "_" +let char_ty = Basic "char" + let int_ty = Basic "int" let string_ty = Basic "string" diff --git a/src/utils/const.ml b/src/utils/const.ml index 841f1e1f..71b2c9db 100644 --- a/src/utils/const.ml +++ b/src/utils/const.ml @@ -1,4 +1,5 @@ type t = + | Char of char | Integer of int | String of string | Boolean of bool @@ -10,6 +11,8 @@ type t = let of_in_channel n = In_channel n let of_out_channel n = Out_channel n +let of_char c = Char c + let of_integer n = Integer n let of_string s = String s @@ -24,6 +27,7 @@ let of_false = of_boolean false let print c ppf = match c with + | Char k -> Format.fprintf ppf "%c" k | Integer k -> Format.fprintf ppf "%d" k | String s -> Format.fprintf ppf "%S" s | Boolean b -> Format.fprintf ppf "%B" b @@ -44,6 +48,7 @@ let compare c1 c2 = | String s1, String s2 -> cmp s1 s2 | Boolean b1, Boolean b2 -> cmp b1 b2 | Float x1, Float x2 -> cmp x1 x2 + | Char x1, Char x2 -> cmp x1 x2 | _ -> Error.runtime "Incomparable constants %t and %t" (print c1) (print c2) diff --git a/src/utils/const.mli b/src/utils/const.mli index 22d2d31a..d789cc3d 100644 --- a/src/utils/const.mli +++ b/src/utils/const.mli @@ -1,4 +1,5 @@ type t = private + | Char of char | Integer of int | String of string | Boolean of bool @@ -9,6 +10,8 @@ type t = private val of_in_channel : in_channel -> t val of_out_channel : out_channel -> t +val of_char : char -> t + val of_integer : int -> t val of_string : string -> t