From 721192c24214187d51d3858da34f98389e308a8a Mon Sep 17 00:00:00 2001 From: Samuel Hammersberg Date: Mon, 6 Feb 2023 15:44:54 +0100 Subject: [PATCH] Started implemented multiple functions. --- Grammar.cf | 22 +++++-- language | 2 +- src/Compiler/Compiler.hs | 139 +++++++++++++++++++++++---------------- src/Interpreter.hs | 10 +-- test/simple.sf | 8 +-- 5 files changed, 108 insertions(+), 73 deletions(-) diff --git a/Grammar.cf b/Grammar.cf index 600cae0..a10ef27 100644 --- a/Grammar.cf +++ b/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 ; -EInt. Exp4 ::= Integer ; +EAbs. Exp ::= "\\" Ident ":" Type "." Exp ; +coercions Exp 3 ; -coercions Exp 4 ; +TInt. Type1 ::= "Int" ; +TPol. Type1 ::= Ident ; +TFun. Type ::= Type "->" Type1; +coercions Type 1 ; comment "--" ; -comment "{-" "-}" ; - +comment "{-" "-}" ; \ No newline at end of file diff --git a/language b/language index 889d071..8c068e4 120000 --- a/language +++ b/language @@ -1 +1 @@ -/home/samuel/.cabal/store/ghc-9.4.4/language-0.1.0.0-e-language-8961629e3f2b94c68db8717be1683dcdcdc8fdba8bf535c043d14892383bd98b/bin/language \ No newline at end of file +/home/samuel/.cabal/store/ghc-9.4.4/language-0.1.0.0-e-language-b2dd0f5c425bcebb6d06c37d2359fc74433c8d1d898fd217ad1cdc50c9035ad3/bin/language \ No newline at end of file diff --git a/src/Compiler/Compiler.hs b/src/Compiler/Compiler.hs index 2afc66f..56ad68e 100644 --- a/src/Compiler/Compiler.hs +++ b/src/Compiler/Compiler.hs @@ -25,20 +25,22 @@ compileFile file = do exitFailure Right cor -> compile cor -data Type = I1 | I8 | I32 | I64 | Ptr | Ref Type | Array Integer Type -instance Show Type where - show :: Type -> String +data LLType = I1 | I8 | I32 | I64 | Ptr + | Ref LLType | Array Integer LLType | CustomType Ident +instance Show LLType where + show :: LLType -> String show t = case t of - I1 -> "i1" - I8 -> "i8" - I32 -> "i32" - I64 -> "i64" - Ptr -> "ptr" - Ref ty -> show ty <> "*" - Array n ty -> concat ["[", show n, " x ", show ty, "]"] + I1 -> "i1" + I8 -> "i8" + I32 -> "i32" + I64 -> "i64" + Ptr -> "ptr" + Ref ty -> show ty <> "*" + Array n ty -> concat ["[", show n, " x ", show ty, "]"] + CustomType (Ident ty) -> ty -type Params = [Type] -type Args = [(Type, Value)] +type Params = [(LLType, Ident)] +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=[] - , methods=[] - , blocks=[] - , variableCount=0} + { instructions = [] + , methods = [] + , blocks = [] + , 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 - | Sub Type Value Value - | Div Type Value Value - | Mul Type Value Value - | Srem Type Value Value - | Call Type Ident Args - | Alloca Type - | Store Type Ident Type Ident - | Bitcast Type Ident Type - | Ret Type Value + | Add LLType Value Value + | Sub LLType Value Value + | Div LLType Value Value + | Mul LLType Value Value + | Srem LLType Value Value + | Call LLType Ident Args + | Alloca LLType + | Store LLType Ident LLType Ident + | Bitcast LLType Ident LLType + | 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,40 +111,54 @@ 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), - UnsafeRaw $ standardLLVMLibrary <> "\n", + Comment (show $ printTree (Program prg)), + 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 ++ - [ 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) - , DefineEnd - ]) + putStrLn $ concatMap printLLVMIr ins where - go :: Exp -> CompilerState - go (EInt int) = emitInt int - go (EAdd e1 e2) = emitAdd e1 e2 - 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 + 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 I64 (VInteger 0) + ] - go (EId id) = undefined - go (EApp e1 e2) = undefined - go (EAbs id e) = undefined + 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 + 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 + + go (EId id) = emit $ Comment $ "EId (" <> show id <> ") is not implemented!" + go (EApp e1 e2) = emit $ Comment $ "EApp (" <> show e1 <> ", " <> show e2 <> ") is not implemented!" + 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 diff --git a/src/Interpreter.hs b/src/Interpreter.hs index bdbd8d2..2686a9e 100644 --- a/src/Interpreter.hs +++ b/src/Interpreter.hs @@ -11,10 +11,10 @@ import Grammar.Abs import Grammar.Print (printTree) interpret :: Program -> Except String Integer -interpret (Program e) = - eval mempty e >>= \case - VClosure {} -> throwError "main evaluated to a function" - VInt i -> pure i +interpret (Program e) = undefined +-- eval mempty e >>= \case +-- VClosure {} -> throwError "main evaluated to a function" +-- 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 diff --git a/test/simple.sf b/test/simple.sf index bbd9312..afb2251 100644 --- a/test/simple.sf +++ b/test/simple.sf @@ -1,5 +1,5 @@ +tripplet : Int -> (Int -> (Int -> Int)) +tripplet x y z = x + y + z; - - - -main = ((2 * (123 + 4214 % (1230)) - 1231) / 2) * 412412 +main : Int +main = {-(((2 * (123 + 4214 % (1230)) - 1231) / 2) * 412412) +-} tripplet 5 1 2; \ No newline at end of file