From ee235235b98d01b00de5a446b48d6dec574b1458 Mon Sep 17 00:00:00 2001
From: William Carroll <wpcarro@gmail.com>
Date: Mon, 24 Oct 2022 17:53:21 -0400
Subject: feat(wpcarro/compiler): Support string literal type

```
repl> "Hello, world"
String
repl> (fn x "testing")
a0 -> String
```

Change-Id: Ia76299a56aa4d2032c9a21277e2fddfb2e055831
Reviewed-on: https://cl.tvl.fyi/c/depot/+/7079
Tested-by: BuildkiteCI
Reviewed-by: wpcarro <wpcarro@gmail.com>
---
 users/wpcarro/scratch/compiler/expr_parser.ml | 26 +++++++++++++++++++++++---
 users/wpcarro/scratch/compiler/inference.ml   |  7 ++++++-
 users/wpcarro/scratch/compiler/types.ml       |  6 +++++-
 3 files changed, 34 insertions(+), 5 deletions(-)

(limited to 'users/wpcarro/scratch/compiler')

diff --git a/users/wpcarro/scratch/compiler/expr_parser.ml b/users/wpcarro/scratch/compiler/expr_parser.ml
index 04ec1dbe92..8ac6756a4a 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 c9d4ba9c78..e00904a09e 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 79c51c6812..0acd05737c 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
 
-- 
cgit 1.4.1