Rakarake/churf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Stuck at a conundrum

Browse source
This commit is contained in:
Samuel Hammersberg 2023-02-06 16:49:29 +01:00
parent 721192c242
commit dbbbc725ea
1 changed files with 49 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

95
src/Compiler/Compiler.hs
View file

@ -1,11 +1,7 @@
module Compiler.Compiler where module Compiler.Compiler where
import Compiler.StandardLLVMLibrary (standardLLVMLibrary) import Compiler.StandardLLVMLibrary (standardLLVMLibrary)
import Control.Applicative (Applicative)
import Control.Monad.Except (Except, MonadError (throwError),
liftEither)
import Control.Monad.State import Control.Monad.State
import Data.Either.Combinators (maybeToRight)
import Data.List (intercalate) import Data.List (intercalate)
import Data.Set (Set) import Data.Set (Set)
import Data.Set as Set import Data.Set as Set
@ -53,20 +49,20 @@ instance Show Value where
data CodeGenerator = CodeGenerator data CodeGenerator = CodeGenerator
{ instructions :: [LLVMIr] { instructions :: [LLVMIr]
, methods :: [Ident] , methods :: [Ident]
, blocks :: [Set Ident] , block :: Set Ident
, variableCount :: Integer } , variableCount :: Integer }
deriving Show deriving Show
defaultCodeGenerator :: CodeGenerator defaultCodeGenerator :: CodeGenerator
defaultCodeGenerator = CodeGenerator defaultCodeGenerator = CodeGenerator
{ instructions = [] { instructions = []
, methods = [] , methods = []
, blocks = [] , block = Set.empty
, variableCount = 0 } , variableCount = 0 }
data LLVMIr = Define LLType Ident Params data LLVMIr = Define LLType Ident Params
| DefineEnd | DefineEnd
| Declare LLType Ident Params | Declare LLType Ident Params
| Variable Ident | SetVariable Ident
| Add LLType Value Value | Add LLType Value Value
| Sub LLType Value Value | Sub LLType Value Value
| Div LLType Value Value | Div LLType Value Value
@ -85,7 +81,7 @@ printLLVMIr :: LLVMIr -> String
printLLVMIr (Define t (Ident i) params) = concat ["define ", show t, " @", i, "(", intercalate "," (fmap (\(x,Ident y) -> unwords [show x, "%"<>y]) 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 (SetVariable (Ident i)) = concat ["%", i, " = "]
printLLVMIr (Add t v1 v2) = concat ["add ", show t, " ", show v1, ", ", show v2, "\n"] printLLVMIr (Add t v1 v2) = concat ["add ", show t, " ", show v1, ", ", show v2, "\n"]
printLLVMIr (Sub t v1 v2) = concat ["sub ", show t, " ", show v1, ", ", show v2, "\n"] printLLVMIr (Sub t v1 v2) = concat ["sub ", show t, " ", show v1, ", ", show v2, "\n"]
printLLVMIr (Div t v1 v2) = concat ["sdiv ", show t, " ", show v1, ", ", show v2, "\n"] printLLVMIr (Div t v1 v2) = concat ["sdiv ", show t, " ", show v1, ", ", show v2, "\n"]
@ -110,6 +106,9 @@ emit l = modify (\t -> t {instructions = instructions t ++ [l]})
increaseVarCount :: CompilerState increaseVarCount :: CompilerState
increaseVarCount = modify (\t -> t {variableCount = variableCount t + 1}) increaseVarCount = modify (\t -> t {variableCount = variableCount t + 1})
setBlock :: [Ident] -> CompilerState
setBlock xs = modify (\s -> s {block = Set.fromList xs})
compile :: Program -> IO () compile :: Program -> IO ()
compile (Program prg) = do compile (Program prg) = do
--Asp --Asp
@ -125,11 +124,11 @@ compile (Program prg) = do
putStrLn $ concatMap printLLVMIr ins putStrLn $ concatMap printLLVMIr ins
where where
mainContent var = mainContent var =
[ Variable (Ident "print_res") [ SetVariable (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) , SetVariable (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) , SetVariable (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 I64 (VInteger 0) , Ret I64 (VInteger 0)
] ]
@ -138,7 +137,7 @@ compile (Program prg) = do
goDef [] = return () goDef [] = return ()
goDef (DExp id@(Ident str) t _id2 args exp : xs) = do goDef (DExp id@(Ident str) t _id2 args exp : xs) = do
let (rt, argTypes) = flattenFuncType t let (rt, argTypes) = flattenFuncType t
emit $ Comment $ show (rt, argTypes) emit $ Comment $ show str <> ": " <> show (rt, argTypes)
emit $ Define rt id (zip argTypes args) -- //TODO parse args emit $ Define rt id (zip argTypes args) -- //TODO parse args
go exp go exp
varNum <- gets variableCount varNum <- gets variableCount
@ -155,19 +154,29 @@ compile (Program prg) = do
go (EMul e1 e2) = emitMul e1 e2 go (EMul e1 e2) = emitMul e1 e2
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) = emitArg id
go (EId id) = emit $ Comment $ "EId (" <> show id <> ") is not implemented!" go (EApp e1 e2) = emitApp e1 e2
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!" go (EAbs id t e) = emit $ Comment $ "EAbs (" <> show id <> ", " <> show t <> ", " <> show e <> ") is not implemented!"
--- aux functions --- --- aux functions ---
emitInt :: Integer -> CompilerState emitApp :: Exp -> Exp -> CompilerState
emitInt i = do emitApp e1 e2 = do
-- ideally this case should not occur if the other emit $ Comment $ "EApp (" <> show e1 <> ", " <> show e2 <> ") is not implemented!"
-- emit operations are optimized
emitArg :: Ident -> CompilerState
emitArg id = do
-- !!this should never happen!!
increaseVarCount increaseVarCount
varCount <- gets variableCount varCount <- gets variableCount
emit $ Variable $ Ident (show varCount) emit $ SetVariable (Ident $ show varCount)
emit $ Add I64 (VIdent id) (VInteger 0)
emitInt :: Integer -> CompilerState
emitInt i = do
-- !!this should never happen!!
increaseVarCount
varCount <- gets variableCount
emit $ SetVariable $ Ident (show varCount)
emit $ Add I64 (VInteger i) (VInteger 0) emit $ Add I64 (VInteger i) (VInteger 0)
emitAdd :: Exp -> Exp -> CompilerState emitAdd :: Exp -> Exp -> CompilerState
@ -175,7 +184,7 @@ compile (Program prg) = do
(v1,v2) <- binExprToValues e1 e2 (v1,v2) <- binExprToValues e1 e2
increaseVarCount increaseVarCount
v <- gets variableCount v <- gets variableCount
emit $ Variable $ Ident $ show v emit $ SetVariable $ Ident $ show v
emit $ Add I64 v1 v2 emit $ Add I64 v1 v2
emitMul :: Exp -> Exp -> CompilerState emitMul :: Exp -> Exp -> CompilerState
@ -183,7 +192,7 @@ compile (Program prg) = do
(v1,v2) <- binExprToValues e1 e2 (v1,v2) <- binExprToValues e1 e2
increaseVarCount increaseVarCount
v <- gets variableCount v <- gets variableCount
emit $ Variable $ Ident $ show v emit $ SetVariable $ Ident $ show v
emit $ Mul I64 v1 v2 emit $ Mul I64 v1 v2
emitMod :: Exp -> Exp -> CompilerState emitMod :: Exp -> Exp -> CompilerState
@ -192,19 +201,19 @@ compile (Program prg) = do
(v1,v2) <- binExprToValues e1 e2 (v1,v2) <- binExprToValues e1 e2
increaseVarCount increaseVarCount
vadd <- gets variableCount vadd <- gets variableCount
emit $ Variable $ Ident $ show vadd emit $ SetVariable $ Ident $ show vadd
emit $ Add I64 v1 v2 emit $ Add I64 v1 v2
increaseVarCount increaseVarCount
vabs <- gets variableCount vabs <- gets variableCount
emit $ Variable $ Ident $ show vabs emit $ SetVariable $ Ident $ show vabs
emit $ Call I64 (Ident "llvm.abs.i64") emit $ Call I64 (Ident "llvm.abs.i64")
[ (I64, VIdent (Ident $ show vadd)) [ (I64, VIdent (Ident $ show vadd))
, (I1, VInteger 1) , (I1, VInteger 1)
] ]
increaseVarCount increaseVarCount
v <- gets variableCount v <- gets variableCount
emit $ Variable $ Ident $ show v emit $ SetVariable $ Ident $ show v
emit $ Srem I64 (VIdent (Ident $ show vabs)) v2 emit $ Srem I64 (VIdent (Ident $ show vabs)) v2
emitDiv :: Exp -> Exp -> CompilerState emitDiv :: Exp -> Exp -> CompilerState
@ -212,7 +221,7 @@ compile (Program prg) = do
(v1,v2) <- binExprToValues e1 e2 (v1,v2) <- binExprToValues e1 e2
increaseVarCount increaseVarCount
v <- gets variableCount v <- gets variableCount
emit $ Variable $ Ident $ show v emit $ SetVariable $ Ident $ show v
emit $ Div I64 v1 v2 emit $ Div I64 v1 v2
emitSub :: Exp -> Exp -> CompilerState emitSub :: Exp -> Exp -> CompilerState
@ -220,30 +229,22 @@ compile (Program prg) = do
(v1,v2) <- binExprToValues e1 e2 (v1,v2) <- binExprToValues e1 e2
increaseVarCount increaseVarCount
v <- gets variableCount v <- gets variableCount
emit $ Variable $ Ident $ show v emit $ SetVariable $ Ident $ show v
emit $ Sub I64 v1 v2 emit $ Sub I64 v1 v2
exprToValue :: Exp -> State CodeGenerator Value
exprToValue (EInt i) = return $ VInteger i
exprToValue (EId i) = return $ VIdent i
exprToValue e = do
go e
v <- gets variableCount
return $ VIdent $ Ident $ show v
binExprToValues :: Exp -> Exp -> State CodeGenerator (Value, Value) binExprToValues :: Exp -> Exp -> State CodeGenerator (Value, Value)
binExprToValues e1 e2 = case (e1, e2) of binExprToValues e1 e2 = do
-- instead of declaring variables for working on ints, v1 <- exprToValue e1
-- we can directly pass them to their functions. v2 <- exprToValue e2
-- This optimization removes the need to declare return (v1,v2)
-- roughly 50% of variables
(EInt i1, EInt i2) -> return (VInteger i1, VInteger i2)
(EInt i, e) -> do
go e
v2 <- gets variableCount
return (VInteger i, VIdent (Ident $ show v2))
(e, EInt i) -> do
go e
v2 <- gets variableCount
return (VIdent (Ident $ show v2), VInteger i)
(e1, e2) -> do
go e1
v1 <- gets variableCount
go e2
v2 <- gets variableCount
return (VIdent (Ident $ show v1),VIdent (Ident $ show v2))
-- very nasty -- very nasty