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