@@ -23,33 +23,38 @@ import qualified AST.Variable as Var
23-------- Basic Terms --------
23-------- Basic Terms --------
25varTerm :: IParser Source.Expr'
25varTerm :: IParser Source.Expr'
26−varTerm = toVar <$> var <?> "variable"
27+ toVar <$> var <?> "variable"
28toVar :: String -> Source.Expr'
30toVar :: String -> Source.Expr'
30− case v of
32+ case v of
31− "True" -> E.Literal (L.Boolean True)
33+ "True" -> E.Literal (L.Boolean True)
32− "False" -> E.Literal (L.Boolean False)
34+ "False" -> E.Literal (L.Boolean False)
33− _ -> E.rawVar v
35+ _ -> E.rawVar v
35accessor :: IParser Source.Expr'
38accessor :: IParser Source.Expr'
36−accessor = do
39+accessor =
37− (start, lbl, end) <- located (try (string "." >> rLabel))
40+ do (start, lbl, end) <- located (try (string "." >> rLabel))
38− let loc e = Annotation.at start end e
41+ let loc e = Annotation.at start end e
39− return (E.Lambda (P.Var "_") (loc $ E.Access (loc $ E.rawVar "_") lbl))
42+ return (E.Lambda (P.Var "_") (loc $ E.Access (loc $ E.rawVar "_") lbl))
41negative :: IParser Source.Expr'
45negative :: IParser Source.Expr'
42−negative = do
46+negative =
43− (start, nTerm, end) <-
47+ do (start, nTerm, end) <-
44− located (try (char '-' >> notFollowedBy (char '.' <|> char '-')) >> term)
48+ located (try (char '-' >> notFollowedBy (char '.' <|> char '-')) >> term)
45− let loc e = Annotation.at start end e
49+ let loc e = Annotation.at start end e
46− return (E.Binop (Var.Raw "-") (loc $ E.Literal (L.IntNum 0)) nTerm)
50+ return (E.Binop (Var.Raw "-") (loc $ E.Literal (L.IntNum 0)) nTerm)
49-------- Complex Terms --------
53-------- Complex Terms --------
51listTerm :: IParser Source.Expr'
55listTerm :: IParser Source.Expr'
52−listTerm = shader' <|> braces (try range <|> E.ExplicitList <$> commaSep expr)
57+ shader' <|> braces (try range <|> E.ExplicitList <$> commaSep expr)
54 range = do
59 range = do
55 lo <- expr
60 lo <- expr
@@ -64,7 +69,8 @@ listTerm = shader' <|> braces (try range <|> E.ExplicitList <$> commaSep expr)
66parensTerm :: IParser Source.Expr
71parensTerm :: IParser Source.Expr
67−parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)
73+ try (parens opFn) <|> parens (tupleFn <|> parened)
70 (start, op, end) <- located anyOp
76 (start, op, end) <- located anyOp
@@ -87,54 +93,62 @@ parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)
87 _ -> Annotation.at start end (E.tuple es)
93 _ -> Annotation.at start end (E.tuple es)
89recordTerm :: IParser Source.Expr
95recordTerm :: IParser Source.Expr
90−recordTerm = brackets $ choice [ misc, addLocation record ]
97+ brackets $ choice [ misc, addLocation record ]
92− field = do
99+ field =
93− label <- rLabel
100+ do label <- rLabel
94− patterns <- spacePrefix Pattern.term
101+ patterns <- spacePrefix Pattern.term
95− padded equals
102+ padded equals
96− body <- expr
103+ body <- expr
97− return (label, makeFunction patterns body)
104+ return (label, makeFunction patterns body)
99− record = E.Record <$> commaSep field
107+ E.Record <$> commaSep field
101− change = do
109+ change =
102− lbl <- rLabel
110+ do lbl <- rLabel
103− padded (string "<-")
111+ padded (string "<-")
104− (,) lbl <$> expr
112+ (,) lbl <$> expr
106− remove r = addLocation (string "-" >> whitespace >> E.Remove r <$> rLabel)
115+ addLocation (string "-" >> whitespace >> E.Remove r <$> rLabel)
108− insert r = addLocation $ do
118+ addLocation $
109− string "|" >> whitespace
119+ do string "|" >> whitespace
110− E.Insert r <$> rLabel <*> (padded equals >> expr)
120+ E.Insert r <$> rLabel <*> (padded equals >> expr)
112− modify r =
122+ modify r =
113− addLocation (string "|" >> whitespace >> E.Modify r <$> commaSep1 change)
123+ addLocation (string "|" >> whitespace >> E.Modify r <$> commaSep1 change)
115− misc = try $ do
126+ try $ do
116− record <- addLocation (E.rawVar <$> rLabel)
127+ record <- addLocation (E.rawVar <$> rLabel)
117− opt <- padded (optionMaybe (remove record))
128+ opt <- padded (optionMaybe (remove record))
118− case opt of
129+ case opt of
119− Just e -> try (insert e) <|> return e
130+ Just e -> try (insert e) <|> return e
120− Nothing -> try (insert record) <|> try (modify record)
131+ Nothing -> try (insert record) <|> try (modify record)
123term :: IParser Source.Expr
134term :: IParser Source.Expr
124term = addLocation (choice [ E.Literal <$> Literal.literal, listTerm, accessor, negative ])
135term = addLocation (choice [ E.Literal <$> Literal.literal, listTerm, accessor, negative ])
125 <|> accessible (addLocation varTerm <|> parensTerm <|> recordTerm)
136 <|> accessible (addLocation varTerm <|> parensTerm <|> recordTerm)
126 <?> "basic term (4, x, 'c', etc.)"
137 <?> "basic term (4, x, 'c', etc.)"
128-------- Applications --------
140-------- Applications --------
130appExpr :: IParser Source.Expr
142appExpr :: IParser Source.Expr
131−appExpr = do
143+appExpr =
132− t <- term
144+ do t <- term
133− ts <- constrainedSpacePrefix term $ \str ->
145+ ts <- constrainedSpacePrefix term $ \str ->
134− if null str then notFollowedBy (char '-') else return ()
146+ if null str then notFollowedBy (char '-') else return ()
135− return $ case ts of
148+ case ts of
137− _ -> List.foldl' (\f x -> Annotation.merge f x $ E.App f x) t ts
150+ _ -> List.foldl' (\f x -> Annotation.merge f x $ E.App f x) t ts
139-------- Normal Expressions --------
153-------- Normal Expressions --------
@@ -152,18 +166,18 @@ ifExpr =
152 whitespace
166 whitespace
153 normal <|> multiIf
167 normal <|> multiIf
155− normal = do
169+ normal =
156− bool <- expr
170+ do bool <- expr
157− padded (reserved "then")
171+ padded (reserved "then")
158− thenBranch <- expr
172+ thenBranch <- expr
159− whitespace <?> "an 'else' branch"
173+ whitespace <?> "an 'else' branch"
160− reserved "else" <?> "an 'else' branch"
174+ reserved "else" <?> "an 'else' branch"
161− whitespace
175+ whitespace
162− elseBranch <- expr
176+ elseBranch <- expr
163− return $ E.MultiIf
177+ return $ E.MultiIf
164− [ (bool, thenBranch)
178+ [ (bool, thenBranch)
165− , (Annotation.sameAs elseBranch (E.Literal . L.Boolean $ True), elseBranch)
179+ , (Annotation.sameAs elseBranch (E.Literal . L.Boolean $ True), elseBranch)
168 multiIf =
182 multiIf =
169 E.MultiIf <$> spaceSep1 iff
183 E.MultiIf <$> spaceSep1 iff
@@ -252,20 +266,26 @@ makeFunction :: [P.RawPattern] -> Source.Expr -> Source.Expr
252makeFunction args body@(Annotation.A ann _) =
266makeFunction args body@(Annotation.A ann _) =
253 foldr (\arg body' -> Annotation.A ann $ E.Lambda arg body') body args
267 foldr (\arg body' -> Annotation.A ann $ E.Lambda arg body') body args
255definition :: IParser Source.Def
270definition :: IParser Source.Def
256−definition = withPos $ do
271+definition =
257− (name:args) <- defStart
273+ do (name:args) <- defStart
258− padded equals
274+ padded equals
259− body <- expr
275+ body <- expr
260− return . Source.Definition name $ makeFunction args body
276+ return . Source.Definition name $ makeFunction args body
262typeAnnotation :: IParser Source.Def
279typeAnnotation :: IParser Source.Def
263−typeAnnotation = Source.TypeAnnotation <$> try start <*> Type.expr
281+ Source.TypeAnnotation <$> try start <*> Type.expr
265− start = do
283+ start =
266− v <- lowVar <|> parens symOp
284+ do v <- lowVar <|> parens symOp
267− padded hasType
285+ padded hasType
268− return v
286+ return v
270def :: IParser Source.Def
289def :: IParser Source.Def
271−def = typeAnnotation <|> definition
291+ typeAnnotation <|> definition