df9ebcf · elk · git.iko.soy

git.iko.soy/elk

Merge branch 'dev' into topic/best_practice_webgl

commitdf9ebcf67bf5d49d0c8c09da3e89fbb2ea411590 authorJohn P Mayer Jr <john.p.mayer.jr@gmail.com> dateFri 15 Nov 2013, 05:26 (13 years ago) parentaacd30a bbede87

11 files changed+70−42

compare with master

unifiedsplit

compiler/Compiler.hs+8−4 compiler/Initialize.hs+10−11 compiler/Language/Elm.hs+16−6 compiler/Metadata/Prelude.hs+2−5 compiler/Parse/Helpers.hs+10−2 compiler/SourceSyntax/Declaration.hs+4−3 compiler/SourceSyntax/Location.hs+1−1 compiler/SourceSyntax/Module.hs+6−1 compiler/SourceSyntax/Type.hs+2−1 compiler/Transform/SortDefinitions.hs+10−5 compiler/Type/Type.hs+1−3

compiler/Compiler.hs+8−4

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

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

185185build flags rootFile = do

186186 let noPrelude = no_prelude flags

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

188− else return [rootFile]

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

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

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

188+

189+ files <- if make flags

190+ then getSortedDependencies (src_dir flags) builtIns rootFile

191+ else return [rootFile]

192+

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

194+

191195 js <- foldM appendToOutput BS.empty files

192196

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

compiler/Initialize.hs+10−11

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

6363 return $ metaModule { types = types }

6464

6565

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

67−getSortedDependencies srcDirs noPrelude root =

68− sortDeps =<< readDeps srcDirs noPrelude root

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

67+getSortedDependencies srcDirs builtIns root =

68+ sortDeps =<< readDeps srcDirs builtIns root

6969

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

7171

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

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

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

8282

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

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

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

84+readDeps srcDirs builtIns root = do

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

86+ evalStateT (go ifaces root) Set.empty

8587 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]

90− go root = do

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

89+ go builtIns root = do

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

9291 case Parse.dependencies txt of

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

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

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

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

10099 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)

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

103102

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

compiler/Language/Elm.hs+16−6

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

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

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

77-}

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

916

1017import qualified Data.List as List

1118import qualified Data.Map as Map

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

2128

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

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

24−compile :: String -> Either String String

25−compile source =

26− case buildFromSource False Prelude.interfaces source of

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

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

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

32+compile ifaces source = do

33+ case buildFromSource False ifaces source of

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

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

36+

37+interfaces :: IO Interfaces

38+interfaces = Prelude.interfaces

2939

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

3141moduleName :: String -> Maybe String

compiler/Metadata/Prelude.hs+2−5

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

77import System.Exit

88import System.FilePath

99import System.IO

10−import System.IO.Unsafe (unsafePerformIO)

1110import SourceSyntax.Module

1211import qualified Data.Binary as Binary

1312import qualified Data.ByteString.Lazy as BS

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

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

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

3332

34−{-# NOINLINE interfaces #-}

35−interfaces :: Interfaces

36−interfaces =

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

33+interfaces :: IO Interfaces

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

3835

3936safeReadDocs :: FilePath -> IO Interfaces

4037safeReadDocs name =

compiler/Parse/Helpers.hs+10−2

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

1414import SourceSyntax.Declaration (Assoc)

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

1616import Text.Parsec.Indent

17+import Text.Read (readMaybe)

1718

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

1920 , "case", "of"

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

5051 runIndent sourceName $ runParserT aParser table sourceName input

5152

5253backslashed :: IParser Char

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

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

54+backslashed = do

55+ char '\\'

56+ c <- anyChar

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

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] ++ "\""

5563

5664var :: IParser String

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

compiler/SourceSyntax/Declaration.hs+4−3

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

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

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

4545

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

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

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

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

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

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

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

compiler/SourceSyntax/Location.hs+1−1

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

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

5454

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

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

56+ show (L _ e) = show e

5757

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

5959 pretty (L _ e) = pretty e

compiler/SourceSyntax/Module.hs+6−1

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

4242 0 -> liftM As get

4343 1 -> liftM Importing get

4444 2 -> liftM Hiding get

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

4546

4647data MetadataModule t v = MetadataModule {

4748 names :: [String],

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

8384

8485instance Binary Assoc where

8586 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"

8792

8893 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

9393 1 -> Var <$> get

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

9595 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) =

120120 mapM free (ctors pattern)

121121

122122 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−

128123 L _ let' = foldr addDefs body' defss

129124

130125 return let'

131126

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." ]

132137

133138reorderField (label, expr) =

134139 (,) label `liftM` reorder expr

compiler/Type/Type.hs+1−3

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

370370 case name desc of

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

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

373− Nothing ->

374− error $ concat

373+ _ -> error $ concat

375374 [ "Problem converting the following type "

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

377376 , P.render (pretty Never variable) ]

378377

379−

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

381379

382380collectApps :: Variable -> IO AppStructure