Combine structs and expressions

8 files changed, 351 insertions, 270 deletions

diff --git a/Elab.sml b/Elab.sml
index cd7a5d4..ba436f5 100644
--- a/Elab.sml
+++ b/Elab.sml
@@ -1,7 +1,9 @@
 structure Elab =
 struct
-  structure StringMap = Map(type k = string val cmp = String.compare)
   structure IntMap = Map(type k = int val cmp = Int.compare)
+  structure IdentMap = Map(type k = Syntax.identType * string val cmp = Syntax.compareIdentifiers)
+
+  fun printIdent (ty : Syntax.identType, name : string) : string = "(" ^ ShowSyntax.identTypeToString ty ^ ", \"" ^ name ^ "\")"
 
   fun primop (s : string) : Syntax.primop =
     case s of
@@ -35,24 +37,39 @@ struct
         NONE => []
       | SOME (heads, tails) => heads :: transpose tails
 
-  datatype env = Env of int StringMap.map
+  type env = int IdentMap.map
 
-  val emptyEnv = Env StringMap.empty
+  val emptyEnv = IdentMap.empty
 
-  fun bindVar (name : string) (sym : int) (Env env) : env = Env (StringMap.insert name sym env)
+  fun bindVar (name : Syntax.identType * string) (sym : int) (env : env) : env =
+    IdentMap.insert name sym env
 
-  fun lookupVar (name : string) (Env env) : int =
-    case StringMap.lookup name env of
+  fun lookupVar (name: Syntax.identType * string) (env : env) : int =
+    case IdentMap.lookup name env of
       SOME x => x
-    | NONE => raise Fail ("unbound identifier " ^ name)
+    | NONE => raise Fail ("unbound identifier " ^ printIdent name)
+
+  fun bindDataCons (cons : (string * Syntax.ty option) list) (env : env) : env =
+    foldl
+      (fn ((name, _), acc) =>
+        IdentMap.insert (Syntax.ITVar, name) (GenSym.new ()) acc)
+      env
+      cons
+
+  fun patternBindings (expr : Syntax.lexp) (Syntax.TPVar v, _ : Syntax.ty) : (string * Syntax.lexp) list = [(v, expr)]
+    | patternBindings expr (Syntax.TPTuple t, _) =
+        List.concat (map (fn (i, p) => patternBindings (Syntax.LSelect (i, expr)) p) (enumerate t))
+    | patternBindings expr (Syntax.TPCon (_, arg), _) = patternBindings (Syntax.LSelect (1, expr)) arg
+    | patternBindings _ _ = []
+
+  fun declBoundVars (Syntax.TDVal (p, _)) : (Syntax.identType * string) list = map (fn (x, _) => (Syntax.ITVar, x)) (patternBindings (Syntax.LInt 0) p)
+    | declBoundVars (Syntax.TDValRec (p, _)) = map (fn (x, _) => (Syntax.ITVar, x)) (patternBindings (Syntax.LInt 0) p)
+    | declBoundVars (Syntax.TDFun (name, _)) = [(Syntax.ITVar, name)]
+    | declBoundVars (Syntax.TDDatatype (_, cons)) = map (fn (x, _) => (Syntax.ITVar, x)) cons
+    | declBoundVars (Syntax.TDStruct (name, _)) = [(Syntax.ITStruct, name)]
+    | declBoundVars (Syntax.TDFunctor (name, _, _, _)) = [(Syntax.ITFunctor, name)]
 
-  fun bindDataCons (cons : (string * Syntax.ty option) list) (Env env) : env =
-    Env
-      (foldl
-        (fn ((name, _), acc) =>
-          StringMap.insert name (GenSym.new ()) acc)
-        env
-        cons)
+  fun structBoundVars (decls : Syntax.typedDec list) : (Syntax.identType * string) list = List.concatMap declBoundVars decls
 
   fun patternMatrix (arms : (Syntax.typedPat * Syntax.ty) list) : (Syntax.typedPat * Syntax.ty) list list =
     if not (isSome (List.find (fn (Syntax.TPTuple t, _) => true | _ => false) arms)) then [arms] else
@@ -80,12 +97,6 @@ struct
     | _ => List.concat (map (fn (i, col) => occurrenceVector (Syntax.LSelect (i, expr)) col) (enumerate cols))
   end
 
-  fun patternBindings (expr : Syntax.lexp) (Syntax.TPVar v, _ : Syntax.ty) : (string * Syntax.lexp) list = [(v, expr)]
-    | patternBindings expr (Syntax.TPTuple t, _) =
-        List.concat (map (fn (i, p) => patternBindings (Syntax.LSelect (i, expr)) p) (enumerate t))
-    | patternBindings expr (Syntax.TPCon (_, arg), _) = patternBindings (Syntax.LSelect (1, expr)) arg
-    | patternBindings _ _ = []
-
   fun swap1 0 (l : 'a list) : 'a list = l
     | swap1 n (first :: rest) =
         (case swap1 (n - 1) rest of
@@ -205,14 +216,6 @@ struct
               end
         end
 
-  fun declBoundVars (Syntax.TDVal (p, _)) : string list = map (fn (x, _) => x) (patternBindings (Syntax.LInt 0) p)
-    | declBoundVars (Syntax.TDValRec (p, _)) = map (fn (x, _) => x) (patternBindings (Syntax.LInt 0) p)
-    | declBoundVars (Syntax.TDFun (name, _)) = [name]
-    | declBoundVars (Syntax.TDDatatype (_, cons)) = map (fn (x, _) => x) cons
-    | declBoundVars (Syntax.TDStruct (name, _)) = [name]
-
-  fun structBoundVars (decls : Syntax.typedDec list) : string list = List.concatMap declBoundVars decls
-
   fun actionVector (env : env) (expr : Syntax.lexp) (arms : ((Syntax.typedPat * Syntax.ty) * (Syntax.typedExpr * Syntax.ty)) list) : Syntax.lexp list =
     map
       (fn (p, body) =>
@@ -221,13 +224,13 @@ struct
           val env =
             foldl
               (fn ((name, _), env) =>
-                bindVar name (GenSym.new ()) env)
+                bindVar (Syntax.ITVar, name) (GenSym.new ()) env)
               env
               bindings
         in
           foldl
             (fn ((name, binding), acc) =>
-              Syntax.LApp (Syntax.LFn (lookupVar name env, acc), binding))
+              Syntax.LApp (Syntax.LFn (lookupVar (Syntax.ITVar, name) env, acc), binding))
             (elab env body)
             bindings
         end)
@@ -256,13 +259,13 @@ struct
   and elab (env : env) (p : Syntax.typedExpr, ty : Syntax.ty) : Syntax.lexp =
     case p of
       Syntax.TEIdent i => Syntax.LVar (lookupVar i env)
-    | Syntax.TEDot (structExpr as (_, Syntax.TStruct (_, fields)), field) =>
+    | Syntax.TEDot (structExpr as (_, Syntax.TStruct fields), field) =>
         let
           val i =
             case List.find (fn (_, (x, _)) => x = field) (enumerate fields) of
-              NONE => raise Fail ("Unknown field " ^ field)
+              NONE => raise Fail ("Unknown field " ^ printIdent field)
             | SOME (i, _) => i
-        in Syntax.LSelect (i, elabStructExpr env structExpr) end
+        in Syntax.LSelect (i, elab env structExpr) end
     | Syntax.TEBuiltin builtin => Syntax.LPrim (primop builtin)
     | Syntax.TEInt i => Syntax.LInt i
     | Syntax.TEStr s => Syntax.LString s
@@ -277,7 +280,7 @@ struct
     | Syntax.TEAndAlso (_, _) => raise Fail "unimplemented"
     | Syntax.TEOrElse (_, _) => raise Fail "unimplemented"
     | Syntax.TELet ([], body) => elab env body
-    | Syntax.TELet (Syntax.TDDatatype (name, cons) :: decls, body) =>
+    | Syntax.TELet (Syntax.TDDatatype (_, cons) :: decls, body) =>
         let
           val env = bindDataCons cons env
           val funs =
@@ -285,12 +288,12 @@ struct
               (fn (_, (_, NONE)) => NONE
                 | (i, (name, _)) =>
                     let val v = GenSym.new ()
-                    in SOME (lookupVar name env, v, Syntax.LRecord [Syntax.LInt i, Syntax.LVar v])
+                    in SOME (lookupVar (Syntax.ITVar, name) env, v, Syntax.LRecord [Syntax.LInt i, Syntax.LVar v])
                     end)
               (enumerate cons)
           val vals =
             List.mapPartial
-              (fn (i, (name, NONE)) => SOME (lookupVar name env, Syntax.LRecord [Syntax.LInt i])
+              (fn (i, (name, NONE)) => SOME (lookupVar (Syntax.ITVar, name) env, Syntax.LRecord [Syntax.LInt i])
                 | _ => NONE)
               (enumerate cons)
         in
@@ -305,7 +308,7 @@ struct
     | Syntax.TELet (Syntax.TDValRec ((Syntax.TPVar name, _), f as (Syntax.TELambda _, _)) :: decls, body) =>
         let
           val n = GenSym.new ()
-          val env = bindVar name n env
+          val env = bindVar (Syntax.ITVar, name) n env
           val (arg, fnBody) =
             case elab env f of
               Syntax.LFn x => x
@@ -323,7 +326,7 @@ struct
         else let
           val n = GenSym.new ()
           val temps = List.tabulate (nPats, fn _ => GenSym.new ())
-          val env = bindVar name n env
+          val env = bindVar (Syntax.ITVar, name) n env
           val t = GenSym.new ()
           val innerCase =
             elabCase env (Syntax.LVar t)
@@ -344,41 +347,58 @@ struct
             , elab env (Syntax.TELet (decls, body), ty)
             )
         end end
-    | Syntax.TELet (Syntax.TDStruct (name, (Syntax.TSStruct structDecls, _)) :: decls, body) =>
-        let
-          val names = structBoundVars structDecls
-          val tuple = elab env (Syntax.TELet (structDecls, (Syntax.TETuple (map (fn n => (Syntax.TEIdent n, Syntax.TTuple [])) names), Syntax.TTuple [] (* TODO *))), Syntax.TTuple [] (* TODO *))
-          val v = GenSym.new ()
-          val env = bindVar name v env
-        in Syntax.LApp (Syntax.LFn (v, elab env (Syntax.TELet (decls, body), ty)), tuple) end
-    | Syntax.TELet (Syntax.TDStruct (name, (Syntax.TSIdent structName, _)) :: decls, body) =>
+    | Syntax.TELet (Syntax.TDStruct (name, expr) :: decls, body) =>
         let
-          val v = GenSym.new ()
-          val env = bindVar name v env
-        in Syntax.LApp (Syntax.LFn (v, elab env (Syntax.TELet (decls, body), ty)), Syntax.LVar (lookupVar structName env)) end
-    | Syntax.TELet (Syntax.TDStruct (name, (Syntax.TSDot (parent as (_, Syntax.TStruct (fields, _)), field), _)) :: decls, body) =>
+          val s = GenSym.new ()
+          val structExpr = elab env expr
+          val env = bindVar (Syntax.ITStruct, name) s env
+        in Syntax.LApp (Syntax.LFn (s, elab env (Syntax.TELet (decls, body), ty)), structExpr)
+        end
+    | Syntax.TELet (Syntax.TDFunctor (name, arg, _, functorBody) :: decls, body) =>
         let
-          val v = GenSym.new ()
-          val env = bindVar name v env
-          val i =
-            case List.find (fn (_, (x, _)) => x = field) (enumerate fields) of
-              NONE => raise Fail ("Unknown field " ^ field)
-            | SOME (i, _) => i
-        in Syntax.LApp (Syntax.LFn (v, elab env (Syntax.TELet (decls, body), ty)), Syntax.LSelect (i, elabStructExpr env parent)) end
+          val (n, v) = (GenSym.new (), GenSym.new())
+          val functorBody = elab (bindVar (Syntax.ITStruct, arg) v env) functorBody
+          val env = bindVar (Syntax.ITFunctor, name) n env
+        in
+          Syntax.LFix
+            ( [ ( n
+                , v
+                , functorBody
+                )
+              ]
+            , elab env (Syntax.TELet (decls, body), ty)
+            )
+        end
     | Syntax.TELambda body =>
         let val v = GenSym.new ()
         in Syntax.LFn (v, elabCase env (Syntax.LVar v) [body]) end
     | Syntax.TECase (expr, arms) =>
         let val v = GenSym.new ()
         in Syntax.LApp (Syntax.LFn (v, elabCase env (Syntax.LVar v) arms), elab env expr) end
-
-  and elabStructExpr (env : env) (Syntax.TSIdent structName, _ : Syntax.structType) : Syntax.lexp = Syntax.LVar (lookupVar structName env)
-    | elabStructExpr env (Syntax.TSDot (expr as (_, Syntax.TStruct (_, fields)), field), _) =
-        let val i =
-          case List.find (fn (_, (x, _)) => x = field) (enumerate fields) of
-            SOME (i, _) => i
-          | NONE => raise Fail "unbound field"
-        in Syntax.LSelect (i, elabStructExpr env expr) end
+    | Syntax.TEStruct structDecls =>
+        let val names = structBoundVars structDecls
+        in
+          elab env
+            (Syntax.TELet
+              (structDecls,
+              (Syntax.TETuple (map (fn n => (Syntax.TEIdent n, Syntax.TTuple [])) names),
+                Syntax.TTuple [] (* TODO *))),
+            Syntax.TTuple [] (* TODO *))
+        end
+    | Syntax.TEFunctorApp (func as (_, funcType as Syntax.TFunctor (Syntax.TStruct funcArgs, _)), arg as (_, argType as Syntax.TStruct args)) =>
+        let
+          val _ = print (ShowSyntax.tyToString funcType)
+          val _ = print (ShowSyntax.tyToString argType)
+          val func = elab env func
+          val arg = elab env arg
+          val (_, argIdxs) =
+            foldl
+              (fn ((name, _), (i, argIdxs)) => (i + 1, IdentMap.insert name i argIdxs))
+              (0, IdentMap.empty)
+              args
+          val tuple = Syntax.LRecord (map (fn (name, _) => Syntax.LSelect (valOf (IdentMap.lookup name argIdxs), arg)) funcArgs)
+        in Syntax.LApp (func, tuple) end
+    | _ => raise Fail ("invalid expression " ^ ShowSyntax.typedExprToString p)
 
   fun elaborate (p : Syntax.typedExpr * Syntax.ty) : Syntax.lexp = elab emptyEnv p
 end
diff --git a/Parser.sml b/Parser.sml
index a967880..8f43352 100644
--- a/Parser.sml
+++ b/Parser.sml
@@ -123,6 +123,8 @@ struct
           | (Empty, Result.Left err) => (consumed1, Result.Left (withHints hints err)))
       | (consumed, Result.Left err) => (consumed, Result.Left err)
 
+  fun thunk (f : unit -> 'a parser) : 'a parser = fn st => f () st
+
   fun (p1 : 'a parser) >> (p2 : 'b parser) : 'b parser = bind p1 (fn _ => p2)
 
   fun (p : 'a parser) <?> (msg : string) : 'a parser =
@@ -451,25 +453,22 @@ struct
       typedPat
       (List.tabulate (10, fn i => 9 - i)) st
 
-  fun makeConvolutedEDotSyntax ([i] : string list) : Syntax.expr = Syntax.EIdent i
-    | makeConvolutedEDotSyntax (i :: is) =
+  fun makeConvolutedEDotSyntax (ty : Syntax.identType) ([i] : string list) : Syntax.expr =
+        Syntax.EIdent (ty, i)
+    | makeConvolutedEDotSyntax (ty : Syntax.identType) (i :: is : string list) : Syntax.expr =
         let
-          val structSelectors = List.take (is, length is - 1)
-          val exprSelector = List.last is
-        in
-          Syntax.EDot
-            ( foldl (fn (x, acc) => Syntax.SDot (acc, x)) (Syntax.SIdent i) structSelectors
-            , exprSelector
-            )
-        end
-    | makeConvolutedEDotSyntax _ = raise Fail "bad identifier"
+          fun go acc [i] = Syntax.EDot (acc, (ty, i))
+            | go acc (i :: is) = go (Syntax.EDot (acc, (Syntax.ITStruct, i))) is
+            | go _ _ = raise Fail "unreachable"
+        in go (Syntax.EIdent (Syntax.ITStruct, i)) is end
+    | makeConvolutedEDotSyntax _ _ = raise Fail "bad identifier"
 
   val rec atom : Syntax.expr parser =
     fn st =>
       (Syntax.EInt <$> integer
       <|> Syntax.EStr <$> stringConstant
-      <|> makeConvolutedEDotSyntax <$> longIdentifier
-      <|> (reserved "op" >> makeConvolutedEDotSyntax <$> longInfixIdentifier)
+      <|> makeConvolutedEDotSyntax Syntax.ITVar <$> longIdentifier
+      <|> (reserved "op" >> makeConvolutedEDotSyntax Syntax.ITVar <$> longInfixIdentifier)
       <|> builtin
       <|> (reserved "let" >>
            bind (many dec) (fn decs =>
@@ -496,14 +495,14 @@ struct
             fun exprLeft expr1 =
               bind (leftOp i) (fn opEx =>
               bind exprLower (fn expr2 =>
-              let val app = Syntax.EApp (Syntax.EIdent opEx, Syntax.ETuple [expr1, expr2])
+              let val app = Syntax.EApp (Syntax.EIdent (Syntax.ITVar, opEx), Syntax.ETuple [expr1, expr2])
               in exprLeft app <|> const app
               end))
             fun exprRight expr1 =
               bind (rightOp i) (fn opEx =>
               bind exprLower (fn expr2 =>
               bind (exprRight expr2 <|> const expr2) (fn rest =>
-              const (Syntax.EApp (Syntax.EIdent opEx, Syntax.ETuple [expr1, rest])))))
+              const (Syntax.EApp (Syntax.EIdent (Syntax.ITVar, opEx), Syntax.ETuple [expr1, rest])))))
           in
             bind exprLower (fn expr1 =>
             exprLeft expr1 <|> exprRight expr1 <|> const expr1)
@@ -605,6 +604,7 @@ struct
                   bind (many1 atpat) (fn args =>
                   const (name, args))
               | _ => unexpected "pattern"))) (fn (name, args) =>
+          ((reserved ":" >> () <$ parseType) <|> const ()) >>
           reserved "=" >>
           bind expr (fn body =>
           const (name, args, body))))
@@ -627,27 +627,19 @@ struct
       reserved "=" >>
       bind structExpr (fn str =>
       const (SOME (Syntax.DStruct (strID, s, str)))))))
-  <|> (reserved "signature" >>
-      bind identifier (fn sigID =>
-      reserved "=" >>
-      reserved "sig" >>
-      bind
-        (many
-          (reserved "val" >>
-          bind identifier (fn id =>
-          reserved ":" >>
-          bind parseType (fn ty =>
-          const (id, ty)))))
-        (fn bindings =>
-      reserved "end" >>
-      const (SOME (Syntax.DSig (sigID, bindings))))))
   <|> dec) st
-  and structExpr : Syntax.structExpr parser = fn st =>
+  and structExpr : Syntax.expr parser = fn st =>
         ((reserved "struct" >>
         bind (many strdec) (fn bindings =>
         reserved "end" >>
-        const (Syntax.SStruct (List.mapPartial (fn x => x) bindings))))
-    <|> (fn is => foldl (fn (x, acc) => Syntax.SDot (acc, x)) (Syntax.SIdent (hd is)) (tl is)) <$> longIdentifier) st
+        const (Syntax.EStruct (List.mapPartial (fn x => x) bindings))))
+    <|> bind longIdentifier (fn is =>
+        (symbol "(" >>
+          thunk (fn () => if length is <> 1 then raise Fail "bad functor has a dot" else
+          bind structExpr (fn arg =>
+          symbol ")" >>
+          const (Syntax.EFunctorApp (Syntax.EIdent (Syntax.ITFunctor, hd is), arg)))))
+        <|> const (makeConvolutedEDotSyntax Syntax.ITStruct is))) st
 
   (* There's ambiguity between pattern variables and constructors that can only
    * be resolved by checking for constructors in scope *)
@@ -674,19 +666,9 @@ struct
         Syntax.DFun (f, map (fn (args, body) => (map (fixPatConstructors constructors) args, fixConstructors constructors body)) arms)
     | fixDecConstructors _ (decl as Syntax.DDatatype _) = decl
     | fixDecConstructors _ (decl as Syntax.DType _) = decl
-    | fixDecConstructors constructors (Syntax.DStruct (name, s, str)) = Syntax.DStruct (name, s, fixStructExprConstructors constructors str)
+    | fixDecConstructors constructors (Syntax.DStruct (name, s, str)) = Syntax.DStruct (name, s, fixConstructors constructors str)
     | fixDecConstructors constructors (s as Syntax.DSig _) = s
-
-  and fixStructExprConstructors (constructors : unit StringMap.map) (Syntax.SStruct decls) : Syntax.structExpr =
-        let val constructors = ref constructors in
-          Syntax.SStruct
-            (map
-              (fn dec =>
-                (constructors := foldl (fn (x, acc) => StringMap.insert x () acc) (!constructors) (findConstructors dec) ;
-                fixDecConstructors (!constructors) dec))
-              decls)
-        end
-    | fixStructExprConstructors _ expr = expr
+    | fixDecConstructors constructors (Syntax.DFunctor (name, arg, ty, body)) = Syntax.DFunctor (name, arg, ty, fixConstructors constructors body)
 
   and fixConstructors (constructors : unit StringMap.map) (Syntax.ETuple exprs) : Syntax.expr =
         Syntax.ETuple (map (fixConstructors constructors) exprs)
@@ -715,11 +697,54 @@ struct
         Syntax.ELambda (fixPatConstructors constructors pat, fixConstructors constructors body)
     | fixConstructors constructors (Syntax.ECase (expr, arms)) =
         Syntax.ECase (fixConstructors constructors expr, map (fn (pat, expr) => (fixPatConstructors constructors pat, fixConstructors constructors expr)) arms)
+    | fixConstructors constructors (Syntax.EStruct decls) =
+        let val constructors = ref constructors in
+          Syntax.EStruct
+            (map
+              (fn dec =>
+                (constructors := foldl (fn (x, acc) => StringMap.insert x () acc) (!constructors) (findConstructors dec) ;
+                fixDecConstructors (!constructors) dec))
+              decls)
+        end
     | fixConstructors _ expr = expr
 
+  val spec : (string * Syntax.etype) parser =
+    reserved "val" >>
+    bind identifier (fn id =>
+    reserved ":" >>
+    bind parseType (fn ty =>
+    const (id, ty)))
+
+  val sigexp : (string * Syntax.etype) list parser =
+    between (reserved "sig") (reserved "end") (many spec)
+
+  val sigdec : Syntax.dec parser =
+    reserved "signature" >>
+    bind identifier (fn sigID =>
+    reserved "=" >>
+    bind sigexp (fn vals =>
+    const (Syntax.DSig (sigID, vals))))
+
+  val fundec : Syntax.dec parser =
+    reserved "functor" >>
+    bind identifier (fn funID =>
+    symbol "(" >>
+    bind identifier (fn arg =>
+    reserved ":" >>
+    bind identifier (fn sigID =>
+    symbol ")" >>
+    reserved "=" >>
+    reserved "struct" >>
+    bind (many strdec) (fn bindings =>
+    reserved "end" >>
+    const (Syntax.DFunctor (funID, arg, sigID, Syntax.EStruct (List.mapPartial (fn x => x) bindings)))))))
+
+  val topdec : Syntax.dec option parser =
+    strdec <|> SOME <$> sigdec <|> SOME <$> fundec
+
   val program : Syntax.expr parser =
     whiteSpace >>
-    bind (many strdec) (fn decs =>
+    bind (many topdec) (fn decs =>
     const (fixConstructors StringMap.empty (Syntax.ELet (List.mapPartial (fn x => x) decs, Syntax.EInt 0))))
   fun parse (f : string) : (string, Syntax.expr) Result.either = runParser program f
 end
diff --git a/ShowSyntax.sml b/ShowSyntax.sml
index 53cc2af..519fb2b 100644
--- a/ShowSyntax.sml
+++ b/ShowSyntax.sml
@@ -46,10 +46,20 @@ and patToStringI (indent : string) (Syntax.PWild : Syntax.pat) : string =
       "PCon " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ listToString (stringToStringI) indent' x0 ^ ",\n" ^ indent' ^ patToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
 and patToString (x : Syntax.pat) : string = patToStringI "" x
 
+and identTypeToStringI (indent : string) (Syntax.ITVar : Syntax.identType) : string =
+      "ITVar"
+  | identTypeToStringI (indent : string) (Syntax.ITStruct : Syntax.identType) : string =
+      "ITStruct"
+  | identTypeToStringI (indent : string) (Syntax.ITFunctor : Syntax.identType) : string =
+      "ITFunctor"
+  | identTypeToStringI (indent : string) (Syntax.ITSignature : Syntax.identType) : string =
+      "ITSignature"
+and identTypeToString (x : Syntax.identType) : string = identTypeToStringI "" x
+
 and exprToStringI (indent : string) (Syntax.EIdent x : Syntax.expr) : string =
-      "EIdent " ^ stringToStringI indent x
+      "EIdent " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ identTypeToStringI indent' x0 ^ ",\n" ^ indent' ^ stringToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
   | exprToStringI (indent : string) (Syntax.EDot x : Syntax.expr) : string =
-      "EDot " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ structExprToStringI indent' x0 ^ ",\n" ^ indent' ^ stringToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
+      "EDot " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ exprToStringI indent' x0 ^ ",\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ identTypeToStringI indent' x0 ^ ",\n" ^ indent' ^ stringToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
   | exprToStringI (indent : string) (Syntax.EBuiltin x : Syntax.expr) : string =
       "EBuiltin " ^ stringToStringI indent x
   | exprToStringI (indent : string) (Syntax.EInt x : Syntax.expr) : string =
@@ -74,6 +84,10 @@ and exprToStringI (indent : string) (Syntax.EIdent x : Syntax.expr) : string =
       "ELambda " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ patToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
   | exprToStringI (indent : string) (Syntax.ECase x : Syntax.expr) : string =
       "ECase " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ exprToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ patToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
+  | exprToStringI (indent : string) (Syntax.EStruct x : Syntax.expr) : string =
+      "EStruct " ^ listToString (decToStringI) indent x
+  | exprToStringI (indent : string) (Syntax.EFunctorApp x : Syntax.expr) : string =
+      "EFunctorApp " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ exprToStringI indent' x0 ^ ",\n" ^ indent' ^ exprToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
 and exprToString (x : Syntax.expr) : string = exprToStringI "" x
 
 and decToStringI (indent : string) (Syntax.DVal x : Syntax.dec) : string =
@@ -87,19 +101,13 @@ and decToStringI (indent : string) (Syntax.DVal x : Syntax.dec) : string =
   | decToStringI (indent : string) (Syntax.DType x : Syntax.dec) : string =
       "DType " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ etypeToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
   | decToStringI (indent : string) (Syntax.DStruct x : Syntax.dec) : string =
-      "DStruct " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ optionToString (stringToStringI) indent' x1 ^ ",\n" ^ indent' ^ structExprToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x
+      "DStruct " ^ (fn indent => fn (x0, x1, x2) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ optionToString (stringToStringI) indent' x1 ^ ",\n" ^ indent' ^ exprToStringI indent' x2 ^ "\n" ^ indent ^ ")" end) indent x
   | decToStringI (indent : string) (Syntax.DSig x : Syntax.dec) : string =
       "DSig " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ etypeToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
+  | decToStringI (indent : string) (Syntax.DFunctor x : Syntax.dec) : string =
+      "DFunctor " ^ (fn indent => fn (x0, x1, x2, x3) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ stringToStringI indent' x1 ^ ",\n" ^ indent' ^ stringToStringI indent' x2 ^ ",\n" ^ indent' ^ exprToStringI indent' x3 ^ "\n" ^ indent ^ ")" end) indent x
 and decToString (x : Syntax.dec) : string = decToStringI "" x
 
-and structExprToStringI (indent : string) (Syntax.SIdent x : Syntax.structExpr) : string =
-      "SIdent " ^ stringToStringI indent x
-  | structExprToStringI (indent : string) (Syntax.SDot x : Syntax.structExpr) : string =
-      "SDot " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ structExprToStringI indent' x0 ^ ",\n" ^ indent' ^ stringToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
-  | structExprToStringI (indent : string) (Syntax.SStruct x : Syntax.structExpr) : string =
-      "SStruct " ^ listToString (decToStringI) indent x
-and structExprToString (x : Syntax.structExpr) : string = structExprToStringI "" x
-
 and tyToStringI (indent : string) (Syntax.TInt : Syntax.ty) : string =
       "TInt"
   | tyToStringI (indent : string) (Syntax.TBool : Syntax.ty) : string =
@@ -116,12 +124,12 @@ and tyToStringI (indent : string) (Syntax.TInt : Syntax.ty) : string =
       "TList " ^ tyToStringI indent x
   | tyToStringI (indent : string) (Syntax.TDatatype x : Syntax.ty) : string =
       "TDatatype " ^ listToString (stringToStringI) indent x
+  | tyToStringI (indent : string) (Syntax.TStruct x : Syntax.ty) : string =
+      "TStruct " ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ identTypeToStringI indent' x0 ^ ",\n" ^ indent' ^ stringToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent x
+  | tyToStringI (indent : string) (Syntax.TFunctor x : Syntax.ty) : string =
+      "TFunctor " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ tyToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
 and tyToString (x : Syntax.ty) : string = tyToStringI "" x
 
-and structTypeToStringI (indent : string) (Syntax.TStruct x : Syntax.structType) : string =
-      "TStruct " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ structTypeToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x0 ^ ",\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
-and structTypeToString (x : Syntax.structType) : string = structTypeToStringI "" x
-
 and typedPatToStringI (indent : string) (Syntax.TPWild : Syntax.typedPat) : string =
       "TPWild"
   | typedPatToStringI (indent : string) (Syntax.TPVar x : Syntax.typedPat) : string =
@@ -135,9 +143,9 @@ and typedPatToStringI (indent : string) (Syntax.TPWild : Syntax.typedPat) : stri
 and typedPatToString (x : Syntax.typedPat) : string = typedPatToStringI "" x
 
 and typedExprToStringI (indent : string) (Syntax.TEIdent x : Syntax.typedExpr) : string =
-      "TEIdent " ^ stringToStringI indent x
+      "TEIdent " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ identTypeToStringI indent' x0 ^ ",\n" ^ indent' ^ stringToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
   | typedExprToStringI (indent : string) (Syntax.TEDot x : Syntax.typedExpr) : string =
-      "TEDot " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ typedStructExprToStringI indent' x0 ^ ",\n" ^ indent' ^ structTypeToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x0 ^ ",\n" ^ indent' ^ stringToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
+      "TEDot " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ typedExprToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x0 ^ ",\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ identTypeToStringI indent' x0 ^ ",\n" ^ indent' ^ stringToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
   | typedExprToStringI (indent : string) (Syntax.TEBuiltin x : Syntax.typedExpr) : string =
       "TEBuiltin " ^ stringToStringI indent x
   | typedExprToStringI (indent : string) (Syntax.TEInt x : Syntax.typedExpr) : string =
@@ -160,6 +168,10 @@ and typedExprToStringI (indent : string) (Syntax.TEIdent x : Syntax.typedExpr) :
       "TELambda " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ typedPatToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x0 ^ ",\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ typedExprToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
   | typedExprToStringI (indent : string) (Syntax.TECase x : Syntax.typedExpr) : string =
       "TECase " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ typedExprToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x0 ^ ",\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ typedPatToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x0 ^ ",\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ typedExprToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
+  | typedExprToStringI (indent : string) (Syntax.TEStruct x : Syntax.typedExpr) : string =
+      "TEStruct " ^ listToString (typedDecToStringI) indent x
+  | typedExprToStringI (indent : string) (Syntax.TEFunctorApp x : Syntax.typedExpr) : string =
+      "TEFunctorApp " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ typedExprToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x0 ^ ",\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ typedExprToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
 and typedExprToString (x : Syntax.typedExpr) : string = typedExprToStringI "" x
 
 and typedDecToStringI (indent : string) (Syntax.TDVal x : Syntax.typedDec) : string =
@@ -171,17 +183,11 @@ and typedDecToStringI (indent : string) (Syntax.TDVal x : Syntax.typedDec) : str
   | typedDecToStringI (indent : string) (Syntax.TDDatatype x : Syntax.typedDec) : string =
       "TDDatatype " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ listToString ((fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ optionToString (tyToStringI) indent' x1 ^ "\n" ^ indent ^ ")" end)) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
   | typedDecToStringI (indent : string) (Syntax.TDStruct x : Syntax.typedDec) : string =
-      "TDStruct " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ typedStructExprToStringI indent' x0 ^ ",\n" ^ indent' ^ structTypeToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
+      "TDStruct " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ typedExprToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
+  | typedDecToStringI (indent : string) (Syntax.TDFunctor x : Syntax.typedDec) : string =
+      "TDFunctor " ^ (fn indent => fn (x0, x1, x2, x3) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ stringToStringI indent' x0 ^ ",\n" ^ indent' ^ stringToStringI indent' x1 ^ ",\n" ^ indent' ^ tyToStringI indent' x2 ^ ",\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ typedExprToStringI indent' x0 ^ ",\n" ^ indent' ^ tyToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x3 ^ "\n" ^ indent ^ ")" end) indent x
 and typedDecToString (x : Syntax.typedDec) : string = typedDecToStringI "" x
 
-and typedStructExprToStringI (indent : string) (Syntax.TSIdent x : Syntax.typedStructExpr) : string =
-      "TSIdent " ^ stringToStringI indent x
-  | typedStructExprToStringI (indent : string) (Syntax.TSDot x : Syntax.typedStructExpr) : string =
-      "TSDot " ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ (fn indent => fn (x0, x1) => let val indent' = indent ^ "  " in "(\n" ^ indent' ^ typedStructExprToStringI indent' x0 ^ ",\n" ^ indent' ^ structTypeToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent' x0 ^ ",\n" ^ indent' ^ stringToStringI indent' x1 ^ "\n" ^ indent ^ ")" end) indent x
-  | typedStructExprToStringI (indent : string) (Syntax.TSStruct x : Syntax.typedStructExpr) : string =
-      "TSStruct " ^ listToString (typedDecToStringI) indent x
-and typedStructExprToString (x : Syntax.typedStructExpr) : string = typedStructExprToStringI "" x
-
 and primopToStringI (indent : string) (Syntax.PExit : Syntax.primop) : string =
       "PExit"
   | primopToStringI (indent : string) (Syntax.PAdd : Syntax.primop) : string =
diff --git a/Syntax.sml b/Syntax.sml
index c9e4323..0eccd36 100644
--- a/Syntax.sml
+++ b/Syntax.sml
@@ -14,9 +14,25 @@ struct
   | PTuple of pat list
   | PCon of string list * pat
 
+  datatype identType =
+    ITVar
+  | ITStruct
+  | ITFunctor
+  | ITSignature
+
+  fun identTypeOrder ITVar = 0
+    | identTypeOrder ITStruct = 1
+    | identTypeOrder ITFunctor = 2
+    | identTypeOrder ITSignature = 3
+
+  fun compareIdentifiers ((t1, n1) : identType * string, (t2, n2) : identType * string) : order =
+    case Int.compare (identTypeOrder t1, identTypeOrder t2) of
+      EQUAL => String.compare (n1, n2)
+    | ord => ord
+
   datatype expr =
-    EIdent of string
-  | EDot of structExpr * string
+    EIdent of identType * string
+  | EDot of expr * (identType * string)
   | EBuiltin of string
   | EInt of int
   | EStr of string
@@ -29,6 +45,8 @@ struct
   | ELet of dec list * expr
   | ELambda of pat * expr
   | ECase of expr * (pat * expr) list
+  | EStruct of dec list
+  | EFunctorApp of expr * expr
 
   and dec =
     DVal of pat * expr
@@ -36,13 +54,10 @@ struct
   | DFun of string * (pat list * expr) list
   | DDatatype of string list * string * (string * etype option) list
   | DType of string * etype
-  | DStruct of string * string option * structExpr
+  | DStruct of string * string option * expr
   | DSig of string * (string * etype) list
-
-  and structExpr =
-    SIdent of string
-  | SDot of structExpr * string
-  | SStruct of dec list
+  (* Functor? I hardly know 'er! *)
+  | DFunctor of string * string * string * expr
 
   datatype ty =
     TInt
@@ -53,10 +68,8 @@ struct
   | TFun of ty * ty
   | TList of ty
   | TDatatype of string list
-
-  datatype structType =
-    TStruct of (string * structType) list * (string * ty) list
-(*| TFunctor of structType * structType *)
+  | TStruct of ((identType * string) * ty) list
+  | TFunctor of ty * ty
 
   datatype typedPat =
     TPWild
@@ -66,8 +79,8 @@ struct
   | TPCon of string list * (typedPat * ty)
 
   datatype typedExpr =
-    TEIdent of string
-  | TEDot of (typedStructExpr * structType) * string
+    TEIdent of identType * string
+  | TEDot of (typedExpr * ty) * (identType * string)
   | TEBuiltin of string
   | TEInt of int
   | TEStr of string
@@ -79,18 +92,16 @@ struct
   | TELet of typedDec list * (typedExpr * ty)
   | TELambda of (typedPat * ty) * (typedExpr * ty)
   | TECase of (typedExpr * ty) * ((typedPat * ty) * (typedExpr * ty)) list
+  | TEStruct of typedDec list
+  | TEFunctorApp of (typedExpr * ty) * (typedExpr * ty)
 
   and typedDec =
     TDVal of (typedPat * ty) * (typedExpr * ty)
   | TDValRec of (typedPat * ty) * (typedExpr * ty)
   | TDFun of string * ((typedPat * ty) list * (typedExpr * ty)) list
   | TDDatatype of string * (string * ty option) list
-  | TDStruct of string * (typedStructExpr * structType)
-
-  and typedStructExpr =
-    TSIdent of string
-  | TSDot of (typedStructExpr * structType) * string
-  | TSStruct of typedDec list
+  | TDStruct of string * (typedExpr * ty)
+  | TDFunctor of string * string * ty * (typedExpr * ty)
 
   (* Lambda language *)
   type var = int
diff --git a/Types.sml b/Types.sml
index 5b0e1a8..6b945f9 100644
--- a/Types.sml
+++ b/Types.sml
@@ -1,30 +1,34 @@
 structure Types = struct
   structure StringMap = Map(type k = string val cmp = String.compare)
   structure IntMap = Map(type k = int val cmp = Int.compare)
+  structure IdentMap = Map(type k = Syntax.identType * string val cmp = Syntax.compareIdentifiers)
 
   type tyvar = int
-  datatype tycon = Bool | Int | Str | Fun | Tuple | List | Datatype of int
-  and ty =
+  datatype tycon = Bool | Int | Str | Fun | Tuple | List | Datatype of int | Functor
+  datatype ty =
     TyVar of tyvar
   | TyCon of tycon * ty list
-  | TyStruct of structTy
-  and structTy = Struct of {
-    structs : structTy StringMap.map,
-    vals : ty StringMap.map
-  }
+  | TyStruct of ty IdentMap.map
 
   structure TyVarMap = IntMap
 
   fun listToString (show : 'a -> string) (l : 'a list) : string =
     "[" ^ String.concatWith ", " (map show l) ^ "]"
 
+  fun printIdent (ty : Syntax.identType, name : string) : string = "(" ^ ShowSyntax.identTypeToString ty ^ ", \"" ^ name ^ "\")"
+
   fun printTyCon Int : string = "Int"
+    | printTyCon Bool = "Bool"
+    | printTyCon Str = "Str"
     | printTyCon Fun = "Fun"
     | printTyCon Tuple = "Tuple"
+    | printTyCon List = "List"
     | printTyCon (Datatype tag) = "Datatype " ^ Int.toString tag
+    | printTyCon Functor = "Functor"
 
   and printTy (TyVar a) : string = "TyVar " ^ Int.toString a
     | printTy (TyCon (n, tys)) = "TyCon (" ^ printTyCon n ^ ", " ^ listToString printTy tys ^ ")"
+    | printTy (TyStruct decls) = "TyStruct " ^ listToString (fn (id, ty) => "(" ^ printIdent id ^ ", " ^ printTy ty ^ ")") (IdentMap.toList decls)
 
   (* map of type variables to types *)
   val substitution : ty TyVarMap.map ref = ref TyVarMap.empty
@@ -55,19 +59,17 @@ structure Types = struct
 
   datatype binding = Let of tyvar | Arg of tyvar
 
-  type env = {
-    bindings : binding StringMap.map,
-    boundVars : unit TyVarMap.map,
-    typesByName : tycon StringMap.map,
-    structs : structTy StringMap.map
-  }
+  type env =
+    { bindings : binding IdentMap.map
+    , boundVars : unit TyVarMap.map
+    , typesByName : tycon StringMap.map
+    }
 
-  fun bind (makeBinding : tyvar -> binding) (s : string) (v : tyvar) ({bindings, boundVars, typesByName, structs} : env) : env = {
-    bindings = StringMap.insert s (makeBinding v) bindings,
-    boundVars = TyVarMap.insert v () boundVars,
-    typesByName = typesByName,
-    structs = structs
-  }
+  fun bind (makeBinding : tyvar -> binding) (s : Syntax.identType * string) (v : tyvar) (env : env) : env =
+    { bindings = IdentMap.insert s (makeBinding v) (#bindings env)
+    , boundVars = TyVarMap.insert v () (#boundVars env)
+    , typesByName = (#typesByName env)
+    }
 
   fun genericVars (env : env) (TyVar a) : unit TyVarMap.map =
         if isSome (TyVarMap.lookup a (#boundVars env))
@@ -115,15 +117,14 @@ structure Types = struct
         | go (Syntax.Tyfun (arg, result)) = TyCon (Fun, [go arg, go result])
     in instantiate env (go t) end
 
-  fun bindType ((vars, name, constructors) : string list * string * (string * Syntax.etype option) list) (env as {bindings, boundVars, typesByName, structs} : env) : env =
+  fun bindType ((vars, name, constructors) : string list * string * (string * Syntax.etype option) list) (env : env) : env =
     let
       val tag = GenSym.new ()
-      val env = {
-        bindings = bindings,
-        boundVars = boundVars,
-        typesByName = StringMap.insert name (Datatype tag) typesByName,
-        structs = structs
-      }
+      val env =
+        { bindings = #bindings env
+        , boundVars = #boundVars env
+        , typesByName = StringMap.insert name (Datatype tag) (#typesByName env)
+        }
     in
       datatypes := IntMap.insert tag (map (fn (x, _) => x) constructors) (!datatypes) ;
       foldl
@@ -137,31 +138,24 @@ structure Types = struct
               | SOME t => TyCon (Fun, [etypeToTy env t, resType])
           in
             unify (TyVar g) conType;
-            bind Let x g env
+            bind Let (Syntax.ITVar, x) g env
           end)
         env
         constructors
     end
 
-  fun bindStruct (name : string) (str : structTy) ({bindings, boundVars, typesByName, structs} : env) : env = {
-    bindings = bindings,
-    boundVars = boundVars,
-    typesByName = typesByName,
-    structs = StringMap.insert name str structs
-  }
-
   fun bindPat (makeBinding : tyvar -> binding) (Syntax.PVar v) (env : env) : env =
-        bind makeBinding v (GenSym.new ()) env
+        bind makeBinding (Syntax.ITVar, v) (GenSym.new ()) env
     | bindPat makeBinding (Syntax.PTuple pats) env =
         foldl (fn (pat, env) => bindPat makeBinding pat env) env pats
     | bindPat makeBinding (Syntax.PCon (_, pat)) env = bindPat makeBinding pat env
     | bindPat _ _ env = env
 
-  fun lookupBinding (name : string) (env : env) : ty =
-    case StringMap.lookup name (#bindings env) of
+  fun lookupBinding (name: Syntax.identType * string) (env : env) : ty =
+    case IdentMap.lookup name (#bindings env) of
       SOME (Let t) => instantiate env (find (TyVar t))
     | SOME (Arg t) => TyVar t
-    | NONE => raise Fail ("unbound var " ^ name)
+    | NONE => raise Fail ("unbound var " ^ printIdent name)
 
   fun patBindings (Syntax.PVar v) : string list = [v]
     | patBindings (Syntax.PTuple pats) = List.concat (map patBindings pats)
@@ -179,17 +173,12 @@ structure Types = struct
         (case (IntMap.lookup tag (!datatypes)) of
           SOME cases => Syntax.TDatatype cases
         | NONE => raise Fail ("unknown datatype tag " ^ Int.toString tag))
+    | tyToSyntaxTy (TyCon (Functor, [f, x])) = Syntax.TFunctor (tyToSyntaxTy f, tyToSyntaxTy x)
+    | tyToSyntaxTy (TyStruct decls) = Syntax.TStruct (map (fn (id, ty) => (id, tyToSyntaxTy ty)) (IdentMap.toList decls))
     | tyToSyntaxTy t = raise Fail ("invalid ty " ^ printTy t)
 
-  fun structTypeToSyntaxStructType (Struct s) =
-    Syntax.TStruct
-      ( map (fn (name, ty) => (name, structTypeToSyntaxStructType ty)) (StringMap.toList (#structs s))
-      , map (fn (name, ty) => (name, tyToSyntaxTy ty)) (StringMap.toList (#vals s))
-      )
-    (* | structTypeToSyntaxStructType _ = raise Fail "we really need to combine structs and expressions" *)
-
   fun tagPat (_ : env) Syntax.PWild : Syntax.typedPat * ty = (Syntax.TPWild, TyVar (GenSym.new ()))
-    | tagPat env (Syntax.PVar v) = (Syntax.TPVar v, TyVar (case (StringMap.lookup v (#bindings env)) of SOME (Let t) => t | SOME (Arg t) => t | NONE => raise Fail "unknown pattern variable"))
+    | tagPat env (Syntax.PVar v) = (Syntax.TPVar v, TyVar (case (IdentMap.lookup (Syntax.ITVar, v) (#bindings env)) of SOME (Let t) => t | SOME (Arg t) => t | NONE => raise Fail "unknown pattern variable"))
     | tagPat _ (Syntax.PInt i) = (Syntax.TPInt i, TyCon (Int, []))
     | tagPat env (Syntax.PTuple pats) =
         let
@@ -201,21 +190,23 @@ structure Types = struct
         let
           val conBinding =
             case con of
-              [ident] => lookupBinding ident env
+              [ident] => lookupBinding (Syntax.ITVar, ident) env
+            | [] => raise Fail "invalid constructor"
             | str :: fields =>
-                case StringMap.lookup str (#structs env) of
-                  SOME (Struct structTy) =>
+                case lookupBinding (Syntax.ITStruct, str) env of
+                  TyStruct structTy =>
                     let
                       fun go structTy [field] =
-                            (case StringMap.lookup field (#vals structTy) of
+                            (case IdentMap.lookup (Syntax.ITVar, field) structTy of
                               SOME t => instantiate env (find t)
                             | NONE => raise Fail "unbound something or other")
                         | go structTy (str :: fields) =
-                            case StringMap.lookup str (#structs structTy) of
-                              SOME (Struct structTy) => go structTy fields
-                            | NONE => raise Fail ("unbound field " ^ str)
+                            (case IdentMap.lookup (Syntax.ITStruct, str) structTy of
+                              SOME (TyStruct structTy) => go structTy fields
+                            | _ => raise Fail ("unbound field " ^ str))
+                        | go _ _ = raise (Fail "a constructor should have at least one field")
                     in go structTy fields end
-                | NONE => raise Fail ("unbound struct " ^ str)
+                | _ => raise Fail ("that's a weird struct " ^ str)
         in
           case conBinding of
             TyCon (Fun, [argType, resType]) =>
@@ -230,13 +221,15 @@ structure Types = struct
               | _ => raise Fail ("non-function " ^ (String.concatWith "." con) ^ " applied to argument in pattern")
         end
 
-  fun F (env : env) (Syntax.EIdent i : Syntax.expr) : Syntax.typedExpr * ty =
+  fun F (env : env) (Syntax.EIdent i) : Syntax.typedExpr * ty =
         (Syntax.TEIdent i, lookupBinding i env)
     | F env (Syntax.EDot (expr, field)) =
-        let
-          val (str, Struct structType) = tagStructExpr env expr
-          val fieldType = instantiate env (find (valOf (StringMap.lookup field (#vals structType))))
-        in (Syntax.TEDot ((str, structTypeToSyntaxStructType (Struct structType)), field), fieldType) end
+        (case F env expr of
+          (str, TyStruct structType) =>
+            let
+              val fieldType = instantiate env (find (valOf (IdentMap.lookup field structType)))
+            in (Syntax.TEDot ((str, tyToSyntaxTy (TyStruct structType)), field), fieldType) end
+        | (_, ty) => raise Fail ("wrong struct type " ^ printTy ty))
     | F _ (Syntax.EBuiltin "exit") = (Syntax.TEBuiltin "exit", TyCon (Fun, [TyCon (Int, []), TyVar (GenSym.new ())]))
     | F _ (Syntax.EBuiltin "add") = (Syntax.TEBuiltin "add", TyCon (Fun, [TyCon (Tuple, [TyCon (Int, []), TyCon (Int, [])]), TyCon (Int, [])]))
     | F _ (Syntax.EBuiltin "sub") = (Syntax.TEBuiltin "sub", TyCon (Fun, [TyCon (Tuple, [TyCon (Int, []), TyCon (Int, [])]), TyCon (Int, [])]))
@@ -312,6 +305,26 @@ structure Types = struct
                 end)
               arms
         in (Syntax.TECase ((arg, tyToSyntaxTy argType), arms), resultType) end
+    | F env (Syntax.EStruct decls) =
+        let val (env, decls) = tagDecs env decls
+        in
+          ( Syntax.TEStruct decls
+          , TyStruct
+              (IdentMap.fromList
+                (map
+                  (fn (name, Let v) => (name, TyVar v)
+                    | (name, Arg v) => (name, TyVar v))
+                  (IdentMap.toList (#bindings env))))
+          )
+        end
+    | F env (Syntax.EFunctorApp (func, arg)) =
+        case F env func of
+          (func, funcType as TyCon (Functor, [_, result])) =>
+            let
+              val (arg, argType) = F env arg
+            in (Syntax.TEFunctorApp ((func, tyToSyntaxTy funcType), (arg, tyToSyntaxTy argType)), result) end
+        | _ => raise Fail "invalid functor"
+    (* | F _ expr = raise Fail ("invalid expression " ^ ShowSyntax.exprToString expr) *)
 
   and tagDec (env : env) (Syntax.DVal (pat, expr)) : env * Syntax.typedDec option =
         let
@@ -337,7 +350,7 @@ structure Types = struct
           val args1Env =
             foldl
               (fn (arg, env) => bindPat Arg arg env)
-              (bind Arg name fnType env)
+              (bind Arg (Syntax.ITVar, name) fnType env)
               args
           val args = map (tagPat args1Env) args
           val argTypes = map (fn (_, ty) => ty) args
@@ -350,7 +363,7 @@ structure Types = struct
                   val env =
                     foldl
                       (fn (arg, env) => bindPat Arg arg env)
-                      (bind Arg name fnType env)
+                      (bind Arg (Syntax.ITVar, name) fnType env)
                       args
                   val args = map (tagPat env) args
                   val (body, bt) = F env body
@@ -362,16 +375,40 @@ structure Types = struct
                   (map (fn (arg, ty) => (arg, tyToSyntaxTy ty)) args, (body, tyToSyntaxTy bt))
                 end)
               cases
-        in (bind Let name fnType env, SOME (Syntax.TDFun (name, cases)))
+        in (bind Let (Syntax.ITVar, name) fnType env, SOME (Syntax.TDFun (name, cases)))
         end
     | tagDec env (Syntax.DDatatype (vars, name, data)) =
         let val env = bindType (vars, name, data) env
         in (env, SOME (Syntax.TDDatatype (name, map (fn (name, ty) => (name, Option.map (tyToSyntaxTy o (etypeToTy env)) ty)) data))) end
     | tagDec _ (Syntax.DType _) = raise Fail "TODO"
     | tagDec env (Syntax.DStruct (name, _, str)) =
-        let val (str, strType) = tagStructExpr env str
-        in (bindStruct name strType env, SOME (Syntax.TDStruct (name, (str, structTypeToSyntaxStructType strType)))) end
-    | tagDec env (Syntax.DSig (s, decls)) = (env, NONE)
+        let
+          val v = GenSym.new ()
+          val (str, strType) = F env str
+          val _ = unify (TyVar v) strType
+        in (bind Let (Syntax.ITStruct, name) v env, SOME (Syntax.TDStruct (name, (str, tyToSyntaxTy strType)))) end
+    | tagDec env (Syntax.DSig (s, decls)) =
+        let
+          val signType = TyStruct
+            (IdentMap.fromList
+              (map
+                (fn (name, ty) => ((Syntax.ITVar, name), etypeToTy env ty))
+                decls))
+          val v = GenSym.new ()
+          val _ = unify (TyVar v) signType
+          val env = bind Let (Syntax.ITSignature, s) v env
+        in (env, NONE) end
+    | tagDec env (Syntax.DFunctor (functorName, arg, sign, body)) =
+        let
+          val (_, signType) = F env (Syntax.EIdent (Syntax.ITSignature, sign))
+          val a = GenSym.new ()
+          val _ = unify (TyVar a) signType
+          val bodyEnv = bind Let (Syntax.ITStruct, arg) a env
+          val (body, bodyType) = F bodyEnv body
+          val f = GenSym.new ()
+          val _ = unify (TyVar f) (TyCon (Functor, [signType, bodyType]))
+          val env = bind Let (Syntax.ITFunctor, functorName) f env
+        in (env, SOME (Syntax.TDFunctor (functorName, arg, tyToSyntaxTy signType, (body, tyToSyntaxTy bodyType)))) end
     | tagDec _ _ = raise Fail "invalid expr"
 
   and tagDecs env [] = (env, [])
@@ -386,32 +423,6 @@ structure Types = struct
         in (env, decs)
         end
 
-  and tagStructExpr (env : env) (Syntax.SIdent s) : Syntax.typedStructExpr * structTy =
-        (case StringMap.lookup s (#structs env) of
-          SOME t => (Syntax.TSIdent s, t)
-        | NONE => raise Fail ("unknown struct type " ^ s))
-    | tagStructExpr env (Syntax.SDot (sExpr, field)) =
-        let
-          val (parent, Struct parentType) = tagStructExpr env sExpr
-          val fieldType =
-            case StringMap.lookup field (#structs parentType) of
-              SOME x => x
-            | NONE => raise Fail ("unknown struct field " ^ field)
-        in (Syntax.TSDot ((parent, structTypeToSyntaxStructType (Struct parentType)), field), fieldType) end
-    | tagStructExpr env (Syntax.SStruct decls) =
-        let val (env, decls) = tagDecs env decls
-        in
-          (Syntax.TSStruct decls, Struct {
-            structs = #structs env,
-            vals =
-              StringMap.fromList
-                (map
-                  (fn (name, Let v) => (name, TyVar v)
-                    | (name, Arg v) => (name, TyVar v))
-                  (StringMap.toList (#bindings env)))
-          })
-        end
-
   fun reexpandType (Syntax.TVar i) : Syntax.ty = tyToSyntaxTy (find (TyVar i))
     | reexpandType ty = ty
 
@@ -428,7 +439,7 @@ structure Types = struct
     let
       val expr =
         case expr of
-          Syntax.TEDot (str, field) => Syntax.TEDot (reexpandStructExpr str, field)
+          Syntax.TEDot (str, field) => Syntax.TEDot (reexpand str, field)
         | Syntax.TETuple exprs => Syntax.TETuple (map reexpand exprs)
         | Syntax.TEList exprs => Syntax.TEList (map reexpand exprs)
         | Syntax.TEApp (f, arg) => Syntax.TEApp (reexpand f, reexpand arg)
@@ -444,25 +455,16 @@ structure Types = struct
     | reexpandDecl (Syntax.TDValRec (pat, expr)) = Syntax.TDValRec (reexpandPat pat, reexpand expr)
     | reexpandDecl (Syntax.TDFun (name, arms)) = Syntax.TDFun (name, map (fn (pats, body) => (map reexpandPat pats, reexpand body)) arms)
     | reexpandDecl (decl as Syntax.TDDatatype _) = decl
-    | reexpandDecl (Syntax.TDStruct (name, str)) = Syntax.TDStruct (name, reexpandStructExpr str)
-
-  and reexpandStructExpr (str : Syntax.typedStructExpr, structType : Syntax.structType) : Syntax.typedStructExpr * Syntax.structType =
-    let
-      val str =
-        case str of
-          Syntax.TSIdent _ => str
-        | Syntax.TSDot (str, field) => Syntax.TSDot (reexpandStructExpr str, field)
-        | Syntax.TSStruct decls => Syntax.TSStruct (map reexpandDecl decls)
-    in (str, structType) end
+    | reexpandDecl (Syntax.TDStruct (name, str)) = Syntax.TDStruct (name, reexpand str)
+    | reexpandDecl (Syntax.TDFunctor (name, arg, argType, body)) = Syntax.TDFunctor (name, arg, reexpandType argType, reexpand body)
 
   fun tag (expr : Syntax.expr) : Syntax.typedExpr * Syntax.ty =
     let
-      val env = {
-        bindings = StringMap.empty,
-        boundVars = TyVarMap.empty,
-        typesByName = StringMap.empty,
-        structs = StringMap.empty
-      }
+      val env =
+        { bindings = IdentMap.empty
+        , boundVars = TyVarMap.empty
+        , typesByName = StringMap.empty
+        }
       val (expr, ty) = F env expr
     in reexpand (expr, tyToSyntaxTy ty) end
 end
diff --git a/generate-show-syntax.sml b/generate-show-syntax.sml
index 708d1b7..d524fcc 100644
--- a/generate-show-syntax.sml
+++ b/generate-show-syntax.sml
@@ -45,7 +45,7 @@ val ast =
   | Result.Right x => x
 val (structName, decls) =
   case ast of
-    Syntax.ELet (Syntax.DStruct (structName, _, Syntax.SStruct decls) :: _, _) => (structName, decls)
+    Syntax.ELet (Syntax.DStruct (structName, _, Syntax.EStruct decls) :: _, _) => (structName, decls)
   | _ => raise Fail "ast has unexpected format (I can't print it sorry)"
 val out = TextIO.openOut (!(#o opts))
 val _ = TextIO.output (out, "(*\n  This file was generated by generate-show-syntax.sml. Do not edit manually.\n  To regenerate, use\n\n    sml generate-show-syntax.sml -o " ^ !(#o opts) ^ " " ^ filename ^ "\n*)\n\n")
diff --git a/main.sml b/main.sml
index 3b74705..3431fa9 100644
--- a/main.sml
+++ b/main.sml
@@ -1,17 +1,17 @@
 use "Sort.sml";
 use "Result.sml";
 use "Buffer.sml";
-use "GenSym.sml";
 use "Map.sml";
-use "Syntax.sml";
 use "Opts.sml";
+use "GenSym.sml";
+use "Syntax.sml";
 use "Parser.sml";
 use "ShowSyntax.sml";
-use "Types.sml";
-use "Elab.sml";
-use "CPS.sml";
 use "CodeGen.sml";
 use "Linker.sml";
+use "CPS.sml";
+use "Elab.sml";
+use "Types.sml";
 use "Compiler.sml";
 
 val _ = Compiler.main (CommandLine.arguments ())
diff --git a/tests/24-functor.sml b/tests/24-functor.sml
new file mode 100644
index 0000000..d18337e
--- /dev/null
+++ b/tests/24-functor.sml
@@ -0,0 +1,17 @@
+signature MagicNumber = sig
+  val n : int
+end
+
+functor Exiter(N : MagicNumber) = struct
+  fun exit _ = __builtin "exit" N.n
+end
+
+structure FourtyTwo = struct
+  val a = 16
+  val n = 42
+  val z = 38
+end
+
+structure FourtyTwoExiter = Exiter(FourtyTwo)
+
+val _ = FourtyTwoExiter.exit ()