294fdfd · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Add prelude in compiler with flag. Re-add the `hiding` option for modules internally.

294fdfdevancz14 years ago

compiler/Compiler.hs+14−3

compare with master

unifiedsplit

@@ -2,7 +2,7 @@

2module Main where

4import Data.Either (lefts, rights)

5−import Data.List (intersect, intercalate)

5+import Data.List (intersect, intercalate,lookup)

6import Data.Maybe (fromMaybe)

7import Data.Version (showVersion)

8import System.Console.CmdArgs

@@ -78,8 +78,6 @@ fileTo flags what rtLoc file = do

78 let path = fromMaybe "" (output_directory flags) </> file

79 js = replaceExtension path ".js"

80 html = replaceExtension path ".html"

81− addPrelude (Module name exs ims stmts) =

82− Module name exs (("Prelude", Importing []) : ims) stmts

83 ms = if no_prelude flags then ms' else map addPrelude ms'

81 ms = if no_prelude flags then ms' else map addPrelude ms'

84 txt = jss ++ concatMap jsModule ms

82 txt = jss ++ concatMap jsModule ms

85 in case what of

83 in case what of

@@ -89,3 +87,16 @@ fileTo flags what rtLoc file = do

89 Split ->

87 Split ->

90 do writeFile html . renderHtml $ linkedHtml rtLoc js ms

88 do writeFile html . renderHtml $ linkedHtml rtLoc js ms

91 writeFile js (formatJS txt)

89 writeFile js (formatJS txt)

90+

91+addPrelude (Module name exs ims stmts) = Module name exs (prelude ++ ims) stmts

92+ where prelude = concatMap addModule allModules

93+

94+ addModule (n, method) = case lookup n ims of

95+ Nothing -> [(n, method)]

96+ Just _ -> []

97+ modules = [ "Prelude", "Signal", "List", "Maybe"

98+ , "Time", "Graphics.Element", "Graphics.Color" ]

99+

100+ text = ("Graphics.Text", Hiding ["link", "color"])

101+

102+ allModules = text : map (\n -> (n, Hiding [])) modules

compiler/Gen/CompileToJS.hs+22−20

@@ -36,6 +36,7 @@ internalImports =

37parens s = "(" ++ s ++ ")"

38brackets s = "{" ++ s ++ "}"

39+jsObj = brackets . intercalate ", "

39jsList ss = "["++ intercalate "," ss ++"]"

40jsList ss = "["++ intercalate "," ss ++"]"

40jsFunc args body = "function(" ++ args ++ "){" ++ indent body ++ "}"

41jsFunc args body = "function(" ++ args ++ "){" ++ indent body ++ "}"

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

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

@@ -79,7 +80,7 @@ getExports names stmts = "\n"++ intercalate ";\n" (op : map fnPair fns)

79 opPair op = "'" ++ op ++ "' : $op['" ++ op ++ "']"

80 opPair op = "'" ++ op ++ "' : $op['" ++ op ++ "']"

80 fnPair fn = let fn' = derename fn in "_." ++ fn' ++ " = " ++ fn

81 fnPair fn = let fn' = derename fn in "_." ++ fn' ++ " = " ++ fn

82− op = ("_.$op = "++) . brackets . intercalate ", " $ map opPair ops

83+ op = ("_.$op = "++) . jsObj $ map opPair ops

84 get' (FnDef x _ _) = Left x

85 get' (FnDef x _ _) = Left x

85 get' (OpDef op _ _ _) = Right op

86 get' (OpDef op _ _ _) = Right op

@@ -94,25 +95,26 @@ getExports names stmts = "\n"++ intercalate ";\n" (op : map fnPair fns)

94jsImport (modul, how) =

95jsImport (modul, how) =

95 case how of

96 case how of

96 As name -> assign name ("Elm." ++ modul ++ parens "elm")

97 As name -> assign name ("Elm." ++ modul ++ parens "elm")

97− Importing vs ->

98+ Hiding vs -> include ++ " var hiding=" ++ (jsObj $ map (++":1") vs) ++

98− "\nvar $ = Elm." ++ modul ++ parens "elm" ++ ";" ++ setup modul ++

99+ "; for(var k in _){if(k in hiding)continue;" ++

99− if null vs then "\nfor (var k in $) {eval('var '+k+'=$[\"'+k+'\"]')}"

100+ "eval('var '+k+'=_[\"'+k+'\"]')}"

100− else "\nvar " ++ intercalate ", " (map def vs) ++ ";"

101+ Importing vs -> include ++ "\nvar " ++ intercalate ", " (map def vs) ++ ";"

102+ where

103+ imprt v = assign' v ("_." ++ v)

104+ def (o:p) = imprt (if isOp o then "$op['" ++ o:p ++ "']" else deprime (o:p))

105+ where

106+ include = "\nvar _ = Elm." ++ modul ++ parens "elm" ++ ";" ++ setup modul

107+ setup moduleName = " var " ++ concatMap (++";") (defs ++ [assign' moduleName "_"])

101 where

108 where

102− imprt v = assign' v ("$." ++ v)

103− def (o:p) = imprt (if isOp o then "$op['" ++ o:p ++ "']" else deprime (o:p))

104− setup moduleName =

105− "\nvar " ++ concatMap (++";") (defs ++ [assign' moduleName "$"])

106− where

107− defs = map (\n -> assign' n (n ++ "||{}")) (subnames moduleName)

109+ defs = map (\n -> assign' n (n ++ "||{}")) (subnames moduleName)

108− subnames = map (intercalate ".") . tail . inits . init . split

110+ subnames = map (intercalate ".") . tail . inits . init . split

109− split names = case go [] names of

111+ split names = case go [] names of

110− (name, []) -> [name]

112+ (name, []) -> [name]

111− (name, ns) -> name : split ns

113+ (name, ns) -> name : split ns

112− go name str = case str of

114+ go name str = case str of

113− '.':rest -> (reverse name, rest)

115+ '.':rest -> (reverse name, rest)

114− c:rest -> go (c:name) rest

116+ c:rest -> go (c:name) rest

115− [] -> (reverse name, [])

117+ [] -> (reverse name, [])

116

118

117

119

118

120

@@ -226,7 +228,7 @@ instance ToJS Expr where

226 return $ case name of

228 return $ case name of

227 "Nil" -> jsNil

229 "Nil" -> jsNil

228 "Cons" -> jsCons (head fs) ((head . tail) fs)

230 "Cons" -> jsCons (head fs) ((head . tail) fs)

229− _ -> brackets $ "ctor:" ++ show name ++ concatMap (", "++) fields

231+ _ -> jsObj $ ("ctor:" ++ show name) : fields

230 where fields = zipWith (\n e -> "_" ++ show n ++ ":" ++ e) [0..] fs

232 where fields = zipWith (\n e -> "_" ++ show n ++ ":" ++ e) [0..] fs

231

233

232 Markdown doc -> return $ "text('" ++ pad ++ md ++ pad ++ "')"

234 Markdown doc -> return $ "text('" ++ pad ++ md ++ pad ++ "')"

compiler/Model/Ast.hs+1−1

@@ -12,7 +12,7 @@ data Module = Module [String] Exports Imports [Statement]

12type Exports = [String]

14type Imports = [(String, ImportMethod)]

15−data ImportMethod = As String | Importing [String]

15+data ImportMethod = As String | Importing [String] | Hiding [String]

16 deriving (Eq,Ord)

compiler/Parse/Modules.hs+1−1

@@ -31,7 +31,7 @@ import' = do

31 reserved "import"

32 whitespace

33 name <- intercalate "." <$> dotSep1 capVar

34− method <- option (Importing []) $ try (whitespace >> (as' <|> importing'))

34+ method <- option (Hiding []) $ try (whitespace >> (as' <|> importing'))

35 return (name, method)