Started implemented multiple functions.

This commit is contained in:
Samuel Hammersberg 2023-02-06 15:44:54 +01:00
parent d41db9bbb8
commit 721192c242
5 changed files with 108 additions and 73 deletions

View file

@ -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 ; EApp. Exp2 ::= Exp2 Exp3 ;
EAdd. Exp1 ::= Exp1 "+" Exp2 ; EAdd. Exp1 ::= Exp1 "+" Exp2 ;
ESub. Exp1 ::= Exp1 "-" Exp2 ; ESub. Exp1 ::= Exp1 "-" Exp2 ;
EMul. Exp2 ::= Exp2 "*" Exp3 ; EMul. Exp2 ::= Exp2 "*" Exp3 ;
EDiv. Exp2 ::= Exp2 "/" Exp3 ; EDiv. Exp2 ::= Exp2 "/" Exp3 ;
EMod. 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 "--" ;
comment "{-" "-}" ; comment "{-" "-}" ;

View file

@ -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

View file

@ -25,9 +25,10 @@ compileFile file = do
exitFailure exitFailure
Right cor -> compile cor 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 show t = case t of
I1 -> "i1" I1 -> "i1"
I8 -> "i8" I8 -> "i8"
@ -36,9 +37,10 @@ instance Show Type where
Ptr -> "ptr" Ptr -> "ptr"
Ref ty -> show ty <> "*" Ref ty -> show ty <> "*"
Array n ty -> concat ["[", show n, " x ", 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 data Value = VInteger Integer | VIdent Ident | VConstant String
instance Show Value where instance Show Value where
@ -61,26 +63,26 @@ defaultCodeGenerator = CodeGenerator
, blocks = [] , blocks = []
, variableCount = 0 } , variableCount = 0 }
data LLVMIr = Define Type Ident Params data LLVMIr = Define LLType Ident Params
| DefineEnd | DefineEnd
| Declare Type Ident Params | Declare LLType Ident Params
| Variable Ident | 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 | UnsafeRaw String
| Comment String | Comment String
deriving (Show) deriving (Show)
printLLVMIr :: LLVMIr -> String 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 DefineEnd = "}\n"
printLLVMIr (Declare t (Ident i) params) = undefined printLLVMIr (Declare t (Ident i) params) = undefined
printLLVMIr (Variable (Ident i)) = concat ["%", i, " = "] printLLVMIr (Variable (Ident i)) = concat ["%", i, " = "]
@ -109,29 +111,43 @@ increaseVarCount :: CompilerState
increaseVarCount = modify (\t -> t {variableCount = variableCount t + 1}) increaseVarCount = modify (\t -> t {variableCount = variableCount t + 1})
compile :: Program -> IO () compile :: Program -> IO ()
compile (Program prgE) = do compile (Program prg) = do
--Asp --Asp
let s = defaultCodeGenerator {instructions = [ 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 i32 @puts(i8* nocapture) nounwind\n",
--UnsafeRaw "declare [21 x i8] @i64ToString(i64)\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 ins = instructions fin
let var = variableCount fin putStrLn $ concatMap printLLVMIr ins
putStrLn $ concatMap printLLVMIr (ins ++ where
mainContent var =
[ Variable (Ident "print_res") [ Variable (Ident "print_res")
, Call (Array 21 I8) (Ident "i64ToString") [(I64, VIdent $ Ident $ show var)] , Call (Array 21 I8) (Ident "i64ToString") [(I64, VIdent $ Ident $ show var)]
, Variable (Ident "print_ptr"), Alloca (Array 21 I8) , Variable (Ident "print_ptr"), Alloca (Array 21 I8)
, Store (Array 21 I8) (Ident "print_res") (Ref (Array 21 I8)) (Ident "print_ptr") , 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) , Variable (Ident "printable"), Bitcast (Ref (Array 21 I8)) (Ident "print_ptr") (Ref I8)
, Call I32 (Ident "puts") [(Ref I8, VIdent (Ident "printable"))] , 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 :: Exp -> CompilerState
go (EInt int) = emitInt int go (EInt int) = emitInt int
go (EAdd e1 e2) = emitAdd e1 e2 go (EAdd e1 e2) = emitAdd e1 e2
@ -140,9 +156,9 @@ compile (Program prgE) = do
go (EDiv e1 e2) = emitDiv e1 e2 go (EDiv e1 e2) = emitDiv e1 e2
go (EMod e1 e2) = emitMod 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 --- --- aux functions ---
emitInt :: Integer -> CompilerState emitInt :: Integer -> CompilerState
@ -172,7 +188,7 @@ compile (Program prgE) = do
emitMod :: Exp -> Exp -> CompilerState emitMod :: Exp -> Exp -> CompilerState
emitMod e1 e2 = do 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 (v1,v2) <- binExprToValues e1 e2
increaseVarCount increaseVarCount
vadd <- gets variableCount vadd <- gets variableCount
@ -228,3 +244,14 @@ compile (Program prgE) = do
go e2 go e2
v2 <- gets variableCount v2 <- gets variableCount
return (VIdent (Ident $ show v1),VIdent (Ident $ show v2)) 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

View file

@ -11,10 +11,10 @@ import Grammar.Abs
import Grammar.Print (printTree) import Grammar.Print (printTree)
interpret :: Program -> Except String Integer 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 data Val = VInt Integer
@ -56,7 +56,7 @@ eval cxt = \case
-- ----------------------------- -- -----------------------------
-- γ ⊢ λx → f ⇓ let γ in λx → f -- γ ⊢ λ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 -- γ ⊢ e ⇓ v

View file

@ -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