diff options
Diffstat (limited to 'AST.hs')
| -rw-r--r-- | AST.hs | 80 |
1 files changed, 69 insertions, 11 deletions
@@ -1,12 +1,17 @@ module AST where import Data.List +import Data.Maybe import Defs import Pretty +import Utils -data Program = Program [DVar] [DFunc] +data Program = Program [DTypedef] [DVar] [DFunc] + deriving (Show, Eq) + +data DTypedef = DTypedef Name Type deriving (Show, Eq) data DVar = DVar Type Name Expression @@ -16,8 +21,9 @@ data DFunc = DFunc (Maybe Type) Name [(Type, Name)] Block deriving (Show, Eq) data Type - = TInt | TChar | TArr Type (Maybe Size) - deriving (Show, Eq) + = TInt | TChar | TArr Type (Maybe Size) | TStruct [(Type, Name)] + | TName Name + deriving (Show, Eq, Ord) data Block = Block [Statement] deriving (Show, Eq) @@ -43,6 +49,7 @@ data Expression | EUn UnaryOp Expression (Maybe Type) | ELit Literal (Maybe Type) | ESubscript Expression Expression (Maybe Type) + | EGet Expression Name (Maybe Type) | ECast Type Expression | ENew Type Expression deriving (Show, Eq) @@ -64,6 +71,7 @@ data Literal | LVar Name | LCall Name [Expression] | LStr String + | LStruct [(Name, Expression)] deriving (Show, Eq) @@ -71,15 +79,50 @@ sizeof :: Type -> Size sizeof TInt = 8 sizeof TChar = 1 sizeof (TArr _ _) = 8 +sizeof (TStruct []) = 0 +sizeof st@(TStruct ms) = + roundUp (sum (layoutStruct st) + sizeof (fst $ last ms)) (foldl1 lcm $ 8 : map (alignmentof . fst) ms) +sizeof t@(TName _) = error $ "sizeof on " ++ show t + +alignmentof :: Type -> Offset +alignmentof TInt = 8 +alignmentof TChar = 1 +alignmentof (TArr _ _) = 8 +alignmentof (TStruct []) = 1 +alignmentof (TStruct ((t,_):_)) = alignmentof t +alignmentof (TName _) = undefined + +layoutStruct :: Type -> [Offset] +layoutStruct (TStruct ms) = go ms 0 + where + go :: [(Type, Name)] -> Offset -> [Offset] + go [] _ = [] + go ((t,_) : rest) start = + let o = roundUp start (alignmentof t) + in o : go rest (o + sizeof t) +layoutStruct _ = undefined + +offsetInStruct :: Type -> Name -> Offset +offsetInStruct st@(TStruct ms) name = layoutStruct st !! (fromJust $ findIndex ((==name) . snd) ms) +offsetInStruct _ _ = undefined + +structMemberType :: Type -> Name -> Type +structMemberType (TStruct ms) name = fst $ fromJust $ find ((==name) . snd) ms +structMemberType _ _ = undefined instance Pretty Program where - prettyI i (Program vars funcs) = - intercalate ("\n" ++ indent i) (map (prettyI i) vars ++ map (prettyI i) funcs) + prettyI i (Program tds vars funcs) = + intercalate ("\n" ++ indent i) + (map (prettyI i) tds ++ map (prettyI i) vars ++ map (prettyI i) funcs) ++ "\n" where indent n = replicate (2*n) ' ' +instance Pretty DTypedef where + prettyI i (DTypedef n t) = + "type " ++ n ++ " := " ++ prettyI i t ++ ";" + instance Pretty DVar where prettyI i (DVar t n e) = prettyI i t ++ " " ++ n ++ " := " ++ prettyI i e ++ ";" @@ -96,6 +139,10 @@ instance Pretty Type where prettyI _ TChar = "char" prettyI _ (TArr t Nothing) = pretty t ++ "[]" prettyI _ (TArr t (Just sz)) = pretty t ++ "[" ++ show sz ++ "]" + prettyI _ (TStruct []) = "struct {}" + prettyI _ (TStruct ms) = + "struct {" ++ intercalate " " [pretty t ++ " " ++ n ++ ";" | (t,n) <- ms] ++ "}" + prettyI _ (TName n) = n instance Pretty Block where prettyI _ (Block []) = "{}" @@ -111,8 +158,10 @@ instance Pretty Statement where prettyI i t ++ " " ++ n ++ " := " ++ prettyI i e ++ ";" prettyI i (SAs target e) = prettyI i target ++ " = " ++ prettyI i e ++ ";" + prettyI i (SIf c b (Block [])) = + "if (" ++ prettyI i c ++ ") " ++ prettyI i b prettyI i (SIf c b1 b2) = - "if " ++ prettyI i c ++ " " ++ prettyI i b1 ++ " else " ++ prettyI i b2 + "if (" ++ prettyI i c ++ ") " ++ prettyI i b1 ++ " else " ++ prettyI i b2 prettyI i (SWhile c b) = "while " ++ prettyI i c ++ " " ++ prettyI i b prettyI _ (SBreak 0) = @@ -138,12 +187,20 @@ instance Pretty Expression where prettyI i uo ++ "(" ++ prettyI i e ++ ")" prettyI i (ELit l (Just t)) = "(" ++ prettyI i (ELit l Nothing) ++ " :: " ++ prettyI i t ++ ")" - prettyI i (ELit l Nothing) = prettyI i l + prettyI i (ELit l Nothing) = + prettyI i l prettyI i (ESubscript a b (Just t)) = "(" ++ prettyI i (ESubscript a b Nothing) ++ " :: " ++ prettyI i t ++ ")" - prettyI i (ESubscript a b Nothing) = "(" ++ prettyI i a ++ ")[" ++ prettyI i b ++ "]" - prettyI i (ECast t e) = prettyI i t ++ "(" ++ prettyI i e ++ ")" - prettyI i (ENew t e) = "new " ++ prettyI i t ++ "[" ++ prettyI i e ++ "]" + prettyI i (ESubscript a b Nothing) = + "(" ++ prettyI i a ++ ")[" ++ prettyI i b ++ "]" + prettyI i (EGet e n Nothing) = + "(" ++ prettyI i e ++ ")." ++ n + prettyI i (EGet e n (Just t)) = + "(" ++ prettyI i (EGet e n Nothing) ++ " :: " ++ prettyI i t ++ ")" + prettyI i (ECast t e) = + prettyI i t ++ "(" ++ prettyI i e ++ ")" + prettyI i (ENew t e) = + "new " ++ prettyI i t ++ "[" ++ prettyI i e ++ "]" instance Pretty AsExpression where prettyI i (AEVar n (Just t)) = @@ -172,7 +229,6 @@ instance Pretty BinaryOp where prettyI _ BOBitOr = "|" prettyI _ BOBitXor = "^" - instance Pretty UnaryOp where prettyI _ UONot = "!" prettyI _ UONeg = "-" @@ -184,3 +240,5 @@ instance Pretty Literal where prettyI i (LCall n al) = n ++ "(" ++ intercalate ", " (map (prettyI i) al) ++ ")" prettyI _ (LStr s) = show s + prettyI i (LStruct ms) = + "{" ++ intercalate ", " (map (\(n,e) -> n ++ " = " ++ prettyI i e) ms) ++ "}" |