Added support for the minus operator.

Grammar.cf

@@ -6,6 +6,7 @@ EAnn. Exp3  ::= "(" Exp ":" Type ")";
 ELet. Exp3 ::= "let" Bind "in" Exp; 
 EApp. Exp2 ::= Exp2 Exp3;
 EAdd. Exp1 ::= Exp1 "+" Exp2;
+ESub. Exp1 ::= Exp1 "-" Exp2;
 EAbs. Exp  ::= "\\" Ident ":" Type "." Exp;
 ECase. Exp ::= "case" Exp "of" "{" [CaseMatch] "}" ":" Type;
 CaseMatch. CaseMatch ::= Case "=>" Exp ;

sample-programs/basic-1

@@ -24,11 +24,10 @@ fibbonaci x = case x of {
     0 => 0,
     1 => 1,
     -- abusing overflows to represent negatives like a boss
-    _ =>   (fibbonaci (x + 9223372036854775807 + 9223372036854775807))
-         + (fibbonaci (x + 9223372036854775807 + 9223372036854775807 + 1))
+    _ =>   (fibbonaci (x - 2))
+         + (fibbonaci (x - 1))
 } : Int;
 
-faccer : Int -> Int;
 
 main : Int;
 main = fibbonaci 10;

src/Compiler.hs

@@ -156,12 +156,12 @@ defaultStart = [ UnsafeRaw "@.str = private unnamed_addr constant [3 x i8] c\"%i
 compileExp :: Exp -> CompilerState ()
 compileExp (EInt int)      = emitInt int
 compileExp (EAdd t e1 e2)  = emitAdd t e1 e2
+compileExp (ESub t e1 e2)  = emitSub t e1 e2
 compileExp (EId (name, _)) = emitIdent name
 compileExp (EApp t e1 e2)  = emitApp t e1 e2
 compileExp (EAbs t ti e)   = emitAbs t ti e
 compileExp (ELet binds e)  = emitLet binds e
 compileExp (ECase t e cs)  = emitECased t e cs
-    -- go (ESub e1 e2)  = emitSub e1 e2
     -- go (EMul e1 e2)  = emitMul e1 e2
     -- go (EDiv e1 e2)  = emitDiv e1 e2
     -- go (EMod e1 e2)  = emitMod e1 e2
@@ -258,6 +258,13 @@ emitAdd t e1 e2 = do
     v <- getNewVar
     emit $ SetVariable (Ident $ show v) (Add (type2LlvmType t) v1 v2)
 
+emitSub :: Type -> Exp -> Exp -> CompilerState ()
+emitSub t e1 e2 = do
+    v1 <- exprToValue e1
+    v2 <- exprToValue e2
+    v <- getNewVar
+    emit $ SetVariable (Ident $ show v) (Sub (type2LlvmType t) v1 v2)
+
 -- emitMul :: Exp -> Exp -> CompilerState ()
 -- emitMul e1 e2 = do
 --     (v1,v2) <- binExprToValues e1 e2
@@ -295,14 +302,6 @@ emitAdd t e1 e2 = do
 --     emit $ SetVariable $ Ident $ show v
 --     emit $ Div I64 v1 v2
 
--- emitSub :: Exp -> Exp -> CompilerState ()
--- emitSub e1 e2 = do
---     (v1,v2) <- binExprToValues e1 e2
---     increaseVarCount
---     v <- gets variableCount
---     emit $ SetVariable $ Ident $ show v
---     emit $ Sub I64 v1 v2
-
 exprToValue :: Exp -> CompilerState LLVMValue
 exprToValue = \case
     EInt i -> pure $ VInteger i
@@ -340,6 +339,7 @@ type2LlvmType = \case
 getType :: Exp -> LLVMType
 getType (EInt _)      = I64
 getType (EAdd t _ _)  = type2LlvmType t
+getType (ESub t _ _)  = type2LlvmType t
 getType (EId (_, t))  = type2LlvmType t
 getType (EApp t _ _)  = type2LlvmType t
 getType (EAbs t _ _)  = type2LlvmType t

src/LambdaLifter.hs

@@ -47,6 +47,12 @@ freeVarsExp localVars = \case
         e1' = freeVarsExp localVars e1
         e2' = freeVarsExp localVars e2
 
+    ESub t e1 e2 -> (Set.union (freeVarsOf e1') (freeVarsOf e2'), ASub t e1' e2')
+      where
+        e1' = freeVarsExp localVars e1
+        e2' = freeVarsExp localVars e2
+
+
     EAbs t par e -> (Set.delete par $ freeVarsOf e', AAbs t par e')
       where
         e' = freeVarsExp (Set.insert par localVars) e
@@ -89,6 +95,7 @@ data AnnExp' = AId  Id
              | ALet ABind AnnExp
              | AApp Type    AnnExp  AnnExp
              | AAdd Type    AnnExp  AnnExp
+             | ASub Type    AnnExp  AnnExp
              | AAbs Type    Id      AnnExp
              | ACase Type   AnnExp  [AnnCase]
              deriving Show
@@ -125,6 +132,7 @@ abstractExp (free, exp) = case exp of
     AInt i       -> pure $ EInt i
     AApp t e1 e2 -> liftA2 (EApp t) (abstractExp e1) (abstractExp e2)
     AAdd t e1 e2 -> liftA2 (EAdd t) (abstractExp e1) (abstractExp e2)
+    ASub t e1 e2 -> liftA2 (ESub t) (abstractExp e1) (abstractExp e2)
     ALet b e     -> liftA2 ELet (go b) (abstractExp e)
       where
         go (ABind name parms rhs) = do
@@ -188,6 +196,11 @@ collectScsExp = \case
         (scs1, e1') = collectScsExp e1
         (scs2, e2') = collectScsExp e2
 
+    ESub t e1 e2 -> (scs1 ++ scs2, ESub t e1' e2')
+      where
+        (scs1, e1') = collectScsExp e1
+        (scs2, e2') = collectScsExp e2
+
     EAbs t par e -> (scs, EAbs t par e')
       where
         (scs, e') = collectScsExp e

src/Renamer.hs

@@ -55,6 +55,11 @@ renameExp old_names = \case
         (env2, e2') <- renameExp old_names e2
         pure (Map.union env1 env2, EAdd e1' e2')
 
+    ESub e1 e2 -> do
+        (env1, e1') <- renameExp old_names e1
+        (env2, e2') <- renameExp old_names e2
+        pure (Map.union env1 env2, ESub e1' e2')
+
     ELet b e  -> do
         (new_names, b)   <- renameLocalBind old_names b
         (new_names', e') <- renameExp new_names e

src/TypeChecker.hs

@@ -78,6 +78,11 @@ infer cxt = \case
         e1' <- check cxt e1 T.TInt
         pure (T.EAdd T.TInt e' e1', T.TInt)
 
+    ESub e e1 -> do
+        e'  <- check cxt e T.TInt
+        e1' <- check cxt e1 T.TInt
+        pure (T.ESub T.TInt e' e1', T.TInt)
+
     EAbs x t e  -> do
         (e', t1) <- infer (insertEnv x t cxt) e
         let t_abs = TFun t t1
@@ -138,6 +143,11 @@ check cxt exp typ = case exp of
         e1' <- check cxt e1 T.TInt
         pure $ T.EAdd T.TInt e' e1'
 
+    ESub e e1 -> do
+        e'  <- check cxt e T.TInt
+        e1' <- check cxt e1 T.TInt
+        pure $ T.ESub T.TInt e' e1'
+
     EAbs x t e  -> do
         (e', t_e) <- infer (insertEnv x t cxt) e
         let t1 = TFun t t_e

src/TypeCheckerIr.hs

@@ -20,6 +20,7 @@ data Exp
     | ELet Bind Exp
     | EApp Type Exp Exp
     | EAdd Type Exp Exp
+    | ESub Type Exp Exp
     | EAbs Type Id  Exp
     | ECase Type Exp [(Type, Case)]
   deriving (C.Eq, C.Ord, C.Show, C.Read)
@@ -93,6 +94,13 @@ instance Print Exp where
                           , doc $ showString "+"
                           , prt 2 e2
                           ]
+      ESub t e1 e2 -> prPrec i 1 $ concatD
+                          [ doc $ showString "@"
+                          , prt 0 t
+                          , prt 1 e1
+                          , doc $ showString "-"
+                          , prt 2 e2
+                          ]
       EAbs t n  e  -> prPrec i 0 $ concatD
                           [ doc $ showString "@"
                           , prt 0 t