diff options
| -rw-r--r-- | AST.hs | 12 | ||||
| -rw-r--r-- | BuildIR.hs | 55 | ||||
| -rw-r--r-- | ProgramParser.hs | 39 | ||||
| -rw-r--r-- | TypeCheck.hs | 11 | ||||
| -rw-r--r-- | TypeRules.hs | 1 | ||||
| -rw-r--r-- | struct.lang | 2 |
6 files changed, 91 insertions, 29 deletions
@@ -42,7 +42,7 @@ data Statement data AsExpression = AEVar Name (Maybe Type) | AESubscript AsExpression Expression (Maybe Type) - -- | AESet + | AEGet AsExpression Name (Maybe Type) deriving (Show, Eq) data Expression @@ -206,10 +206,16 @@ instance Pretty Expression where instance Pretty AsExpression where prettyI i (AEVar n (Just t)) = "(" ++ prettyI i (AEVar n Nothing) ++ " :: " ++ prettyI i t ++ ")" - prettyI _ (AEVar n Nothing) = n + prettyI _ (AEVar n Nothing) = + n prettyI i (AESubscript ae e (Just t)) = "(" ++ prettyI i (AESubscript ae e Nothing) ++ " :: " ++ prettyI i t ++ ")" - prettyI i (AESubscript ae e Nothing) = prettyI i ae ++ "[" ++ prettyI i e ++ "]" + prettyI i (AESubscript ae e Nothing) = + prettyI i ae ++ "[" ++ prettyI i e ++ "]" + prettyI i (AEGet ae n (Just t)) = + "(" ++ prettyI i (AEGet ae n Nothing) ++ " :: " ++ prettyI i t ++ ")" + prettyI i (AEGet ae n Nothing) = + prettyI i ae ++ "." ++ n instance Pretty BinaryOp where prettyI _ BOAdd = "+" @@ -417,15 +417,45 @@ convertExpression (ENew t sze) nextnext = do return ref convertAsExpression :: AsExpression -> Ref -> Id -> BuildM () -convertAsExpression (AEVar n _) valueref nextnext = do - mres <- findVar n - vref <- case mres of - Just (_, (r, _)) -> return r - Nothing -> throwError $ "Undefined variable '" ++ n ++ "'" ++ - " used in assignment expression" +convertAsExpression aevar@(AEVar _ _) valueref nextnext = do + vref <- getAEVarRef aevar addIns $ IMov vref valueref setTerm $ IJmp nextnext -convertAsExpression (AESubscript ae2 expr mrt) valueref nextnext = do +convertAsExpression aesubscript@(AESubscript _ _ _) valueref nextnext = do + elemptr <- getAESubscriptStoreRef aesubscript + addIns $ IStore elemptr valueref + setTerm $ IJmp nextnext +convertAsExpression topae@(AEGet _ _ _) valueref nextnext = do + let (core, _, offset) = collectAESets topae + case core of + aevar@(AEVar _ _) -> do + vref <- getAEVarRef aevar + addIns $ ISet vref offset valueref + aesubscript@(AESubscript _ _ _) -> do + elemptr <- getAESubscriptStoreRef aesubscript + fieldptr <- genTemp (refSize elemptr) + addIns $ IAri AAdd fieldptr elemptr (Constant (refSize elemptr) (fromIntegral offset)) + addIns $ IStore fieldptr valueref + AEGet _ _ _ -> undefined + setTerm $ IJmp nextnext + +collectAESets :: AsExpression -> (AsExpression, [AsExpression], Offset) +collectAESets ae@(AEGet ae2 n _) = + let (core, sets, offset) = collectAESets ae2 + in (core, ae : sets, offset + offsetInStruct (fromJust $ typeof ae2) n) +collectAESets ae = (ae, [], 0) + +getAEVarRef :: AsExpression -> BuildM Ref +getAEVarRef (AEVar n _) = do + mres <- findVar n + case mres of + Just (_, (r, _)) -> return r + Nothing -> throwError $ "Undefined variable '" ++ n ++ "'" ++ + " used in assignment expression" +getAEVarRef _ = undefined + +getAESubscriptStoreRef :: AsExpression -> BuildM Ref +getAESubscriptStoreRef (AESubscript ae2 expr mrt) = do let elemsz = sizeof $ fromJust mrt ae2ref <- goLoad ae2 bl2 <- newBlockNoSwitch @@ -446,9 +476,9 @@ convertAsExpression (AESubscript ae2 expr mrt) valueref nextnext = do switchBlock bl3 addIns $ IAri AMul offref subref (Constant (refSize subref) (fromIntegral elemsz)) addIns $ IAri AAdd elemptr ae2ref offref - addIns $ IStore elemptr valueref - setTerm $ IJmp nextnext + return elemptr where + -- evaluate as if it were an Expression goLoad :: AsExpression -> BuildM Ref goLoad (AEVar n _) = do mres <- findVar n @@ -483,3 +513,10 @@ convertAsExpression (AESubscript ae2 expr mrt) valueref nextnext = do dstref <- genTemp elemsz addIns $ ILoad dstref elemptr return dstref + goLoad topae@(AEGet topup _ _) = do + let (core, _, offset) = collectAESets topae + coreref <- goLoad core + ref <- genTemp (sizeof $ fromJust $ typeof topup) + addIns $ IGet ref coreref offset + return ref +getAESubscriptStoreRef _ = undefined diff --git a/ProgramParser.hs b/ProgramParser.hs index 411e063..a25de6e 100644 --- a/ProgramParser.hs +++ b/ProgramParser.hs @@ -190,28 +190,37 @@ pExpression = E.buildExpressionParser optable litparser <?> "expression" preops <- many pPrefixOp e <- pParenExpr <|> pENew <|> (mkELit <$> pLiteral) postops <- many pPostfixOp - let e' = foldl (\ex op -> case op of - Left sub -> ESubscript ex sub Nothing - Right n -> EGet ex n Nothing) - e postops - e'' = foldl (\ex pop -> EUn pop ex Nothing) e' preops - return e'' + return $ foldl (flip ($)) e (postops ++ preops) pAsExpression :: Parser AsExpression pAsExpression = do n <- pName - subs <- many $ between (symbol "[") (symbol "]") pExpression - return $ foldl (\ae expr -> AESubscript ae expr Nothing) (AEVar n Nothing) subs + postops <- many pPostfixAsOp + return $ foldl (flip ($)) (AEVar n Nothing) postops -pPrefixOp :: Parser UnaryOp -pPrefixOp = (symbol "!" >> return UONot) <|> - (symbol "-" >> return UONeg) +pPrefixOp :: Parser (Expression -> Expression) +pPrefixOp = (symbol "!" >> return (\e -> EUn UONot e Nothing)) <|> + (symbol "-" >> return (\e -> EUn UONeg e Nothing)) --- Left: subscript; Right: dot-index -pPostfixOp :: Parser (Either Expression Name) +pPostfixOp :: Parser (Expression -> Expression) pPostfixOp = - (Left <$> between (symbol "[") (symbol "]") pExpression) <|> - (Right <$> (symbol "." >> pName)) + (do + expr <- between (symbol "[") (symbol "]") pExpression + return $ \e -> ESubscript e expr Nothing) <|> + (do + symbol "." + n <- pName + return $ \e -> EGet e n Nothing) + +pPostfixAsOp :: Parser (AsExpression -> AsExpression) +pPostfixAsOp = + (do + expr <- between (symbol "[") (symbol "]") pExpression + return $ \ae -> AESubscript ae expr Nothing) <|> + (do + symbol "." + n <- pName + return $ \ae -> AEGet ae n Nothing) pParenExpr :: Parser Expression pParenExpr = do diff --git a/TypeCheck.hs b/TypeCheck.hs index 2b05df1..6d8134d 100644 --- a/TypeCheck.hs +++ b/TypeCheck.hs @@ -259,7 +259,7 @@ annotateExpr db (EGet st n _) = do Nothing -> Left $ "Struct of type " ++ pretty stt ++ " has no member named '" ++ n ++ "'" Just (t, _) -> return $ EGet st' n (Just t) - Just stt -> Left $ "Use of non-struct type " ++ pretty stt ++ " as dot-indexed expression" + Just t -> Left $ "Use of non-struct type " ++ pretty t ++ " as dot-indexed expression" annotateExpr db (ECast t e) = do e' <- annotateExpr db e let typ = fromJust (typeof e') @@ -293,6 +293,15 @@ annotateAsExpr db (AESubscript ae expr _) = do TArr t _ -> return $ AESubscript ae' expr' (Just t) t -> Left $ "Indexed expression '" ++ pretty ae ++ "' has non-array type " ++ pretty t ++ " in assignment expression" +annotateAsExpr db (AEGet ae n _) = do + ae' <- annotateAsExpr db ae + case typeof ae' of + Nothing -> Left $ "Use of void value in dot-indexed assignment expression" + Just stt@(TStruct ms) -> case find ((==n) . snd) ms of + Nothing -> Left $ "Struct of type " ++ pretty stt ++ " has no member named '" ++ n ++ + "' in assignment expression" + Just (t, _) -> return $ AEGet ae' n (Just t) + Just t -> Left $ "Use of non-struct type " ++ pretty t ++ " as dot-indexed assignment expression" resolveType :: TypeDB -> Type -> Error Type diff --git a/TypeRules.hs b/TypeRules.hs index b73daf2..2eb8974 100644 --- a/TypeRules.hs +++ b/TypeRules.hs @@ -62,3 +62,4 @@ instance TypeOf Expression where instance TypeOf AsExpression where typeof (AEVar _ mt) = mt typeof (AESubscript _ _ mt) = mt + typeof (AEGet _ _ mt) = mt diff --git a/struct.lang b/struct.lang index 5bd38c4..4f89e52 100644 --- a/struct.lang +++ b/struct.lang @@ -11,7 +11,7 @@ func f(int iets1, S s, int iets2) { } func int main() { - // global.x = 3 * global.x + int(global.y); + global.x = 3 * global.x + int(global.y); putint(global.x + 1); putc(global.y); putc('\n'); int a := getc(); int b := getc(); |