Started implemented multiple functions.

Grammar.cf

@@ -1,19 +1,27 @@
+Program. Program ::= [Def] ;
 
+DExp.  Def ::= Ident ":" Type
+               Ident [Ident] "=" Exp ";" ;
 
-Program. Program ::= "main" "=" Exp ;
+separator Def "";
+separator Ident "";
+separator Type "->";
 
-EAbs. Exp  ::= "\\" Ident "->" Exp ;
+EId.  Exp3 ::= Ident   ;
+EInt. Exp3 ::= Integer ;
 EApp. Exp2 ::= Exp2 Exp3 ;
 EAdd. Exp1 ::= Exp1 "+" Exp2 ;
 ESub. Exp1 ::= Exp1 "-" Exp2 ;
 EMul. Exp2 ::= Exp2 "*" Exp3 ;
 EDiv. Exp2 ::= Exp2 "/" Exp3 ;
 EMod. Exp2 ::= Exp2 "%" Exp3 ;
-EId.  Exp4 ::= Ident   ;
+EAbs. Exp  ::= "\\" Ident ":" Type "." Exp ;
-EInt. Exp4 ::= Integer ;
+coercions Exp 3 ;
 
-coercions Exp 4 ;
+TInt. Type1 ::= "Int" ;
+TPol. Type1 ::= Ident ;
+TFun. Type  ::= Type "->" Type1;
+coercions Type 1 ;
 
 comment "--" ;
 comment "{-" "-}" ;
-

language

@@ -1 +1 @@
-/home/samuel/.cabal/store/ghc-9.4.4/language-0.1.0.0-e-language-8961629e3f2b94c68db8717be1683dcdcdc8fdba8bf535c043d14892383bd98b/bin/language
+/home/samuel/.cabal/store/ghc-9.4.4/language-0.1.0.0-e-language-b2dd0f5c425bcebb6d06c37d2359fc74433c8d1d898fd217ad1cdc50c9035ad3/bin/language

src/Compiler/Compiler.hs

@@ -25,9 +25,10 @@ compileFile file = do
             exitFailure
         Right cor -> compile cor
 
-data Type = I1 | I8 | I32 | I64 | Ptr | Ref Type | Array Integer Type
+data LLType = I1 | I8 | I32 | I64 | Ptr
-instance Show Type where
+            | Ref LLType | Array Integer LLType | CustomType Ident
-    show :: Type -> String
+instance Show LLType where
+    show :: LLType -> String
     show t = case t of
         I1                    -> "i1"
         I8                    -> "i8"
@@ -36,9 +37,10 @@ instance Show Type where
         Ptr                   -> "ptr"
         Ref ty                -> show ty <> "*"
         Array n ty            -> concat ["[", show n, " x ", show ty, "]"]
+        CustomType (Ident ty) -> ty
 
-type Params = [Type]
+type Params = [(LLType, Ident)]
-type Args = [(Type, Value)]
+type Args = [(LLType, Value)]
 
 data Value = VInteger Integer | VIdent Ident | VConstant String
 instance Show Value where
@@ -56,31 +58,31 @@ data CodeGenerator = CodeGenerator
     deriving Show
 defaultCodeGenerator :: CodeGenerator
 defaultCodeGenerator = CodeGenerator
-                    { instructions=[]
+                    { instructions = []
-                    , methods=[]
+                    , methods = []
-                    , blocks=[]
+                    , blocks = []
-                    , variableCount=0}
+                    , variableCount = 0 }
 
-data LLVMIr = Define Type Ident Params
+data LLVMIr = Define LLType Ident Params
             | DefineEnd
-            | Declare Type Ident Params
+            | Declare LLType Ident Params
             | Variable Ident
-            | Add Type Value Value
+            | Add LLType Value Value
-            | Sub Type Value Value
+            | Sub LLType Value Value
-            | Div Type Value Value
+            | Div LLType Value Value
-            | Mul Type Value Value
+            | Mul LLType Value Value
-            | Srem Type Value Value
+            | Srem LLType Value Value
-            | Call Type Ident Args
+            | Call LLType Ident Args
-            | Alloca Type
+            | Alloca LLType
-            | Store Type Ident Type Ident
+            | Store LLType Ident LLType Ident
-            | Bitcast Type Ident Type
+            | Bitcast LLType Ident LLType
-            | Ret Type Value
+            | Ret LLType Value
             | UnsafeRaw String
             | Comment String
     deriving (Show)
 
 printLLVMIr :: LLVMIr -> String
-printLLVMIr (Define t (Ident i) params)           = concat ["define ", show t, " @", i, "(", intercalate "," (fmap show params),") {\n"]
+printLLVMIr (Define t (Ident i) params)           = concat ["define ", show t, " @", i, "(", intercalate "," (fmap (\(x,Ident y) -> unwords [show x, "%"<>y]) params),") {\n"]
 printLLVMIr DefineEnd                             = "}\n"
 printLLVMIr (Declare t (Ident i) params)          = undefined
 printLLVMIr (Variable (Ident i))                  = concat ["%", i, " = "]
@@ -109,29 +111,43 @@ increaseVarCount :: CompilerState
 increaseVarCount = modify (\t -> t {variableCount = variableCount t + 1})
 
 compile :: Program -> IO ()
-compile (Program prgE) = do
+compile (Program prg) = do
     --Asp
     let s = defaultCodeGenerator {instructions = [
-        Comment $ printTree (Program prgE),
+        Comment (show $ printTree (Program prg)),
-        UnsafeRaw $ standardLLVMLibrary <> "\n",
+        UnsafeRaw $ standardLLVMLibrary <> "\n"
         --UnsafeRaw "declare i32 @puts(i8* nocapture) nounwind\n",
         --UnsafeRaw "declare [21 x i8] @i64ToString(i64)\n",
-        Define I32 (Ident "main") []
+        --Define I32 (Ident "main") []
     ]}
-    let fin = execState (go prgE) s
+    let fin = execState (goDef prg) s
     let ins = instructions fin
-    let var = variableCount fin
+    putStrLn $ concatMap printLLVMIr ins
-    putStrLn $ concatMap printLLVMIr (ins ++
+    where
+        mainContent var =
                 [ Variable (Ident "print_res")
                 , Call (Array 21 I8) (Ident "i64ToString") [(I64, VIdent $ Ident $ show var)]
                 , Variable (Ident "print_ptr"), Alloca (Array 21 I8)
                 , Store (Array 21 I8) (Ident "print_res") (Ref (Array 21 I8)) (Ident "print_ptr")
                 , Variable (Ident "printable"), Bitcast (Ref (Array 21 I8)) (Ident "print_ptr") (Ref I8)
                 , Call I32 (Ident "puts") [(Ref I8, VIdent (Ident "printable"))]
-        , Ret I32 (VInteger 0)
+                , Ret I64 (VInteger 0)
-        , DefineEnd
+                ]
-        ])
+
-    where
+        goDef :: [Def] -> CompilerState
+        goDef []                               = return ()
+        goDef (DExp id@(Ident str) t _id2 args exp : xs) = do
+            let (rt, argTypes) = flattenFuncType t
+            emit $ Comment $ show (rt, argTypes)
+            emit $ Define rt id (zip argTypes args) -- //TODO parse args
+            go exp
+            varNum <- gets variableCount
+            if str == "main" then mapM_ emit (mainContent varNum)
+                             else emit $ Ret rt (VIdent (Ident (show varNum)))
+            emit DefineEnd
+            modify (\s -> s {variableCount = 0})
+            goDef xs
+
         go :: Exp -> CompilerState
         go (EInt int)    = emitInt int
         go (EAdd e1 e2)  = emitAdd e1 e2
@@ -140,9 +156,9 @@ compile (Program prgE) = do
         go (EDiv e1 e2)  = emitDiv e1 e2
         go (EMod e1 e2)  = emitMod e1 e2
 
-        go (EId  id)    = undefined
+        go (EId  id)     = emit $ Comment $ "EId (" <> show id <> ") is not implemented!"
-        go (EApp e1 e2) = undefined
+        go (EApp e1 e2)  = emit $ Comment $ "EApp (" <> show e1 <> ", " <> show e2 <> ") is not implemented!"
-        go (EAbs id e)  = undefined
+        go (EAbs id t e) = emit $ Comment $ "EAbs (" <> show id <> ", " <> show t <> ", " <> show e <> ") is not implemented!"
 
         --- aux functions ---
         emitInt :: Integer -> CompilerState
@@ -172,7 +188,7 @@ compile (Program prgE) = do
 
         emitMod :: Exp -> Exp -> CompilerState
         emitMod e1 e2 = do
-            -- //TODO Replace with `let m a b = rem (abs $ b + a) b`
+            -- `let m a b = rem (abs $ b + a) b`
             (v1,v2) <- binExprToValues e1 e2
             increaseVarCount
             vadd <- gets variableCount
@@ -228,3 +244,14 @@ compile (Program prgE) = do
                         go e2
                         v2 <- gets variableCount
                         return (VIdent (Ident $ show v1),VIdent (Ident $ show v2))
+
+
+-- very nasty
+flattenFuncType :: Type -> (LLType, [LLType])
+flattenFuncType xs = do
+    let res = go xs
+    (last res, init res)
+    where
+        go TInt         = [I64]
+        go (TPol id)    = [CustomType id]
+        go (TFun t1 t2) = go t1 ++ go t2

src/Interpreter.hs

@@ -11,10 +11,10 @@ import           Grammar.Abs
 import           Grammar.Print           (printTree)
 
 interpret :: Program -> Except String Integer
-interpret (Program e) =
+interpret (Program e) = undefined
-  eval mempty e >>= \case
+--  eval mempty e >>= \case
-    VClosure {} -> throwError "main evaluated to a function"
+--    VClosure {} -> throwError "main evaluated to a function"
-    VInt i      -> pure i
+--    VInt i      -> pure i
 
 
 data Val = VInt Integer
@@ -56,7 +56,7 @@ eval cxt = \case
   --  -----------------------------
   --  γ ⊢ λx → f ⇓ let γ in λx → f
 
-  EAbs x e  -> pure $ VClosure cxt x e
+  EAbs x t e  -> pure $ VClosure cxt x e
 
 
   --  γ ⊢ e  ⇓ v

test/simple.sf

@@ -1,5 +1,5 @@
+tripplet : Int -> (Int -> (Int -> Int))
+tripplet x y z = x + y + z;
 
-
+main : Int
-
+main = {-(((2 * (123 + 4214 % (1230)) - 1231) / 2) * 412412) +-} tripplet 5 1 2;
-
-main =  ((2 * (123 + 4214 % (1230)) - 1231) / 2) * 412412