df9ebcf · elk · git.iko.soy

compiler/Compiler.hs+8−4

compare with master

unifiedsplit

@@ -184,10 +184,14 @@ getRuntime flags =

184build :: Flags -> FilePath -> IO ()

185build flags rootFile = do

186 let noPrelude = no_prelude flags

187+ builtIns <- if noPrelude then return Map.empty else Prelude.interfaces

188+

189+ files <- if make flags

187− files <- if make flags then getSortedDependencies (src_dir flags) noPrelude rootFile

190+ then getSortedDependencies (src_dir flags) builtIns rootFile

188− else return [rootFile]

191+ else return [rootFile]

189− let ifaces = if noPrelude then Map.empty else Prelude.interfaces

192+

190− (moduleName, interfaces) <- buildFiles flags (length files) ifaces "" files

193+ (moduleName, interfaces) <- buildFiles flags (length files) builtIns "" files

194+

191 js <- foldM appendToOutput BS.empty files

195 js <- foldM appendToOutput BS.empty files

192

196

193 (extension, code) <- case only_js flags of

197 (extension, code) <- case only_js flags of

compiler/Initialize.hs+10−11

@@ -63,9 +63,9 @@ buildFromSource noPrelude interfaces source =

63 return $ metaModule { types = types }

64

65

66−getSortedDependencies :: [FilePath] -> Bool -> FilePath -> IO [String]

66+getSortedDependencies :: [FilePath] -> Interfaces -> FilePath -> IO [String]

67−getSortedDependencies srcDirs noPrelude root =

67+getSortedDependencies srcDirs builtIns root =

68− sortDeps =<< readDeps srcDirs noPrelude root

68+ sortDeps =<< readDeps srcDirs builtIns root

69

70type Deps = (FilePath, String, [String])

71

@@ -80,14 +80,13 @@ sortDeps depends =

80 mistakes = filter (\scc -> length scc > 1) sccs

81 msg = "A cyclical module dependency or was detected in: "

82

83−readDeps :: [FilePath] -> Bool -> FilePath -> IO [Deps]

83+readDeps :: [FilePath] -> Interfaces -> FilePath -> IO [Deps]

84+readDeps srcDirs builtIns root = do

85+ let ifaces = (Set.fromList . Map.keys) builtIns

84−readDeps srcDirs noPrelude root = evalStateT (go root) Set.empty

86+ evalStateT (go ifaces root) Set.empty

85 where

87 where

86− builtIns = if noPrelude then Set.empty

87− else Set.fromList (Map.keys Prelude.interfaces)

88−

89− go :: FilePath -> StateT (Set.Set String) IO [Deps]

88+ go :: Set.Set String -> FilePath -> StateT (Set.Set String) IO [Deps]

90− go root = do

89+ go builtIns root = do

91 (root', txt) <- liftIO $ getFile srcDirs root

90 (root', txt) <- liftIO $ getFile srcDirs root

92 case Parse.dependencies txt of

91 case Parse.dependencies txt of

93 Left err -> liftIO (putStrLn msg >> print err >> exitFailure)

92 Left err -> liftIO (putStrLn msg >> print err >> exitFailure)

@@ -98,7 +97,7 @@ readDeps srcDirs noPrelude root = evalStateT (go root) Set.empty

98 let realDeps = Set.difference (Set.fromList deps) builtIns

97 let realDeps = Set.difference (Set.fromList deps) builtIns

99 newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen

98 newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen

100 put (Set.insert name (Set.union newDeps seen))

99 put (Set.insert name (Set.union newDeps seen))

101− rest <- mapM (go . toFilePath) (Set.toList newDeps)

100+ rest <- mapM (go builtIns . toFilePath) (Set.toList newDeps)

102 return ((makeRelative "." root', name, Set.toList realDeps) : concat rest)

101 return ((makeRelative "." root', name, Set.toList realDeps) : concat rest)

103

102

104getFile :: [FilePath] -> FilePath -> IO (FilePath,String)

103getFile :: [FilePath] -> FilePath -> IO (FilePath,String)

compiler/Language/Elm.hs+16−6

@@ -5,7 +5,14 @@

5 <http://elm-lang.org/Documentation.elm>, and many interactive examples are

6 available at <http://elm-lang.org/Examples.elm>

7-}

8−module Language.Elm (compile, moduleName, runtime, docs) where

8+module Language.Elm ( compile

9+ , interfaces

10+ , moduleName

11+ , runtime

12+ , docs

13+ , Interfaces

14+ , ModuleInterface )

15+where

9

16

10import qualified Data.List as List

17import qualified Data.List as List

11import qualified Data.Map as Map

18import qualified Data.Map as Map

@@ -21,11 +28,14 @@ import Paths_Elm

21

28

22-- |This function compiles Elm code to JavaScript. It will return either

29-- |This function compiles Elm code to JavaScript. It will return either

23-- an error message or the compiled JS code.

30-- an error message or the compiled JS code.

24−compile :: String -> Either String String

31+compile :: Interfaces -> String -> Either String String

25−compile source =

32+compile ifaces source = do

26− case buildFromSource False Prelude.interfaces source of

33+ case buildFromSource False ifaces source of

27− Left docs -> Left . unlines . List.intersperse "" $ map P.render docs

34+ Left docs -> Left . unlines . List.intersperse "" $ map P.render docs

28− Right modul -> Right $ jsModule (modul :: MetadataModule () ())

35+ Right modul -> Right $ jsModule (modul :: MetadataModule () ())

36+

37+interfaces :: IO Interfaces

38+interfaces = Prelude.interfaces

29

39

30-- |This function extracts the module name of a given source program.

40-- |This function extracts the module name of a given source program.

31moduleName :: String -> Maybe String

41moduleName :: String -> Maybe String

compiler/Metadata/Prelude.hs+2−5

@@ -7,7 +7,6 @@ import System.Directory

7import System.Exit

8import System.FilePath

9import System.IO

10−import System.IO.Unsafe (unsafePerformIO)

11import SourceSyntax.Module

10import SourceSyntax.Module

12import qualified Data.Binary as Binary

11import qualified Data.Binary as Binary

13import qualified Data.ByteString.Lazy as BS

12import qualified Data.ByteString.Lazy as BS

@@ -31,10 +30,8 @@ prelude = text ++ map (\n -> (n, Hiding [])) modules

31 modules = [ "Basics", "Signal", "List", "Maybe", "Time", "Prelude"

30 modules = [ "Basics", "Signal", "List", "Maybe", "Time", "Prelude"

32 , "Graphics.Element", "Color", "Graphics.Collage" ]

31 , "Graphics.Element", "Color", "Graphics.Collage" ]

33

32

34−{-# NOINLINE interfaces #-}

35−interfaces :: Interfaces

33+interfaces :: IO Interfaces

36−interfaces =

37− unsafePerformIO (safeReadDocs =<< Path.getDataFileName "interfaces.data")

34+interfaces = safeReadDocs =<< Path.getDataFileName "interfaces.data"

38

35

39safeReadDocs :: FilePath -> IO Interfaces

36safeReadDocs :: FilePath -> IO Interfaces

40safeReadDocs name =

37safeReadDocs name =

compiler/Parse/Helpers.hs+10−2

@@ -14,6 +14,7 @@ import SourceSyntax.PrettyPrint

14import SourceSyntax.Declaration (Assoc)

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

16import Text.Parsec.Indent

17+import Text.Read (readMaybe)

17

18

18reserveds = [ "if", "then", "else"

19reserveds = [ "if", "then", "else"

19 , "case", "of"

20 , "case", "of"

@@ -50,8 +51,15 @@ iParseWithTable sourceName table aParser input =

50 runIndent sourceName $ runParserT aParser table sourceName input

51 runIndent sourceName $ runParserT aParser table sourceName input

51

52

52backslashed :: IParser Char

53backslashed :: IParser Char

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

54+backslashed = do

55+ char '\\'

56+ c <- anyChar

57+ case readMaybe ['\'','\\',c,'\''] of

54− ; return . read $ ['\'','\\',c,'\''] }

58+ Just chr -> return chr

59+ Nothing ->

60+ fail $ "Did not recognize character '\\" ++ [c] ++

61+ "'. If the backslash is meant to be a character of its own, " ++

62+ "it should be escaped like this: \"\\\\" ++ [c] ++ "\""

55

63

56var :: IParser String

64var :: IParser String

57var = makeVar (letter <|> char '_' <?> "variable")

65var = makeVar (letter <|> char '_' <?> "variable")

compiler/SourceSyntax/Declaration.hs+4−3

@@ -43,6 +43,7 @@ instance Pretty (Declaration t v) where

43 let alias = P.text name <+> P.hsep (map P.text tvars) in

44 P.hang (P.text "type" <+> alias <+> P.equals) 4 (pretty tipe)

45

46− -- TODO: actually write out the other cases. They are currently unused, but

46+ -- TODO: Actually write out the contained data in these cases.

47− -- this is probably going to be a bug someday.

47+ ImportEvent _ _ _ _ -> P.text (show decl)

48+ ExportEvent _ _ _ -> P.text (show decl)

48− _ -> P.text (show decl)

49+ Fixity _ _ _ -> P.text (show decl)

compiler/SourceSyntax/Location.hs+1−1

@@ -53,7 +53,7 @@ instance Show SrcSpan where

53 show (column start) ++ " to " ++ show (column end)

54

55instance Show e => Show (Located e) where

56− show (L s e) = "L (" ++ show s ++ ") (" ++ show e ++ ")"

56+ show (L _ e) = show e

57

58instance Pretty a => Pretty (Located a) where

59 pretty (L _ e) = pretty e

compiler/SourceSyntax/Module.hs+6−1

@@ -42,6 +42,7 @@ instance Binary ImportMethod where

42 0 -> liftM As get

43 1 -> liftM Importing get

44 2 -> liftM Hiding get

45+ _ -> error "Error reading valid ImportMethod type from serialized string"

45

46

46data MetadataModule t v = MetadataModule {

47data MetadataModule t v = MetadataModule {

47 names :: [String],

48 names :: [String],

@@ -83,6 +84,10 @@ instance Binary ModuleInterface where

83

84

84instance Binary Assoc where

85instance Binary Assoc where

85 get = do n <- getWord8

86 get = do n <- getWord8

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

87+ return $ case n of

88+ 0 -> L

89+ 1 -> N

90+ 2 -> R

91+ _ -> error "Error reading valid associativity from serialized string"

87

92

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

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

compiler/SourceSyntax/Type.hs+2−1

@@ -93,4 +93,5 @@ instance Binary Type where

93 1 -> Var <$> get

94 2 -> Data <$> get <*> get

95 3 -> return EmptyRecord

96− 4 -> Record <$> get <*> get

96+ 4 -> Record <$> get <*> get

97+ _ -> error "Error reading a valid type from serialized string"

compiler/Transform/SortDefinitions.hs+10−5

@@ -120,15 +120,20 @@ reorder lexpr@(L s expr) =

120 mapM free (ctors pattern)

121

122 let addDefs ds bod = L s (Let (concatMap toDefs ds) bod)

123− where

124− toDefs (pattern, expr, Nothing) = [ Def pattern expr ]

125− toDefs (PVar name, expr, Just tipe) =

126− [ TypeAnnotation name tipe, Def (PVar name) expr ]

127−

128 L _ let' = foldr addDefs body' defss

123 L _ let' = foldr addDefs body' defss

129

124

130 return let'

125 return let'

131

126

127+ where

128+ toDefs def =

129+ case def of

130+ (pattern, expr, Nothing) -> [ Def pattern expr ]

131+ (PVar name, expr, Just tipe) ->

132+ [ TypeAnnotation name tipe, Def (PVar name) expr ]

133+ _ -> error $ unlines

134+ [ "The impossible occurred."

135+ , "Please report an issue at <https://github.com/evancz/Elm/issues>."

136+ , "Be very descriptive because something quite weird probably happened." ]

132

137

133reorderField (label, expr) =

138reorderField (label, expr) =

134 (,) label `liftM` reorder expr

139 (,) label `liftM` reorder expr

compiler/Type/Type.hs+1−3

@@ -370,13 +370,11 @@ toSrcType variable = do

370 case name desc of

371 Just x@(c:cs) | Char.isLower c -> return (Src.Var x)

372 | otherwise -> return (Src.Data x [])

373− Nothing ->

374− error $ concat

373+ _ -> error $ concat

375 [ "Problem converting the following type "

374 [ "Problem converting the following type "

376 , "from a type-checker type to a source-syntax type:"

375 , "from a type-checker type to a source-syntax type:"

377 , P.render (pretty Never variable) ]

376 , P.render (pretty Never variable) ]

378

377

379−

380data AppStructure = List Variable | Tuple [Variable] | Other

378data AppStructure = List Variable | Tuple [Variable] | Other

381

379

382collectApps :: Variable -> IO AppStructure

380collectApps :: Variable -> IO AppStructure