never executed always true always false
    1 -- Copyright (C) 2018-2024 Jun Zhang <zhangjunphy[at]gmail[dot]com>
    2 --
    3 -- This file is a part of decafc.
    4 --
    5 -- decafc is free software: you can redistribute it and/or modify it under the
    6 -- terms of the MIT (X11) License as described in the LICENSE file.
    7 --
    8 -- decafc is distributed in the hope that it will be useful, but WITHOUT ANY
    9 -- WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   10 -- FOR A PARTICULAR PURPOSE.  See the X11 license for more details.
   11 
   12 -- AST -- AST after type checking and clean up
   13 module AST where
   14 
   15 import Control.Lens (view)
   16 import Data.Functor ((<&>))
   17 import Data.Int (Int64)
   18 import Data.Text (Text)
   19 import Formatting
   20 import Data.Generics.Labels
   21 import GHC.Generics (Generic)
   22 import Text.Printf (printf)
   23 import Types
   24 import Util.SourceLoc qualified as SL
   25 
   26 -- operators
   27 data RelOp
   28   = LessThan
   29   | GreaterThan
   30   | LessEqual
   31   | GreaterEqual
   32   deriving (Eq)
   33 
   34 instance Show RelOp where
   35   show LessThan = "<"
   36   show GreaterThan = ">"
   37   show LessEqual = "<="
   38   show GreaterEqual = ">="
   39 
   40 data ArithOp
   41   = Plus
   42   | Minus
   43   | Multiply
   44   | Division
   45   | Modulo
   46   deriving (Eq)
   47 
   48 instance Show ArithOp where
   49   show Plus = "+"
   50   show Minus = "-"
   51   show Multiply = "*"
   52   show Division = "/"
   53   show Modulo = "%"
   54 
   55 data EqOp
   56   = Equal
   57   | NotEqual
   58   deriving (Eq)
   59 
   60 instance Show EqOp where
   61   show Equal = "=="
   62   show NotEqual = "!="
   63 
   64 data CondOp
   65   = Or
   66   | And
   67   deriving (Eq)
   68 
   69 instance Show CondOp where
   70   show Or = "||"
   71   show And = "&&"
   72 
   73 data NegOp
   74   = Neg
   75   deriving (Eq)
   76 
   77 instance Show NegOp where
   78   show Neg = "-"
   79 
   80 data NotOp
   81   = Not
   82   deriving (Eq)
   83 
   84 instance Show NotOp where
   85   show Not = "!"
   86 
   87 data ChoiceOp
   88   = Choice
   89   deriving (Show, Eq)
   90 
   91 data AssignOp
   92   = EqlAssign
   93   | IncAssign
   94   | DecAssign
   95   | PlusPlus
   96   | MinusMinus
   97   deriving (Eq)
   98 
   99 instance Show AssignOp where
  100   show EqlAssign = "="
  101   show IncAssign = "+="
  102   show DecAssign = "-="
  103   show PlusPlus = "++"
  104   show MinusMinus = "--"
  105 
  106 data Type
  107   = Void
  108   | BoolType
  109   | CharType
  110   | IntType
  111   | StringType
  112   | ArrayType !Type !Int64
  113   | Ptr !Type
  114   deriving (Eq)
  115 
  116 instance Show Type where
  117   show Void = "void"
  118   show BoolType = "bool"
  119   show CharType = "char"
  120   show IntType = "int"
  121   show StringType = "string"
  122   show (ArrayType tpe size) = formatToString (shown % "x" % shown) size tpe
  123   show (Ptr tpe) = formatToString ("ptr" %+ shown) tpe
  124 
  125 dataSize :: Type -> Maybe Int64
  126 dataSize Void = Nothing
  127 dataSize IntType = Just 8
  128 dataSize BoolType = Just 1
  129 dataSize StringType = Just 8
  130 dataSize (ArrayType tpe size) = dataSize tpe <&> \s -> s * size
  131 dataSize (Ptr _) = Just 8
  132 
  133 parseArithOp :: Text -> ArithOp
  134 parseArithOp op = case op of
  135   "+" -> Plus
  136   "-" -> Minus
  137   "*" -> Multiply
  138   "/" -> Division
  139   "%" -> Modulo
  140 
  141 parseRelOp :: Text -> RelOp
  142 parseRelOp op = case op of
  143   "<" -> LessThan
  144   ">" -> GreaterThan
  145   "<=" -> LessEqual
  146   ">=" -> GreaterEqual
  147 
  148 parseEqOp :: Text -> EqOp
  149 parseEqOp op = case op of
  150   "==" -> Equal
  151   "!=" -> NotEqual
  152 
  153 parseCondOp :: Text -> CondOp
  154 parseCondOp op = case op of
  155   "||" -> Or
  156   "&&" -> And
  157 
  158 parseNegOp :: Text -> NegOp
  159 parseNegOp op = case op of
  160   "-" -> Neg
  161 
  162 parseNotOp :: Text -> NotOp
  163 parseNotOp op = case op of
  164   "!" -> Not
  165 
  166 parseAssignOp :: Text -> AssignOp
  167 parseAssignOp s = case s of
  168   "+=" -> IncAssign
  169   "-=" -> DecAssign
  170   "=" -> EqlAssign
  171   "++" -> PlusPlus
  172   "--" -> MinusMinus
  173 
  174 -- auxiliary data types
  175 data Location = Location
  176   { name :: !Name,
  177     idx :: !(Maybe Expr),
  178     variableDef :: !(Either Argument FieldDecl),
  179     tpe :: !Type,
  180     loc :: !SL.Range
  181   }
  182   deriving (Generic)
  183 
  184 typeOfDef :: Either Argument FieldDecl -> Type
  185 typeOfDef (Left Argument {tpe = tpe}) = tpe
  186 typeOfDef (Right FieldDecl {tpe = tpe}) = tpe
  187 
  188 instance Show Location where
  189   show Location {name = nm, idx = idx} = printf "Location {name=%s, idx=%s}" nm (show idx)
  190 
  191 data Assignment = Assignment
  192   { location :: !Location,
  193     op :: !AssignOp,
  194     expr :: !(Maybe Expr),
  195     loc :: !SL.Range
  196   }
  197   deriving (Generic, Show)
  198 
  199 data MethodCall = MethodCall
  200   { name :: !Name,
  201     args :: ![Expr],
  202     loc :: !SL.Range
  203   }
  204   deriving (Generic, Show)
  205 
  206 -- AST nodes
  207 data ASTRoot = ASTRoot
  208   { imports :: ![ImportDecl],
  209     vars :: ![FieldDecl],
  210     methods :: ![MethodDecl]
  211   }
  212   deriving (Generic, Show)
  213 
  214 data ImportDecl = ImportDecl
  215   { name :: !Name,
  216     loc :: !SL.Range
  217   }
  218   deriving (Generic, Show)
  219 
  220 data FieldDecl = FieldDecl
  221   { name :: !Name,
  222     tpe :: !Type,
  223     loc :: !SL.Range
  224   }
  225   deriving (Generic, Show)
  226 
  227 data Argument = Argument
  228   { name :: !Name,
  229     tpe :: !Type,
  230     loc :: !SL.Range
  231   }
  232   deriving (Generic, Show)
  233 
  234 data MethodSig = MethodSig
  235   { name :: !Name,
  236     tpe :: !(Maybe Type),
  237     args :: ![Argument]
  238   }
  239   deriving (Generic, Show)
  240 
  241 mangle :: MethodSig -> Text
  242 mangle (MethodSig name _ args) =
  243   sformat (stext % "@" % intercalated "@" shown) name (args <&> view #tpe)
  244 
  245 data MethodDecl = MethodDecl
  246   { sig :: !MethodSig,
  247     block :: !Block,
  248     loc :: !SL.Range
  249   }
  250   deriving (Generic, Show)
  251 
  252 data Statement = Statement
  253   { statement_ :: !Statement_,
  254     loc :: !SL.Range
  255   }
  256   deriving (Generic, Show)
  257 
  258 data Statement_
  259   = AssignStmt {assign :: !Assignment}
  260   | IfStmt {pred :: !Expr, ifBlock :: !Block, elseBlock :: !(Maybe Block)}
  261   | ForStmt {init :: !(Maybe Assignment), pred :: !Expr, update :: !(Maybe Assignment), block :: !Block}
  262   | ReturnStmt {expr :: !(Maybe Expr)}
  263   | MethodCallStmt {methodCall :: !MethodCall}
  264   | BreakStmt
  265   | ContinueStmt
  266   deriving (Generic, Show)
  267 
  268 data Expr = Expr
  269   { expr_ :: !Expr_,
  270     tpe :: !Type,
  271     loc :: !SL.Range
  272   }
  273   deriving (Generic, Show)
  274 
  275 data Expr_
  276   = LocationExpr {location :: !Location}
  277   | MethodCallExpr {methodCall :: !MethodCall}
  278   | ExternCallExpr {name :: !Name, args :: ![Expr]}
  279   | IntLiteralExpr {intVal :: !Int64}
  280   | BoolLiteralExpr {boolVal :: !Bool}
  281   | CharLiteralExpr {charVal :: !Char}
  282   | StringLiteralExpr {strVal :: !Text}
  283   | ArithOpExpr {arithOp :: !ArithOp, lhs :: !Expr, rhs :: !Expr}
  284   | RelOpExpr {relOp :: !RelOp, lhs :: !Expr, rhs :: !Expr}
  285   | CondOpExpr {condOp :: !CondOp, lhs :: !Expr, rhs :: !Expr}
  286   | EqOpExpr {eqOp :: !EqOp, lhs :: !Expr, rhs :: !Expr}
  287   | NegOpExpr {negOp :: !NegOp, expr :: !Expr}
  288   | NotOpExpr {notOp :: !NotOp, expr :: !Expr}
  289   | ChoiceOpExpr {choiceOp :: !ChoiceOp, expr1 :: !Expr, expr2 :: !Expr, expr3 :: !Expr}
  290   | LengthExpr {name :: !Name}
  291   deriving (Generic, Show)
  292 
  293 data Typed a = Typed {ele :: !a, tpe :: !Type}
  294   deriving (Generic, Show)
  295 
  296 data Block = Block
  297   { vars :: ![FieldDecl],
  298     stmts :: ![Statement],
  299     blockID :: !ScopeID
  300   }
  301   deriving (Generic, Show)