459cf8e · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Switch parsers over to new AST

459cf8eevancz13 years ago

compiler/Parse/Binops.hs → compiler/Parse/Binop.hsrenamed+1−1

compare with master

unifiedsplit

@@ -1,4 +1,4 @@

1−module Parse.Binops (binops, infixStmt, OpTable) where

1+module Parse.Binop (binops, infixStmt, OpTable) where

3import Control.Monad.Error

4import Data.List (intercalate)

compiler/Parse/Expr.hs → compiler/Parse/Expression.hsrenamed+31−46

@@ -1,20 +1,22 @@

1−module Parse.Expr (def,term) where

1+module Parse.Expression (def,term) where

3import Control.Applicative ((<$>), (<*>))

4−import Control.Monad

5−import Data.Char (isSymbol, isDigit)

6import Data.List (foldl')

4import Data.List (foldl')

7import Text.Parsec hiding (newline,spaces)

5import Text.Parsec hiding (newline,spaces)

8import Text.Parsec.Indent

6import Text.Parsec.Indent

9import qualified Text.Pandoc as Pan

7import qualified Text.Pandoc as Pan

11−import Parse.Library

9+import Parse.Helpers

10+import qualified Parse.Pattern as Pattern

12−import Parse.Patterns

11+import qualified Parse.Type as Type

13−import Parse.Binops

12+import Parse.Binop

14−import Parse.Types

13+import Parse.Literal

16−import Ast

15+import SourceSyntax.Location as Location

17−import Located

16+import SourceSyntax.Pattern hiding (tuple,list)

17+import qualified SourceSyntax.Literal as Literal

18+import SourceSyntax.Expression

19+import SourceSyntax.Declaration (Declaration(Definition))

19import Guid

21import Guid

20import Types.Types (Type (VarT), Scheme (Forall))

22import Types.Types (Type (VarT), Scheme (Forall))

@@ -24,36 +26,19 @@ import System.IO.Unsafe

25-------- Basic Terms --------

27-------- Basic Terms --------

27−numTerm :: IParser Expr

28−numTerm = toExpr <$> (preNum <?> "number")

29− where toExpr n | '.' `elem` n = FloatNum (read n)

30− | otherwise = IntNum (read n)

31− preNum = (++) <$> many1 digit <*> option "" postNum

32− postNum = do try $ lookAhead (string "." >> digit)

33− string "."

34− ('.':) <$> many1 digit

35−

36−strTerm :: IParser Expr

37−strTerm = liftM Str . expecting "string" . betwixt '"' '"' . many $

38− backslashed <|> satisfy (/='"')

39−

40varTerm :: IParser Expr

29varTerm :: IParser Expr

41varTerm = toVar <$> var <?> "variable"

30varTerm = toVar <$> var <?> "variable"

43−toVar v = case v of "True" -> Boolean True

32+toVar v = case v of "True" -> Literal (Literal.Boolean True)

44− "False" -> Boolean False

33+ "False" -> Literal (Literal.Boolean False)

45 _ -> Var v

34 _ -> Var v

47−chrTerm :: IParser Expr

48−chrTerm = Chr <$> betwixt '\'' '\'' (backslashed <|> satisfy (/='\''))

49− <?> "character"

50−

51accessor :: IParser Expr

36accessor :: IParser Expr

52accessor = do

37accessor = do

53 start <- getPosition

38 start <- getPosition

54 lbl <- try (string "." >> rLabel)

39 lbl <- try (string "." >> rLabel)

55 end <- getPosition

40 end <- getPosition

56− let loc e = addLoc ("." ++ lbl) (pos start end e)

41+ let loc e = Location.add ("." ++ lbl) (Location.at start end e)

57 return (Lambda "_" (loc $ Access (loc $ Var "_") lbl))

42 return (Lambda "_" (loc $ Access (loc $ Var "_") lbl))

@@ -76,7 +61,7 @@ parensTerm = parens $ choice

76 [ do start <- getPosition

61 [ do start <- getPosition

77 op <- try anyOp

62 op <- try anyOp

78 end <- getPosition

63 end <- getPosition

79− let loc = pos start end

64+ let loc = Location.at start end

80 return . loc . Lambda "x" . loc . Lambda "y" . loc $

65 return . loc . Lambda "x" . loc . Lambda "y" . loc $

81 Binop op (loc $ Var "x") (loc $ Var "y")

66 Binop op (loc $ Var "x") (loc $ Var "y")

82 , do start <- getPosition

67 , do start <- getPosition

@@ -84,24 +69,24 @@ parensTerm = parens $ choice

84 commas <- comma >> many (whitespace >> comma)

69 commas <- comma >> many (whitespace >> comma)

85 end <- getPosition

70 end <- getPosition

86 let vars = map (('v':) . show) [ 0 .. length commas + 1 ]

71 let vars = map (('v':) . show) [ 0 .. length commas + 1 ]

87− loc = pos start end

72+ loc = Location.at start end

88 return $ foldr (\x e -> loc $ Lambda x e)

73 return $ foldr (\x e -> loc $ Lambda x e)

89 (loc . tuple $ map (loc . Var) vars) vars

74 (loc . tuple $ map (loc . Var) vars) vars

90 , do start <- getPosition

75 , do start <- getPosition

91 es <- commaSep expr

76 es <- commaSep expr

92 end <- getPosition

77 end <- getPosition

93 return $ case es of [e] -> e

78 return $ case es of [e] -> e

94− _ -> pos start end (tuple es)

79+ _ -> Location.at start end (tuple es)

95 ]

80 ]

97recordTerm :: IParser LExpr

82recordTerm :: IParser LExpr

98recordTerm = brackets $ choice [ misc, addLocation record ]

83recordTerm = brackets $ choice [ misc, addLocation record ]

99 where field = do

84 where field = do

100− fDefs <- (:) <$> (PVar <$> rLabel) <*> spacePrefix patternTerm

85+ fDefs <- (:) <$> (PVar <$> rLabel) <*> spacePrefix Pattern.term

101 whitespace

86 whitespace

102 e <- string "=" >> whitespace >> expr

87 e <- string "=" >> whitespace >> expr

103 n <- sourceLine <$> getPosition

88 n <- sourceLine <$> getPosition

104− runAt (1000 * n) $ flattenPatterns fDefs e

89+ runAt (1000 * n) $ Pattern.flatten fDefs e

105 extract [ FnDef f args exp ] = return (f,args,exp)

90 extract [ FnDef f args exp ] = return (f,args,exp)

106 extract _ = fail "Improperly formed record field."

91 extract _ = fail "Improperly formed record field."

107 record = Record <$> (mapM extract =<< commaSep field)

92 record = Record <$> (mapM extract =<< commaSep field)

@@ -127,7 +112,7 @@ recordTerm = brackets $ choice [ misc, addLocation record ]

127

112

128

113

129term :: IParser LExpr

114term :: IParser LExpr

130−term = addLocation (choice [ numTerm, strTerm, chrTerm, listTerm, accessor ])

115+term = addLocation (choice [ Literal <$> literal, listTerm, accessor ])

131 <|> accessible (addLocation varTerm <|> parensTerm <|> recordTerm)

116 <|> accessible (addLocation varTerm <|> parensTerm <|> recordTerm)

132 <?> "basic term (4, x, 'c', etc.)"

117 <?> "basic term (4, x, 'c', etc.)"

133

118

@@ -138,7 +123,7 @@ appExpr = do

138 tlist <- spaceSep1 term

123 tlist <- spaceSep1 term

139 return $ case tlist of

124 return $ case tlist of

140 t:[] -> t

125 t:[] -> t

141− t:ts -> foldl' (\f x -> epos f x $ App f x) t ts

126+ t:ts -> foldl' (\f x -> Location.merge f x $ App f x) t ts

142

127

143-------- Normal Expressions --------

128-------- Normal Expressions --------

144

129

@@ -154,7 +139,7 @@ ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)

154 thenBranch <- expr

139 thenBranch <- expr

155 whitespace <?> "an 'else' branch" ; reserved "else" <?> "an 'else' branch" ; whitespace

140 whitespace <?> "an 'else' branch" ; reserved "else" <?> "an 'else' branch" ; whitespace

156 elseBranch <- expr

141 elseBranch <- expr

157− return $ MultiIf [(bool, thenBranch), (notLocated (Var "otherwise"), elseBranch)]

142+ return $ MultiIf [(bool, thenBranch), (Location.none (Var "otherwise"), elseBranch)]

158 multiIf = MultiIf <$> spaceSep1 iff

143 multiIf = MultiIf <$> spaceSep1 iff

159 where iff = do string "|" ; whitespace

144 where iff = do string "|" ; whitespace

160 b <- expr ; whitespace ; string "->" ; whitespace

145 b <- expr ; whitespace ; string "->" ; whitespace

@@ -163,10 +148,10 @@ ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)

163lambdaExpr :: IParser LExpr

148lambdaExpr :: IParser LExpr

164lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"

149lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"

165 whitespace

150 whitespace

166− pats <- spaceSep1 patternTerm

151+ pats <- spaceSep1 Pattern.term

167 whitespace ; arrow ; whitespace

152 whitespace ; arrow ; whitespace

168 e <- expr

153 e <- expr

169− return . run $ makeLambda pats e

154+ return . run $ Pattern.makeLambda pats e

170

155

171defSet :: IParser [Def]

156defSet :: IParser [Def]

172defSet = concat <$> block (do d <- anyDef ; whitespace ; return d)

157defSet = concat <$> block (do d <- anyDef ; whitespace ; return d)

@@ -182,7 +167,7 @@ caseExpr :: IParser Expr

182caseExpr = do

167caseExpr = do

183 reserved "case"; whitespace; e <- expr; whitespace; reserved "of"; whitespace

168 reserved "case"; whitespace; e <- expr; whitespace; reserved "of"; whitespace

184 Case e <$> (with <|> without)

169 Case e <$> (with <|> without)

185− where case_ = do p <- patternExpr; whitespace; arrow; whitespace

170+ where case_ = do p <- Pattern.expr; whitespace; arrow; whitespace

186 (,) p <$> expr

171 (,) p <$> expr

187 with = brackets (semiSep1 (case_ <?> "cases { x -> ... }"))

172 with = brackets (semiSep1 (case_ <?> "cases { x -> ... }"))

188 without = block (do c <- case_ ; whitespace ; return c)

173 without = block (do c <- case_ ; whitespace ; return c)

@@ -192,15 +177,15 @@ expr = addLocation (choice [ ifExpr, letExpr, caseExpr ])

192 <|> binaryExpr

177 <|> binaryExpr

193 <?> "an expression"

178 <?> "an expression"

194

179

195−funcDef = try (do p1 <- try patternTerm ; infics p1 <|> func p1)

180+funcDef = try (do p1 <- try Pattern.term ; infics p1 <|> func p1)

196− <|> ((:[]) <$> patternExpr)

181+ <|> ((:[]) <$> Pattern.expr)

197 <?> "the definition of a variable (x = ...)"

182 <?> "the definition of a variable (x = ...)"

198− where func p@(PVar v) = (p:) <$> spacePrefix patternTerm

183+ where func p@(PVar v) = (p:) <$> spacePrefix Pattern.term

199 func p = do try (lookAhead (whitespace >> string "="))

184 func p = do try (lookAhead (whitespace >> string "="))

200 return [p]

185 return [p]

201 infics p1 = do

186 infics p1 = do

202 o:p <- try (whitespace >> anyOp)

187 o:p <- try (whitespace >> anyOp)

203− p2 <- (whitespace >> patternTerm)

188+ p2 <- (whitespace >> Pattern.term)

204 return $ if o == '`' then [ PVar $ takeWhile (/='`') p, p1, p2 ]

189 return $ if o == '`' then [ PVar $ takeWhile (/='`') p, p1, p2 ]

205 else [ PVar (o:p), p1, p2 ]

190 else [ PVar (o:p), p1, p2 ]

206

191

@@ -210,10 +195,10 @@ assignExpr = withPos $ do

210 whitespace

195 whitespace

211 e <- string "=" >> whitespace >> expr

196 e <- string "=" >> whitespace >> expr

212 n <- sourceLine <$> getPosition

197 n <- sourceLine <$> getPosition

213− runAt (1000 * n) $ flattenPatterns fDefs e

198+ runAt (1000 * n) $ Pattern.flatten fDefs e

214

199

215anyDef =

200anyDef =

216− ((\d -> [d]) <$> typeAnnotation) <|>

201+ ((\d -> [d]) <$> Type.annotation) <|>

217 assignExpr

202 assignExpr

218

203

219def = map Definition <$> anyDef

204def = map Definition <$> anyDef

compiler/Parse/Foreign.hs+9−6

@@ -2,18 +2,19 @@

2module Parse.Foreign (foreignDef) where

4import Control.Applicative ((<$>), (<*>))

5−import Data.Either (partitionEithers)

6import Text.Parsec hiding (newline,spaces)

5import Text.Parsec hiding (newline,spaces)

8−import Ast

7+import SourceSyntax.Declaration (Declaration(ExportEvent,ImportEvent))

9−import Parse.Library

8+import Parse.Helpers

10−import Parse.Expr (term)

9+import Parse.Expression (term)

11−import Parse.Types

10+import Parse.Type

12import Types.Types (signalOf)

11import Types.Types (signalOf)

13+foreignDef :: IParser Declaration

14foreignDef = do try (reserved "foreign") ; whitespace

15 importEvent <|> exportEvent

17+exportEvent :: IParser Declaration

17exportEvent = do

18exportEvent = do

18 try (reserved "export") >> whitespace >> reserved "jsevent" >> whitespace

19 try (reserved "export") >> whitespace >> reserved "jsevent" >> whitespace

19 js <- jsVar ; whitespace

20 js <- jsVar ; whitespace

@@ -25,6 +26,7 @@ exportEvent = do

25 either error (return . ExportEvent js elm . signalOf) (toForeignType pt)

26 either error (return . ExportEvent js elm . signalOf) (toForeignType pt)

26 _ -> error "When exporting events, the exported value must be a Signal."

27 _ -> error "When exporting events, the exported value must be a Signal."

29+importEvent :: IParser Declaration

28importEvent = do

30importEvent = do

29 try (reserved "import") >> whitespace >> reserved "jsevent" >> whitespace

31 try (reserved "import") >> whitespace >> reserved "jsevent" >> whitespace

30 js <- jsVar ; whitespace

32 js <- jsVar ; whitespace

@@ -39,13 +41,14 @@ importEvent = do

39 _ -> error "When importing events, the imported value must be a Signal."

41 _ -> error "When importing events, the imported value must be a Signal."

42−jsVar :: (Monad m) => ParsecT [Char] u m String

44+jsVar :: IParser String

43jsVar = betwixt '"' '"' $ do

45jsVar = betwixt '"' '"' $ do

44 v <- (:) <$> (letter <|> char '_') <*> many (alphaNum <|> char '_')

46 v <- (:) <$> (letter <|> char '_') <*> many (alphaNum <|> char '_')

45 if v `notElem` jsReserveds then return v else

47 if v `notElem` jsReserveds then return v else

46 error $ "'" ++ v ++

48 error $ "'" ++ v ++

47 "' is not a good name for a importing or exporting JS values."

49 "' is not a good name for a importing or exporting JS values."

51+jsReserveds :: [String]

49jsReserveds =

52jsReserveds =

50 [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"

53 [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"

51 , "arguments", "int", "byte", "char", "goto", "long", "final", "float"

54 , "arguments", "int", "byte", "char", "goto", "long", "final", "float"

compiler/Parse/Literal.hsnew file+33

@@ -0,0 +1,33 @@

1+module Parse.Literal (literal) where

3+import Control.Applicative ((<$>), (<*>))

4+import Control.Monad

5+import Text.Parsec hiding (newline,spaces)

6+import Text.Parsec.Indent

8+import Parse.Helpers

9+import qualified Parse.Pattern as Pattern

10+import qualified Parse.Type as Type

11+import Parse.Binop

12+

13+import SourceSyntax.Pattern hiding (tuple,list)

14+import SourceSyntax.Literal

15+

16+literal = num <|> str <|> chr

17+

18+num :: IParser Literal

19+num = fmap toLit (preNum <?> "number")

20+ where toLit n | '.' `elem` n = FloatNum (read n)

21+ | otherwise = IntNum (read n)

22+ preNum = (++) <$> many1 digit <*> option "" postNum

23+ postNum = do try $ lookAhead (string "." >> digit)

24+ string "."

25+ ('.':) <$> many1 digit

26+

27+str :: IParser Literal

28+str = liftM Str . expecting "string" . betwixt '"' '"' . many $

29+ backslashed <|> satisfy (/='"')

30+

31+chr :: IParser Literal

32+chr = Chr <$> betwixt '\'' '\'' (backslashed <|> satisfy (/='\''))

33+ <?> "character"

compiler/Parse/Modules.hs → compiler/Parse/Module.hsrenamed+3−3

@@ -1,12 +1,12 @@

2−module Parse.Modules (moduleDef, imports) where

2+module Parse.Module (moduleDef, imports) where

4import Control.Applicative ((<$>), (<*>))

5import Data.List (intercalate)

6import Text.Parsec hiding (newline,spaces)

8−import Ast

8+import Parse.Helpers

9−import Parse.Library

9+import SourceSyntax.Module

11varList :: IParser [String]

12varList = parens $ commaSep1 (var <|> parens symOp)

compiler/Parse/Patterns.hs → compiler/Parse/Pattern.hsrenamed+36−35

@@ -1,8 +1,6 @@

2−module Parse.Pattern (patternTerm, patternExpr, makeLambda, flattenPatterns) where

2+module Parse.Pattern (term, expr, makeLambda, flatten) where

4−import Ast

5−import Located

6import Control.Applicative ((<$>),(<*>),(*>),pure)

4import Control.Applicative ((<$>),(<*>),(*>),pure)

7import Control.Monad

5import Control.Monad

8import Control.Monad.State

6import Control.Monad.State

@@ -10,62 +8,65 @@ import Data.Char (isUpper)

10import Guid

8import Guid

11import Text.Parsec hiding (newline,spaces,State)

9import Text.Parsec hiding (newline,spaces,State)

12import Text.Parsec.Indent

10import Text.Parsec.Indent

13−import Parse.Library

11+import Parse.Helpers

13+import SourceSyntax.Helpers (isOp)

14+import SourceSyntax.Location

15+import SourceSyntax.Pattern hiding (tuple,list)

16+import qualified SourceSyntax.Pattern as Pattern

17+import SourceSyntax.Expression (Expr(..), Def(..), LExpr)

18+

15−patternBasic :: IParser Pattern

19+basic :: IParser Pattern

16−patternBasic =

20+basic =

17 choice [ char '_' >> return PAnything

21 choice [ char '_' >> return PAnything

18 , do x@(c:_) <- var

22 , do x@(c:_) <- var

19 return $ if isUpper c then PData x [] else PVar x

23 return $ if isUpper c then PData x [] else PVar x

20 ]

24 ]

22−asPattern :: IParser Pattern -> IParser Pattern

26+asPattern :: Pattern -> IParser Pattern

23asPattern pattern = do

27asPattern pattern = do

24− p <- pattern

25 var <- optionMaybe (try (whitespace >> reserved "as" >> whitespace >> lowVar))

28 var <- optionMaybe (try (whitespace >> reserved "as" >> whitespace >> lowVar))

26 return $ case var of

29 return $ case var of

27− Just v -> PAsVar v p

30+ Just v -> PAlias v pattern

28− Nothing -> p

31+ Nothing -> pattern

30−patternRecord :: IParser Pattern

33+record :: IParser Pattern

31−patternRecord = PRecord <$> brackets (commaSep1 lowVar)

34+record = PRecord <$> brackets (commaSep1 lowVar)

33−patternTuple :: IParser Pattern

36+tuple :: IParser Pattern

34−patternTuple = do ps <- parens (commaSep patternExpr)

37+tuple = do ps <- parens (commaSep expr)

35− return $ case ps of { [p] -> p; _ -> ptuple ps }

38+ return $ case ps of { [p] -> p; _ -> Pattern.tuple ps }

37−patternList :: IParser Pattern

40+list :: IParser Pattern

38−patternList = plist <$> braces (commaSep patternExpr)

41+list = Pattern.list <$> braces (commaSep expr)

40−patternTerm :: IParser Pattern

43+term :: IParser Pattern

41−patternTerm = (choice [ patternRecord, patternTuple, patternList,

44+term = (choice [ record, tuple, list, basic ]) <?> "pattern"

42− patternBasic ])

43− <?> "pattern"

45patternConstructor :: IParser Pattern

46patternConstructor :: IParser Pattern

46−patternConstructor = PData <$> capVar <*> spacePrefix patternTerm

47+patternConstructor = PData <$> capVar <*> spacePrefix term

48−patternExpr :: IParser Pattern

49+expr :: IParser Pattern

49−patternExpr =

50+expr = do

50− asPattern (foldr1 pcons <$> consSep1 (patternConstructor <|> patternTerm))

51+ patterns <- consSep1 (patternConstructor <|> term)

51− <?> "pattern"

52+ asPattern (foldr1 Pattern.cons patterns) <?> "pattern"

53−makeLambda :: [Pattern] -> CExpr -> GuidCounter CExpr

54+makeLambda :: [Pattern] -> LExpr -> GuidCounter LExpr

54makeLambda pats body = go (reverse pats) body

55makeLambda pats body = go (reverse pats) body

55 where go [] body = return body

56 where go [] body = return body

56 go (p:ps) body@(L t s _) = do

57 go (p:ps) body@(L t s _) = do

57 (x,e) <- extract p body

58 (x,e) <- extract p body

58 go ps (L t s $ Lambda x e)

59 go ps (L t s $ Lambda x e)

60−extract :: Pattern -> CExpr -> GuidCounter (String, CExpr)

61+extract :: Pattern -> LExpr -> GuidCounter (String, LExpr)

61extract pattern body@(L t s _) =

62extract pattern body@(L t s _) =

62 let loc = L t s in

63 let loc = L t s in

63 let fn x e = (x,e) in

64 let fn x e = (x,e) in

64 case pattern of

65 case pattern of

65 PAnything -> return $ fn "_" body

66 PAnything -> return $ fn "_" body

66 PVar x -> return $ fn x body

67 PVar x -> return $ fn x body

67− PAsVar x PAnything -> return $ fn x body

68+ PAlias x PAnything -> return $ fn x body

68− PAsVar x p -> do

69+ PAlias x p -> do

69 (x', body') <- extract p body

70 (x', body') <- extract p body

70 return $ fn x (loc $ Let [FnDef x' [] (loc $ Var x)] body')

71 return $ fn x (loc $ Let [FnDef x' [] (loc $ Var x)] body')

71 PData name ps -> do

72 PData name ps -> do

@@ -78,14 +79,14 @@ extract pattern body@(L t s _) =

78 toDef f = FnDef f [] (loc $ Access (loc $ Var a) f)

79 toDef f = FnDef f [] (loc $ Access (loc $ Var a) f)

79 return . fn a . loc $ Let (map toDef fs) body

80 return . fn a . loc $ Let (map toDef fs) body

81−extracts :: [Pattern] -> CExpr -> GuidCounter ([String], CExpr)

82+extracts :: [Pattern] -> LExpr -> GuidCounter ([String], LExpr)

82extracts ps body = go [] (reverse ps) body

83extracts ps body = go [] (reverse ps) body

83 where go args [] body = return (args, body)

84 where go args [] body = return (args, body)

84 go args (p:ps) body = do (x,e) <- extract p body

85 go args (p:ps) body = do (x,e) <- extract p body

85 go (x:args) ps e

86 go (x:args) ps e

87−flattenPatterns :: [Pattern] -> CExpr -> GuidCounter (IParser [Def])

88+flatten :: [Pattern] -> LExpr -> GuidCounter (IParser [Def])

88−flattenPatterns patterns exp@(L t s _) =

89+flatten patterns exp@(L t s _) =

89 let loc = L t s in

90 let loc = L t s in

90 case patterns of

91 case patterns of

91 PVar f : args -> do

92 PVar f : args -> do

@@ -99,7 +100,7 @@ flattenPatterns patterns exp@(L t s _) =

99 _ -> return . fail $ "Pattern (" ++ unwords (map show patterns) ++

100 _ -> return . fail $ "Pattern (" ++ unwords (map show patterns) ++

100 ") cannot be used on the left-hand side of an assign statement."

101 ") cannot be used on the left-hand side of an assign statement."

101

102

102−matchSingle :: Pattern -> CExpr -> Pattern -> GuidCounter [Def]

103+matchSingle :: Pattern -> LExpr -> Pattern -> GuidCounter [Def]

103matchSingle pat exp@(L t s _) p =

104matchSingle pat exp@(L t s _) p =

104 let loc = L t s in

105 let loc = L t s in

105 case p of

106 case p of

@@ -112,7 +113,7 @@ matchSingle pat exp@(L t s _) p =

112 PVar x ->

113 PVar x ->

113 return [ FnDef x [] (loc $ Case exp [(pat, loc $ Var x)]) ]

114 return [ FnDef x [] (loc $ Case exp [(pat, loc $ Var x)]) ]

114

115

115− PAsVar x p' -> do

116+ PAlias x p' -> do

116 subPat <- matchSingle p' (loc $ Var x) p'

117 subPat <- matchSingle p' (loc $ Var x) p'

117 return $ (FnDef x [] (loc $ Case exp [(pat, loc $ Var x)])):subPat

118 return $ (FnDef x [] (loc $ Case exp [(pat, loc $ Var x)])):subPat

118

119

compiler/Parse/Types.hs → compiler/Parse/Type.hsrenamed+4−5

@@ -1,9 +1,8 @@

1−module Parse.Types where

1+module Parse.Type where

3import Control.Applicative ((<$>),(<*>))

4import Control.Monad (liftM,mapM)

5−import Data.Char (isUpper,isLower)

5+import Data.Char (isLower)

6−import Data.Maybe (fromMaybe)

7import Data.List (lookup,intercalate)

6import Data.List (lookup,intercalate)

8import Text.Parsec

7import Text.Parsec

9import Text.Parsec.Indent

8import Text.Parsec.Indent

@@ -103,8 +102,8 @@ toConstructor start end alias (Just _) kvs =

103 rec = foldl insert (Var "_ext_") (zip args (map (loc . Var) args))

102 rec = foldl insert (Var "_ext_") (zip args (map (loc . Var) args))

104 insert e (k,v) = Insert (loc e) k v

103 insert e (k,v) = Insert (loc e) k v

105

104

106−typeAnnotation :: IParser Def

105+annotation :: IParser Def

107−typeAnnotation = TypeAnnotation <$> try start <*> (toType <$> typeExpr)

106+annotation = TypeAnnotation <$> try start <*> (toType <$> typeExpr)

108 where start = do v <- lowVar <|> parens symOp

107 where start = do v <- lowVar <|> parens symOp

109 whitespace ; hasType ; whitespace ; return v

108 whitespace ; hasType ; whitespace ; return v

110

109