Write a first draft of the compiler.

Sorry I haven't been better about these commit messages.
You're not my mom.

1 files changed, 120 insertions, 1 deletions

diff --git a/syntax.sml b/syntax.sml
index fbb61bd..2e2cc11 100644
--- a/syntax.sml
+++ b/syntax.sml
@@ -1,9 +1,128 @@
 structure Syntax =
 struct
-  datatype expr = EIdent of string
+  (* SML syntax *)
+  datatype etype = Tyvar of string
+                 | Tycon of etype list * string
+                 | TyTuple of etype list
+                 | Tyfun of etype * etype
+
+  datatype expr = EIdent of string list
+                | EBuiltin of string
                 | EInt of int
                 | EStr of string
                 | ETuple of expr list
                 | EList of expr list
                 | EApp of expr * expr
+                | ETyped of expr * etype
+                | EAndAlso of expr * expr
+                | EOrElse of expr * expr
+                | ELet of dec list * expr
+
+  and dec = DVal of expr
+
+  (* Lambda language *)
+  datatype primop = PExit
+  datatype lexp = LApp of lexp * lexp
+                | LInt of int
+                | LString of string
+                | LRecord of lexp list
+                | LPrim of primop
+
+  (* CPS *)
+  type var = int
+  datatype value = VVar of var
+                 | VLabel of var
+                 | VInt of int
+                 | VString of string
+  datatype cexp = CRecord of (value * int list) list * var * cexp
+                | CSelect of int * value * var * cexp
+                | CApp of value * value list
+                | CFix of (var * var list * cexp) list * cexp
+                | CPrimop of primop * value list * var list * cexp list
+
+  datatype opcode = OAlloc of var * value
+                  | OCall
+                  | OPoke of int * var * value
+                  | OPeek of var * int * value
+                  | OShuf of var * value
+                  | OExit of value
+                  | OLabel of var
+
+  fun listToString (show : 'a -> string) (l : 'a list) =
+    "[" ^ String.concatWith ", " (map show l) ^ "]"
+
+  fun multilineListToString (show : string -> 'a -> string) (indent : string) (l : 'a list) =
+    case l of
+      [] => "[]"
+    | [x] => "[ " ^ show (indent ^ "  ") x ^ " ]"
+    | (x :: xs) =>
+        let val indent' = indent ^ "  "
+        in "[ " ^ show indent' x ^ concat (map (fn x => "\n" ^ indent ^ ", " ^ show indent' x) xs) ^ "\n" ^ indent ^ "]"
+        end
+
+  fun quote (s : string) : string = "\"" ^ String.toString s ^ "\""
+
+  fun etypeToString (x : etype) : string =
+    case x of
+      Tyvar s => "Tyvar " ^ quote s
+    | Tycon (args, con) => "Tycon (" ^ listToString etypeToString args ^ ", " ^ quote con ^ ")"
+    | TyTuple args => "TyTuple " ^ listToString etypeToString args
+    | Tyfun (a, b) => "Tyfun (" ^ etypeToString a ^ ", " ^ etypeToString b ^ ")"
+
+  fun exprToStringI (indent : string) (x : expr) : string =
+    let val self = exprToStringI indent
+    in case x of
+         EIdent i => "EIdent " ^ listToString quote i
+       | EBuiltin b => "EBuiltin " ^ quote b
+       | EInt i => "EInt " ^ Int.toString i
+       | EStr s => "EStr " ^ quote s
+       | ETuple xs => "ETuple " ^ listToString self xs
+       | EList l => "EList " ^ listToString self l
+       | EApp (f, x) => "EApp (" ^ self f ^ ", " ^ self x ^ ")"
+       | ETyped (e, t) => "ETyped (" ^ self e ^ ", " ^ etypeToString t ^ ")"
+       | EAndAlso (a, b) => "EAndAlso (" ^ self a ^ ", " ^ self b ^ ")"
+       | EOrElse (a, b) => "EOrElse (" ^ self a ^ ", " ^ self b ^ ")"
+       | ELet (decs, e) => "ELet (" ^ multilineListToString decToStringI indent decs ^ ", " ^ self e ^ ")"
+    end
+
+  and decToStringI (indent : string) (x : dec) : string =
+    case x of
+      DVal e => "DVal (" ^ exprToStringI indent e ^ ")"
+
+  val exprToString : expr -> string = exprToStringI ""
+
+  val decToString : dec -> string = decToStringI ""
+
+  fun primopToString (x : primop) : string =
+    case x of
+      PExit => "PExit"
+
+  fun lexpToString (x : lexp) : string =
+    case x of
+      LApp (a, b) => "LApp (" ^ lexpToString a ^ ", " ^ lexpToString b ^ ")"
+    | LInt i => "LInt " ^ Int.toString i
+    | LString s => "LString " ^ quote s
+    | LRecord l => "LRecord " ^ listToString lexpToString l
+    | LPrim p => "LPrim " ^ primopToString p
+
+  fun valueToString (x : value) : string =
+    case x of
+      VVar v => "VVar " ^ Int.toString v
+    | VLabel l => "VLabel " ^ Int.toString l
+    | VInt i => "VInt " ^ Int.toString i
+    | VString s => "VString " ^ quote s
+
+  fun cexpToStringI (indent : string) (x : cexp) : string =
+    let
+      val self = cexpToStringI indent
+      val newIndent = indent ^ "\t"
+    in case x of
+         CRecord (a, b, c) => "CRecord (" ^ listToString (fn (x, y) => "(" ^ valueToString x ^ ", " ^ listToString Int.toString y ^ ")") a ^ ", " ^ Int.toString b ^ ",\n" ^ indent ^ self c ^ ")"
+       | CSelect (a, b, c, d) => "CSelect (" ^ Int.toString a ^ ", " ^ valueToString b ^ ", " ^ Int.toString c ^ ",\n" ^ indent ^ self d ^ ")"
+       | CApp (a, b) => "CApp (" ^ valueToString a ^ ", " ^ listToString valueToString b ^ ")"
+       | CFix (a, b) => "CFix (" ^ multilineListToString (fn indent' => fn (x, y, z) => "(" ^ Int.toString x ^ ", " ^ listToString Int.toString y ^ ",\n" ^ indent' ^ "\t" ^ cexpToStringI (indent' ^ "\t") z) newIndent a ^ ",\n" ^ newIndent ^ cexpToStringI newIndent b ^ ")"
+       | CPrimop (a, b, c, d) => "CPrimop (" ^ primopToString a ^ ", " ^ listToString valueToString b ^ ", " ^ listToString Int.toString c ^ ",\n" ^ indent ^ multilineListToString cexpToStringI indent d ^ ")"
+    end
+
+  val cexpToString : cexp -> string = cexpToStringI ""
 end