5d536d1 · elk · git.iko.soy

compiler/Compiler.hs+3−2

compare with master

unifiedsplit

@@ -68,9 +68,10 @@ data What = JS | HTML | Split

68fileTo flags what rtLoc file = do

69 let jsStyle = if minify flags then Minified else Readable

70 formatJS = if minify flags then BS.unpack . JS.minify . BS.pack else id

71+ prelude = not (no_prelude flags)

71− ems <- if make flags then build file

72+ ems <- if make flags then build prelude file

72 else do src <- readFile file

73 else do src <- readFile file

73− return (fmap (:[]) (buildFromSource src))

74+ return (fmap (:[]) (buildFromSource prelude src))

74 jss <- concat `fmap` mapM readFile (import_js flags)

75 jss <- concat `fmap` mapM readFile (import_js flags)

75 case ems of

76 case ems of

76 Left err -> do putStrLn $ "Error while compiling " ++ file ++ ":\n" ++ err

77 Left err -> do putStrLn $ "Error while compiling " ++ file ++ ":\n" ++ err

compiler/Gen/GenerateHtml.hs+6−4

@@ -15,9 +15,10 @@ import Text.Jasmine (minify)

15import qualified Data.ByteString.Lazy.Char8 as BS

16

17import Ast

18−import Initialize

18+import Initialize (buildFromSource)

19import CompileToJS

20import ExtractNoscript

21+import Libraries as Libraries

21

22

22data JSStyle = Minified | Readable

23data JSStyle = Minified | Readable

23

24

@@ -40,9 +41,10 @@ generateHtml :: String -- ^ Location of elm-runtime.js as expected by the browse

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

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

41 -> Html

42 -> Html

42generateHtml libLoc title source =

43generateHtml libLoc title source =

43− case buildFromSource source of

44+ case buildFromSource True source of

45+ Right modul -> modulesToHtml Readable title libLoc [] True [modul]

44− Left err -> createHtml Readable libLoc title (Right $ showErr err) (H.noscript "") "Elm.Main"

46+ Left err -> createHtml Readable libLoc title (Right $ showErr err)

45− Right modul -> modulesToHtml Readable title libLoc [] True [modul]

47+ (H.noscript "") "Elm.Main"

46

48

47

49

48modulesToHtml jsStyle title libLoc jss nscrpt modules =

50modulesToHtml jsStyle title libLoc jss nscrpt modules =

compiler/Initialize.hs+11−10

@@ -10,7 +10,7 @@ import Data.Either (lefts,rights)

10import Data.List (intercalate,partition)

11import Parse.Parser (parseProgram, preParse)

12import Rename

13−import Libraries (libraries)

13+import qualified Libraries as Libs

14import Types.Types ((-:))

15import Types.Hints (hints)

16import Types.Unify

@@ -32,29 +32,30 @@ checkTypes modul =

32check :: Module -> Either String Module

33check = checkMistakes >=> checkTypes

34

35−buildFromSource :: String -> Either String Module

35+buildFromSource :: Bool -> String -> Either String Module

36−buildFromSource src = check =<< parseProgram src

36+buildFromSource withPrelude src = (check . add) =<< (parseProgram src)

37+ where add = if withPrelude then Libs.addPrelude else id

37

38

38−build :: FilePath -> IO (Either String [Module])

39+build :: Bool -> FilePath -> IO (Either String [Module])

39−build root = do

40+build withPrelude root = do

40 names <- getSortedModuleNames root

41 names <- getSortedModuleNames root

41 case names of

42 case names of

42 Left err -> return (Left err)

43 Left err -> return (Left err)

43 Right ns -> do srcs <- zipWithM buildFile' [1..] ns

44 Right ns -> do srcs <- zipWithM buildFile' [1..] ns

44 return (sequence srcs)

45 return (sequence srcs)

45 where

46 where

46− buildFile' n name = putStrLn (msg n name) >> buildFile name

47+ buildFile' n name = putStrLn (msg n name) >> buildFile withPrelude name

47 msg n name = "["++show n++" of "++show (length ns)++"] Compiling "++name

48 msg n name = "["++show n++" of "++show (length ns)++"] Compiling "++name

48

49

49−buildFile :: String -> IO (Either String Module)

50+buildFile :: Bool -> String -> IO (Either String Module)

50−buildFile moduleName =

51+buildFile withPrelude moduleName =

51 let filePath = toFilePath moduleName in

52 let filePath = toFilePath moduleName in

52 case isNative moduleName of

53 case isNative moduleName of

53 True -> return (Right $ Module [moduleName] [] [] [])

54 True -> return (Right $ Module [moduleName] [] [] [])

54 --return (Left "Can't do that yet")

55 --return (Left "Can't do that yet")

55 --Right `liftM` readFile filePath

56 --Right `liftM` readFile filePath

56 False -> do txt <- readFile filePath

57 False -> do txt <- readFile filePath

57− return $ buildFromSource txt

58+ return $ buildFromSource withPrelude txt

58

59

60

60getSortedModuleNames :: FilePath -> IO (Either String [String])

61getSortedModuleNames :: FilePath -> IO (Either String [String])

@@ -87,7 +88,7 @@ readDeps seen root = do

87 where realDeps = filter (`notElem` builtIns) deps

88 where realDeps = filter (`notElem` builtIns) deps

88 newDeps = filter (`notElem` seen) realDeps

89 newDeps = filter (`notElem` seen) realDeps

89 seen' = root : seen ++ newDeps

90 seen' = root : seen ++ newDeps

90− builtIns = Map.keys libraries

91+ builtIns = Map.keys Libs.libraries

91

92

92isNative name = takeWhile (/='.') name == "Native"

93isNative name = takeWhile (/='.') name == "Native"

93toFilePath name = map swapDots name ++ ext

94toFilePath name = map swapDots name ++ ext

compiler/Language/Elm.hs+3−7

@@ -28,21 +28,17 @@ import ExtractNoscript

28import GenerateHtml

29import Initialize

30import Text.Blaze.Html (Html)

31−import Language.Elm.Quasi

32import Paths_Elm

31import Paths_Elm

33

32

34−import qualified Data.Text as TS

35−import qualified Data.Text.Lazy as TL

36−

37-- |This function compiles Elm code to JavaScript.

33-- |This function compiles Elm code to JavaScript.

38compile :: String -> String

34compile :: String -> String

39−compile source = either showErr (jsModule . Libraries.addPrelude) modul

35+compile source = either showErr jsModule modul

40− where modul = buildFromSource source

36+ where modul = buildFromSource True source

41

37

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

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

43moduleName :: String -> String

39moduleName :: String -> String

44moduleName source = either (const "Main") getName modul

40moduleName source = either (const "Main") getName modul

45− where modul = buildFromSource source

41+ where modul = buildFromSource False source

46 getName (Ast.Module names _ _ _) = intercalate "." names

42 getName (Ast.Module names _ _ _) = intercalate "." names

47

43

48-- |This function compiles Elm code into a full HTML page.

44-- |This function compiles Elm code into a full HTML page.

compiler/Model/Libraries.hs+20−10

@@ -6,8 +6,13 @@ import Data.List (inits)

6import Text.JSON

7import LoadLibraries (docs)

8

9+import System.IO.Unsafe

9

10

11+addPrelude :: Module -> Module

12+addPrelude (Module name exs ims stmts) =

13+ unsafePerformIO $ do

14+ mapM print $ customIms ++ ims

10−addPrelude (Module name exs ims stmts) = Module name exs (customIms ++ ims) stmts

15+ return $ Module name exs (customIms ++ ims) stmts

11 where customIms = concatMap addModule prelude

16 where customIms = concatMap addModule prelude

12

17

13 addModule (n, method) = case lookup n ims of

18 addModule (n, method) = case lookup n ims of

@@ -23,15 +28,20 @@ prelude = text : map (\n -> (n, Hiding [])) modules

23 , "Graphics.Collage", "Graphics.Geometry" ]

28 , "Graphics.Collage", "Graphics.Geometry" ]

24

29

25libraries :: Map.Map String (Map.Map String String)

30libraries :: Map.Map String (Map.Map String String)

31+libraries =

26−libraries = case getLibs of

32+ case getLibs of

27− Error err -> error err

33+ Error err -> error err

28− Ok libs -> Map.unionWith Map.union libs nilAndTuples

34+ Ok libs -> Map.unionWith Map.union libs nilAndTuples

29− where nilAndTuples = Map.singleton "Prelude" (Map.fromList pairs)

35+ where nilAndTuples = Map.singleton "Prelude" (Map.fromList pairs)

36+ pairs =

37+ [ ("Cons", "a -> [a] -> [a]")

38+ , ("Nil", "[a]")

30− pairs = ("Nil", "List a") : map makeTuple (inits ['a'..'i'])

39+ ] ++ map makeTuple (inits ['a'..'i'])

40+

31− makeTuple cs =

41+ makeTuple cs =

32− let name = "Tuple" ++ show (length cs)

42+ let name = "Tuple" ++ show (length cs)

33− in (name, concatMap (\c -> c : " -> ") cs ++

43+ in (name, concatMap (\c -> c : " -> ") cs ++

34− name ++ concatMap (\c -> [' ',c]) cs)

44+ name ++ concatMap (\c -> [' ',c]) cs)

35

45

36getLibs :: Result (Map.Map String (Map.Map String String))

46getLibs :: Result (Map.Map String (Map.Map String String))

37getLibs = do

47getLibs = do

compiler/Types/Hints.hs+4−1

@@ -12,8 +12,11 @@ import Types.Types

12hints :: GuidCounter [(String, Scheme)]

13hints = mapM toScheme values

14 where

15− addPrefixes = concatMap (\(m,vs) -> map (first (\n -> m ++ "." ++ n)) vs)

15+

16 values = addPrefixes (Map.toList (Map.map Map.toList libraries))

17+

18+ addPrefixes = concatMap (\(m,vs) -> map (first (\n -> m ++ "." ++ n)) vs)

19+

17 toScheme (name, tipeString) =

20 toScheme (name, tipeString) =

18 case iParse (fmap toType typeExpr) "parsing types in docs.json" tipeString of

21 case iParse (fmap toType typeExpr) "parsing types in docs.json" tipeString of

19 Left err -> error (show err)

22 Left err -> error (show err)

compiler/Types/Substitutions.hs+5−5

@@ -113,11 +113,11 @@ superize name tipe =

113 EmptyRecord -> return t

114 Super _ -> return t

115 VarT _ -> return t

116− LambdaT t1 t2 -> liftM2 LambdaT (go t1) (go t2)

116+ LambdaT t1 t2 -> liftM2 LambdaT (go t1) (go t2)

117− ADT "Number" [] -> liftM VarT number

117+ ADT "Number" [] -> liftM VarT number

118− ADT "Appendable" [] -> liftM VarT append

118+ ADT "Appendable" [t] -> liftM VarT append

119− ADT name ts -> liftM (ADT name) (mapM go ts)

119+ ADT name ts -> liftM (ADT name) (mapM go ts)

120− RecordT fs t -> liftM2 RecordT fs' (go t)

120+ RecordT fs t -> liftM2 RecordT fs' (go t)

121 where pairs = Map.toList fs

122 fs' = do ps <- mapM (\(f,t) -> liftM ((,) f) (mapM go t)) pairs

123 return (Map.fromList ps)