Replace GADTs to normal datatypes

ast.ml

@@ -1,27 +1,24 @@
-type _ typ =
-  | Int : int -> int typ
-  | Unit : unit typ
+type typ =
+  | Int of int
+  | Unit
 
-let typ_to_string : type a. a typ -> string = function
+let typ_to_string = function
   | Int n -> Printf.sprintf "%d" n
   | Unit -> "()"
 
-type (_, _) binop =
-  | Add : (int, int) binop
-  | Sub : (int, int) binop
-  | Mul : (int, int) binop
-  | Div : (int, int) binop
+type binop =
+  | Add | Sub | Mul | Div
 
-let binop_to_string : type a b. (a, b) binop -> string = function
+let binop_to_string = function
   | Add -> "+"
   | Sub -> "-"
   | Mul -> "*"
   | Div -> "/"
 
-type _ t =
-  | Value : 'a typ -> 'a t
-  | Binop : 'a t * ('a, 'b) binop * 'a t -> 'b t
-  | Set_binop_pre : ('a, 'b) binop * int t -> unit t
+type t =
+  | Value of typ
+  | Binop of t * binop * t
+  | Set_binop_pre of binop * t
 
 let value v = Value v
 
@@ -35,7 +32,7 @@ let set_binop_pre op pre =
 let print ast =
   let pr = Printf.printf in
   let pv v = pr "%s" @@ typ_to_string v in
-  let rec aux : type a. a t -> unit = function
+  let rec aux = function
     | Value n -> pv n
     | Binop (left, op, right) -> begin
         pr "(%s " @@ binop_to_string op;

eval.ml

@@ -1,18 +1,22 @@
 open Ast
 
-let binop_to_func : type a b. (a, b) Ast.binop -> (a -> a -> b) = function
-  | Add -> Int.add
-  | Sub -> Int.sub
-  | Mul -> Int.mul
-  | Div -> Int.div
-  | Eq -> (=)
+let intop f a b =
+  match a, b with
+  | Int a, Int b -> Int (f a b)
+  | _ -> failwith "typecheck failed"
 
-let rec eval : type a. a Ast.t -> a = function
-  | Value (Int t) -> t
-  | Value Unit -> ()
+let binop_to_func = function
+  | Add -> intop Int.add
+  | Sub -> intop Int.sub
+  | Mul -> intop Int.mul
+  | Div -> intop Int.div
+
+let rec eval = function
+  | Value v -> v
   | Binop (l, op, r) ->
     let f = binop_to_func op in
     f (eval l) (eval r)
   | Set_binop_pre (op, l) ->
-    Hashtbl.replace Parser.precedence
-      (Ast.binop_to_string op) (eval l)
+    let l = match eval l with Int n -> n | _ -> failwith "not int" in 
+    Hashtbl.replace Parser.precedence (Ast.binop_to_string op) l;
+    Unit

lex.ml

@@ -15,7 +15,7 @@ let is_whitespace = function
   | _ -> false
 
 let is_alpha c =
-  'A' <= c && c <= 'Z' && 'a' <= c && c <= 'z'
+  ('A' <= c && c <= 'Z') || ('a' <= c && c <= 'z')
 
 let is_ident_start =
   either is_alpha ((=) '_')
@@ -48,9 +48,11 @@ let tokenize (str : string) : tokens =
         let n = String.of_seq @@ Seq.cons x n in
         Seq.cons (of_string n) (aux s)
       else if is_ident_start x then
-        let id, s = partition_while is_ident s in
-        let id = String.of_seq @@ Seq.cons x id in
-        Seq.cons (Ident id) (aux s)
+        begin
+          let id, s = partition_while is_ident s in
+          let id = String.of_seq @@ Seq.cons x id in
+          Seq.cons (Ident id) (aux s)
+        end
       else
         Seq.cons (of_char x) (aux s)
   in

main.ml

@@ -7,7 +7,8 @@ let rec repl () : unit =
     |> Lex.tokenize
     |> Parser.parse
     |> Eval.eval
-    |> Printf.printf "%d\n";
+    |> Ast.typ_to_string
+    |> Printf.printf "%s\n";
     repl ()
   end
 

parser.ml

@@ -9,6 +9,10 @@ let expected t =
 let unexpected_token t =
   raise @@ Unexpected_token (Token.to_string t)
 
+(* precedence table.
+ * my first thought was using some sort of partially-ordered graph for
+ * precedency, but infering precedence relation from the graph is hard
+ * and the graph can be made to have loops, I just used plain table. *)
 let precedence = [
   "+", 10;
   "-", 10;
@@ -19,6 +23,9 @@ let precedence = [
 let precedence_of op =
   Hashtbl.find precedence (Ast.binop_to_string op)
 
+let is_left_to_right = function
+  | Add | Sub | Mul | Div -> true
+
 let token_to_op = function
   | Token.Plus -> Add
   | Minus -> Sub
@@ -26,7 +33,7 @@ let token_to_op = function
   | Slash -> Div
   | _ -> failwith "Parser.token_to_op"
 
-let parse : type a. Token.t Seq.t -> a Ast.t = fun ts ->
+let parse ts =
   (* value := int | ( expr ) *)
   let rec value seq =
     match seq () with
@@ -75,7 +82,7 @@ let parse : type a. Token.t Seq.t -> a Ast.t = fun ts ->
 
   and expr seq =
     match seq () with
-    | Seq.Nil -> Value Unit (* nop *)
+    | Seq.Nil -> Value Unit, Seq.empty (* nop *)
     | Seq.Cons (x, s) -> begin match x with
         | Ident "set" -> set_conf s
         | _ ->
@@ -83,8 +90,6 @@ let parse : type a. Token.t Seq.t -> a Ast.t = fun ts ->
           binop ~-1 left seq
       end
   in
-  let ast, _ = expr ts in
-  (*
+  let ast, rest = expr ts in
   if rest () <> Seq.Nil then failwith "Parser.parse";
-     *)
   ast