267f77c · elk · git.iko.soy

git.iko.soy/elk

Add basic module system and improve parser error messages.

commit267f77c9b37c0a95aee42823f3f34432dc366abc authorevancz <info@elm-lang.org> dateTue 12 Jun 2012, 01:28 (14 years ago) parentea9ac12

12 files changed+231−174

compare with master

unifiedsplit

elm/src/Ast.hs+2−2 elm/src/Gen/CompileToJS.hs+56−12 elm/src/Gen/ExtractNoscript.hs+12−3 elm/src/Gen/GenerateHtml.hs+6−5 elm/src/Initialize.hs+11−94 elm/src/Optimize.hs+84 elm/src/Parse/Binops.hs+3−4 elm/src/Parse/ParseExpr.hs+13−12 elm/src/Parse/ParseLib.hs+20−19 elm/src/Parse/ParseModules.hs+11−11 elm/src/Parse/ParseTypes.hs+3−3 elm/src/Parse/Parser.hs+10−9

elm/src/Ast.hs+2−2

@@ -6,11 +6,11 @@ import Data.List (intercalate)

66import Types

77import Guid

9−data Module = Module String Exports Imports Defs

9+data Module = Module [String] Exports Imports Defs

1010

1111type Exports = [String]

1212

13−data Imports = Imports [(String, ImportMethod)]

13+type Imports = [(String, ImportMethod)]

1414data ImportMethod = As String | Hiding [String] | Importing [String]

1515

1616type Defs = [(String,Expr)]

elm/src/Gen/CompileToJS.hs+56−12

@@ -3,28 +3,71 @@ module CompileToJS (compile, compileToJS) where

44import Ast

55import Control.Monad (liftM,(<=<),join)

6−import Data.Char (isAlpha)

7−import Data.List (intercalate,sortBy)

6+import Data.Char (isAlpha,isDigit)

7+import Data.List (intercalate,sortBy,inits)

88import Data.Map (toList)

9+import Data.Maybe (mapMaybe)

910

1011import Initialize

1112

1213showErr :: String -> String

13−showErr err = "text(monospace(" ++ msg ++ "))"

14+showErr err = mainEquals $ "text(monospace(" ++ msg ++ "))"

1415 where msg = show . concatMap (++" ") . lines $ err

1516

16−compile = (return . addMain . toJS) <=< initialize

17−compileToJS = addMain . either showErr toJS

18−addMain body = "function main(){return " ++ body ++ ";}"

17+compile str = jsModule `liftM` initialize str

18+compileToJS = either showErr jsModule

1919

2020parens = ("("++) . (++")")

2121braces = ("{"++) . (++"}")

2222jsList = ("["++) . (++"]") . intercalate ","

2323jsFunc args body = "function(" ++ args ++ "){" ++ body ++ "}"

24−assign x e = "var " ++ x ++ "=" ++ e ++ ";"

25−ret e = "return "++ e ++";"

24+assign x e = "\nvar " ++ x ++ "=" ++ e ++ ";"

25+ret e = "\nreturn "++ e ++";"

2626iff a b c = a ++ "?" ++ b ++ ":" ++ c

2727

28+mainEquals s = globalAssign "ElmCode.main" (jsFunc "" (ret s))

29+globalAssign m s = "\n" ++ m ++ "=" ++ s ++ ";"

30+

31+tryBlock e =

32+ unlines [ "\ntry{\n" ++ e ++ "\n\n} catch (e) {"

33+ , "ElmCode.main=function() {"

34+ , "var msg = (' <h2>Your browser may not be supported. Are you using a modern browser?</h2>' +" ++

35+ " ' Runtime Error: ' + e + '')"

36+ , "document.body.innerHTML = Text.monospace(msg);"

37+ , "throw e;"

38+ , "};}"

39+ ]

40+

41+

42+jsModule (Module names exports imports defs) =

43+ tryBlock $ unwords

44+ [ concatMap (\n -> globalAssign n $ n ++ " || {}") . map (intercalate ".") . drop 2 . inits $ take (length modNames - 1) modNames

45+ , "\nif (" ++ modName ++ ") throw 'Module name collision, " ++ intercalate "." names ++ " is already defined.'; "

46+ , globalAssign modName $ jsFunc "" (includes ++ body ++ export) ++ "()"

47+ , mainEquals $ modName ++ ".main" ]

48+ where modNames = if null names then ["ElmCode", "Main"] else "ElmCode" : names

49+ modName = intercalate "." modNames

50+ includes = concatMap jsImport $

51+ map (\(x,y) -> ("ElmCode." ++ x,y)) imports

52+ body = jsDefs defs

53+ export = ret . braces . intercalate "," $ mapMaybe getNames defs

54+ exps = if null exports then ["main"] else exports

55+ getNames (x,_) =

56+ let y = reverse . tail . dropWhile isDigit $ reverse x in

57+ if y `elem` exps then Just $ y ++ ":" ++ x else Nothing

58+

59+jsImport (modul, As name) = assign name modul

60+jsImport (modul, Importing []) = jsImport (modul, Hiding [])

61+jsImport (modul, Importing vs) =

62+ concatMap (\v -> assign v $ modul ++ "." ++ v) vs

63+jsImport (modul, Hiding vs) =

64+ unwords [ "\nfor(var i in " ++ modul ++ "){"

65+ , assign "hiddenVars" . jsList $ map (\v -> "'" ++ v ++ "'") vs

66+ , "\nif (hiddenVars.indexOf(i) >= 0) continue;"

67+ , globalAssign "this[i]" $ modul ++ "[i]"

68+ , "}" ]

69+

70+

2871toJS expr =

2972 case expr of

3073 Number n -> show n

@@ -45,13 +88,14 @@ toJS expr =

4588 Case e cases -> jsCase e cases

4689 Data name es -> jsList $ show name : map toJS es

4790

48−jsLet defs e' = jsFunc "" (defs' ++ ret (toJS e')) ++ "()"

49− where defs' = concatMap toDef $ sortBy f defs

50− f a b = compare (isLambda a) (isLambda b)

91+jsLet defs e' = jsFunc "" (jsDefs defs ++ ret (toJS e')) ++ "()"

92+

93+jsDefs defs = concatMap toDef $ sortBy f defs

94+ where f a b = compare (isLambda a) (isLambda b)

5195 isLambda (_, Lambda _ _) = 1

5296 isLambda _ = 0

5397 toDef (f, Lambda x e) =

54− "function " ++ f ++ parens x ++ braces (ret $ toJS e) ++ ";"

98+ "\nfunction " ++ f ++ parens x ++ braces (ret $ toJS e) ++ ";"

5599 toDef (x, e) = assign x (toJS e)

56100

57101jsCase e [c] = jsMatch c ++ parens (toJS e)

elm/src/Gen/ExtractNoscript.hs+12−3

@@ -3,9 +3,10 @@ module ExtractNoscript (extract) where

44import Ast

6−extract = concatMap (\s -> "" ++ s ++ "") . extract'

6+extract (Module _ _ _ defs) =

7+ concatMap (\s -> "" ++ s ++ "") $ concatMap (extract' . snd) defs

8−extract' expr =

9+extract' expr =

910 let f = extract' in

1011 case expr of

1112 Str s -> [s]

@@ -17,10 +18,18 @@ extract' expr =

1718 case (f src, f txt) of

1819 ([s1],[s2]) -> [ "<a href=\"" ++ s1 ++ "\">" ++ s2 ++ "</a>" ]

1920 ( ss1, ss2) -> ss1 ++ ss2

21+ App (Var "header") e -> tag "h1" e

22+ App (Var "bold") e -> tag "b" e

23+ App (Var "italic") e -> tag "i" e

24+ App (Var "monospace") e -> tag "code" e

2025 App e1 e2 -> f e1 ++ f e2

2126 If eb et ef -> f et ++ f ef

2227 Let defs e -> concatMap (f . snd) defs ++ f e

2328 Var _ -> []

2429 Case e cases -> concatMap (f . snd) cases

2530 Data _ es -> concatMap f es

26− _ -> []

31+ _ -> []

32+

33+tag t e = case extract' e of

34+ [s] -> [ concat [ "<", t, ">", s, "</", t, ">" ] ]

35+ ss -> ss

elm/src/Gen/GenerateHtml.hs+6−5

@@ -7,6 +7,7 @@ import qualified Text.Blaze.Html5 as H

77import Text.Blaze.Html5 ((!))

88import qualified Text.Blaze.Html5.Attributes as A

10+import Ast

1011import Initialize

1112import CompileToJS

1213import ExtractNoscript

@@ -34,9 +35,9 @@ generateHtml :: String -- ^ Location of elm-min.js as expected by the browser

3435 -> String -- ^ The elm source code.

3536 -> Html

3637generateHtml libLoc title source =

37− let expr = initialize source

38− js = compileToJS expr

39− noscript = either id extract expr

38+ let modul = initialize source

39+ js = compileToJS modul

40+ noscript = either id extract modul

4041 in

4142 H.docTypeHtml $ do

4243 H.head $ do

@@ -49,11 +50,11 @@ generateHtml libLoc title source =

4950

5051body noscript = do

5152 H.div ! A.id "widthChecker" ! A.style "width:100%; height:1px; position:absolute; top:-1px;" $ ""

52− H.span ! A.id "content" $ ""

53+ H.div ! A.id "content" $ ""

5354 H.script ! A.type_ "text/javascript" $ "Dispatcher.initialize()"

5455 H.noscript $ preEscapedToMarkup noscript

5556

5657widgetBody noscript = do

5758 H.div ! A.id "widthChecker" ! A.style "width:100%; height:1px; position:absolute; top:-1px;" $ ""

58− H.span ! A.id "content" $ ""

59+ H.div ! A.id "content" $ ""

5960 H.noscript $ preEscapedToMarkup noscript

elm/src/Initialize.hs+11−94

@@ -1,100 +1,17 @@

11module Initialize (initialize) where

3−import Ast

4−import Control.Arrow (first, second)

5−import Control.Monad

6−import Data.Char (isAlpha)

7−import Data.Maybe (mapMaybe)

8−import Data.Either (rights)

9−

10−import Parser (toDefs)

11−import Rename (rename)

3+import Control.Monad.Error

124

13−import Unify

5+import Ast

6+import Parser (parseProgram)

147import Hints

15−

8+import Unify

9+import Rename

10+import Optimize

1611

1712initialize str = do

18− (expr, hints') <- toDefs str

19− let expr' = rename expr

20− subs <- unify (liftM2 (++) hints hints') expr'

21− let init = simp_loop expr'

22− return (seq subs init)

23−

24−simp_loop exp = if exp == exp' then exp' else simp_loop exp'

25− where exp' = simp exp

26−

27−simp expr =

28− let f = simp in

29− case expr of

30− Range e1 e2 -> Range (f e1) (f e2)

31− Binop op e1 e2 -> simp_binop op (f e1) (f e2)

32− Lambda x e -> Lambda x (f e)

33− App e1 e2 -> App (f e1) (f e2)

34− If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3)

35− Let defs e -> Let (map (second f) defs) (f e)

36− Data name es -> Data name (map f es)

37− Case e cases -> Case (f e) (map (second f) cases)

38− _ -> expr

39−

40−simp_if (Boolean b) e2 e3 = if b then e2 else e3

41−simp_if a b c = If a b c

42−

43−simp_binop "mod" (Number n) (Number m) = Number (mod n m)

44−simp_binop "mod" e1 e2 = Binop "mod" e1 e2

45−simp_binop str e1 e2

46− | isAlpha (head str) || '_' == head str = App (App (Var str) e1) e2

47− | otherwise = binop str e1 e2

48−

49−binop op (Number n) (Number m) = f n m

50− where f a b = case op of

51− { "+" -> Number $ (+) a b

52− ; "-" -> Number $ (-) a b

53− ; "*" -> Number $ (*) a b

54− --; "/" -> Number $ div a b

55− ; "<" -> Boolean $ a < b

56− ; ">" -> Boolean $ a < b

57− ; "<=" -> Boolean $ a <= b

58− ; ">=" -> Boolean $ a >= b

59− ; "==" -> Boolean $ a == b

60− ; "/=" -> Boolean $ a /= b

61− ; _ -> Binop op (Number n) (Number m) }

62−

63−binop "-" e (Number 0) = e

64−binop "+" (Number 0) e = e

65−binop "+" (Number n) (Binop "+" (Number m) e) = binop "+" (Number (n+m)) e

66−binop "+" (Number n) (Binop "+" e (Number m)) = binop "+" (Number (n+m)) e

67−

68−binop "/" e (Number 1) = e

69−binop "*" (Number 0) e = Number 0

70−binop "*" (Number 1) e = e

71−binop "*" (Number n) (Binop "*" (Number m) e) = binop "*" (Number (n*m)) e

72−binop "*" (Number n) (Binop "*" e (Number m)) = binop "*" (Number (n*m)) e

73−

74−binop "+" e (Number n) = binop "+" (Number n) e

75−binop "*" e (Number n) = binop "*" (Number n) e

76−

77−binop op (Boolean n) (Boolean m) = f n m

78− where f a b = case op of { "&&" -> Boolean $ (&&) n m

79− ; "||" -> Boolean $ (||) n m

80− ; _ -> Binop op (Boolean n) (Boolean m) }

81−

82−binop "&&" (Boolean True) e = e

83−binop "&&" (Boolean False) e = Boolean False

84−binop "||" (Boolean True) e = Boolean True

85−binop "||" (Boolean False) e = e

86−

87−binop op e (Boolean n) = binop op (Boolean n) e

88−

89−binop ":" h t = cons h t

90−binop "++" (Str s1) (Str s2) = Str $ s1 ++ s2

91−binop "++" (Str s1) (Binop "++" (Str s2) e) = Binop "++" (Str $ s1 ++ s2) e

92−binop "++" (Binop "++" e (Str s1)) (Str s2) = Binop "++" e (Str $ s1 ++ s2)

93−binop "++" (Data "Nil" []) e = e

94−binop "++" e (Data "Nil" []) = e

95−binop "++" (Data "Cons" [h,t]) e = Data "Cons" [h, binop "++" t e]

96−

97−binop "$" e1 e2 = App e1 e2

98−

99−binop op e1 e2 = Binop op e1 e2

100−--}

13+ (Module name ex im defs, tipes) <- parseProgram str

14+ let expr = rename . Let defs $ Var "_"

15+ subs <- unify (liftM2 (++) hints tipes) expr

16+ let Let defs' _ = optimize expr

17+ return (subs `seq` Module name ex im defs')

elm/src/Optimize.hsnew file+84

@@ -0,0 +1,84 @@

1+module Optimize (optimize) where

3+import Ast

4+import Control.Arrow (second)

5+import Data.Char (isAlpha)

8+optimize exp = if exp == exp' then exp' else optimize exp'

9+ where exp' = simp exp

10+

11+simp expr =

12+ let f = simp in

13+ case expr of

14+ Range e1 e2 -> Range (f e1) (f e2)

15+ Binop op e1 e2 -> simp_binop op (f e1) (f e2)

16+ Lambda x e -> Lambda x (f e)

17+ App e1 e2 -> App (f e1) (f e2)

18+ If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3)

19+ Let defs e -> Let (map (second f) defs) (f e)

20+ Data name es -> Data name (map f es)

21+ Case e cases -> Case (f e) (map (second f) cases)

22+ _ -> expr

23+

24+simp_if (Boolean b) e2 e3 = if b then e2 else e3

25+simp_if a b c = If a b c

26+

27+simp_binop "mod" (Number n) (Number m) = Number (mod n m)

28+simp_binop "mod" e1 e2 = Binop "mod" e1 e2

29+simp_binop str e1 e2

30+ | isAlpha (head str) || '_' == head str = App (App (Var str) e1) e2

31+ | otherwise = binop str e1 e2

32+

33+binop op (Number n) (Number m) = f n m

34+ where f a b = case op of

35+ { "+" -> Number $ (+) a b

36+ ; "-" -> Number $ (-) a b

37+ ; "*" -> Number $ (*) a b

38+ --; "/" -> Number $ div a b

39+ ; "<" -> Boolean $ a < b

40+ ; ">" -> Boolean $ a < b

41+ ; "<=" -> Boolean $ a <= b

42+ ; ">=" -> Boolean $ a >= b

43+ ; "==" -> Boolean $ a == b

44+ ; "/=" -> Boolean $ a /= b

45+ ; _ -> Binop op (Number n) (Number m) }

46+

47+binop "-" e (Number 0) = e

48+binop "+" (Number 0) e = e

49+binop "+" (Number n) (Binop "+" (Number m) e) = binop "+" (Number (n+m)) e

50+binop "+" (Number n) (Binop "+" e (Number m)) = binop "+" (Number (n+m)) e

51+

52+binop "/" e (Number 1) = e

53+binop "*" (Number 0) e = Number 0

54+binop "*" (Number 1) e = e

55+binop "*" (Number n) (Binop "*" (Number m) e) = binop "*" (Number (n*m)) e

56+binop "*" (Number n) (Binop "*" e (Number m)) = binop "*" (Number (n*m)) e

57+

58+binop "+" e (Number n) = binop "+" (Number n) e

59+binop "*" e (Number n) = binop "*" (Number n) e

60+

61+binop op (Boolean n) (Boolean m) = f n m

62+ where f a b = case op of { "&&" -> Boolean $ (&&) n m

63+ ; "||" -> Boolean $ (||) n m

64+ ; _ -> Binop op (Boolean n) (Boolean m) }

65+

66+binop "&&" (Boolean True) e = e

67+binop "&&" (Boolean False) e = Boolean False

68+binop "||" (Boolean True) e = Boolean True

69+binop "||" (Boolean False) e = e

70+

71+binop op e (Boolean n) = binop op (Boolean n) e

72+

73+binop ":" h t = cons h t

74+binop "++" (Str s1) (Str s2) = Str $ s1 ++ s2

75+binop "++" (Str s1) (Binop "++" (Str s2) e) = Binop "++" (Str $ s1 ++ s2) e

76+binop "++" (Binop "++" e (Str s1)) (Str s2) = Binop "++" e (Str $ s1 ++ s2)

77+binop "++" (Data "Nil" []) e = e

78+binop "++" e (Data "Nil" []) = e

79+binop "++" (Data "Cons" [h,t]) e = Data "Cons" [h, binop "++" t e]

80+

81+binop "$" e1 e2 = App e1 e2

82+

83+binop op e1 e2 = Binop op e1 e2

84+--}

elm/src/Parse/Binops.hs+3−4

@@ -28,10 +28,9 @@ sortOps = sortBy (\(i,_,_) (j,_,_) -> compare i j)

2828binops term anyOp = do

2929 e <- term

3030 (ops,es) <- liftM unzip $

31− many (try $ do { whitespace

32− ; op <- anyOp

33− ; whitespace

34− ; e <- term; return (op,e) })

31+ many (commitIf (whitespace >> anyOp) $ do { whitespace ; op <- anyOp

32+ ; whitespace ; e <- term

33+ ; return (op,e) })

3534 case binopOf Map.empty (sortOps table) ops (e:es) of

3635 Right e -> return e

3736 Left msg -> fail msg

elm/src/Parse/ParseExpr.hs+13−12

@@ -79,16 +79,6 @@ lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"

7979 e <- expr

8080 return $ makeFunction args e

8181

82−assignExpr = do

83− patterns <-

84− choice [ try $ do v <- PVar <$> lowVar

85− notFollowedBy (whitespace >> char ':')

86− (v:) <$> spacePrefix patternTerm

87− , (:[]) <$> patternExpr

88− ] <?> "the definition of a variable (x = ...)"

89− whitespace; string "="; whitespace; exp <- expr

90− flattenPatterns patterns exp

91−

9282letExpr = do

9383 reserved "let"

9484 brace <- optionMaybe . try $ do

@@ -108,13 +98,24 @@ caseExpr = do

10898 where case_ = do p <- patternExpr; whitespace; arrow; whitespace

10999 (,) p <$> expr

110100

101+expr = choice [ ifExpr, letExpr, caseExpr

102+ , lambdaExpr, binaryExpr ] <?> "an expression"

103+

104+assignExpr = do

105+ patterns <-

106+ choice [ try $ do v <- PVar <$> lowVar

107+ notFollowedBy (whitespace >> char ':')

108+ (v:) <$> spacePrefix patternTerm

109+ , (:[]) <$> patternExpr

110+ ] <?> "the definition of a variable (x = ...)"

111+ whitespace; string "="; whitespace; exp <- expr

112+ flattenPatterns patterns exp

111113

112−expr = choice [ ifExpr, letExpr, caseExpr, lambdaExpr, binaryExpr ] <?> "expression"

113114

114115def = do (fs,es) <- unzip <$> assignExpr

115116 return (fs, es, mapM (\_ -> liftM VarT guid) fs)

116117

117−parseDef str =

118+parseDef str =

118119 case parse def "" str of

119120 Right result -> Right result

120121 Left err -> Left $ "Parse error at " ++ show err

elm/src/Parse/ParseLib.hs+20−19

@@ -42,36 +42,35 @@ anyOp :: (Monad m) => ParsecT [Char] u m String

4242anyOp = betwixt '`' '`' var <|>

4343 (do op <- many1 (satisfy isSymbol <|> oneOf "+-/*=.$<>:&|^?%#@~!")

4444 guard (op `notElem` [ "=", "..", "->", "--" ])

45− return op) <?> "infix operator (e.g. x + y)"

45+ return op) <?> "infix operator (e.g. +, *, ||)"

4646

4747arrow :: (Monad m) => ParsecT [Char] u m String

4848arrow = string "->" <|> string "\8594" <?> "arrow (->)"

4949

50−commaSep :: (Monad m) => ParsecT [Char] u m a -> ParsecT [Char] u m [a]

51−commaSep p = option [] (commaSep1 p)

50+

51+commitIf check p = commit <|> try p

52+ where commit = do (try $ lookAhead check) >> p

53+

54+spaceySepBy1 :: (Monad m) => ParsecT [Char] u m b -> ParsecT [Char] u m a -> ParsecT [Char] u m [a]

55+spaceySepBy1 sep p = do

56+ a <- p

57+ (a:) <$> many (commitIf (whitespace >> sep) (whitespace >> sep >> whitespace >> p))

58+

5259

5360commaSep1 :: (Monad m) => ParsecT [Char] u m a -> ParsecT [Char] u m [a]

54−commaSep1 p =

55− (:) <$> p <*> many (try (whitespace >> (char ',' <?> "comma ','")) >>

56− whitespace >> p)

61+commaSep1 = spaceySepBy1 (char ',' <?> "comma ','")

62+

63+commaSep :: (Monad m) => ParsecT [Char] u m a -> ParsecT [Char] u m [a]

64+commaSep = option [] . commaSep1

5765

5866semiSep1 :: (Monad m) => ParsecT [Char] u m a -> ParsecT [Char] u m [a]

59−semiSep1 p = do

60− a <- p

61− (a:) <$> many (try (whitespace >> (char ';' <?> "semicolon ';'")) >>

62− whitespace >> p)

67+semiSep1 = spaceySepBy1 (char ';' <?> "semicolon ';'")

6368

6469pipeSep1 :: (Monad m) => ParsecT [Char] u m a -> ParsecT [Char] u m [a]

65−pipeSep1 p = do

66− a <- p

67− (a:) <$> many (try (whitespace >> (char '|' <?> "type divider '|'")) >>

68− whitespace >> p)

70+pipeSep1 = spaceySepBy1 (char '|' <?> "type divider '|'")

6971

7072consSep1 :: (Monad m) => ParsecT [Char] u m a -> ParsecT [Char] u m [a]

71−consSep1 p = do

72− a <- p

73− (a:) <$> many (try (whitespace >> (char ':' <?> "cons operator ':'")) >>

74− whitespace >> p)

73+consSep1 = spaceySepBy1 (char ':' <?> "cons operator ':'")

7574

7675dotSep1 :: (Monad m) => ParsecT [Char] u m a -> ParsecT [Char] u m [a]

7776dotSep1 p = (:) <$> p <*> many (try (char '.') >> p)

@@ -79,7 +78,9 @@ dotSep1 p = (:) <$> p <*> many (try (char '.') >> p)

7978spaceSep1 :: (Monad m) => ParsecT [Char] u m a -> ParsecT [Char] u m [a]

8079spaceSep1 p = (:) <$> p <*> spacePrefix p

8180

82−spacePrefix p = many (try (whitespace >> p))

81+spacePrefix p = many (commitIf (whitespace >> (char '[' <|> char '(')) (whitespace >> p))

82+

83+followedBy a b = do x <- a ; b ; return x

8384

8485betwixt a b c = do char a ; out <- c

8586 char b <?> "closing '" ++ [b] ++ "'" ; return out

elm/src/Parse/ParseModules.hs+11−11

@@ -8,20 +8,19 @@ import Text.Parsec hiding (newline,spaces)

88import Ast

99import ParseLib

1010

11−moduleDef :: (Monad m) => ParsecT [Char] u m (String, [String])

11+moduleDef :: (Monad m) => ParsecT [Char] u m ([String], [String])

1212moduleDef = do

13− reserved "module"

14− whitespace

15− name <- capVar

13+ try (reserved "module")

14+ whitespace <?> "name of module"

15+ names <- dotSep1 capVar

1616 whitespace

1717 exports <- option [] . parens $ commaSep var

18− whitespace

18+ whitespace <?> "reserved word 'where'"

1919 reserved "where"

20− return (name, exports)

20+ return (names, exports)

2121

2222imports :: (Monad m) => ParsecT [Char] u m Imports

23−imports =

24− Imports <$> option [] ((:) <$> import' <*> many (try (freshLine >> import')))

23+imports = option [] ((:) <$> import' <*> many (try (freshLine >> import')))

2524

2625

2726import' :: (Monad m) => ParsecT [Char] u m (String, ImportMethod)

@@ -35,10 +34,11 @@ import' = do

3534

3635

3736as' :: (Monad m) => ParsecT [Char] u m ImportMethod

38−as' = reserved "as" >> whitespace >> As <$> capVar

37+as' = reserved "as" >> whitespace >> As <$> capVar <?> "alias for module"

3938

4039hiding' :: (Monad m) => ParsecT [Char] u m ImportMethod

41−hiding' = reserved "hiding" >> whitespace >> Hiding <$> parens (commaSep1 var)

40+hiding' = reserved "hiding" >> whitespace >>

41+ Hiding <$> parens (commaSep1 var) <?> "listing of hidden values"

4242

4343importing' :: (Monad m) => ParsecT [Char] u m ImportMethod

44−importing' = Importing <$> parens (commaSep1 var)

44+importing' = Importing <$> parens (commaSep1 var) <?> "listing of imported values (x,y,z)"

elm/src/Parse/ParseTypes.hs+3−3

@@ -36,7 +36,7 @@ typeSimple :: (Monad m) => ParsecT [Char] u m ParseType

3636typeSimple = VarPT <$> var

3737

3838typeApp :: (Monad m) => ParsecT [Char] u m ParseType

39−typeApp = do name <- capVar

39+typeApp = do name <- capVar <?> "type constructor"

4040 args <- spacePrefix (typeUnambiguous <|> typeSimple)

4141 return $ case args of

4242 [] -> VarPT name

@@ -50,12 +50,12 @@ typeExpr = do

5050 Nothing -> return t1

5151

5252typeConstructor :: (Monad m) => ParsecT [Char] u m (String, [ParseType])

53−typeConstructor = (,) <$> capVar <*> spacePrefix (typeSimple <|> typeUnambiguous)

53+typeConstructor = (,) <$> (capVar <?> "another type constructor") <*> spacePrefix (typeSimple <|> typeUnambiguous)

5454

5555datatype :: (Monad m) => ParsecT [Char] u m ([String], [Expr], GuidCounter [Type])

5656datatype = do

5757 reserved "data" <?> "datatype definition (data T = A | B | ...)"

58− forcedWS ; name <- capVar ; args <- spacePrefix lowVar

58+ forcedWS ; name <- capVar <?> "name of data-type" ; args <- spacePrefix lowVar

5959 whitespace ; string "=" ; whitespace

6060 tcs <- pipeSep1 typeConstructor

6161 return $ (map fst tcs , map toFunc tcs , toTypes name args tcs)

elm/src/Parse/Parser.hs+10−9

@@ -13,24 +13,25 @@ import ParseTypes

1313import ParseModules

1414

1515

16+freshDef = commitIf (freshLine >> (letter <|> char '_')) $ do

17+ freshLine

18+ datatype <|> def <?> "another datatype or variable definition"

1619

17−defs1 = do d <- datatype <|> def <?> "at least one definition"

18− (d:) <$> many (try (try freshLine >> (datatype <|> def)))

20+defs1 = do d <- datatype <|> def <?> "at least one datatype or variable definition"

21+ (d:) <$> many freshDef

1922

2023defs = do

2124 (fss,ess,tss) <- unzip3 <$> defs1

2225 return (concat fss, concat ess, concat `liftM` sequence tss)

2326

24−

2527program = do

2628 optional freshLine

27− (name,exports) <- option ("",[]) moduleDef

28− freshLine

29− is <- imports

30− freshLine

31− ds <- defs

29+ (names,exports) <- option ([],[]) (moduleDef `followedBy` freshLine)

30+ is <- (do try (lookAhead $ reserved "import")

31+ imports `followedBy` freshLine) <|> return []

32+ (vs,es,ts) <- defs

3233 optional freshLine ; optional spaces ; eof

33− return (Module name exports is, ds)

34+ return (Module names exports is $ zip vs es, zip vs `liftM` ts)

3435

3536parseProgram source =

3637 case parse program "" source of