Simon Janssen pushed to branch SimonJ at Stefan / Typer
Commits: 4480962a by JanssenSimon at 2022-08-26T11:12:07-04:00 Adds Chars to typer
- - - - -
4 changed files:
- btl/builtins.typer - btl/pervasive.typer - btl/poly-lits.typer - src/eval.ml
Changes:
===================================== btl/builtins.typer ===================================== @@ -134,6 +134,13 @@ Int_>= = Built-in "Int.>=" : Int -> Int -> Bool; %% bitwise negation Int_not = Built-in "Int.not" : Int -> Int;
+%% A `String` may in fact be a `Char` depending on usage +Char : Type; +Char = Int; + +Char->String = Built-in "Char->String" : Char -> String; +String->Char = Built-in "String->Char" : String -> Char; + %% `Int` and `Integer` are conceptually isomorphic in that they both %% represent unbounded integers, but in reality, both are bounded. %% `Int` is implemented with `int` type in ocaml (31 or 63 bits), and
===================================== btl/pervasive.typer ===================================== @@ -579,6 +579,13 @@ IntFromInteger = poly-lits.IntFromInteger; IntegerFromInteger = poly-lits.IntegerFromInteger; instance IntFromInteger IntegerFromInteger; typeclass FromInteger; +FromString = poly-lits.FromString; +mkFromString = poly-lits.mkFromString; +fromString = poly-lits.fromString; +CharFromString = poly-lits.CharFromString; +StringFromString = poly-lits.StringFromString; +instance CharFromString StringFromString; +typeclass FromString;
%% %% Monads
===================================== btl/poly-lits.typer ===================================== @@ -5,6 +5,15 @@ typeclass FromInteger;
fromInteger = lambda inst => case inst | mkFromInteger fromInteger => fromInteger;
+ +type (FromString (α : Type)) + | mkFromString (fromString : String -> α); + +typeclass FromString; + +fromString = lambda inst => case inst | mkFromString fromString => fromString; + + typer-immediate = macro (lambda args -> let deflt = @@ -14,11 +23,21 @@ typer-immediate = (case Sexp_wrap sexp | integer i => IO_return (quote (fromInteger (##typer-immediate (uquote sexp)))) + | string s => + IO_return (quote (fromString (##typer-immediate (uquote sexp)))) | _ => deflt) | _ => deflt);
+ IntegerFromInteger : FromInteger Integer; IntegerFromInteger = mkFromInteger I;
IntFromInteger : FromInteger Int; IntFromInteger = mkFromInteger Integer->Int; + + +StringFromString : FromString String; +StringFromString = mkFromString S; + +CharFromString : FromString Char; +CharFromString = mkFromString String->Char;
===================================== src/eval.ml ===================================== @@ -290,6 +290,27 @@ let _ = add_binary_bool_biop "<" BI.lt; | _ -> error loc {|"%s" expects 1 Integer argument|} name) 1
+(* Chars *) +let _ = let name = "Char->String" in + add_builtin_function + name + (fun loc (_depth : eval_debug_info) (args_val: value_type list) + -> match args_val with + | [Vint v] -> Vstring (Char.escaped (Char.chr v)) + | _ -> error loc {|"%s" expects 1 Char argument|} name) + 1; + let name = "String->Char" in + add_builtin_function + name + (fun loc (_depth : eval_debug_info) (args_val: value_type list) + -> match args_val with + | [Vstring v] + -> if String.length v = 1 then Vint (Char.code (String.get v 0)) + else error loc {|Non-character string in "%s"|} name + | _ -> error loc {|"%s" expects 1 String argument|} name) + 1 + + (* Floating point numers. *)
let add_binary_fop name f =
View it on GitLab: https://gitlab.com/monnier/typer/-/commit/4480962a73a09d6695ca02177ed03c3bdb...
Afficher les réponses par date