1-- | Data types for the imperative core AST 2module Language.PureScript.CoreImp.AST where 3 4import Prelude.Compat 5 6import Control.Monad ((>=>)) 7import Control.Monad.Identity (Identity(..), runIdentity) 8import Data.Text (Text) 9 10import Language.PureScript.AST (SourceSpan(..)) 11import Language.PureScript.Comments 12import Language.PureScript.PSString (PSString) 13import Language.PureScript.Traversals 14 15-- | Built-in unary operators 16data UnaryOperator 17 = Negate 18 | Not 19 | BitwiseNot 20 | Positive 21 | New 22 deriving (Show, Eq) 23 24-- | Built-in binary operators 25data BinaryOperator 26 = Add 27 | Subtract 28 | Multiply 29 | Divide 30 | Modulus 31 | EqualTo 32 | NotEqualTo 33 | LessThan 34 | LessThanOrEqualTo 35 | GreaterThan 36 | GreaterThanOrEqualTo 37 | And 38 | Or 39 | BitwiseAnd 40 | BitwiseOr 41 | BitwiseXor 42 | ShiftLeft 43 | ShiftRight 44 | ZeroFillShiftRight 45 deriving (Show, Eq) 46 47-- | Data type for simplified JavaScript expressions 48data AST 49 = NumericLiteral (Maybe SourceSpan) (Either Integer Double) 50 -- ^ A numeric literal 51 | StringLiteral (Maybe SourceSpan) PSString 52 -- ^ A string literal 53 | BooleanLiteral (Maybe SourceSpan) Bool 54 -- ^ A boolean literal 55 | Unary (Maybe SourceSpan) UnaryOperator AST 56 -- ^ A unary operator application 57 | Binary (Maybe SourceSpan) BinaryOperator AST AST 58 -- ^ A binary operator application 59 | ArrayLiteral (Maybe SourceSpan) [AST] 60 -- ^ An array literal 61 | Indexer (Maybe SourceSpan) AST AST 62 -- ^ An array indexer expression 63 | ObjectLiteral (Maybe SourceSpan) [(PSString, AST)] 64 -- ^ An object literal 65 | Function (Maybe SourceSpan) (Maybe Text) [Text] AST 66 -- ^ A function introduction (optional name, arguments, body) 67 | App (Maybe SourceSpan) AST [AST] 68 -- ^ Function application 69 | Var (Maybe SourceSpan) Text 70 -- ^ Variable 71 | Block (Maybe SourceSpan) [AST] 72 -- ^ A block of expressions in braces 73 | VariableIntroduction (Maybe SourceSpan) Text (Maybe AST) 74 -- ^ A variable introduction and optional initialization 75 | Assignment (Maybe SourceSpan) AST AST 76 -- ^ A variable assignment 77 | While (Maybe SourceSpan) AST AST 78 -- ^ While loop 79 | For (Maybe SourceSpan) Text AST AST AST 80 -- ^ For loop 81 | ForIn (Maybe SourceSpan) Text AST AST 82 -- ^ ForIn loop 83 | IfElse (Maybe SourceSpan) AST AST (Maybe AST) 84 -- ^ If-then-else statement 85 | Return (Maybe SourceSpan) AST 86 -- ^ Return statement 87 | ReturnNoResult (Maybe SourceSpan) 88 -- ^ Return statement with no return value 89 | Throw (Maybe SourceSpan) AST 90 -- ^ Throw statement 91 | InstanceOf (Maybe SourceSpan) AST AST 92 -- ^ instanceof check 93 | Comment (Maybe SourceSpan) [Comment] AST 94 -- ^ Commented JavaScript 95 deriving (Show, Eq) 96 97withSourceSpan :: SourceSpan -> AST -> AST 98withSourceSpan withSpan = go where 99 ss :: Maybe SourceSpan 100 ss = Just withSpan 101 102 go :: AST -> AST 103 go (NumericLiteral _ n) = NumericLiteral ss n 104 go (StringLiteral _ s) = StringLiteral ss s 105 go (BooleanLiteral _ b) = BooleanLiteral ss b 106 go (Unary _ op j) = Unary ss op j 107 go (Binary _ op j1 j2) = Binary ss op j1 j2 108 go (ArrayLiteral _ js) = ArrayLiteral ss js 109 go (Indexer _ j1 j2) = Indexer ss j1 j2 110 go (ObjectLiteral _ js) = ObjectLiteral ss js 111 go (Function _ name args j) = Function ss name args j 112 go (App _ j js) = App ss j js 113 go (Var _ s) = Var ss s 114 go (Block _ js) = Block ss js 115 go (VariableIntroduction _ name j) = VariableIntroduction ss name j 116 go (Assignment _ j1 j2) = Assignment ss j1 j2 117 go (While _ j1 j2) = While ss j1 j2 118 go (For _ name j1 j2 j3) = For ss name j1 j2 j3 119 go (ForIn _ name j1 j2) = ForIn ss name j1 j2 120 go (IfElse _ j1 j2 j3) = IfElse ss j1 j2 j3 121 go (Return _ js) = Return ss js 122 go (ReturnNoResult _) = ReturnNoResult ss 123 go (Throw _ js) = Throw ss js 124 go (InstanceOf _ j1 j2) = InstanceOf ss j1 j2 125 go (Comment _ com j) = Comment ss com j 126 127getSourceSpan :: AST -> Maybe SourceSpan 128getSourceSpan = go where 129 go :: AST -> Maybe SourceSpan 130 go (NumericLiteral ss _) = ss 131 go (StringLiteral ss _) = ss 132 go (BooleanLiteral ss _) = ss 133 go (Unary ss _ _) = ss 134 go (Binary ss _ _ _) = ss 135 go (ArrayLiteral ss _) = ss 136 go (Indexer ss _ _) = ss 137 go (ObjectLiteral ss _) = ss 138 go (Function ss _ _ _) = ss 139 go (App ss _ _) = ss 140 go (Var ss _) = ss 141 go (Block ss _) = ss 142 go (VariableIntroduction ss _ _) = ss 143 go (Assignment ss _ _) = ss 144 go (While ss _ _) = ss 145 go (For ss _ _ _ _) = ss 146 go (ForIn ss _ _ _) = ss 147 go (IfElse ss _ _ _) = ss 148 go (Return ss _) = ss 149 go (ReturnNoResult ss) = ss 150 go (Throw ss _) = ss 151 go (InstanceOf ss _ _) = ss 152 go (Comment ss _ _) = ss 153 154everywhere :: (AST -> AST) -> AST -> AST 155everywhere f = go where 156 go :: AST -> AST 157 go (Unary ss op j) = f (Unary ss op (go j)) 158 go (Binary ss op j1 j2) = f (Binary ss op (go j1) (go j2)) 159 go (ArrayLiteral ss js) = f (ArrayLiteral ss (map go js)) 160 go (Indexer ss j1 j2) = f (Indexer ss (go j1) (go j2)) 161 go (ObjectLiteral ss js) = f (ObjectLiteral ss (map (fmap go) js)) 162 go (Function ss name args j) = f (Function ss name args (go j)) 163 go (App ss j js) = f (App ss (go j) (map go js)) 164 go (Block ss js) = f (Block ss (map go js)) 165 go (VariableIntroduction ss name j) = f (VariableIntroduction ss name (fmap go j)) 166 go (Assignment ss j1 j2) = f (Assignment ss (go j1) (go j2)) 167 go (While ss j1 j2) = f (While ss (go j1) (go j2)) 168 go (For ss name j1 j2 j3) = f (For ss name (go j1) (go j2) (go j3)) 169 go (ForIn ss name j1 j2) = f (ForIn ss name (go j1) (go j2)) 170 go (IfElse ss j1 j2 j3) = f (IfElse ss (go j1) (go j2) (fmap go j3)) 171 go (Return ss js) = f (Return ss (go js)) 172 go (Throw ss js) = f (Throw ss (go js)) 173 go (InstanceOf ss j1 j2) = f (InstanceOf ss (go j1) (go j2)) 174 go (Comment ss com j) = f (Comment ss com (go j)) 175 go other = f other 176 177everywhereTopDown :: (AST -> AST) -> AST -> AST 178everywhereTopDown f = runIdentity . everywhereTopDownM (Identity . f) 179 180everywhereTopDownM :: (Monad m) => (AST -> m AST) -> AST -> m AST 181everywhereTopDownM f = f >=> go where 182 f' = f >=> go 183 go (Unary ss op j) = Unary ss op <$> f' j 184 go (Binary ss op j1 j2) = Binary ss op <$> f' j1 <*> f' j2 185 go (ArrayLiteral ss js) = ArrayLiteral ss <$> traverse f' js 186 go (Indexer ss j1 j2) = Indexer ss <$> f' j1 <*> f' j2 187 go (ObjectLiteral ss js) = ObjectLiteral ss <$> traverse (sndM f') js 188 go (Function ss name args j) = Function ss name args <$> f' j 189 go (App ss j js) = App ss <$> f' j <*> traverse f' js 190 go (Block ss js) = Block ss <$> traverse f' js 191 go (VariableIntroduction ss name j) = VariableIntroduction ss name <$> traverse f' j 192 go (Assignment ss j1 j2) = Assignment ss <$> f' j1 <*> f' j2 193 go (While ss j1 j2) = While ss <$> f' j1 <*> f' j2 194 go (For ss name j1 j2 j3) = For ss name <$> f' j1 <*> f' j2 <*> f' j3 195 go (ForIn ss name j1 j2) = ForIn ss name <$> f' j1 <*> f' j2 196 go (IfElse ss j1 j2 j3) = IfElse ss <$> f' j1 <*> f' j2 <*> traverse f' j3 197 go (Return ss j) = Return ss <$> f' j 198 go (Throw ss j) = Throw ss <$> f' j 199 go (InstanceOf ss j1 j2) = InstanceOf ss <$> f' j1 <*> f' j2 200 go (Comment ss com j) = Comment ss com <$> f' j 201 go other = f other 202 203everything :: (r -> r -> r) -> (AST -> r) -> AST -> r 204everything (<>.) f = go where 205 go j@(Unary _ _ j1) = f j <>. go j1 206 go j@(Binary _ _ j1 j2) = f j <>. go j1 <>. go j2 207 go j@(ArrayLiteral _ js) = foldl (<>.) (f j) (map go js) 208 go j@(Indexer _ j1 j2) = f j <>. go j1 <>. go j2 209 go j@(ObjectLiteral _ js) = foldl (<>.) (f j) (map (go . snd) js) 210 go j@(Function _ _ _ j1) = f j <>. go j1 211 go j@(App _ j1 js) = foldl (<>.) (f j <>. go j1) (map go js) 212 go j@(Block _ js) = foldl (<>.) (f j) (map go js) 213 go j@(VariableIntroduction _ _ (Just j1)) = f j <>. go j1 214 go j@(Assignment _ j1 j2) = f j <>. go j1 <>. go j2 215 go j@(While _ j1 j2) = f j <>. go j1 <>. go j2 216 go j@(For _ _ j1 j2 j3) = f j <>. go j1 <>. go j2 <>. go j3 217 go j@(ForIn _ _ j1 j2) = f j <>. go j1 <>. go j2 218 go j@(IfElse _ j1 j2 Nothing) = f j <>. go j1 <>. go j2 219 go j@(IfElse _ j1 j2 (Just j3)) = f j <>. go j1 <>. go j2 <>. go j3 220 go j@(Return _ j1) = f j <>. go j1 221 go j@(Throw _ j1) = f j <>. go j1 222 go j@(InstanceOf _ j1 j2) = f j <>. go j1 <>. go j2 223 go j@(Comment _ _ j1) = f j <>. go j1 224 go other = f other 225