@@ -23,33 +23,38 @@ import qualified AST.Variable as Var
2323-------- Basic Terms --------
2424
2525varTerm :: IParser Source.Expr'
26−varTerm = toVar <$> var <?> "variable"
26+varTerm =
27+ toVar <$> var <?> "variable"
28+
2729
2830toVar :: String -> Source.Expr'
2931toVar v =
30− case v of
31− "True" -> E.Literal (L.Boolean True)
32− "False" -> E.Literal (L.Boolean False)
33− _ -> E.rawVar v
32+ case v of
33+ "True" -> E.Literal (L.Boolean True)
34+ "False" -> E.Literal (L.Boolean False)
35+ _ -> E.rawVar v
36+
3437
3538accessor :: IParser Source.Expr'
36−accessor = do
37− (start, lbl, end) <- located (try (string "." >> rLabel))
38− let loc e = Annotation.at start end e
39− return (E.Lambda (P.Var "_") (loc $ E.Access (loc $ E.rawVar "_") lbl))
39+accessor =
40+ do (start, lbl, end) <- located (try (string "." >> rLabel))
41+ let loc e = Annotation.at start end e
42+ return (E.Lambda (P.Var "_") (loc $ E.Access (loc $ E.rawVar "_") lbl))
43+
4044
4145negative :: IParser Source.Expr'
42−negative = do
43− (start, nTerm, end) <-
44− located (try (char '-' >> notFollowedBy (char '.' <|> char '-')) >> term)
45− let loc e = Annotation.at start end e
46− return (E.Binop (Var.Raw "-") (loc $ E.Literal (L.IntNum 0)) nTerm)
46+negative =
47+ do (start, nTerm, end) <-
48+ located (try (char '-' >> notFollowedBy (char '.' <|> char '-')) >> term)
49+ let loc e = Annotation.at start end e
50+ return (E.Binop (Var.Raw "-") (loc $ E.Literal (L.IntNum 0)) nTerm)
4751
4852
4953-------- Complex Terms --------
5054
5155listTerm :: IParser Source.Expr'
52−listTerm = shader' <|> braces (try range <|> E.ExplicitList <$> commaSep expr)
56+listTerm =
57+ shader' <|> braces (try range <|> E.ExplicitList <$> commaSep expr)
5358 where
5459 range = do
5560 lo <- expr
@@ -64,7 +69,8 @@ listTerm = shader' <|> braces (try range <|> E.ExplicitList <$> commaSep expr)
6469
6570
6671parensTerm :: IParser Source.Expr
67−parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)
72+parensTerm =
73+ try (parens opFn) <|> parens (tupleFn <|> parened)
6874 where
6975 opFn = do
7076 (start, op, end) <- located anyOp
@@ -87,54 +93,62 @@ parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)
8793 _ -> Annotation.at start end (E.tuple es)
8894
8995recordTerm :: IParser Source.Expr
90−recordTerm = brackets $ choice [ misc, addLocation record ]
91− where
92− field = do
93− label <- rLabel
94− patterns <- spacePrefix Pattern.term
95− padded equals
96− body <- expr
97− return (label, makeFunction patterns body)
98−
99− record = E.Record <$> commaSep field
100−
101− change = do
102− lbl <- rLabel
103− padded (string "<-")
104− (,) lbl <$> expr
105−
106− remove r = addLocation (string "-" >> whitespace >> E.Remove r <$> rLabel)
107−
108− insert r = addLocation $ do
109− string "|" >> whitespace
110− E.Insert r <$> rLabel <*> (padded equals >> expr)
111−
112− modify r =
113− addLocation (string "|" >> whitespace >> E.Modify r <$> commaSep1 change)
114−
115− misc = try $ do
116− record <- addLocation (E.rawVar <$> rLabel)
117− opt <- padded (optionMaybe (remove record))
118− case opt of
119− Just e -> try (insert e) <|> return e
120− Nothing -> try (insert record) <|> try (modify record)
121−
96+recordTerm =
97+ brackets $ choice [ misc, addLocation record ]
98+ where
99+ field =
100+ do label <- rLabel
101+ patterns <- spacePrefix Pattern.term
102+ padded equals
103+ body <- expr
104+ return (label, makeFunction patterns body)
105+
106+ record =
107+ E.Record <$> commaSep field
108+
109+ change =
110+ do lbl <- rLabel
111+ padded (string "<-")
112+ (,) lbl <$> expr
113+
114+ remove r =
115+ addLocation (string "-" >> whitespace >> E.Remove r <$> rLabel)
116+
117+ insert r =
118+ addLocation $
119+ do string "|" >> whitespace
120+ E.Insert r <$> rLabel <*> (padded equals >> expr)
121+
122+ modify r =
123+ addLocation (string "|" >> whitespace >> E.Modify r <$> commaSep1 change)
124+
125+ misc =
126+ try $ do
127+ record <- addLocation (E.rawVar <$> rLabel)
128+ opt <- padded (optionMaybe (remove record))
129+ case opt of
130+ Just e -> try (insert e) <|> return e
131+ Nothing -> try (insert record) <|> try (modify record)
132+
122133
123134term :: IParser Source.Expr
124135term = addLocation (choice [ E.Literal <$> Literal.literal, listTerm, accessor, negative ])
125136 <|> accessible (addLocation varTerm <|> parensTerm <|> recordTerm)
126137 <?> "basic term (4, x, 'c', etc.)"
127138
139+
128140-------- Applications --------
129141
130142appExpr :: IParser Source.Expr
131−appExpr = do
132− t <- term
133− ts <- constrainedSpacePrefix term $ \str ->
134− if null str then notFollowedBy (char '-') else return ()
135− return $ case ts of
136− [] -> t
137− _ -> List.foldl' (\f x -> Annotation.merge f x $ E.App f x) t ts
143+appExpr =
144+ do t <- term
145+ ts <- constrainedSpacePrefix term $ \str ->
146+ if null str then notFollowedBy (char '-') else return ()
147+ return $
148+ case ts of
149+ [] -> t
150+ _ -> List.foldl' (\f x -> Annotation.merge f x $ E.App f x) t ts
151+
138152
139153-------- Normal Expressions --------
140154
@@ -152,18 +166,18 @@ ifExpr =
152166 whitespace
153167 normal <|> multiIf
154168 where
155− normal = do
156− bool <- expr
157− padded (reserved "then")
158− thenBranch <- expr
159− whitespace <?> "an 'else' branch"
160− reserved "else" <?> "an 'else' branch"
161− whitespace
162− elseBranch <- expr
163− return $ E.MultiIf
164− [ (bool, thenBranch)
165− , (Annotation.sameAs elseBranch (E.Literal . L.Boolean $ True), elseBranch)
166− ]
169+ normal =
170+ do bool <- expr
171+ padded (reserved "then")
172+ thenBranch <- expr
173+ whitespace <?> "an 'else' branch"
174+ reserved "else" <?> "an 'else' branch"
175+ whitespace
176+ elseBranch <- expr
177+ return $ E.MultiIf
178+ [ (bool, thenBranch)
179+ , (Annotation.sameAs elseBranch (E.Literal . L.Boolean $ True), elseBranch)
180+ ]
167181
168182 multiIf =
169183 E.MultiIf <$> spaceSep1 iff
@@ -252,20 +266,26 @@ makeFunction :: [P.RawPattern] -> Source.Expr -> Source.Expr
252266makeFunction args body@(Annotation.A ann _) =
253267 foldr (\arg body' -> Annotation.A ann $ E.Lambda arg body') body args
254268
269+
255270definition :: IParser Source.Def
256−definition = withPos $ do
257− (name:args) <- defStart
258− padded equals
259− body <- expr
260− return . Source.Definition name $ makeFunction args body
271+definition =
272+ withPos $
273+ do (name:args) <- defStart
274+ padded equals
275+ body <- expr
276+ return . Source.Definition name $ makeFunction args body
277+
261278
262279typeAnnotation :: IParser Source.Def
263−typeAnnotation = Source.TypeAnnotation <$> try start <*> Type.expr
280+typeAnnotation =
281+ Source.TypeAnnotation <$> try start <*> Type.expr
264282 where
265− start = do
266− v <- lowVar <|> parens symOp
267− padded hasType
268− return v
283+ start =
284+ do v <- lowVar <|> parens symOp
285+ padded hasType
286+ return v
287+
269288
270289def :: IParser Source.Def
271−def = typeAnnotation <|> definition
290+def =
291+ typeAnnotation <|> definition