9311704 · elk · git.iko.soy

compiler/AST/Module.hs+20−13

compare with master

unifiedsplit

@@ -17,7 +17,7 @@ import Text.PrettyPrint as P

17

18-- HELPFUL TYPE ALIASES

19

20−type Interfaces = Map.Map String Interface

20+type Interfaces = Map.Map Name Interface

21

22type Types = Map.Map String Type.CanonicalType

23type Aliases = Map.Map String ([String], Type.CanonicalType)

@@ -38,15 +38,12 @@ type ValidModule =

38type CanonicalModule =

39 Module [Var.Value] CanonicalBody

40

41−getName :: Module exs body -> String

42−getName modul =

43− nameToString (names modul)

44

41

45data Module exports body = Module

42data Module exports body = Module

46 { names :: Name

43 { names :: Name

47 , path :: FilePath

44 , path :: FilePath

48 , exports :: exports

45 , exports :: exports

49− , imports :: [(String, ImportMethod)]

46+ , imports :: [(Name, ImportMethod)]

50 , body :: body

47 , body :: body

51 }

48 }

52

49

@@ -74,6 +71,13 @@ type Name = [String] -- must be non-empty

74nameToString :: Name -> String

71nameToString :: Name -> String

75nameToString = List.intercalate "."

72nameToString = List.intercalate "."

76

73

74+nameIsNative :: Name -> Bool

75+nameIsNative name =

76+ case name of

77+ "Native" : _ -> True

78+ _ -> False

79+

80+

77

81

78-- INTERFACES

82-- INTERFACES

79

83

@@ -82,7 +86,7 @@ data Interface = Interface

82 { iVersion :: String

86 { iVersion :: String

83 , iExports :: [Var.Value]

87 , iExports :: [Var.Value]

84 , iTypes :: Types

88 , iTypes :: Types

85− , iImports :: [(String, ImportMethod)]

89+ , iImports :: [(Name, ImportMethod)]

86 , iAdts :: ADTs

90 , iAdts :: ADTs

87 , iAliases :: Aliases

91 , iAliases :: Aliases

88 , iFixities :: [(Decl.Assoc, Int, String)]

92 , iFixities :: [(Decl.Assoc, Int, String)]

@@ -150,13 +154,16 @@ instance (Pretty exs, Pretty body) => Pretty (Module exs body) where

150 modul = P.text "module" <+> name <+> pretty exs <+> P.text "where"

154 modul = P.text "module" <+> name <+> pretty exs <+> P.text "where"

151 name = P.text (List.intercalate "." names)

155 name = P.text (List.intercalate "." names)

152

156

157+ prettyImports =

153− prettyImports = P.vcat $ map prettyMethod ims

158+ P.vcat $ map prettyMethod ims

154

159

160+

155−prettyMethod :: (String, ImportMethod) -> Doc

161+prettyMethod :: (Name, ImportMethod) -> Doc

156−prettyMethod (name, method) =

162+prettyMethod import' =

157− case method of

163+ case import' of

158− As alias

164+ ([name], As alias)

159 | name == alias -> P.empty

165 | name == alias -> P.empty

160− | otherwise -> P.text "as" <+> P.text alias

161

166

167+ (_, As alias) -> P.text "as" <+> P.text alias

168+

162− Open listing -> pretty listing

169+ (_, Open listing) -> pretty listing

compiler/AST/Variable.hs+12−10

@@ -1,8 +1,9 @@

1{-# OPTIONS_GHC -W #-}

2module AST.Variable where

3

4−import Data.Binary

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

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

5+import Data.Binary

6+import qualified Data.List as List

6import Text.PrettyPrint as P

7import Text.PrettyPrint as P

7import qualified AST.Helpers as Help

8import qualified AST.Helpers as Help

8import AST.PrettyPrint

9import AST.PrettyPrint

@@ -12,7 +13,7 @@ newtype Raw = Raw String

12

13

13data Home

14data Home

14 = BuiltIn

15 = BuiltIn

15− | Module !String

16+ | Module [String]

16 | Local

17 | Local

17 deriving (Eq,Ord,Show)

18 deriving (Eq,Ord,Show)

18

19

@@ -28,24 +29,25 @@ builtin :: String -> Canonical

28builtin x = Canonical BuiltIn x

29builtin x = Canonical BuiltIn x

29

30

30-- To help with pattern matching on some common canonical variables:

31-- To help with pattern matching on some common canonical variables:

31−is :: String -> String -> Canonical -> Bool

32+is :: [String] -> String -> Canonical -> Bool

32is home name var =

33is home name var =

33 var == Canonical (Module home) name

34 var == Canonical (Module home) name

34

35

35isJson :: Canonical -> Bool

36isJson :: Canonical -> Bool

36−isJson = is "Json" "Value"

37+isJson = is ["Json"] "Value"

37

38

38isMaybe :: Canonical -> Bool

39isMaybe :: Canonical -> Bool

39−isMaybe = is "Maybe" "Maybe"

40+isMaybe = is ["Maybe"] "Maybe"

40

41

41isArray :: Canonical -> Bool

42isArray :: Canonical -> Bool

42−isArray = is "Array" "Array"

43+isArray = is ["Array"] "Array"

43

44

44isSignal :: Canonical -> Bool

45isSignal :: Canonical -> Bool

45−isSignal = is "Signal" "Signal"

46+isSignal = is ["Signal"] "Signal"

46

47

47isList :: Canonical -> Bool

48isList :: Canonical -> Bool

49+isList v =

48−isList v = v == Canonical BuiltIn "_List"

50+ v == Canonical BuiltIn "_List"

49

51

50isTuple :: Canonical -> Bool

52isTuple :: Canonical -> Bool

51isTuple v =

53isTuple v =

@@ -66,7 +68,7 @@ isPrim prim v =

66 _ -> False

68 _ -> False

67

69

68isText :: Canonical -> Bool

70isText :: Canonical -> Bool

69−isText = is "Text" "Text"

71+isText = is ["Text"] "Text"

70

72

71class ToString a where

73class ToString a where

72 toString :: a -> String

74 toString :: a -> String

@@ -78,7 +80,7 @@ instance ToString Canonical where

78 toString (Canonical home name) =

80 toString (Canonical home name) =

79 case home of

81 case home of

80 BuiltIn -> name

82 BuiltIn -> name

81− Module path -> path ++ "." ++ name

83+ Module path -> List.intercalate "." (path ++ [name])

82 Local -> name

84 Local -> name

83

85

84-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)

86-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)

compiler/Elm/Compiler.hs+26−11

@@ -1,14 +1,18 @@

1{-# OPTIONS_GHC -Wall #-}

2{-# LANGUAGE FlexibleContexts #-}

3−module Elm.Compiler (version, parseDependencies, elmToJs) where

3+module Elm.Compiler (version, parseDependencies, compile) where

4

5import Control.Monad.Error (MonadError, MonadIO, liftIO, throwError)

6import qualified Data.List as List

7+import qualified Data.Map as Map

7import System.IO.Unsafe (unsafePerformIO)

8import System.IO.Unsafe (unsafePerformIO)

9+import qualified Text.PrettyPrint as P

8

10

9import qualified AST.Module as Module (HeaderAndImports(HeaderAndImports), Interfaces)

11import qualified AST.Module as Module (HeaderAndImports(HeaderAndImports), Interfaces)

12+import qualified Build.Source as Source

10−import qualified Elm.Compiler.Module as Module

13+import qualified Elm.Compiler.Module as PublicModule

11import qualified Elm.Compiler.Version as Version

14import qualified Elm.Compiler.Version as Version

15+import qualified Generate.JavaScript as JS

12import qualified Metadata.Prelude as Prelude

16import qualified Metadata.Prelude as Prelude

13import qualified Parse.Helpers as Help

17import qualified Parse.Helpers as Help

14import qualified Parse.Module as Parse

18import qualified Parse.Module as Parse

@@ -23,27 +27,38 @@ version =

23

27

24-- DEPENDENCIES

28-- DEPENDENCIES

25

29

26−parseDependencies :: (MonadError String m) => String -> m (Module.Name, [Module.Name])

30+parseDependencies

31+ :: (MonadError String m)

32+ => String

33+ -> m (PublicModule.Name, [PublicModule.Name])

27parseDependencies src =

34parseDependencies src =

28 case Help.iParse Parse.headerAndImports src of

35 case Help.iParse Parse.headerAndImports src of

29 Left msg ->

36 Left msg ->

30 throwError (show msg)

37 throwError (show msg)

31

38

32 Right (Module.HeaderAndImports names _exports imports) ->

39 Right (Module.HeaderAndImports names _exports imports) ->

40+ return

41+ ( PublicModule.Name names

33− return ( Module.Name names, map (Module.Name . fst) imports )

42+ , map (PublicModule.Name . fst) imports

43+ )

34

44

35

45

36-- COMPILATION

46-- COMPILATION

37

47

38{-| Compiles Elm source code to JavaScript. -}

48{-| Compiles Elm source code to JavaScript. -}

39−elmToJs :: String -> Either String String

49+compile

40−elmToJs source =

50+ :: String

41− error "elmToJs is not working yet"

51+ -> Map.Map PublicModule.Name PublicModule.Interface

42−{-

52+ -> Either String PublicModule.Interface

53+compile source interfaces =

43− case Source.build False interfaces source of

54+ case Source.build False unwrappedInterfaces source of

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

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

45− Right modul -> Right $ JS.generate modul

56+ Right modul -> Right $ error "JS.generate modul"

46−-}

57+ where

58+ unwrappedInterfaces =

59+ Map.map (\(PublicModule.Interface iface) -> iface) $

60+ Map.mapKeysMonotonic (\(PublicModule.Name name) -> name) interfaces

61+

47

62

48{-# NOINLINE interfaces #-}

63{-# NOINLINE interfaces #-}

49interfaces :: Module.Interfaces

64interfaces :: Module.Interfaces

compiler/Elm/Compiler/Module.hs+7−1

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

1+module Elm.Compiler.Module

2+ ( Interface(Interface), Name(Name)

1−module Elm.Compiler.Module (Name(Name), nameToPath, nameToString, nameFromString) where

3+ , nameToPath, nameToString, nameFromString

4+ )

5+ where

2

6

3import Control.Monad (mzero)

7import Control.Monad (mzero)

4import qualified Data.Aeson as Json

8import qualified Data.Aeson as Json

@@ -9,6 +13,8 @@ import System.FilePath ((</>))

9import qualified AST.Module as Module

13import qualified AST.Module as Module

10

14

11

15

16+newtype Interface = Interface Module.Interface

17+

12newtype Name = Name [String]

18newtype Name = Name [String]

13 deriving (Eq, Ord)

19 deriving (Eq, Ord)

14

20

compiler/Generate/JavaScript.hs+16−16

@@ -30,14 +30,14 @@ varDecl :: String -> Expression () -> VarDecl ()

30varDecl x expr =

31 VarDecl () (var x) (Just expr)

32

33−internalImports :: String -> [VarDecl ()]

33+internalImports :: Module.Name -> [VarDecl ()]

34internalImports name =

35 [ varDecl "_N" (obj ["Elm","Native"])

36 , include "_U" "Utils"

37 , include "_L" "List"

38 , include "_A" "Array"

39 , include "_E" "Error"

40− , varDecl Help.localModuleName (string name)

40+ , varDecl Help.localModuleName (string (Module.nameToString name))

41 ]

42 where

43 include :: String -> String -> VarDecl ()

@@ -149,7 +149,7 @@ expression (A region expr) =

149 MultiIf branches ->

150 do branches' <- forM branches $ \(b,e) -> (,) <$> expression b <*> expression e

151 return $ case last branches of

152− (A _ (Var (Var.Canonical (Var.Module "Basics") "otherwise")), _) ->

152+ (A _ (Var (Var.Canonical (Var.Module ["Basics"]) "otherwise")), _) ->

153 safeIfs branches'

154 (A _ (Literal (Boolean True)), _) -> safeIfs branches'

155 _ -> ifs branches' (throw "If" region)

@@ -183,7 +183,7 @@ expression (A region expr) =

183

184 Markdown uid doc es ->

185 do es' <- mapM expression es

186− return $ Var.value "Text" "markdown" `call` (string md : string uid : es')

186+ return $ Var.value ["Text"] "markdown" `call` (string md : string uid : es')

187 where

188 pad = "<div style=\"height:0;width:0;\"> </div>"

189 md = pad ++ MD.toHtml doc ++ pad

@@ -192,12 +192,12 @@ expression (A region expr) =

192 return $ ObjectLit () [(PropString () "src", literal (Str src))]

193

194 PortIn name tipe ->

195− return $ Var.value "Native.Ports" "portIn" `call`

195+ return $ Var.value ["Native","Ports"] "portIn" `call`

196 [ string name, Port.incoming tipe ]

197

198 PortOut name tipe value ->

199 do value' <- expression value

200− return $ Var.value "Native.Ports" "portOut" `call`

200+ return $ Var.value ["Native","Ports"] "portOut" `call`

201 [ string name, Port.outgoing tipe, value' ]

202

203definition :: Canonical.Def -> State Int [Statement ()]

@@ -326,17 +326,17 @@ generate modul =

326

327 localVars :: [VarDecl ()]

328 localVars = varDecl "_op" (ObjectLit () []) :

329− internalImports (Module.getName modul) ++

329+ internalImports (Module.names modul) ++

330 explicitImports

331 where

332 explicitImports :: [VarDecl ()]

333 explicitImports =

334 map jsImport . Set.toList . Set.fromList . map fst $ Module.imports modul

335

336− jsImport :: String -> VarDecl ()

336+ jsImport :: Module.Name -> VarDecl ()

337 jsImport name =

338 varDecl (Var.moduleName name) $

339− obj ("Elm" : Help.splitDots name ++ ["make"]) <| ref "_elm"

339+ obj ("Elm" : name ++ ["make"]) <| ref "_elm"

340

341 body :: [Statement ()]

342 body = concat $ evalState defs 0

@@ -369,20 +369,20 @@ binop :: Region -> Var.Canonical -> Canonical.Expr -> Canonical.Expr

369 -> State Int (Expression ())

370binop region func@(Var.Canonical home op) e1 e2 =

371 case (home, op) of

372− (Var.Module "Basics", ">>") ->

372+ (Var.Module ["Basics"], ">>") ->

373 do es <- mapM expression (collectLeftAssoc [e2] e1)

374 return $ ["$"] ==> List.foldl' (\e f -> f <| e) (ref "$") es

375

376− (Var.Module "Basics", "<<") ->

376+ (Var.Module ["Basics"], "<<") ->

377 do es <- mapM expression (e1 : collectRightAssoc [] e2)

378 return $ ["$"] ==> foldr (<|) (ref "$") es

379

380− (Var.Module "Basics", "<|") ->

380+ (Var.Module ["Basics"], "<|") ->

381 do e2' <- expression e2

382 es <- mapM expression (collectRightAssoc [] e1)

383 return $ foldr (<|) e2' es

384

385− (Var.Module "List", "++") ->

385+ (Var.Module ["List"], "++") ->

386 do e1' <- expression e1

387 e2' <- expression e2

388 return $ _List "append" `call` [e1', e2']

@@ -390,7 +390,7 @@ binop region func@(Var.Canonical home op) e1 e2 =

390 (Var.BuiltIn, "::") ->

391 expression (A region (Data "::" [e1,e2]))

392

393− (Var.Module "Basics", _) ->

393+ (Var.Module ["Basics"], _) ->

394 do e1' <- expression e1

395 e2' <- expression e2

396 return $ case Map.lookup op basicOps of

@@ -405,13 +405,13 @@ binop region func@(Var.Canonical home op) e1 e2 =

405 where

406 collectRightAssoc es e =

407 case e of

408− A _ (Binop (Var.Canonical (Var.Module "Basics") "<<") e1 e2) ->

408+ A _ (Binop (Var.Canonical (Var.Module ["Basics"]) "<<") e1 e2) ->

409 collectRightAssoc (es ++ [e1]) e2

410 _ -> es ++ [e]

411

412 collectLeftAssoc es e =

413 case e of

414− A _ (Binop (Var.Canonical (Var.Module "Basics") ">>") e1 e2) ->

414+ A _ (Binop (Var.Canonical (Var.Module ["Basics"]) ">>") e1 e2) ->

415 collectLeftAssoc (e2 : es) e1

416 _ -> e : es

417

compiler/Generate/JavaScript/Ports.hs+6−6

@@ -31,7 +31,7 @@ incoming tipe =

31 Aliased _ t -> incoming t

32

33 App (Type v) [t]

34− | Var.isSignal v -> V.value "Native.Ports" "incomingSignal" <| incoming t

34+ | Var.isSignal v -> V.value ["Native","Ports"] "incomingSignal" <| incoming t

35

36 _ -> ["v"] ==> inc tipe (ref "v")

37

@@ -52,7 +52,7 @@ inc tipe x =

52 from checks = check x checks x

53

54 Type name

55− | Var.isJson name -> V.value "Native.Json" "fromJS" <| x

55+ | Var.isJson name -> V.value ["Native","Json"] "fromJS" <| x

56 | Var.isTuple name -> incomingTuple [] x

57 | otherwise -> error "bad type got to incoming port generation code"

58

@@ -62,8 +62,8 @@ inc tipe x =

62 | Var.isMaybe name ->

63 CondExpr ()

64 (equal x (NullLit ()))

65− (V.value "Maybe" "Nothing")

65+ (V.value ["Maybe"] "Nothing")

66− (V.value "Maybe" "Just" <| inc t x)

66+ (V.value ["Maybe"] "Just" <| inc t x)

67

68 | Var.isList name ->

69 check x JSArray (obj ["_L","fromArray"] <| array)

@@ -107,7 +107,7 @@ outgoing tipe =

107 Aliased _ t -> outgoing t

108

109 App (Type v) [t]

110− | Var.isSignal v -> V.value "Native.Ports" "outgoingSignal" <| outgoing t

110+ | Var.isSignal v -> V.value ["Native","Ports"] "outgoingSignal" <| outgoing t

111

112 _ -> ["v"] ==> out tipe (ref "v")

113

@@ -137,7 +137,7 @@ out tipe x =

137 | name `elem` ["Int","Float","Bool","String"] -> x

138

139 Type name

140− | Var.isJson name -> V.value "Native.Json" "toJS" <| x

140+ | Var.isJson name -> V.value ["Native","Json"] "toJS" <| x

141 | Var.isTuple name -> ArrayLit () []

142 | otherwise -> error "bad type got to outgoing port generation code"

143

compiler/Generate/JavaScript/Variable.hs+6−3

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

2module Generate.JavaScript.Variable where

3

4import qualified AST.Helpers as Help

5+import qualified AST.Module as Module

5import qualified AST.Variable as Var

6import qualified AST.Variable as Var

7+import qualified Data.List as List

6import qualified Data.Set as Set

8import qualified Data.Set as Set

7import qualified Generate.JavaScript.Helpers as JS

9import qualified Generate.JavaScript.Helpers as JS

8import qualified Language.ECMAScript3.Syntax as JS

10import qualified Language.ECMAScript3.Syntax as JS

@@ -22,15 +24,16 @@ canonical (Var.Canonical home name) =

22 Var.BuiltIn -> []

24 Var.BuiltIn -> []

23 Var.Module path -> [ moduleName path ]

25 Var.Module path -> [ moduleName path ]

24

26

25−moduleName :: String -> String

27+moduleName :: Module.Name -> String

26−moduleName x = '$' : map (swap '.' '$') x

28+moduleName name =

29+ '$' : List.intercalate "$" name

27

30

28varName :: String -> String

31varName :: String -> String

29varName x = map (swap '\'' '$') x'

32varName x = map (swap '\'' '$') x'

30 where

33 where

31 x' = if Set.member x jsReserveds then '$' : x else x

34 x' = if Set.member x jsReserveds then '$' : x else x

32

35

33−value :: String -> String -> JS.Expression ()

36+value :: Module.Name -> String -> JS.Expression ()

34value home name =

37value home name =

35 canonical (Var.Canonical (Var.Module home) name)

38 canonical (Var.Canonical (Var.Module home) name)

36

39

compiler/Metadata/Prelude.hs+15−11

@@ -16,33 +16,33 @@ import qualified Elm.Compiler.Version as Compiler

16-- DEFINITION OF THE PRELUDE

17

18type ImportDict =

19− Map.Map String ([String], Var.Listing Var.Value)

19+ Map.Map Module.Name ([String], Var.Listing Var.Value)

20

21

22prelude :: ImportDict

23prelude =

24 Map.unions [ string, text, maybe, openImports ]

25 where

26− importing :: String -> [Var.Value] -> ImportDict

26+ importing :: Module.Name -> [Var.Value] -> ImportDict

27 importing name values =

28 Map.singleton name ([], Var.Listing values False)

29

30 openImports :: ImportDict

31 openImports =

32 Map.fromList $ map (\name -> (name, ([], Var.openListing))) $

33− [ "Basics", "Signal", "List", "Time", "Color"

33+ [ ["Basics"], ["Signal"], ["List"], ["Time"], ["Color"]

34− , "Graphics.Element", "Graphics.Collage"

34+ , ["Graphics","Element"], ["Graphics","Collage"]

35− , "Native.Ports", "Native.Json"

35+ , ["Native","Ports"], ["Native","Json"]

36 ]

37

38 maybe :: ImportDict

39− maybe = importing "Maybe" [ Var.ADT "Maybe" Var.openListing ]

39+ maybe = importing ["Maybe"] [ Var.ADT "Maybe" Var.openListing ]

40

41 string :: ImportDict

42− string = importing "String" [Var.Value "show"]

42+ string = importing ["String"] [Var.Value "show"]

43

44 text :: ImportDict

45− text = importing "Text" (Var.ADT "Text" (Var.Listing [] False) : values)

45+ text = importing ["Text"] (Var.ADT "Text" (Var.Listing [] False) : values)

46 where

47 values =

48 map Var.Value

@@ -62,7 +62,7 @@ add noPrelude (Module.Module moduleName path exports imports decls) =

62 foldr addImport (if noPrelude then Map.empty else prelude) imports

63

64

65−importDictToList :: ImportDict -> [(String, Module.ImportMethod)]

65+importDictToList :: ImportDict -> [(Module.Name, Module.ImportMethod)]

66importDictToList dict =

67 concatMap toImports (Map.toList dict)

68 where

@@ -74,7 +74,7 @@ importDictToList dict =

74 else []

75

76

77−addImport :: (String, Module.ImportMethod) -> ImportDict -> ImportDict

77+addImport :: (Module.Name, Module.ImportMethod) -> ImportDict -> ImportDict

78addImport (name, method) importDict =

79 Map.alter mergeMethods name importDict

80 where

@@ -117,7 +117,11 @@ readInterfaces filePath =

117 _ -> return (Map.fromList interfaces)

118

119

120−isValid :: (MonadError String m) => FilePath -> (String, Module.Interface) -> m (String, Module.Interface)

120+isValid

121+ :: (MonadError String m)

122+ => FilePath

123+ -> (Module.Name, Module.Interface)

124+ -> m (Module.Name, Module.Interface)

121isValid filePath (name, interface) =

125isValid filePath (name, interface) =

122 if version == Compiler.version

126 if version == Compiler.version

123 then return (name, interface)

127 then return (name, interface)

compiler/Parse/Parse.hs+1−3

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

2module Parse.Parse (program) where

3

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

5−import Control.Arrow (first)

6import qualified Data.List as List

5import qualified Data.List as List

7import qualified Data.Map as Map

6import qualified Data.Map as Map

8import Text.Parsec hiding (newline, spaces)

7import Text.Parsec hiding (newline, spaces)

@@ -37,8 +36,7 @@ programParser =

37 do (M.HeaderAndImports names exports imports) <- Module.headerAndImports

36 do (M.HeaderAndImports names exports imports) <- Module.headerAndImports

38 declarations <- decls

37 declarations <- decls

39 optional freshLine ; optional spaces ; eof

38 optional freshLine ; optional spaces ; eof

40− let stringyImports = map (first M.nameToString) imports

41− return $ M.Module names "" exports stringyImports declarations

39+ return $ M.Module names "" exports imports declarations

42

40

43setupParserWithTable :: OpTable -> IParser a -> String -> Either [P.Doc] a

41setupParserWithTable :: OpTable -> IParser a -> String -> Either [P.Doc] a

44setupParserWithTable table p source =

42setupParserWithTable table p source =

compiler/Transform/Canonicalize.hs+13−12

@@ -58,7 +58,7 @@ moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =

58 body decls =

59 Module.CanonicalBody

60 { program =

61− let expr = Transform.toExpr (Module.getName modul) decls

61+ let expr = Transform.toExpr (Module.names modul) decls

62 in Transform.sortDefs (dummyLet expr)

63 , types = Map.empty

64 , datatypes =

@@ -181,16 +181,17 @@ declaration env decl =

181 return (D.TypeAlias name tvars expanded')

182

183 D.Port port -> do

184− Env.uses "Native.Ports"

184+ Env.uses ["Native","Ports"]

185− Env.uses "Native.Json"

185+ Env.uses ["Native","Json"]

186+ D.Port <$>

186− D.Port <$> case port of

187+ case port of

187− D.In name t ->

188+ D.In name t ->

188− do t' <- canonicalize Canonicalize.tipe "port" name env t

189+ do t' <- canonicalize Canonicalize.tipe "port" name env t

189− return (D.In name t')

190+ return (D.In name t')

190− D.Out name e t ->

191+ D.Out name e t ->

191− do e' <- expression env e

192+ do e' <- expression env e

192− t' <- canonicalize Canonicalize.tipe "port" name env t

193+ t' <- canonicalize Canonicalize.tipe "port" name env t

193− return (D.Out name e' t')

194+ return (D.Out name e' t')

194

195

195 D.Fixity assoc prec op -> return $ D.Fixity assoc prec op

196 D.Fixity assoc prec op -> return $ D.Fixity assoc prec op

196

197

@@ -254,7 +255,7 @@ expression env (A.A ann expr) =

254 <*> expression (update p env) b

255 <*> expression (update p env) b

255

256

256 Markdown uid md es ->

257 Markdown uid md es ->

257− do Env.uses "Text"

258+ do Env.uses ["Text"]

258 Markdown uid md <$> mapM go es

259 Markdown uid md <$> mapM go es

259

260

260 PortIn name st -> PortIn name <$> tipe' env st

261 PortIn name st -> PortIn name <$> tipe' env st

compiler/Transform/Canonicalize/Environment.hs+13−6

@@ -8,23 +8,29 @@ import qualified Data.Map as Map

8import qualified Data.Set as Set

9

10import AST.Expression.General (saveEnvName)

11+import qualified AST.Module as Module

11import qualified AST.Pattern as P

12import qualified AST.Pattern as P

12import qualified AST.Type as Type

13import qualified AST.Type as Type

13import qualified AST.Variable as Var

14import qualified AST.Variable as Var

14

15

15import Text.PrettyPrint (Doc)

16import Text.PrettyPrint (Doc)

16

17

18+

17type Dict a = Map.Map String [a]

19type Dict a = Map.Map String [a]

18

20

19dict :: [(String,a)] -> Dict a

21dict :: [(String,a)] -> Dict a

22+dict pairs =

20−dict pairs = Map.fromList $ map (second (:[])) pairs

23+ Map.fromList $ map (second (:[])) pairs

21

24

22insert :: String -> a -> Dict a -> Dict a

25insert :: String -> a -> Dict a -> Dict a

26+insert key value =

23−insert key value = Map.insertWith (++) key [value]

27+ Map.insertWith (++) key [value]

28+

24

29

30+type Canonicalizer err a =

25−type Canonicalizer err a = Error.ErrorT err (State.State (Set.Set String)) a

31+ Error.ErrorT err (State.State (Set.Set Module.Name)) a

26

32

27−uses :: (Error.Error e) => String -> Canonicalizer e ()

33+uses :: (Error.Error e) => Module.Name -> Canonicalizer e ()

28uses home =

34uses home =

29 Error.lift (State.modify (Set.insert home))

35 Error.lift (State.modify (Set.insert home))

30

36

@@ -46,15 +52,16 @@ onError handler canonicalizer =

46 Left err -> Error.throwError [handler err]

52 Left err -> Error.throwError [handler err]

47 Right x -> return x

53 Right x -> return x

48

54

55+

49data Environment = Env

56data Environment = Env

50− { _home :: String

57+ { _home :: Module.Name

51 , _values :: Dict Var.Canonical

58 , _values :: Dict Var.Canonical

52 , _adts :: Dict Var.Canonical

59 , _adts :: Dict Var.Canonical

53 , _aliases :: Dict (Var.Canonical, [String], Type.CanonicalType)

60 , _aliases :: Dict (Var.Canonical, [String], Type.CanonicalType)

54 , _patterns :: Dict Var.Canonical

61 , _patterns :: Dict Var.Canonical

55 }

62 }

56

63

57−builtIns :: String -> Environment

64+builtIns :: Module.Name -> Environment

58builtIns home =

65builtIns home =

59 Env { _home = home

66 Env { _home = home

60 , _values = builtIn (tuples ++ [saveEnvName])

67 , _values = builtIn (tuples ++ [saveEnvName])

compiler/Transform/Canonicalize/Setup.hs+14−11

@@ -23,10 +23,11 @@ import Transform.Canonicalize.Environment as Env

23import qualified Transform.Canonicalize.Type as Canonicalize

24import qualified Transform.Interface as Interface

25

26+

26environment :: Module.Interfaces -> Module.ValidModule -> Canonicalizer [Doc] Environment

27environment :: Module.Interfaces -> Module.ValidModule -> Canonicalizer [Doc] Environment

27environment interfaces modul@(Module.Module _ _ _ imports decls) =

28environment interfaces modul@(Module.Module _ _ _ imports decls) =

28 do () <- allImportsAvailable

29 do () <- allImportsAvailable

29− let moduleName = Module.getName modul

30+ let moduleName = Module.names modul

30 nonLocalEnv <- foldM (addImports moduleName interfaces) (builtIns moduleName) imports

31 nonLocalEnv <- foldM (addImports moduleName interfaces) (builtIns moduleName) imports

31 let (aliases, env) = List.foldl' (addDecl moduleName) ([], nonLocalEnv) decls

32 let (aliases, env) = List.foldl' (addDecl moduleName) ([], nonLocalEnv) decls

32 addTypeAliases moduleName aliases env

33 addTypeAliases moduleName aliases env

@@ -39,18 +40,19 @@ environment interfaces modul@(Module.Module _ _ _ imports decls) =

39 where

40 where

40 modules = map fst imports

41 modules = map fst imports

41

42

42− found m = Map.member m interfaces || List.isPrefixOf "Native." m

43+ found m = Map.member m interfaces || Module.nameIsNative m

43

44

44 missingModuleError missings =

45 missingModuleError missings =

45 concat [ "The following imports were not found: "

46 concat [ "The following imports were not found: "

46− , List.intercalate ", " missings

47+ , List.intercalate ", " (map Module.nameToString missings)

47 , "\n You may need to compile with the --make "

48 , "\n You may need to compile with the --make "

48 , "flag to detect modules you have written." ]

49 , "flag to detect modules you have written." ]

49

50

51+

50−addImports :: String -> Module.Interfaces -> Environment -> (String, Module.ImportMethod)

52+addImports :: Module.Name -> Module.Interfaces -> Environment -> (Module.Name, Module.ImportMethod)

51 -> Canonicalizer [Doc] Environment

53 -> Canonicalizer [Doc] Environment

52addImports moduleName interfaces environ (name, method)

54addImports moduleName interfaces environ (name, method)

53− | List.isPrefixOf "Native." name = return environ

55+ | Module.nameIsNative name = return environ

54 | otherwise =

56 | otherwise =

55 case method of

57 case method of

56 Module.As name' ->

58 Module.As name' ->

@@ -82,10 +84,11 @@ addImports moduleName interfaces environ (name, method)

82

84

83 ctors = concatMap (map (pair . fst) . snd . snd) (Map.toList (iAdts interface))

85 ctors = concatMap (map (pair . fst) . snd . snd) (Map.toList (iAdts interface))

84

86

85−addValue :: String -> Module.Interface -> Environment -> Var.Value

87+addValue :: Module.Name -> Module.Interface -> Environment -> Var.Value

86 -> Canonicalizer [Doc] Environment

88 -> Canonicalizer [Doc] Environment

87−addValue name interface env value =

89+addValue moduleName interface env value =

90+ let name = Module.nameToString moduleName

88− let insert' x = insert x (Var.Canonical (Var.Module name) x)

91+ insert' x = insert x (Var.Canonical (Var.Module moduleName) x)

89 msg x = "Import Error: Could not import value '" ++ name ++ "." ++ x ++

92 msg x = "Import Error: Could not import value '" ++ name ++ "." ++ x ++

90 "'.\n It is not exported by module " ++ name ++ "."

93 "'.\n It is not exported by module " ++ name ++ "."

91 notFound x = throwError [ P.text (msg x) ]

94 notFound x = throwError [ P.text (msg x) ]

@@ -104,7 +107,7 @@ addValue name interface env value =

104 , _values = updatedValues

107 , _values = updatedValues

105 }

108 }

106 where

109 where

107− v = (Var.Canonical (Var.Module name) x, tvars, t)

110+ v = (Var.Canonical (Var.Module moduleName) x, tvars, t)

108 updatedValues =

111 updatedValues =

109 if Map.member x (iTypes interface)

112 if Map.member x (iTypes interface)

110 then insert' x (_values env)

113 then insert' x (_values env)

@@ -147,7 +150,7 @@ node name tvars alias = ((name, tvars, alias), name, edges alias)

147 Type.Record fs ext -> maybe [] edges ext ++ concatMap (edges . snd) fs

150 Type.Record fs ext -> maybe [] edges ext ++ concatMap (edges . snd) fs

148 Type.Aliased _ t -> edges t

151 Type.Aliased _ t -> edges t

149

152

150−addTypeAliases :: String -> [Node] -> Environment -> Canonicalizer [Doc] Environment

153+addTypeAliases :: Module.Name -> [Node] -> Environment -> Canonicalizer [Doc] Environment

151addTypeAliases moduleName nodes environ =

154addTypeAliases moduleName nodes environ =

152 foldM addTypeAlias environ (Graph.stronglyConnComp nodes)

155 foldM addTypeAlias environ (Graph.stronglyConnComp nodes)

153 where

156 where

@@ -193,7 +196,7 @@ addTypeAliases moduleName nodes environ =

193-- When canonicalizing, all _values should be Local, but all _adts and _patterns

196-- When canonicalizing, all _values should be Local, but all _adts and _patterns

194-- should be fully namespaced. With _adts, they may appear in types that can

197-- should be fully namespaced. With _adts, they may appear in types that can

195-- escape the module.

198-- escape the module.

196−addDecl :: String -> ([Node], Environment) -> D.ValidDecl -> ([Node], Environment)

199+addDecl :: Module.Name -> ([Node], Environment) -> D.ValidDecl -> ([Node], Environment)

197addDecl moduleName info@(nodes,env) decl =

200addDecl moduleName info@(nodes,env) decl =

198 let namespacedVar = Var.Canonical (Var.Module moduleName)

201 let namespacedVar = Var.Canonical (Var.Module moduleName)

199 addLocal x e = insert x (Var.local x) e

202 addLocal x e = insert x (Var.local x) e

compiler/Transform/Canonicalize/Variable.hs+7−6

@@ -7,6 +7,7 @@ import qualified Data.Map as Map

7import Data.Maybe (fromMaybe)

8

9import AST.Helpers as Help

10+import qualified AST.Module as Module

10import qualified AST.Type as Type

11import qualified AST.Type as Type

11import qualified AST.Variable as Var

12import qualified AST.Variable as Var

12import Transform.Canonicalize.Environment as Env

13import Transform.Canonicalize.Environment as Env

@@ -14,10 +15,9 @@ import Transform.Canonicalize.Environment as Env

14variable :: Environment -> String -> Canonicalizer String Var.Canonical

15variable :: Environment -> String -> Canonicalizer String Var.Canonical

15variable env var =

16variable env var =

16 case modul of

17 case modul of

17− Just ms@(m:_)

18+ Just name

19+ | Module.nameIsNative name ->

18− | m == "Native" -> Env.using (Var.Canonical home name)

20+ Env.using (Var.Canonical (Var.Module name) varName)

19− where

20− home = Var.Module (List.intercalate "." ms)

21

22 _ ->

23 case Map.lookup var (_values env) of

@@ -25,7 +25,7 @@ variable env var =

25 Just vs -> preferLocals env "variable" vs var

26 Nothing -> notFound "variable" (Map.keys (_values env)) var

27 where

28− (modul, name) =

28+ (modul, varName) =

29 case Help.splitDots var of

30 [x] -> (Nothing, x)

31 xs -> (Just (init xs), last xs)

@@ -83,7 +83,8 @@ preferLocals' env extract kind possibilities var =

83 case home of

84 Var.Local -> True

85 Var.BuiltIn -> False

86+ Var.Module name ->

86− Var.Module name -> name == Env._home env

87+ name == Env._home env

87

88

88 ambiguous possibleVars =

89 ambiguous possibleVars =

89 throwError msg

90 throwError msg

compiler/Transform/Declaration.hs+3−2

@@ -9,6 +9,7 @@ import qualified AST.Expression.General as E

9import qualified AST.Expression.Source as Source

10import qualified AST.Expression.Valid as Valid

11import qualified AST.Expression.Canonical as Canonical

12+import qualified AST.Module as Module

12import qualified AST.Pattern as P

13import qualified AST.Pattern as P

13import qualified AST.Type as T

14import qualified AST.Type as T

14import qualified AST.Variable as Var

15import qualified AST.Variable as Var

@@ -70,10 +71,10 @@ combineAnnotations = go

70 _ -> (:) (D.Port (D.In name tipe)) <$> go portRest

71 _ -> (:) (D.Port (D.In name tipe)) <$> go portRest

71

72

73

73−toExpr :: String -> [D.CanonicalDecl] -> [Canonical.Def]

74+toExpr :: Module.Name -> [D.CanonicalDecl] -> [Canonical.Def]

74toExpr moduleName = concatMap (toDefs moduleName)

75toExpr moduleName = concatMap (toDefs moduleName)

75

76

76−toDefs :: String -> D.CanonicalDecl -> [Canonical.Def]

77+toDefs :: Module.Name -> D.CanonicalDecl -> [Canonical.Def]

77toDefs moduleName decl =

78toDefs moduleName decl =

78 let typeVar = Var.Canonical (Var.Module moduleName) in

79 let typeVar = Var.Canonical (Var.Module moduleName) in

79 case decl of

80 case decl of

compiler/Type/Inference.hs+4−4

@@ -62,24 +62,24 @@ genConstraints interfaces modul = do

62 return (header, environ c)

63

64

65−canonicalizeValues :: Env.Environment -> (String, Interface)

65+canonicalizeValues :: Env.Environment -> (Module.Name, Interface)

66 -> ErrorT [Doc] IO [(String, ([T.Variable], T.Type))]

67canonicalizeValues env (moduleName, iface) =

68 forM (Map.toList (iTypes iface)) $ \(name,tipe) -> do

69 tipe' <- Env.instantiateType env tipe Map.empty

70− return (moduleName ++ "." ++ name, tipe')

70+ return (Module.nameToString moduleName ++ "." ++ name, tipe')

71

72canonicalizeAdts :: Interfaces -> CanonicalModule -> [CanonicalAdt]

73canonicalizeAdts interfaces modul =

74 localAdts ++ importedAdts

75 where

76 localAdts :: [CanonicalAdt]

77− localAdts = format (Module.getName modul, datatypes (body modul))

77+ localAdts = format (Module.names modul, datatypes (body modul))

78

79 importedAdts :: [CanonicalAdt]

80 importedAdts = concatMap (format . second iAdts) (Map.toList interfaces)

81

82− format :: (String, Module.ADTs) -> [CanonicalAdt]

82+ format :: (Module.Name, Module.ADTs) -> [CanonicalAdt]

83 format (home, adts) =

84 map canonical (Map.toList adts)

85 where