6ba2d70 · elk · git.iko.soy

git.iko.soy/elk

Revert 95ec3a8..1a093ac

This rolls back to commit 95ec3a822edeb97e667aab96996cc08aa8f605a9.

commit6ba2d703656aed655bfadaf73b8fe045925a850c authorEvan Czaplicki <info@elm-lang.org> dateThu 29 Aug 2013, 16:43 (13 years ago) parent1a093ac

9 files changed+33−89

compare with master

unifiedsplit

compiler/Compiler.hs+1−2 compiler/Initialize.hs+1−4 compiler/Parse/Binop.hs+12−8 compiler/Parse/Expression.hs+1−1 compiler/Parse/Helpers.hs+4−11 compiler/Parse/Module.hs+1−1 compiler/Parse/Parse.hs+4−40 compiler/SourceSyntax/Module.hs+5−17 compiler/Transform/Canonicalize.hs+4−5

compiler/Compiler.hs+1−2

@@ -150,8 +150,7 @@ buildFile flags moduleNum numModules interfaces filePath =

150150 let interface = Canonical.interface name $ ModuleInterface {

151151 iTypes = types metaModule,

152152 iAdts = datatypes metaModule,

153− iAliases = aliases metaModule,

154− iFixities = fixities metaModule

153+ iAliases = aliases metaModule

155154 }

156155 createDirectoryIfMissing True . dropFileName $ elmi flags filePath

157156 handle <- openBinaryFile (elmi flags filePath) WriteMode

compiler/Initialize.hs+1−4

@@ -23,10 +23,7 @@ import qualified Transform.Canonicalize as Canonical

2323buildFromSource :: Bool -> Interfaces -> String -> Either [Doc] (MetadataModule () ())

2424buildFromSource noPrelude interfaces source =

2525 do let add = if noPrelude then id else Prelude.add

26− infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))

27− . concatMap iFixities $ Map.elems interfaces

28−

29− modul@(Module _ _ _ decls') <- add `fmap` Parse.program infixes source

26+ modul@(Module _ _ _ decls') <- add `fmap` Parse.program source

3027

3128 -- check for structural errors

3229 Module names exs ims decls <-

compiler/Parse/Binop.hs+12−8

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

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

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

33import Control.Applicative ((<$>))

44import Control.Monad.Error

@@ -11,8 +11,10 @@ import SourceSyntax.Declaration (Assoc(..))

1111import Text.Parsec

1212import Parse.Helpers

1313

14+type OpTable = [(Int, Assoc, String)]

15+

1416preludeTable :: OpTable

15−preludeTable = Map.fromList $ map (\(lvl,assoc,op) -> (op, (lvl,assoc)))

17+preludeTable =

1618 [ (9, R, ".")

1719 , (8, R, "^")

1820 , (7, L, "*"), (7, L, "/"), (7, L, "mod"), (7, L, "div"), (7, L, "rem")

@@ -27,22 +29,24 @@ preludeTable = Map.fromList $ map (\(lvl,assoc,op) -> (op, (lvl,assoc)))

2729 ]

2830

2931opLevel :: OpTable -> String -> Int

30−opLevel table op = fst $ Map.findWithDefault (9,R) op table

32+opLevel table op = Map.findWithDefault 9 op dict

33+ where dict = Map.fromList (map (\(lvl,_,op) -> (op,lvl)) table)

3134

3235opAssoc :: OpTable -> String -> Assoc

33−opAssoc table op = snd $ Map.findWithDefault (9,R) op table

36+opAssoc table op = Map.findWithDefault R op dict

37+ where dict = Map.fromList (map (\(_,assoc,op) -> (op,assoc)) table)

3438

3539hasLevel :: OpTable -> Int -> (String, LExpr t v) -> Bool

3640hasLevel table n (op,_) = opLevel table op == n

3741

38−binops :: IParser (LExpr t v)

42+binops :: OpTable

43+ -> IParser (LExpr t v)

3944 -> IParser (LExpr t v)

4045 -> IParser String

4146 -> IParser (LExpr t v)

42−binops term last anyOp =

47+binops table term last anyOp =

4348 do e <- term

44− table <- getState

45− split table 0 e =<< nextOps

49+ split (table ++ preludeTable) 0 e =<< nextOps

4650 where

4751 nextOps = choice [ commitIf (whitespace >> anyOp) $ do

4852 whitespace ; op <- anyOp ; whitespace

compiler/Parse/Expression.hs+1−1

@@ -144,7 +144,7 @@ appExpr = do

144144-------- Normal Expressions --------

145145

146146binaryExpr :: IParser (LExpr t v)

147−binaryExpr = binops appExpr lastExpr anyOp

147+binaryExpr = binops [] appExpr lastExpr anyOp

148148 where lastExpr = addLocation (choice [ ifExpr, letExpr, caseExpr ])

149149 <|> lambdaExpr

150150

compiler/Parse/Helpers.hs+4−11

@@ -5,11 +5,9 @@ import Control.Monad

55import Control.Monad.State

66import Data.Char (isUpper)

77import qualified Data.Set as Set

8−import qualified Data.Map as Map

98import SourceSyntax.Helpers as Help

109import SourceSyntax.Location as Location

1110import SourceSyntax.Expression

12−import SourceSyntax.Declaration (Assoc)

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

1412import Text.Parsec.Indent

1513

@@ -37,16 +35,11 @@ jsReserveds = Set.fromList

3735

3836expecting = flip (<?>)

3937

40−type OpTable = Map.Map String (Int, Assoc)

38+type IParser a = ParsecT String () (State SourcePos) a

4139

42−type IParser a = ParsecT String OpTable (State SourcePos) a

43−

44−iParse :: IParser a -> String -> Either ParseError a

45−iParse = iParseWithTable "" Map.empty

46−

47−iParseWithTable :: SourceName -> OpTable -> IParser a -> String -> Either ParseError a

48−iParseWithTable sourceName table aParser input =

49− runIndent sourceName $ runParserT aParser table sourceName input

40+iParse :: IParser a -> SourceName -> String -> Either ParseError a

41+iParse aParser source_name input =

42+ runIndent source_name $ runParserT aParser () source_name input

5043

5144backslashed :: IParser Char

5245backslashed = do { char '\\'; c <- anyChar

compiler/Parse/Module.hs+1−1

@@ -13,7 +13,7 @@ varList = parens $ commaSep1 (var <|> parens symOp)

1313

1414getModuleName :: String -> Maybe String

1515getModuleName source =

16− case iParse getModuleName source of

16+ case iParse getModuleName "" source of

1717 Right name -> Just name

1818 Left _ -> Nothing

1919 where

compiler/Parse/Parse.hs+4−40

@@ -4,13 +4,12 @@ import Control.Applicative ((<$>), (<*>))

44import Control.Monad

55import Data.Char (isSymbol, isDigit)

66import Data.List (foldl',intercalate)

7−import qualified Data.Map as Map

87import Text.Parsec hiding (newline,spaces)

98import qualified Text.PrettyPrint as P

109

1110import qualified SourceSyntax.Module as S

1211import Parse.Helpers

13−import Parse.Binop (infixStmt, OpTable, preludeTable)

12+import Parse.Binop (infixStmt, OpTable)

1413import Parse.Expression

1514import Parse.Type

1615import Parse.Module

@@ -23,8 +22,8 @@ freshDef = commitIf (freshLine >> (letter <|> char '_')) $ do

2322decls = do d <- Decl.declaration <?> "at least one datatype or variable definition"

2423 (d:) <$> many freshDef

2524

26−program :: OpTable -> String -> Either [P.Doc] (S.Module t v)

27−program table = setupParserWithTable table $ do

25+program :: String -> Either [P.Doc] (S.Module t v)

26+program = setupParser $ do

2827 optional freshLine

2928 (names,exports) <- option (["Main"],[]) (moduleDef `followedBy` freshLine)

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

@@ -41,43 +40,8 @@ dependencies =

4140 (,) <$> option "Main" (getName <$> moduleDef `followedBy` freshLine)

4241 <*> option [] (map fst <$> imports `followedBy` freshLine)

4342

44−setupParserWithTable :: OpTable -> IParser a -> String -> Either [P.Doc] a

45−setupParserWithTable table p source =

46− do let initialTable = Map.union preludeTable table

47− localTable <- setupParser parseFixities source

48− case Map.intersection initialTable localTable of

49− overlap | not (Map.null overlap) -> Left [ msg overlap ]

50− | otherwise ->

51− flip setupParser source $ do

52− putState preludeTable --(Map.union initialTable localTable)

53− p

54− where

55− msg overlap =

56− P.vcat [ P.text "Parse error:"

57− , P.text $ "Overlapping definitions for infix operators: " ++

58− intercalate " " (Map.keys overlap)

59− ]

60−

61−parseFixities = infixes []

62− where

63− nil p = const () <$> p

64− manyTil p end = end <|> (p >> manyTil p end)

65−

66− eatLine = manyTil (nil multiComment <|> nil anyChar)

67− (const False <$> simpleNewline <|> const True <$> eof)

68−

69− infixes stmts = do

70− next <- Left <$> infixStmt <|> Right <$> eatLine

71− case next of

72− Left stmt -> infixes (stmt:stmts)

73− Right True -> return $ format stmts

74− Right False -> infixes stmts

75−

76− format = Map.fromList . map (\(lvl,assoc,op) -> (op, (lvl,assoc)))

77−

78−

7943setupParser :: IParser a -> String -> Either [P.Doc] a

8044setupParser p source =

81− case iParse p source of

45+ case iParse p "" source of

8246 Right result -> Right result

8347 Left err -> Left [ P.text $ "Parse error at " ++ show err ]

compiler/SourceSyntax/Module.hs+5−17

@@ -41,23 +41,11 @@ type Interfaces = Map.Map String ModuleInterface

4141type ADT = (String, [String], [(String,[Type])])

4242

4343data ModuleInterface = ModuleInterface {

44− iTypes :: Map.Map String Type,

45− iAdts :: [ADT],

46− iAliases :: [(String, [String], Type)],

47− iFixities :: [(Assoc, Int, String)]

44+ iTypes :: Map.Map String Type,

45+ iAdts :: [ADT],

46+ iAliases :: [(String, [String], Type)]

4847} deriving Show

4948

5049instance Binary ModuleInterface where

51− get = ModuleInterface <$> get <*> get <*> get <*> get

52− put modul = do

53− put (iTypes modul)

54− put (iAdts modul)

55− put (iAliases modul)

56− put (iFixities modul)

57−

58−

59−instance Binary Assoc where

60− get = do n <- getWord8

61− return $ case n of { 0 -> L ; 1 -> N ; 2 -> R }

62−

63− put assoc = putWord8 $ case assoc of { L -> 0 ; N -> 1 ; R -> 2 }

50+ put modul = put (iTypes modul) >> put (iAdts modul) >> put (iAliases modul)

51+ get = ModuleInterface <$> get <*> get <*> get

compiler/Transform/Canonicalize.hs+4−5

@@ -18,11 +18,10 @@ import Text.PrettyPrint as P

1818

1919interface :: String -> ModuleInterface -> ModuleInterface

2020interface moduleName iface =

21− ModuleInterface

22− { iTypes = Map.mapKeys prefix (Map.map renameType' (iTypes iface))

23− , iAdts = map (both prefix renameCtors) (iAdts iface)

24− , iAliases = map (both prefix renameType') (iAliases iface)

25− , iFixities = iFixities iface -- cannot have canonicalized operators while parsing

21+ ModuleInterface {

22+ iTypes = Map.mapKeys prefix (Map.map renameType' (iTypes iface)),

23+ iAdts = map (both prefix renameCtors) (iAdts iface),

24+ iAliases = map (both prefix renameType') (iAliases iface)

2625 }

2726 where

2827 both f g (a,b,c) = (f a, b, g c)