171f199 · elk · git.iko.soy

Elm.cabal+2−3

compare with master

unifiedsplit

@@ -39,7 +39,6 @@ Library

39 Hs-Source-Dirs: compiler

40 other-modules: SourceSyntax.Declaration,

41 SourceSyntax.Expression,

42− SourceSyntax.Everything,

43 SourceSyntax.Helpers,

42 SourceSyntax.Helpers,

44 SourceSyntax.Literal,

43 SourceSyntax.Literal,

45 SourceSyntax.Location,

44 SourceSyntax.Location,

@@ -54,6 +53,7 @@ Library

54 Generate.Cases,

53 Generate.Cases,

55 Transform.Canonicalize,

54 Transform.Canonicalize,

56 Transform.Check,

55 Transform.Check,

56+ Transform.SafeNames,

57 Transform.SortDefinitions,

58 Transform.Substitute,

59 Transform.Optimize,

@@ -117,7 +117,6 @@ Executable elm

117 Hs-Source-Dirs: compiler

118 other-modules: SourceSyntax.Declaration,

119 SourceSyntax.Expression,

120− SourceSyntax.Everything,

121 SourceSyntax.Helpers,

120 SourceSyntax.Helpers,

122 SourceSyntax.Literal,

121 SourceSyntax.Literal,

123 SourceSyntax.Location,

122 SourceSyntax.Location,

@@ -132,6 +131,7 @@ Executable elm

132 Generate.Cases,

131 Generate.Cases,

133 Transform.Canonicalize,

132 Transform.Canonicalize,

134 Transform.Check,

133 Transform.Check,

134+ Transform.SafeNames,

135 Transform.SortDefinitions,

136 Transform.Substitute,

137 Transform.Optimize,

@@ -193,7 +193,6 @@ Executable elm-doc

193 Main-is: Docs.hs

194 Hs-Source-Dirs: compiler

195 other-modules: SourceSyntax.Declaration,

196− SourceSyntax.Everything,

197 SourceSyntax.Expression,

196 SourceSyntax.Expression,

198 SourceSyntax.Helpers,

197 SourceSyntax.Helpers,

199 SourceSyntax.Literal,

198 SourceSyntax.Literal,

compiler/Build/Dependencies.hs+3−3

@@ -18,7 +18,7 @@ import System.FilePath as FP

18import System.IO

19import Text.PrettyPrint (Doc)

20

21−import SourceSyntax.Everything

21+import qualified SourceSyntax.Module as Module

22import qualified SourceSyntax.Type as Type

23import qualified Parse.Parse as Parse

24import qualified Metadata.Prelude as Prelude

@@ -32,7 +32,7 @@ import qualified Elm.Internal.Name as N

32import qualified Elm.Internal.Version as V

33import qualified Elm.Internal.Dependencies as Deps

34

35−getSortedDependencies :: [FilePath] -> Interfaces -> FilePath -> IO [String]

35+getSortedDependencies :: [FilePath] -> Module.Interfaces -> FilePath -> IO [String]

36getSortedDependencies srcDirs builtIns root =

37 do extras <- extraDependencies

38 let allSrcDirs = srcDirs ++ Maybe.fromMaybe [] extras

@@ -86,7 +86,7 @@ sortDeps depends =

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

87 msg = "A cyclical module dependency or was detected in:\n"

88

89−readDeps :: [FilePath] -> Interfaces -> FilePath -> ErrorT String IO [Deps]

89+readDeps :: [FilePath] -> Module.Interfaces -> FilePath -> ErrorT String IO [Deps]

90readDeps srcDirs builtIns root = do

91 let ifaces = (Set.fromList . Map.keys) builtIns

92 State.evalStateT (go ifaces root) Set.empty

compiler/Build/Source.hs+5−3

@@ -11,7 +11,9 @@ import System.Exit

11import System.FilePath as FP

12import Text.PrettyPrint (Doc)

13

14−import SourceSyntax.Everything

14+import SourceSyntax.Declaration

15+import SourceSyntax.Module

16+import qualified SourceSyntax.Expression as Expr

15import qualified SourceSyntax.Type as Type

17import qualified SourceSyntax.Type as Type

16import qualified Parse.Parse as Parse

18import qualified Parse.Parse as Parse

17import qualified Metadata.Prelude as Prelude

19import qualified Metadata.Prelude as Prelude

@@ -38,7 +40,7 @@ build noPrelude interfaces source =

38 let exports'

40 let exports'

39 | null exs =

41 | null exs =

40 let get = Set.toList . SD.boundVars in

42 let get = Set.toList . SD.boundVars in

41− concat [ get pattern | Definition (Def pattern _) <- decls ] ++

43+ concat [ get pattern | Definition (Expr.Def pattern _) <- decls ] ++

42 concat [ map fst ctors | Datatype _ _ ctors <- decls ] ++

44 concat [ map fst ctors | Datatype _ _ ctors <- decls ] ++

43 [ name | TypeAlias name _ (Type.Record _ _) <- decls ]

45 [ name | TypeAlias name _ (Type.Record _ _) <- decls ]

44 | otherwise = exs

46 | otherwise = exs

@@ -49,7 +51,7 @@ build noPrelude interfaces source =

49 exports = exports',

51 exports = exports',

50 imports = ims,

52 imports = ims,

51 -- reorder AST into strongly connected components

53 -- reorder AST into strongly connected components

52− program = SD.sortDefs . dummyLet $ TcDecl.toExpr decls,

54+ program = SD.sortDefs . Expr.dummyLet $ TcDecl.toExpr decls,

53 types = Map.empty,

55 types = Map.empty,

54 datatypes = [ (name,vars,ctors) | Datatype name vars ctors <- decls ],

56 datatypes = [ (name,vars,ctors) | Datatype name vars ctors <- decls ],

55 fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ],

57 fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ],

compiler/Generate/JavaScript.hs+16−19

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

1−module Generate.JavaScript where

1+module Generate.JavaScript (generate) where

2

3import Control.Arrow (first,(***))

4import Control.Applicative ((<$>),(<*>))

@@ -9,31 +9,27 @@ import qualified Data.Set as Set

9

10import qualified Generate.Cases as Case

11import qualified Generate.Markdown as MD

12+import qualified SourceSyntax.Helpers as Help

13+import SourceSyntax.Literal

12−import SourceSyntax.Everything

14+import SourceSyntax.Pattern

13import SourceSyntax.Location

15import SourceSyntax.Location

16+import SourceSyntax.Expression

17+import SourceSyntax.Module

14import qualified Transform.SortDefinitions as SD

18import qualified Transform.SortDefinitions as SD

15import Language.ECMAScript3.Syntax

19import Language.ECMAScript3.Syntax

16import Language.ECMAScript3.PrettyPrint

20import Language.ECMAScript3.PrettyPrint

17−import Parse.Helpers (jsReserveds)

21+import qualified Transform.SafeNames as MakeSafe

18−

19−makeSafe :: String -> String

20−makeSafe = List.intercalate "." . map dereserve . split . deprime

21− where

22− deprime = map (\c -> if c == '\'' then '$' else c)

23− dereserve x = case Set.member x jsReserveds of

24− False -> x

25− True -> "$" ++ x

26

22

27split :: String -> [String]

23split :: String -> [String]

28split = go []

24split = go []

29 where

25 where

30 go vars str =

26 go vars str =

31 case break (=='.') str of

27 case break (=='.') str of

32− (x,'.':rest) | isOp x -> vars ++ [x ++ '.' : rest]

28+ (x,'.':rest) | Help.isOp x -> vars ++ [x ++ '.' : rest]

33 | otherwise -> go (vars ++ [x]) rest

29 | otherwise -> go (vars ++ [x]) rest

34 (x,[]) -> vars ++ [x]

30 (x,[]) -> vars ++ [x]

35

31

36−var name = Id () (makeSafe name)

32+var name = Id () name

37ref name = VarRef () (var name)

33ref name = VarRef () (var name)

38prop name = PropId () (var name)

34prop name = PropId () (var name)

39f <| x = CallExpr () f [x]

35f <| x = CallExpr () f [x]

@@ -185,7 +181,7 @@ expression (L span expr) =

185 do es' <- mapM expression es

181 do es' <- mapM expression es

186 return $ ObjectLit () (ctor : fields es')

182 return $ ObjectLit () (ctor : fields es')

187 where

183 where

188− ctor = (prop "ctor", string (makeSafe name))

184+ ctor = (prop "ctor", string name)

189 fields = zipWith (\n e -> (prop ("_" ++ show n), e)) [0..]

185 fields = zipWith (\n e -> (prop ("_" ++ show n), e)) [0..]

190

186

191 Markdown uid doc es ->

187 Markdown uid doc es ->

@@ -205,7 +201,7 @@ definition def =

205 let assign x = varDecl x expr'

201 let assign x = varDecl x expr'

206 case pattern of

202 case pattern of

207 PVar x

203 PVar x

208− | isOp x ->

204+ | Help.isOp x ->

209 let op = LBracket () (ref "_op") (string x) in

205 let op = LBracket () (ref "_op") (string x) in

210 return [ ExprStmt () $ AssignExpr () OpAssign op expr' ]

206 return [ ExprStmt () $ AssignExpr () OpAssign op expr' ]

211 | otherwise ->

207 | otherwise ->

@@ -228,7 +224,7 @@ definition def =

228

224

229 decl x n = varDecl x (dotSep ["$","_" ++ show n])

225 decl x n = varDecl x (dotSep ["$","_" ++ show n])

230 setup vars

226 setup vars

231− | isTuple name = assign "$" : vars

227+ | Help.isTuple name = assign "$" : vars

232 | otherwise = safeAssign : vars

228 | otherwise = safeAssign : vars

233

229

234 safeAssign = varDecl "$" (CondExpr () if' expr' exception)

230 safeAssign = varDecl "$" (CondExpr () if' expr' exception)

@@ -291,10 +287,11 @@ clause span variable (Case.Clause value vars mtch) =

291

287

292

288

293generate :: MetadataModule () () -> String

289generate :: MetadataModule () () -> String

294−generate modul =

290+generate unsafeModule =

295 show . prettyPrint $ setup (Just "Elm") (names modul ++ ["make"]) ++

291 show . prettyPrint $ setup (Just "Elm") (names modul ++ ["make"]) ++

296 [ assign ("Elm" : names modul ++ ["make"]) (function ["_elm"] programStmts) ]

292 [ assign ("Elm" : names modul ++ ["make"]) (function ["_elm"] programStmts) ]

297 where

293 where

294+ modul = MakeSafe.metadataModule unsafeModule

298 thisModule = dotSep ("_elm" : names modul ++ ["values"])

295 thisModule = dotSep ("_elm" : names modul ++ ["values"])

299 programStmts =

296 programStmts =

300 concat [ setup (Just "_elm") (names modul ++ ["values"])

297 concat [ setup (Just "_elm") (names modul ++ ["values"])

@@ -311,7 +308,7 @@ generate modul =

311

308

312 jsExports = assign ("_elm" : names modul ++ ["values"]) (ObjectLit () exs)

309 jsExports = assign ("_elm" : names modul ++ ["values"]) (ObjectLit () exs)

313 where

310 where

314− exs = map entry . filter (not . isOp) $ "_op" : exports modul

311+ exs = map entry . filter (not . Help.isOp) $ "_op" : exports modul

315 entry x = (PropId () (var x), ref x)

312 entry x = (PropId () (var x), ref x)

316

313

317 assign path expr =

314 assign path expr =

@@ -387,7 +384,7 @@ binop span op e1 e2 =

387 js1 = expression e1

384 js1 = expression e1

388 js2 = expression e2

385 js2 = expression e2

389

386

390− func | isOp operator = BracketRef () (dotSep (init parts ++ ["_op"])) (string operator)

387+ func | Help.isOp operator = BracketRef () (dotSep (init parts ++ ["_op"])) (string operator)

391 | otherwise = dotSep parts

388 | otherwise = dotSep parts

392 where

389 where

393 parts = split op

390 parts = split op

compiler/Generate/Noscript.hs+5−1

@@ -1,7 +1,11 @@

1module Generate.Noscript (noscript) where

2

3import Data.List (isInfixOf)

4−import SourceSyntax.Everything

4+import SourceSyntax.Declaration (Declaration(..))

5+import SourceSyntax.Expression

6+import SourceSyntax.Literal

7+import SourceSyntax.Location

8+import SourceSyntax.Module

5import qualified Generate.Markdown as MD

9import qualified Generate.Markdown as MD

6

10

7noscript :: Module t v -> String

11noscript :: Module t v -> String

compiler/Parse/Helpers.hs+4

@@ -36,6 +36,10 @@ jsReserveds = Set.fromList

36 , "const", "enum", "export", "extends", "import", "super", "implements"

37 , "interface", "let", "package", "private", "protected", "public"

38 , "static", "yield"

39+ -- reserved by the Elm runtime system

40+ , "Elm", "ElmRuntime"

41+ , "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"

42+ , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"

39 ]

43 ]

40

44

41expecting = flip (<?>)

45expecting = flip (<?>)

compiler/Parse/Pattern.hs+2−2

@@ -11,9 +11,9 @@ import Text.Parsec.Indent

11

12import Parse.Helpers

13import Parse.Literal

14+import SourceSyntax.Literal

15+import SourceSyntax.Pattern hiding (tuple, list)

14import qualified SourceSyntax.Pattern as Pattern

16import qualified SourceSyntax.Pattern as Pattern

15−import SourceSyntax.Everything hiding (tuple)

16−

17

18basic :: IParser Pattern

19basic = choice

compiler/SourceSyntax/Everything.hsdeleted−17

@@ -1,17 +0,0 @@

1−module SourceSyntax.Everything

2− (module SourceSyntax.Helpers,

3− module SourceSyntax.Location,

4− module SourceSyntax.Literal,

5− module SourceSyntax.Pattern,

6− module SourceSyntax.Expression,

7− module SourceSyntax.Declaration,

8− module SourceSyntax.Module

9− ) where

10−

11−import SourceSyntax.Helpers

12−import SourceSyntax.Location

13−import SourceSyntax.Literal

14−import SourceSyntax.Pattern hiding (tuple, list, cons, nil, prettyParens)

15−import SourceSyntax.Expression

16−import SourceSyntax.Declaration hiding (Assoc(..))

17−import SourceSyntax.Module

compiler/Transform/Check.hs+4−1

@@ -1,7 +1,10 @@

1module Transform.Check (mistakes) where

2

3import Transform.SortDefinitions (boundVars)

4−import SourceSyntax.Everything

4+import SourceSyntax.Declaration (Declaration(..))

5+import SourceSyntax.Expression

6+import SourceSyntax.Pattern

7+import SourceSyntax.Location

5import SourceSyntax.PrettyPrint

8import SourceSyntax.PrettyPrint

6import qualified SourceSyntax.Type as T

9import qualified SourceSyntax.Type as T

7import Data.List as List

10import Data.List as List

compiler/Transform/Optimize.hs+5−1

@@ -1,6 +1,10 @@

1module Transform.Optimize (optimize) where

2

3−import SourceSyntax.Everything

3+import SourceSyntax.Declaration (Declaration(..))

4+import SourceSyntax.Expression

5+import SourceSyntax.Literal

6+import SourceSyntax.Location

7+import SourceSyntax.Module

4import Control.Arrow (second, (***))

8import Control.Arrow (second, (***))

5import Data.Char (isAlpha)

9import Data.Char (isAlpha)

6

10

compiler/Transform/SafeNames.hsnew file+78

@@ -0,0 +1,78 @@

1+{-# OPTIONS_GHC -Wall #-}

2+module Transform.SafeNames (metadataModule) where

3+

4+import Control.Arrow (first, (***))

5+import SourceSyntax.Expression

6+import SourceSyntax.Location

7+import SourceSyntax.Module

8+import SourceSyntax.Pattern

9+import qualified Data.Set as Set

10+import qualified Parse.Helpers as PHelp

11+

12+var :: String -> String

13+var = dereserve . deprime

14+ where

15+ deprime = map (\c -> if c == '\'' then '$' else c)

16+ dereserve x = case Set.member x PHelp.jsReserveds of

17+ False -> x

18+ True -> "$" ++ x

19+

20+pattern :: Pattern -> Pattern

21+pattern pat =

22+ case pat of

23+ PVar x -> PVar (var x)

24+ PLiteral _ -> pat

25+ PRecord fs -> PRecord (map var fs)

26+ PAnything -> pat

27+ PAlias x p -> PAlias (var x) (pattern p)

28+ PData name ps -> PData name (map pattern ps)

29+

30+expression :: LExpr t v -> LExpr t v

31+expression (L loc expr) =

32+ let f = expression in

33+ L loc $

34+ case expr of

35+ Literal _ -> expr

36+ Var x -> Var (var x)

37+ Range e1 e2 -> Range (f e1) (f e2)

38+ ExplicitList es -> ExplicitList (map f es)

39+ Binop op e1 e2 -> Binop op (f e1) (f e2)

40+ Lambda p e -> Lambda (pattern p) (f e)

41+ App e1 e2 -> App (f e1) (f e2)

42+ MultiIf ps -> MultiIf (map (f *** f) ps)

43+ Let defs body -> Let (map definition defs) (f body)

44+ Case e cases -> Case (f e) $ map (pattern *** f) cases

45+ Data name es -> Data name (map f es)

46+ Access e x -> Access (f e) (var x)

47+ Remove e x -> Remove (f e) (var x)

48+ Insert e x v -> Insert (f e) (var x) (f v)

49+ Modify r fs -> Modify (f r) (map (var *** f) fs)

50+ Record fs -> Record (map (var *** f) fs)

51+ Markdown uid md es -> Markdown uid md (map f es)

52+

53+definition :: Def t v -> Def t v

54+definition def =

55+ case def of

56+ Def p e -> Def (pattern p) (expression e)

57+ TypeAnnotation name t -> TypeAnnotation (var name) t

58+

59+metadataModule :: MetadataModule t v -> MetadataModule t v

60+metadataModule modul =

61+ modul

62+ { names = map var (names modul)

63+ , exports = map var (exports modul)

64+ , imports = map (first var) (imports modul)

65+ , program = expression (program modul)

66+ , aliases =

67+ let makeSafe (name, tvars, tipe) = (var name, tvars, tipe)

68+ in map makeSafe (aliases modul)

69+ , datatypes =

70+ let makeSafe (name,tvars,ctors) = (var name, tvars, map (first var) ctors)

71+ in map makeSafe (datatypes modul)

72+ , foreignImports =

73+ let makeSafe (js,expr,elm,tipe) = (js, expression expr, var elm, tipe)

74+ in map makeSafe (foreignImports modul)

75+ , foreignExports =

76+ let makeSafe (js,elm,tipe) = (js, var elm, tipe)

77+ in map makeSafe (foreignExports modul)

78+ }

compiler/Transform/SortDefinitions.hs+3−1

@@ -6,7 +6,9 @@ import Control.Applicative ((<$>))

6import qualified Data.Set as Set

7import qualified Data.Map as Map

8import qualified SourceSyntax.Type as ST

9−import SourceSyntax.Everything

9+import SourceSyntax.Expression

10+import SourceSyntax.Location

11+import SourceSyntax.Pattern

10import qualified Data.Graph as Graph

12import qualified Data.Graph as Graph

11import qualified Data.Map as Map

13import qualified Data.Map as Map

12import qualified Data.Maybe as Maybe

14import qualified Data.Maybe as Maybe

compiler/Type/Constrain/Declaration.hs+13−11

@@ -9,7 +9,9 @@ import qualified Type.Constrain.Expression as TcExpr

9import qualified Type.Environment as Env

10

11import SourceSyntax.Declaration

12−import qualified SourceSyntax.Everything as Src

12+import qualified SourceSyntax.Expression as Src

13+import qualified SourceSyntax.Location as L

14+import qualified SourceSyntax.Pattern as P

13import qualified SourceSyntax.Type as Type

15import qualified SourceSyntax.Type as Type

14

16

15toExpr :: [Declaration t v] -> [Src.Def t v]

17toExpr :: [Declaration t v] -> [Src.Def t v]

@@ -25,34 +27,34 @@ toDefs decl =

25 toDefs (ctor, tipes) =

27 toDefs (ctor, tipes) =

26 let vars = take (length tipes) arguments

28 let vars = take (length tipes) arguments

27 tbody = Type.Data name $ map Type.Var tvars

29 tbody = Type.Data name $ map Type.Var tvars

28− body = Src.none . Src.Data ctor $ map (Src.none . Src.Var) vars

30+ body = L.none . Src.Data ctor $ map (L.none . Src.Var) vars

29 in [ Src.TypeAnnotation ctor $ foldr Type.Lambda tbody tipes

31 in [ Src.TypeAnnotation ctor $ foldr Type.Lambda tbody tipes

30− , Src.Def (Src.PVar ctor) $ buildFunction body vars

32+ , Src.Def (P.PVar ctor) $ buildFunction body vars

31 ]

33 ]

32

34

33 TypeAlias name tvars tipe@(Type.Record fields ext) ->

35 TypeAlias name tvars tipe@(Type.Record fields ext) ->

34 [ Src.TypeAnnotation name $ foldr Type.Lambda tipe args

36 [ Src.TypeAnnotation name $ foldr Type.Lambda tipe args

35− , Src.Def (Src.PVar name) $ buildFunction record vars ]

37+ , Src.Def (P.PVar name) $ buildFunction record vars ]

36 where

38 where

37 args = case ext of

39 args = case ext of

38 Type.EmptyRecord -> map snd fields

40 Type.EmptyRecord -> map snd fields

39 _ -> map snd fields ++ [ext]

41 _ -> map snd fields ++ [ext]

40

42

41− var = Src.none . Src.Var

43+ var = L.none . Src.Var

42 vars = take (length args) arguments

44 vars = take (length args) arguments

43

45

44 efields = zip (map fst fields) (map var vars)

46 efields = zip (map fst fields) (map var vars)

45 record = case ext of

47 record = case ext of

46− Type.EmptyRecord -> Src.none $ Src.Record efields

48+ Type.EmptyRecord -> L.none $ Src.Record efields

47− _ -> foldl (\r (f,v) -> Src.none $ Src.Insert r f v) (var $ last vars) efields

49+ _ -> foldl (\r (f,v) -> L.none $ Src.Insert r f v) (var $ last vars) efields

48

50

49 -- Type aliases must be added to an extended equality dictionary,

51 -- Type aliases must be added to an extended equality dictionary,

50 -- but they do not require any basic constraints.

52 -- but they do not require any basic constraints.

51 TypeAlias _ _ _ -> []

53 TypeAlias _ _ _ -> []

52

54

53− ImportEvent _ expr@(Src.L s _) name tipe ->

55+ ImportEvent _ expr@(L.L s _) name tipe ->

54 [ Src.TypeAnnotation name tipe

56 [ Src.TypeAnnotation name tipe

55− , Src.Def (Src.PVar name) (Src.L s $ Src.App (Src.L s $ Src.Var "constant") expr) ]

57+ , Src.Def (P.PVar name) (L.L s $ Src.App (L.L s $ Src.Var "constant") expr) ]

56

58

57 ExportEvent _ name tipe ->

59 ExportEvent _ name tipe ->

58 [ Src.TypeAnnotation name tipe ]

60 [ Src.TypeAnnotation name tipe ]

@@ -64,5 +66,5 @@ toDefs decl =

64arguments :: [String]

66arguments :: [String]

65arguments = map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show n) [1..]

67arguments = map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show n) [1..]

66

68

67−buildFunction body@(Src.L s _) vars =

69+buildFunction body@(L.L s _) vars =

68− foldr (\p e -> Src.L s (Src.Lambda p e)) body (map Src.PVar vars)

70+ foldr (\p e -> L.L s (Src.Lambda p e)) body (map P.PVar vars)