diff --git a/users/wpcarro/scratch/compiler/expr_parser.ml b/users/wpcarro/scratch/compiler/expr_parser.ml index 04ec1dbe9..8ac6756a4 100644 --- a/users/wpcarro/scratch/compiler/expr_parser.ml +++ b/users/wpcarro/scratch/compiler/expr_parser.ml @@ -5,6 +5,7 @@ * * Helpers: * symbol -> [-a-z]+ + * string -> '"' [^"]* '"' * boolean -> 'true' | 'false' * integer -> [1-9][0-9]* * @@ -13,7 +14,7 @@ * binding -> '(' 'let' symbol expr expr ')' * funcdef -> '(' 'fn' symbol expr ')' * funccall -> '(' ( symbol | funcdef) expr ')' - * literal -> boolean | integer + * literal -> string | boolean | integer * variable -> symbol * * Example Usage: @@ -52,6 +53,17 @@ let tokenize (x : string) : token array = while !i < String.length x do match x.[!i] with | ' ' -> i := !i + 1 + (* strings *) + | '"' -> + let curr = ref "\"" in + i := !i + 1; + while x.[!i] != '"' do + curr := !curr ^ "?"; + i := !i + 1 + done; + curr := !curr ^ "\""; + Queue.push !curr q; + i := !i + 1 | '(' -> Queue.push "(" q; i := !i + 1 @@ -95,7 +107,14 @@ let parse_literal (p : parser) : Types.value option = | Some n -> p#advance; Some (ValueLiteral (LiteralInt n)) - | _ -> parse_variable p) + | _ -> + if String.starts_with "\"" x then + begin + p#advance; + Some (ValueLiteral (LiteralString x)) + end + else + parse_variable p) | _ -> None let rec parse_expression (p : parser) : Types.value option = @@ -144,7 +163,8 @@ let print_tokens (xs : string array) = |> List.map (Printf.sprintf "\"%s\"") |> String.concat ", " |> Printf.sprintf "tokens: [ %s ]" - |> print_string |> print_newline + |> print_string + |> print_newline let parse_language (x : string) : Types.value option = let tokens = tokenize x in diff --git a/users/wpcarro/scratch/compiler/inference.ml b/users/wpcarro/scratch/compiler/inference.ml index c9d4ba9c7..e00904a09 100644 --- a/users/wpcarro/scratch/compiler/inference.ml +++ b/users/wpcarro/scratch/compiler/inference.ml @@ -29,6 +29,7 @@ let rec free_type_vars (t : _type) : set = | TypeVariable k -> FromString.singleton k true | TypeInt -> FromString.empty | TypeBool -> FromString.empty + | TypeString -> FromString.empty | TypeArrow (a, b) -> lww (free_type_vars a) (free_type_vars b) let i : int ref = ref 0 @@ -51,6 +52,7 @@ let rec instantiate (q : quantified_type) : _type = match t with | TypeInt -> TypeInt | TypeBool -> TypeBool + | TypeString -> TypeString | TypeVariable k -> if List.exists (( == ) k) names then make_type_var () else TypeVariable k | TypeArrow (a, b) -> @@ -83,6 +85,7 @@ let rec substitute_type (s : substitution) (t : _type) : _type = | TypeArrow (a, b) -> TypeArrow (substitute_type s a, substitute_type s b) | TypeInt -> TypeInt | TypeBool -> TypeBool + | TypeString -> TypeString let substitute_quantified_type (s : substitution) (q : quantified_type) : quantified_type = let (QuantifiedType (names, t)) = q in @@ -102,6 +105,7 @@ let rec unify (a : _type) (b : _type) : substitution option = match (a, b) with | TypeInt, TypeInt -> Some FromString.empty | TypeBool, TypeBool -> Some FromString.empty + | TypeString, TypeString -> Some FromString.empty | TypeVariable k, _ -> Some (bind_var k b) | _, TypeVariable k -> Some (bind_var k a) | TypeArrow (a, b), TypeArrow (c, d) -> @@ -136,7 +140,8 @@ let rec infer (env : env) (x : value) : inference option = | ValueLiteral lit -> ( match lit with | LiteralInt _ -> Some (Inference (FromString.empty, TypeInt)) - | LiteralBool _ -> Some (Inference (FromString.empty, TypeBool))) + | LiteralBool _ -> Some (Inference (FromString.empty, TypeBool)) + | LiteralString _ -> Some (Inference (FromString.empty, TypeString))) | ValueVariable k -> let* v = FromString.find_opt k env in Some (Inference (FromString.empty, instantiate v)) diff --git a/users/wpcarro/scratch/compiler/types.ml b/users/wpcarro/scratch/compiler/types.ml index 79c51c681..0acd05737 100644 --- a/users/wpcarro/scratch/compiler/types.ml +++ b/users/wpcarro/scratch/compiler/types.ml @@ -1,4 +1,7 @@ -type literal = LiteralInt of int | LiteralBool of bool +type literal + = LiteralInt of int + | LiteralBool of bool + | LiteralString of string (* Lambda Calculus definition *) type value = @@ -14,6 +17,7 @@ module FromString = Map.Make (String) type _type = | TypeInt | TypeBool + | TypeString | TypeVariable of string | TypeArrow of _type * _type