171f199 · elk · git.iko.soy

Elm.cabal+2−3

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

3939 Hs-Source-Dirs: compiler

4040 other-modules: SourceSyntax.Declaration,

4141 SourceSyntax.Expression,

42− SourceSyntax.Everything,

4342 SourceSyntax.Helpers,

4443 SourceSyntax.Literal,

4544 SourceSyntax.Location,

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

5453 Generate.Cases,

5554 Transform.Canonicalize,

5655 Transform.Check,

56+ Transform.SafeNames,

5757 Transform.SortDefinitions,

5858 Transform.Substitute,

5959 Transform.Optimize,

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

117117 Hs-Source-Dirs: compiler

118118 other-modules: SourceSyntax.Declaration,

119119 SourceSyntax.Expression,

120− SourceSyntax.Everything,

121120 SourceSyntax.Helpers,

122121 SourceSyntax.Literal,

123122 SourceSyntax.Location,

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

132131 Generate.Cases,

133132 Transform.Canonicalize,

134133 Transform.Check,

134+ Transform.SafeNames,

135135 Transform.SortDefinitions,

136136 Transform.Substitute,

137137 Transform.Optimize,

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

193193 Main-is: Docs.hs

194194 Hs-Source-Dirs: compiler

195195 other-modules: SourceSyntax.Declaration,

196− SourceSyntax.Everything,

197196 SourceSyntax.Expression,

198197 SourceSyntax.Helpers,

199198 SourceSyntax.Literal,

compiler/Build/Dependencies.hs+3−3

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

1818import System.IO

1919import Text.PrettyPrint (Doc)

2020

21−import SourceSyntax.Everything

21+import qualified SourceSyntax.Module as Module

2222import qualified SourceSyntax.Type as Type

2323import qualified Parse.Parse as Parse

2424import qualified Metadata.Prelude as Prelude

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

3232import qualified Elm.Internal.Version as V

3333import qualified Elm.Internal.Dependencies as Deps

3434

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

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

3636getSortedDependencies srcDirs builtIns root =

3737 do extras <- extraDependencies

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

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

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

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

8888

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

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

9090readDeps srcDirs builtIns root = do

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

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

compiler/Build/Source.hs+5−3

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

1111import System.FilePath as FP

1212import Text.PrettyPrint (Doc)

1313

14−import SourceSyntax.Everything

14+import SourceSyntax.Declaration

15+import SourceSyntax.Module

16+import qualified SourceSyntax.Expression as Expr

1517import qualified SourceSyntax.Type as Type

1618import qualified Parse.Parse as Parse

1719import qualified Metadata.Prelude as Prelude

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

3840 let exports'

3941 | null exs =

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

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

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

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

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

4446 | otherwise = exs

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

4951 exports = exports',

5052 imports = ims,

5153 -- reorder AST into strongly connected components

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

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

5355 types = Map.empty,

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

5557 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

22

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

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

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

99

1010import qualified Generate.Cases as Case

1111import qualified Generate.Markdown as MD

12−import SourceSyntax.Everything

12+import qualified SourceSyntax.Helpers as Help

13+import SourceSyntax.Literal

14+import SourceSyntax.Pattern

1315import SourceSyntax.Location

16+import SourceSyntax.Expression

17+import SourceSyntax.Module

1418import qualified Transform.SortDefinitions as SD

1519import Language.ECMAScript3.Syntax

1620import Language.ECMAScript3.PrettyPrint

17−import Parse.Helpers (jsReserveds)

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

21+import qualified Transform.SafeNames as MakeSafe

2622

2723split :: String -> [String]

2824split = go []

2925 where

3026 go vars str =

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

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

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

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

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

3531

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

32+var name = Id () name

3733ref name = VarRef () (var name)

3834prop name = PropId () (var name)

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

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

185181 do es' <- mapM expression es

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

187183 where

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

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

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

190186

191187 Markdown uid doc es ->

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

205201 let assign x = varDecl x expr'

206202 case pattern of

207203 PVar x

208− | isOp x ->

204+ | Help.isOp x ->

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

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

211207 | otherwise ->

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

228224

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

230226 setup vars

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

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

232228 | otherwise = safeAssign : vars

233229

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

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

291287

292288

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

294−generate modul =

290+generate unsafeModule =

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

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

297293 where

294+ modul = MakeSafe.metadataModule unsafeModule

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

299296 programStmts =

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

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

311308

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

313310 where

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

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

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

316313

317314 assign path expr =

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

387384 js1 = expression e1

388385 js2 = expression e2

389386

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

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

391388 | otherwise = dotSep parts

392389 where

393390 parts = split op

compiler/Generate/Noscript.hs+5−1

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

11module Generate.Noscript (noscript) where

22

33import 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

59import qualified Generate.Markdown as MD

610

711noscript :: Module t v -> String

compiler/Parse/Helpers.hs+4

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

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

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

3838 , "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"

3943 ]

4044

4145expecting = flip (<?>)

compiler/Parse/Pattern.hs+2−2

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

1111

1212import Parse.Helpers

1313import Parse.Literal

14+import SourceSyntax.Literal

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

1416import qualified SourceSyntax.Pattern as Pattern

15−import SourceSyntax.Everything hiding (tuple)

16−

1717

1818basic :: IParser Pattern

1919basic = 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 @@

11module Transform.Check (mistakes) where

22

33import Transform.SortDefinitions (boundVars)

4−import SourceSyntax.Everything

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

5+import SourceSyntax.Expression

6+import SourceSyntax.Pattern

7+import SourceSyntax.Location

58import SourceSyntax.PrettyPrint

69import qualified SourceSyntax.Type as T

710import Data.List as List

compiler/Transform/Optimize.hs+5−1

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

11module Transform.Optimize (optimize) where

22

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

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

59import Data.Char (isAlpha)

610

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 ((<$>))

66import qualified Data.Set as Set

77import qualified Data.Map as Map

88import qualified SourceSyntax.Type as ST

9−import SourceSyntax.Everything

9+import SourceSyntax.Expression

10+import SourceSyntax.Location

11+import SourceSyntax.Pattern

1012import qualified Data.Graph as Graph

1113import qualified Data.Map as Map

1214import qualified Data.Maybe as Maybe

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

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

99import qualified Type.Environment as Env

1010

1111import 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

1315import qualified SourceSyntax.Type as Type

1416

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

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

2527 toDefs (ctor, tipes) =

2628 let vars = take (length tipes) arguments

2729 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

2931 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

3133 ]

3234

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

3436 [ 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 ]

3638 where

3739 args = case ext of

3840 Type.EmptyRecord -> map snd fields

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

4042

41− var = Src.none . Src.Var

43+ var = L.none . Src.Var

4244 vars = take (length args) arguments

4345

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

4547 record = case ext of

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

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

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

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

4850

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

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

5153 TypeAlias _ _ _ -> []

5254

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

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

5456 [ 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) ]

5658

5759 ExportEvent _ name tipe ->

5860 [ Src.TypeAnnotation name tipe ]

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

6466arguments :: [String]

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

6668

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

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

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

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