aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--AST.hs12
-rw-r--r--BuildIR.hs55
-rw-r--r--ProgramParser.hs39
-rw-r--r--TypeCheck.hs11
-rw-r--r--TypeRules.hs1
-rw-r--r--struct.lang2
6 files changed, 91 insertions, 29 deletions
diff --git a/AST.hs b/AST.hs
index 7a76208..b42f1af 100644
--- a/AST.hs
+++ b/AST.hs
@@ -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 = "+"
diff --git a/BuildIR.hs b/BuildIR.hs
index 028c649..f40e141 100644
--- a/BuildIR.hs
+++ b/BuildIR.hs
@@ -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();