9311704 · elk · git.iko.soy

compiler/AST/Module.hs+20−13

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

1717

1818-- HELPFUL TYPE ALIASES

1919

20−type Interfaces = Map.Map String Interface

20+type Interfaces = Map.Map Name Interface

2121

2222type Types = Map.Map String Type.CanonicalType

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

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

3838type CanonicalModule =

3939 Module [Var.Value] CanonicalBody

4040

41−getName :: Module exs body -> String

42−getName modul =

43− nameToString (names modul)

4441

4542data Module exports body = Module

4643 { names :: Name

4744 , path :: FilePath

4845 , exports :: exports

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

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

5047 , body :: body

5148 }

5249

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

7471nameToString :: Name -> String

7572nameToString = List.intercalate "."

7673

74+nameIsNative :: Name -> Bool

75+nameIsNative name =

76+ case name of

77+ "Native" : _ -> True

78+ _ -> False

79+

80+

7781

7882-- INTERFACES

7983

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

8286 { iVersion :: String

8387 , iExports :: [Var.Value]

8488 , iTypes :: Types

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

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

8690 , iAdts :: ADTs

8791 , iAliases :: Aliases

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

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

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

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

152156

153− prettyImports = P.vcat $ map prettyMethod ims

157+ prettyImports =

158+ P.vcat $ map prettyMethod ims

154159

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

156−prettyMethod (name, method) =

157− case method of

158− As alias

160+

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

162+prettyMethod import' =

163+ case import' of

164+ ([name], As alias)

159165 | name == alias -> P.empty

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

161166

162− Open listing -> pretty listing

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

168+

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

compiler/AST/Variable.hs+12−10

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

11{-# OPTIONS_GHC -W #-}

22module AST.Variable where

33

4−import Data.Binary

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

5+import Data.Binary

6+import qualified Data.List as List

67import Text.PrettyPrint as P

78import qualified AST.Helpers as Help

89import AST.PrettyPrint

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

1213

1314data Home

1415 = BuiltIn

15− | Module !String

16+ | Module [String]

1617 | Local

1718 deriving (Eq,Ord,Show)

1819

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

2829builtin x = Canonical BuiltIn x

2930

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

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

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

3233is home name var =

3334 var == Canonical (Module home) name

3435

3536isJson :: Canonical -> Bool

36−isJson = is "Json" "Value"

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

3738

3839isMaybe :: Canonical -> Bool

39−isMaybe = is "Maybe" "Maybe"

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

4041

4142isArray :: Canonical -> Bool

42−isArray = is "Array" "Array"

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

4344

4445isSignal :: Canonical -> Bool

45−isSignal = is "Signal" "Signal"

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

4647

4748isList :: Canonical -> Bool

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

49+isList v =

50+ v == Canonical BuiltIn "_List"

4951

5052isTuple :: Canonical -> Bool

5153isTuple v =

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

6668 _ -> False

6769

6870isText :: Canonical -> Bool

69−isText = is "Text" "Text"

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

7072

7173class ToString a where

7274 toString :: a -> String

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

7880 toString (Canonical home name) =

7981 case home of

8082 BuiltIn -> name

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

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

8284 Local -> name

8385

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

compiler/Elm/Compiler.hs+26−11

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

11{-# OPTIONS_GHC -Wall #-}

22{-# LANGUAGE FlexibleContexts #-}

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

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

44

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

66import qualified Data.List as List

7+import qualified Data.Map as Map

78import System.IO.Unsafe (unsafePerformIO)

9+import qualified Text.PrettyPrint as P

810

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

10−import qualified Elm.Compiler.Module as Module

12+import qualified Build.Source as Source

13+import qualified Elm.Compiler.Module as PublicModule

1114import qualified Elm.Compiler.Version as Version

15+import qualified Generate.JavaScript as JS

1216import qualified Metadata.Prelude as Prelude

1317import qualified Parse.Helpers as Help

1418import qualified Parse.Module as Parse

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

2327

2428-- DEPENDENCIES

2529

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

2734parseDependencies src =

2835 case Help.iParse Parse.headerAndImports src of

2936 Left msg ->

3037 throwError (show msg)

3138

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

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

40+ return

41+ ( PublicModule.Name names

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

43+ )

3444

3545

3646-- COMPILATION

3747

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

39−elmToJs :: String -> Either String String

40−elmToJs source =

41− error "elmToJs is not working yet"

42−{-

43− case Source.build False interfaces source of

49+compile

50+ :: String

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

52+ -> Either String PublicModule.Interface

53+compile source interfaces =

54+ case Source.build False unwrappedInterfaces source of

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

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

46−-}

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

57+ where

58+ unwrappedInterfaces =

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

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

61+

4762

4863{-# NOINLINE interfaces #-}

4964interfaces :: Module.Interfaces

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

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

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

1+module Elm.Compiler.Module

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

3+ , nameToPath, nameToString, nameFromString

4+ )

5+ where

26

37import Control.Monad (mzero)

48import qualified Data.Aeson as Json

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

913import qualified AST.Module as Module

1014

1115

16+newtype Interface = Interface Module.Interface

17+

1218newtype Name = Name [String]

1319 deriving (Eq, Ord)

1420

compiler/Generate/JavaScript.hs+16−16

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

3030varDecl x expr =

3131 VarDecl () (var x) (Just expr)

3232

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

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

3434internalImports name =

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

3636 , include "_U" "Utils"

3737 , include "_L" "List"

3838 , include "_A" "Array"

3939 , include "_E" "Error"

40− , varDecl Help.localModuleName (string name)

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

4141 ]

4242 where

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

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

149149 MultiIf branches ->

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

151151 return $ case last branches of

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

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

153153 safeIfs branches'

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

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

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

183183

184184 Markdown uid doc es ->

185185 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')

187187 where

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

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

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

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

193193

194194 PortIn name tipe ->

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

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

196196 [ string name, Port.incoming tipe ]

197197

198198 PortOut name tipe value ->

199199 do value' <- expression value

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

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

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

202202

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

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

326326

327327 localVars :: [VarDecl ()]

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

329− internalImports (Module.getName modul) ++

329+ internalImports (Module.names modul) ++

330330 explicitImports

331331 where

332332 explicitImports :: [VarDecl ()]

333333 explicitImports =

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

335335

336− jsImport :: String -> VarDecl ()

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

337337 jsImport name =

338338 varDecl (Var.moduleName name) $

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

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

340340

341341 body :: [Statement ()]

342342 body = concat $ evalState defs 0

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

369369 -> State Int (Expression ())

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

371371 case (home, op) of

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

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

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

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

375375

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

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

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

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

379379

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

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

381381 do e2' <- expression e2

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

383383 return $ foldr (<|) e2' es

384384

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

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

386386 do e1' <- expression e1

387387 e2' <- expression e2

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

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

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

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

392392

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

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

394394 do e1' <- expression e1

395395 e2' <- expression e2

396396 return $ case Map.lookup op basicOps of

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

405405 where

406406 collectRightAssoc es e =

407407 case e of

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

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

409409 collectRightAssoc (es ++ [e1]) e2

410410 _ -> es ++ [e]

411411

412412 collectLeftAssoc es e =

413413 case e of

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

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

415415 collectLeftAssoc (e2 : es) e1

416416 _ -> e : es

417417

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

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

3131 Aliased _ t -> incoming t

3232

3333 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

3535

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

3737

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

5252 from checks = check x checks x

5353

5454 Type name

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

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

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

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

5858

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

6262 | Var.isMaybe name ->

6363 CondExpr ()

6464 (equal x (NullLit ()))

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

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

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

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

6767

6868 | Var.isList name ->

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

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

107107 Aliased _ t -> outgoing t

108108

109109 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

111111

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

113113

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

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

138138

139139 Type name

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

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

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

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

143143

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

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

22module Generate.JavaScript.Variable where

33

44import qualified AST.Helpers as Help

5+import qualified AST.Module as Module

56import qualified AST.Variable as Var

7+import qualified Data.List as List

68import qualified Data.Set as Set

79import qualified Generate.JavaScript.Helpers as JS

810import qualified Language.ECMAScript3.Syntax as JS

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

2224 Var.BuiltIn -> []

2325 Var.Module path -> [ moduleName path ]

2426

25−moduleName :: String -> String

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

27+moduleName :: Module.Name -> String

28+moduleName name =

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

2730

2831varName :: String -> String

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

3033 where

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

3235

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

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

3437value home name =

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

3639

compiler/Metadata/Prelude.hs+15−11

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

1616-- DEFINITION OF THE PRELUDE

1717

1818type ImportDict =

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

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

2020

2121

2222prelude :: ImportDict

2323prelude =

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

2525 where

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

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

2727 importing name values =

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

2929

3030 openImports :: ImportDict

3131 openImports =

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

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

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

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

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

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

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

3636 ]

3737

3838 maybe :: ImportDict

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

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

4040

4141 string :: ImportDict

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

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

4343

4444 text :: ImportDict

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

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

4646 where

4747 values =

4848 map Var.Value

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

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

6363

6464

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

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

6666importDictToList dict =

6767 concatMap toImports (Map.toList dict)

6868 where

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

7474 else []

7575

7676

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

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

7878addImport (name, method) importDict =

7979 Map.alter mergeMethods name importDict

8080 where

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

117117 _ -> return (Map.fromList interfaces)

118118

119119

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)

121125isValid filePath (name, interface) =

122126 if version == Compiler.version

123127 then return (name, interface)

compiler/Parse/Parse.hs+1−3

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

22module Parse.Parse (program) where

33

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

5−import Control.Arrow (first)

65import qualified Data.List as List

76import qualified Data.Map as Map

87import Text.Parsec hiding (newline, spaces)

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

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

3837 declarations <- decls

3938 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

4240

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

4442setupParserWithTable table p source =

compiler/Transform/Canonicalize.hs+13−12

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

5858 body decls =

5959 Module.CanonicalBody

6060 { program =

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

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

6262 in Transform.sortDefs (dummyLet expr)

6363 , types = Map.empty

6464 , datatypes =

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

181181 return (D.TypeAlias name tvars expanded')

182182

183183 D.Port port -> do

184− Env.uses "Native.Ports"

185− Env.uses "Native.Json"

186− D.Port <$> case port of

187− D.In name t ->

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

189− return (D.In name t')

190− D.Out name e t ->

191− do e' <- expression env e

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

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

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

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

186+ D.Port <$>

187+ case port of

188+ D.In name t ->

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

190+ return (D.In name t')

191+ D.Out name e t ->

192+ do e' <- expression env e

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

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

194195

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

196197

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

254255 <*> expression (update p env) b

255256

256257 Markdown uid md es ->

257− do Env.uses "Text"

258+ do Env.uses ["Text"]

258259 Markdown uid md <$> mapM go es

259260

260261 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

88import qualified Data.Set as Set

99

1010import AST.Expression.General (saveEnvName)

11+import qualified AST.Module as Module

1112import qualified AST.Pattern as P

1213import qualified AST.Type as Type

1314import qualified AST.Variable as Var

1415

1516import Text.PrettyPrint (Doc)

1617

18+

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

1820

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

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

22+dict pairs =

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

2124

2225insert :: String -> a -> Dict a -> Dict a

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

26+insert key value =

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

28+

2429

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

30+type Canonicalizer err a =

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

2632

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

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

2834uses home =

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

3036

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

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

4753 Right x -> return x

4854

55+

4956data Environment = Env

50− { _home :: String

57+ { _home :: Module.Name

5158 , _values :: Dict Var.Canonical

5259 , _adts :: Dict Var.Canonical

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

5461 , _patterns :: Dict Var.Canonical

5562 }

5663

57−builtIns :: String -> Environment

64+builtIns :: Module.Name -> Environment

5865builtIns home =

5966 Env { _home = home

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

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

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

2323import qualified Transform.Canonicalize.Type as Canonicalize

2424import qualified Transform.Interface as Interface

2525

26+

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

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

2829 do () <- allImportsAvailable

29− let moduleName = Module.getName modul

30+ let moduleName = Module.names modul

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

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

3233 addTypeAliases moduleName aliases env

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

3940 where

4041 modules = map fst imports

4142

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

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

4344

4445 missingModuleError missings =

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

46− , List.intercalate ", " missings

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

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

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

4950

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

51+

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

5153 -> Canonicalizer [Doc] Environment

5254addImports moduleName interfaces environ (name, method)

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

55+ | Module.nameIsNative name = return environ

5456 | otherwise =

5557 case method of

5658 Module.As name' ->

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

8284

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

8486

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

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

8688 -> Canonicalizer [Doc] Environment

87−addValue name interface env value =

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

89+addValue moduleName interface env value =

90+ let name = Module.nameToString moduleName

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

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

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

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

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

104107 , _values = updatedValues

105108 }

106109 where

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

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

108111 updatedValues =

109112 if Map.member x (iTypes interface)

110113 then insert' x (_values env)

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

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

148151 Type.Aliased _ t -> edges t

149152

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

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

151154addTypeAliases moduleName nodes environ =

152155 foldM addTypeAlias environ (Graph.stronglyConnComp nodes)

153156 where

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

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

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

195198-- escape the module.

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

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

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

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

199202 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

77import Data.Maybe (fromMaybe)

88

99import AST.Helpers as Help

10+import qualified AST.Module as Module

1011import qualified AST.Type as Type

1112import qualified AST.Variable as Var

1213import Transform.Canonicalize.Environment as Env

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

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

1516variable env var =

1617 case modul of

17− Just ms@(m:_)

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

19− where

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

18+ Just name

19+ | Module.nameIsNative name ->

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

2121

2222 _ ->

2323 case Map.lookup var (_values env) of

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

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

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

2727 where

28− (modul, name) =

28+ (modul, varName) =

2929 case Help.splitDots var of

3030 [x] -> (Nothing, x)

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

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

8383 case home of

8484 Var.Local -> True

8585 Var.BuiltIn -> False

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

86+ Var.Module name ->

87+ name == Env._home env

8788

8889 ambiguous possibleVars =

8990 throwError msg

compiler/Transform/Declaration.hs+3−2

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

99import qualified AST.Expression.Source as Source

1010import qualified AST.Expression.Valid as Valid

1111import qualified AST.Expression.Canonical as Canonical

12+import qualified AST.Module as Module

1213import qualified AST.Pattern as P

1314import qualified AST.Type as T

1415import qualified AST.Variable as Var

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

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

7172

7273

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

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

7475toExpr moduleName = concatMap (toDefs moduleName)

7576

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

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

7778toDefs moduleName decl =

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

7980 case decl of

compiler/Type/Inference.hs+4−4

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

6262 return (header, environ c)

6363

6464

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

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

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

6767canonicalizeValues env (moduleName, iface) =

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

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

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

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

7171

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

7373canonicalizeAdts interfaces modul =

7474 localAdts ++ importedAdts

7575 where

7676 localAdts :: [CanonicalAdt]

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

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

7878

7979 importedAdts :: [CanonicalAdt]

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

8181

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

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

8383 format (home, adts) =

8484 map canonical (Map.toList adts)

8585 where