diff --git a/design/sa.md b/design/sa.md index fa9bb33..5179cee 100644 --- a/design/sa.md +++ b/design/sa.md @@ -7,11 +7,11 @@ 每个阶段本身不会因为检测到错误而中断，因此会尽量收集足够多的错误。但是一个阶段结束时如果产生了错误，那么编译应该结束并报错，输出的AST有错，无法继续编译。 1. Name Resolution：确保程序没有使用未定义的变量或符号，并且没有冲突的重复定义。需要提前包含库函数的符号。 -2. Type Checking：确保程序没有类型错误，并提供足够的类型标注，尤其需要标注类型转换 +2. Type Checking：确保程序没有类型错误，并提供足够的类型标注，尤其需要标注类型转换 * 函数`putf`的参数处理需要额外的手段介入，但是目前的functional tests没有找到使用该函数的测例，所以打算等到功能大致实现完成再做。 - * 初值检查和整理：尤其是数组初值的整理，需要根据类型信息丢弃(警告)和补0。 3. Constant Computation：计算所有编译期常量并标注在AST上 * 需要上一阶段标注的类型信息。由于类型检查通过，所以只需要判断是否是常量即可，然后根据规则计算。 + * 初值检查和整理：尤其是数组初值的整理，需要根据类型信息丢弃(警告)和补0。 * 检查数组常量的左值，不能有修改的代码。 4. 基本块、DAG、优化、代码生成等其他阶段，目前还是先用LLVM吧，可以直接从AST生成LLVM IR，后端以后慢慢写。 diff --git a/src/SysY/AST/Basic.hs b/src/SysY/AST/Basic.hs index f6a8448..9458d82 100644 --- a/src/SysY/AST/Basic.hs +++ b/src/SysY/AST/Basic.hs @@ -38,6 +38,11 @@ data FuncDef = FuncDef FuncType Ident [FuncFParam] Block data FuncType = FVoid | FInt | FFloat deriving (Eq, Show) +funcType2TermType :: FuncType -> TermType +funcType2TermType FVoid = TermVoid +funcType2TermType FInt = TermBType BInt +funcType2TermType FFloat = TermBType BFloat + data FuncFParam = FuncFParam BType Ident Int [TypedExp] deriving (Eq, Show) diff --git a/src/SysY/StaticAnalysis.hs b/src/SysY/StaticAnalysis.hs index 18084f9..0a2b45c 100644 --- a/src/SysY/StaticAnalysis.hs +++ b/src/SysY/StaticAnalysis.hs @@ -18,15 +18,40 @@ import Prelude hiding (error) import SysY.AST.Basic import Control.Monad.State +import Control.Monad.Except +import Control.Monad (when) +import Control.Lens -checkNameRes :: CompUnit -> State SAContext () -checkNameRes comp_unit = runSAEffectsPure $ SysY.StaticAnalysis.NameRes.check_comp_unit comp_unit +checkNameRes :: State (CompUnit, SAContext) () +checkNameRes = do + comp_unit <- gets fst + zoom _2 $ do + runSAEffectsPure $ SysY.StaticAnalysis.NameRes.check_comp_unit comp_unit +checkType :: State (CompUnit, SAContext) () +checkType = do + comp_unit <- gets fst + comp_unit' <- zoom _2 $ do + runSAEffectsPure $ SysY.StaticAnalysis.TypeCheck.check_comp_unit comp_unit + _1 .= comp_unit' + +terminate_if_has_error :: ExceptT () (State (CompUnit, SAContext)) () +terminate_if_has_error = do + e <- lift (zoom _2 has_error) + when e $ throwError () + lift $ zoom _2 reset_symbols + +static_analysis_inner :: ExceptT () (State (CompUnit, SAContext)) () +static_analysis_inner = do + lift $ checkNameRes + terminate_if_has_error + lift $ checkType + terminate_if_has_error static_analysis :: CompUnit -> ([String], CompUnit) -- TODO: rewrite for effect stack static_analysis c = do - let SAContext ws es _ _ = execState (checkNameRes c) defaultSAContext - -- mapM_ print es + let ex = runExceptT static_analysis_inner + let (c', SAContext ws es _ _) = execState ex (c, defaultSAContext) (es, c) diff --git a/src/SysY/StaticAnalysis/Basic.hs b/src/SysY/StaticAnalysis/Basic.hs index a78ddfe..c48413b 100644 --- a/src/SysY/StaticAnalysis/Basic.hs +++ b/src/SysY/StaticAnalysis/Basic.hs @@ -5,7 +5,7 @@ {-# LANGUAGE TypeApplications #-} module SysY.StaticAnalysis.Basic ( SAEffects, warn, SysY.StaticAnalysis.Basic.error, withScope, newFunc, findFunc, newSymbol, findSymbol, - SymInfo(..), FuncInfo(..), SAContext(..), defaultSAContext, runSAEffectsPure, lib_functions + SymInfo(..), FuncInfo(..), SAContext(..), defaultSAContext, runSAEffectsPure, reset_symbols, has_error ) where import SysY.AST (Ident, TermType, ConstVal, TermType(..), BType(..)) import Polysemy @@ -43,6 +43,9 @@ data SAContext = SAContext } makeLenses ''SAContext +lib_funcs :: [(Ident, FuncInfo)] +lib_funcs = zip (fmap funcName lib_functions) lib_functions + defaultSAContext :: SAContext defaultSAContext = SAContext { _warnings = [] @@ -50,7 +53,14 @@ defaultSAContext = SAContext , _symbols = [Map.empty] -- top level scope , _functions = Map.fromList lib_funcs } - where lib_funcs = zip (fmap funcName lib_functions) lib_functions + +reset_symbols :: State SAContext () +reset_symbols = do + symbols .= [Map.empty] + functions .= Map.fromList lib_funcs + +has_error :: State SAContext Bool +has_error = uses errors (not . Prelude.null) append_warning :: String -> State SAContext () append_warning w = warnings %= (w <|) -- this version of lens does not have `<|=` diff --git a/src/SysY/StaticAnalysis/NameRes.hs b/src/SysY/StaticAnalysis/NameRes.hs index 8fc41a6..00a2efb 100644 --- a/src/SysY/StaticAnalysis/NameRes.hs +++ b/src/SysY/StaticAnalysis/NameRes.hs @@ -62,8 +62,8 @@ check_exp (ExpCall name args) = do assert_function name mapM_ check_typed_exp args -check_block :: Member SAEffects r => Block -> Sem r () -check_block (Block items) = withScope $ mapM_ check_block_item items +check_block_unscoped :: Member SAEffects r => Block -> Sem r () +check_block_unscoped (Block items) = mapM_ check_block_item items where check_block_item (BlockItemDecl decl) = check_decl decl check_block_item (BlockItemStmt stmt) = check_stmt stmt @@ -72,7 +72,7 @@ check_stmt :: Member SAEffects r => Stmt -> Sem r () check_stmt (StmtLVal lval e) = check_lval lval >> check_typed_exp e check_stmt (StmtExp Nothing) = pure () check_stmt (StmtExp (Just e)) = check_typed_exp e -check_stmt (StmtBlock block) = check_block block +check_stmt (StmtBlock block) = withScope $ check_block_unscoped block check_stmt (StmtIf cond then' Nothing) = check_typed_exp cond >> check_stmt then' check_stmt (StmtIf cond then' (Just else')) = check_typed_exp cond >> check_stmt then' >> check_stmt else' check_stmt (StmtWhile cond do') = check_typed_exp cond >> check_stmt do' @@ -117,7 +117,7 @@ check_func (FuncDef _ name args block) = do new_function name -- insert function symbol so it can be recursive withScope $ do -- function scope mapM_ check_fparam args - check_block block -- block scope + check_block_unscoped block -- block scope check_top_level :: Member SAEffects r => TopLevel -> Sem r () check_top_level (TLDecl decl) = check_decl decl diff --git a/src/SysY/StaticAnalysis/TypeCheck.hs b/src/SysY/StaticAnalysis/TypeCheck.hs index e318835..05b8ab7 100644 --- a/src/SysY/StaticAnalysis/TypeCheck.hs +++ b/src/SysY/StaticAnalysis/TypeCheck.hs @@ -4,25 +4,23 @@ {-# LANGUAGE FunctionalDependencies #-} module SysY.StaticAnalysis.TypeCheck ( - + check_comp_unit ) where import SysY.AST import Polysemy import Text.Printf (printf) -import Control.Monad (unless, zipWithM) +import Control.Monad (unless, zipWithM, when) import SysY.StaticAnalysis.Basic as SA import Prelude hiding (error) import qualified Prelude as Pre +import Data.Functor (($>)) arith_op :: [Optr] arith_op = [Plus, Minus, Mul, Div] comp_op :: [Optr] comp_op = [Lt, Gt, Le, Ge, Eq, Ne] -cond_op :: [Optr] -cond_op = [LAnd, LOr] - --- lift_typed :: (TermType, Exp) -> TypedExp --- lift_typed (t, e) = (Just t, e) +-- cond_op :: [Optr] +-- cond_op = [LAnd, LOr] typeInfer' :: Member SAEffects r => TypedExp -> Sem r (TermType, TypedExp) typeInfer' (RawExp e) = do @@ -45,23 +43,14 @@ findTypeDecl name = do Nothing -> assert_name_resolution Just (SymInfo _ t _, _) -> pure t - --- | We assert that name resolution has succeeded, so type checking can safely panic when there're unexpected cases, --- so in which cases compiler code should checked. --- --- This functions cannot return `TermVoid`. --- --- `TermAny` being returned indicates type inference has failed. --- But caller should not generate error message in this case. The inference which failed is responsible to do that. -typeInfer :: Member SAEffects r => Exp -> Sem r (TermType, Exp) -typeInfer (ExpLVal (LVal name indexers)) = do +check_lval :: Member SAEffects r => LVal -> Sem r (TermType, LVal) +check_lval (LVal name indexers) = do carrier_type <- findTypeDecl name - if null indexers then pure (carrier_type, ExpLVal (LVal name indexers)) + if null indexers then pure (carrier_type, LVal name indexers) else do - indexers_ <- mapM typeInfer_ indexers - indexers__ <- mapM (typeCheck_ex (TermBType BInt)) indexers_ - let val = LVal name indexers__ - let def = pure $ (TermAny, ExpLVal val) + indexers' <- check_indexers indexers + let val = LVal name indexers' + let def = pure (TermAny, val) case carrier_type of TermAny -> assert_name_resolution TermVoid -> Pre.error "Impossible. Symbol cannot be of void" @@ -71,16 +60,27 @@ typeInfer (ExpLVal (LVal name indexers)) = do TermArray type_ dimensions -> do if length dimensions < length indexers then do - error "Indexers cannot be more than dimensions of array type" + error "Indexers cannot be of more dimensions than of array type" def else do let new_dimensions = drop (length indexers) dimensions if null new_dimensions - then pure $ (TermBType type_, ExpLVal val) + then pure $ (TermBType type_, val) else do let new_type = TermArray type_ new_dimensions - pure $ (new_type, ExpLVal val) + pure $ (new_type, val) +-- | We assert that name resolution has succeeded, so type checking can safely panic when there're unexpected cases, +-- so in which cases compiler code should checked. +-- +-- This functions cannot return `TermVoid`. +-- +-- `TermAny` being returned indicates type inference has failed. +-- But caller should not generate error message in this case. The inference which failed is responsible to do that. +typeInfer :: Member SAEffects r => Exp -> Sem r (TermType, Exp) +typeInfer (ExpLVal lval) = do + (type_, lval') <- check_lval lval + pure (type_, ExpLVal lval') typeInfer ((ExpNum (IntConst i))) = pure $ (TermBType BInt, ExpNum (IntConst i)) typeInfer ((ExpNum (FloatConst f))) = pure $ (TermBType BFloat, ExpNum (FloatConst f)) typeInfer ((ExpOpUnary op oprd)) = do @@ -171,6 +171,9 @@ typeInfer ((ExpCall name args)) = do pure $ (ret_type, ExpCall name new_args) +check_indexers :: Member SAEffects r => [TypedExp] -> Sem r [TypedExp] +check_indexers = mapM (typeCheck_ex (TermBType BInt)) + typeCheck_im :: Member SAEffects r => TermType -> TypedExp -> Sem r TypedExp typeCheck_im = typeCheck True typeCheck_ex :: Member SAEffects r => TermType -> TypedExp -> Sem r TypedExp @@ -181,29 +184,132 @@ typeCheck implicit_conv t (RawExp e) = do (type_, e_) <- typeInfer e typeCheck implicit_conv t (TypedExp type_ e_) typeCheck implicit_conv t (TypedExp o e) = do -- combine the two cases - if implicit_conv then - if (o, t) `elem` typeImplicitConv then - pure $ ConvExp t (TypedExp o e) + if t == o then + pure (TypedExp o e) + else + if implicit_conv then + if (o, t) `elem` typeImplicitConv then + pure $ ConvExp t (TypedExp o e) + else do + error $ printf "Expected type %s, got %s, conversion failed" (show t) (show o) + pure (TypedExp o e) else do - error $ printf "Expected type %s, got %s, conversion failed" (show t) (show o) + error $ printf "Expected type %s, got %s" (show t) (show o) pure (TypedExp o e) - else do - unless (t == o) $ error $ printf "Expected type %s, got %s" (show t) (show o) - pure (TypedExp o e) typeCheck implicit_conv t (ConvExp o e) = do - if implicit_conv then - if (o, t) `elem` typeImplicitConv then - pure $ ConvExp t (ConvExp o e) -- in the case where multiple conversion is needed + if t == o then + pure (ConvExp o e) + else + if implicit_conv then + if (o, t) `elem` typeImplicitConv then + pure $ ConvExp t (ConvExp o e) -- in the case where multiple conversion is needed + else do + error $ printf "Expected type %s, got %s, conversion failed" (show t) (show o) + pure (ConvExp o e) else do - error $ printf "Expected type %s, got %s, conversion failed" (show t) (show o) + error $ printf "Expected type %s, got %s" (show t) (show o) pure (ConvExp o e) - else do - unless (t == o) $ error $ printf "Expected type %s, got %s" (show t) (show o) - pure (ConvExp o e) typeImplicitConv :: [(TermType, TermType)] typeImplicitConv = [(TermBType BInt, TermBType BFloat), (TermBType BFloat, TermBType BInt)] +check_typed_exp :: Member SAEffects r => TypedExp -> Sem r TypedExp +check_typed_exp = typeInfer_ + +check_decl :: Member SAEffects r => Decl -> Sem r Decl +check_decl (DeclConst (ConstDecl btype defs)) = do + defs_ <- mapM (check_const_def btype) defs + pure $ DeclConst (ConstDecl btype defs_) +check_decl (DeclVar (VarDecl btype defs)) = do + defs_ <- mapM (check_var_def btype) defs + pure $ DeclVar (VarDecl btype defs_) + +check_const_def :: Member SAEffects r => BType -> ConstDef -> Sem r ConstDef +check_const_def btype (ConstDef name indexers init_) = do + indexers' <- check_indexers indexers + let type' = gen_type btype (length indexers') + init' <- check_const_init_val type' init_ -- check type of init value with unknown dimensions length + newSymbol (SymInfo name type' Nothing) + pure (ConstDef name indexers' init') --- check_typed_exp :: +check_var_def :: Member SAEffects r => BType -> VarDef -> Sem r VarDef +check_var_def btype (VarDefUninit name indexers) = do + indexers' <- check_indexers indexers + let type' = gen_type btype (length indexers') + newSymbol (SymInfo name type' Nothing) + pure (VarDefUninit name indexers') +check_var_def btype (VarDefInit name indexers init_) = do + indexers' <- check_indexers indexers + let type' = gen_type btype (length indexers') + init' <- check_const_init_val type' init_ + newSymbol (SymInfo name type' Nothing) + pure (VarDefInit name indexers' init') +gen_type :: BType -> Int -> TermType +gen_type btype indexers = type' + where + type' = if null dimensions then TermBType btype else TermArray btype dimensions + dimensions = replicate indexers Nothing -- all nothing, to be computed and checked in next stage of static analysis + +exp_type :: TypedExp -> TermType +exp_type (RawExp _) = Pre.error "Imposssible. Cannot call `exp_type` on non-checked expression" +exp_type (TypedExp t _) = t +exp_type (ConvExp t _) = t + +check_block_unscoped :: Member SAEffects r => Block -> Sem r Block +check_block_unscoped (Block items) = Block <$> mapM check_block_item items + where + check_block_item (BlockItemDecl decl) = BlockItemDecl <$> check_decl decl + check_block_item (BlockItemStmt stmt) = BlockItemStmt <$> check_stmt stmt + +check_fparam :: Member SAEffects r => FuncFParam -> Sem r (TermType, FuncFParam) +check_fparam (FuncFParam btype name dimensions indexers) = do + indexers' <- check_indexers indexers + let type' = gen_type btype dimensions + newSymbol (SymInfo name type' Nothing) + pure (type', FuncFParam btype name dimensions indexers') + +check_func :: Member SAEffects r => FuncDef -> Sem r FuncDef +check_func (FuncDef func_type name args block) = do + withScope $ do -- function scope + args' <- mapM check_fparam args + let ret_type = funcType2TermType func_type + let arg_types = fst <$> args' + newFunc (FuncInfo name ret_type arg_types) -- insert function + block' <- check_block_unscoped block -- block scope + pure (FuncDef func_type name (snd <$> args') block') + +check_top_level :: Member SAEffects r => TopLevel -> Sem r TopLevel +check_top_level (TLDecl decl) = TLDecl <$> check_decl decl +check_top_level (TLFun func) = TLFun <$> check_func func + +check_comp_unit :: Member SAEffects r => CompUnit -> Sem r CompUnit +check_comp_unit (CompUnit tops) = CompUnit <$> mapM check_top_level tops + +check_stmt :: Member SAEffects r => Stmt -> Sem r Stmt +check_stmt (StmtLVal lval e) = (StmtLVal . snd <$> check_lval lval) <*> check_typed_exp e +check_stmt (StmtExp Nothing) = pure (StmtExp Nothing) +check_stmt (StmtExp (Just e)) = StmtExp . Just <$> check_typed_exp e +check_stmt (StmtBlock block) = StmtBlock <$> withScope (check_block_unscoped block) +check_stmt (StmtIf cond then_ Nothing) = StmtIf <$> check_typed_exp cond <*> check_stmt then_ <*> pure Nothing +check_stmt (StmtIf cond then_ (Just else_)) = StmtIf <$> check_typed_exp cond <*> check_stmt then_ <*> (Just <$> check_stmt else_) +check_stmt (StmtWhile cond do_) = StmtWhile <$> check_typed_exp cond <*> check_stmt do_ +check_stmt StmtBreak = pure StmtBreak +check_stmt StmtContinue = pure StmtContinue +check_stmt (StmtReturn Nothing) = pure (StmtReturn Nothing) +check_stmt (StmtReturn (Just e)) = StmtReturn . Just <$> check_typed_exp e + +check_const_init_val :: Member SAEffects r => TermType -> ConstInitVal -> Sem r ConstInitVal +check_const_init_val type_ (ci, InitValExp e) = do + e' <- check_typed_exp e -- exp is of array type, which is not permitted + e'' <- case exp_type e' of + TermAny -> pure e' + TermBType _ -> typeCheck_im type_ e -- check type implicitly, TODO: float to int in initval is not permitted in SysY2022 + TermVoid -> error "Initial value cannot be void" $> e' + TermArray _ _ -> error "Initial value of array type must be literal" $> e' + pure (ci, InitValExp e'') +check_const_init_val type_ (ci, InitValArray arr) = do + case type_ of + TermArray _ _ -> pure () -- compile-time constants are computed in next stage + _ -> error "Array-like initial value assigned to non-array symbol" + pure (ci, InitValArray arr)