4c27440 · elk · git.iko.soy

compiler/Build/File.hs+30−8

@@ -10,6 +10,7 @@ import System.FilePath

1010import System.IO

1111

1212import qualified Data.Binary as Binary

13+import qualified Data.List as List

1314import qualified Data.Maybe as Maybe

1415import qualified Data.Map as Map

1516import qualified Data.ByteString.Lazy as L

@@ -34,17 +35,37 @@ type Build a = BuildT IO a

3435-- Interfaces, remembering if something was recompiled

3536type BInterfaces = Map.Map String (Bool, M.ModuleInterface)

3637

37−evalBuild :: Flag.Flags -> M.Interfaces -> Build () -> IO (Maybe String)

38−evalBuild flags interfaces b = do

39− (_, s) <- evalRWST b flags (fmap notUpdated interfaces)

40− return . getLast $ s

38+evalBuild :: Flag.Flags -> M.Interfaces -> Build ()

39+ -> IO (Map.Map String M.ModuleInterface, Maybe String)

40+evalBuild flags interfaces build =

41+ do (ifaces, moduleNames) <- execRWST build flags (fmap notUpdated interfaces)

42+ return (fmap snd ifaces, getLast moduleNames)

4143 where

42− notUpdated i = (False, i)

44+ notUpdated iface = (False, iface)

4345

4446-- | Builds a list of files, returning the moduleName of the last one.

4547-- Returns \"\" if the list is empty

4648build :: Flag.Flags -> M.Interfaces -> [FilePath] -> IO String

47−build flags is = fmap (Maybe.fromMaybe "") . evalBuild flags is . buildAll

49+build flags interfaces files =

50+ do (ifaces, topName) <- evalBuild flags interfaces (buildAll files)

51+ let removeTopName = Maybe.maybe id Map.delete topName

52+ mapM_ (checkPorts topName) (Map.toList $ removeTopName ifaces)

53+ return $ Maybe.fromMaybe "" topName

54+ where

55+ checkPorts topName (name,iface)

56+ | null ports = return ()

57+ | otherwise = Print.failure msg

58+ where

59+ ports = M.iPorts iface

60+ msg = concat

61+ [ "Port Error: ports may only appear in the main module, but\n"

62+ , " sub-module ", name, " declares the following port"

63+ , if length ports == 1 then "" else "s", ": "

64+ , List.intercalate ", " ports

65+ , case topName of

66+ Nothing -> ""

67+ Just tname -> "\n All ports must appear in module " ++ tname

68+ ]

4869

4970buildAll :: [FilePath] -> Build ()

5071buildAll fs = mapM_ (uncurry build1) (zip [1..] fs)

@@ -152,5 +173,6 @@ compile number filePath =

152173 L.hPut handle (Binary.encode (name, interfs))

153174

154175update :: String -> M.ModuleInterface -> Bool -> Build ()

155−update name inter wasUpdated = modify (Map.insert name (wasUpdated, inter))

156− >> tell (Last . Just $ name)

176+update name inter wasUpdated =

177+ do modify (Map.insert name (wasUpdated, inter))

178+ tell (Last . Just $ name)

compiler/Build/Interface.hs+3−8

@@ -4,28 +4,23 @@ module Build.Interface (load,isValid) where

44import qualified Data.ByteString.Lazy as L

55import qualified Data.Binary as Binary

66

7+import qualified Build.Print as Print

78import qualified Elm.Internal.Version as Version

89import System.Directory (doesFileExist)

9−import System.Exit

10−import System.IO

11−

1210import SourceSyntax.Module

1311

1412load :: Binary.Binary a => FilePath -> IO a

1513load filePath =

1614 do exists <- doesFileExist filePath

1715 case exists of

18− False -> failure $ "Unable to find file " ++ filePath ++ " for deserialization!"

16+ False -> Print.failure $ "Unable to find file " ++ filePath ++ " for deserialization!"

1917 True -> do

2018 bytes <- L.readFile filePath

2119 case Binary.decodeOrFail bytes of

2220 Right (_, _, binaryInfo) -> return binaryInfo

23− Left (_, offset, err) -> failure $ msg offset err

21+ Left (_, offset, err) -> Print.failure $ msg offset err

2422

2523 where

26− failure err = do hPutStrLn stderr err

27− exitFailure

28−

2924 msg offset err = concat

3025 [ "Error reading build artifact: ", filePath, "\n"

3126 , " '", err, "' at offset ", show offset, "\n"

compiler/Build/Source.hs+5−4

@@ -35,8 +35,8 @@ build noPrelude interfaces source =

3535 | null exs =

3636 let get = Set.toList . Pattern.boundVars in

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

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

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

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

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

4040 | otherwise = exs

4141

4242 metaModule <- Canonical.metadataModule interfaces $

@@ -48,9 +48,10 @@ build noPrelude interfaces source =

4848 -- reorder AST into strongly connected components

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

5050 , types = Map.empty

51− , datatypes = [ (name,vars,ctors,ds) | Datatype name vars ctors ds <- decls ]

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

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

53− , aliases = [ (name,tvs,tipe,ds) | TypeAlias name tvs tipe ds <- decls ]

53+ , aliases = [ (name,tvs,tipe) | TypeAlias name tvs tipe <- decls ]

54+ , ports = [ portName port | Port port <- decls ]

5455 }

5556

5657 types <- TI.infer interfaces metaModule

compiler/Docs.hs+4−8

@@ -134,14 +134,13 @@ collect infixes types aliases adts things =

134134 collect (Map.insert name (assoc,prec) infixes) types aliases adts rest

135135 D.Definition (E.TypeAnnotation name tipe) ->

136136 collect infixes (insert name [ "type" .= tipe ] types) aliases adts rest

137− D.TypeAlias name vars tipe derivations ->

138− let fields = ["typeVariables" .= vars, "type" .= tipe, "deriving" .= derivations ]

137+ D.TypeAlias name vars tipe ->

138+ let fields = ["typeVariables" .= vars, "type" .= tipe ]

139139 in collect infixes types (insert name fields aliases) adts rest

140− D.Datatype name vars ctors derivations ->

140+ D.Datatype name vars ctors ->

141141 let tipe = Data name (map Var vars)

142142 fields = ["typeVariables" .= vars

143− , "constructors" .= map (ctorToJson tipe) ctors

144− , "deriving" .= derivations ]

143+ , "constructors" .= map (ctorToJson tipe) ctors ]

145144 in collect infixes types aliases (insert name fields adts) rest

146145 where

147146 insert name fields dict = Map.insert name (obj name fields) dict

@@ -162,6 +161,3 @@ instance ToJSON Type where

162161ctorToJson tipe (ctor, tipes) =

163162 object [ "name" .= ctor

164163 , "type" .= foldr Lambda tipe tipes ]

165−

166−instance ToJSON D.Derivation where

167− toJSON = toJSON . show

compiler/Parse/Declaration.hs+3−7

@@ -24,11 +24,7 @@ alias = do

2424 args <- spacePrefix lowVar

2525 padded equals

2626 tipe <- Type.expr

27− json <- option [] $ do

28− try $ padded (reserved "deriving")

29− string "Json"

30− return [D.Json]

31− return (D.TypeAlias name args tipe json)

27+ return (D.TypeAlias name args tipe)

3228

3329datatype :: IParser D.ParseDeclaration

3430datatype = do

@@ -38,7 +34,7 @@ datatype = do

3834 args <- spacePrefix lowVar

3935 padded equals

4036 tcs <- pipeSep1 Type.constructor

41− return $ D.Datatype name args tcs []

37+ return $ D.Datatype name args tcs

4238

4339

4440infixDecl :: IParser D.ParseDeclaration

@@ -60,4 +56,4 @@ port =

6056 whitespace

6157 let port' op ctor expr = do { try op ; whitespace ; ctor name <$> expr }

6258 D.Port <$> choice [ port' hasType D.PPAnnotation Type.expr

63− , port' equals D.PPDef Expr.expr ]

59+ , port' equals D.PPDef Expr.expr ]

compiler/Paths_Elm.h → compiler/Paths_Elmrenamed

The content is the same.

compiler/SourceSyntax/Declaration.hs+12−35

@@ -9,8 +9,8 @@ import Text.PrettyPrint as P

99

1010data Declaration' port def

1111 = Definition def

12− | Datatype String [String] [(String,[T.Type])] [Derivation]

13− | TypeAlias String [String] T.Type [Derivation]

12+ | Datatype String [String] [(String,[T.Type])]

13+ | TypeAlias String [String] T.Type

1414 | Port port

1515 | Fixity Assoc Int String

1616 deriving (Show)

@@ -18,9 +18,6 @@ data Declaration' port def

1818data Assoc = L | N | R

1919 deriving (Eq)

2020

21−data Derivation = Json | JS | Binary | New

22− deriving (Eq, Show)

23−

2421data ParsePort

2522 = PPAnnotation String T.Type

2623 | PPDef String Expr.LParseExpr

@@ -31,26 +28,15 @@ data Port

3128 | In String T.Type

3229 deriving (Show)

3330

31+portName :: Port -> String

32+portName port =

33+ case port of

34+ Out name _ _ -> name

35+ In name _ -> name

36+

3437type ParseDeclaration = Declaration' ParsePort Expr.ParseDef

3538type Declaration = Declaration' Port Expr.Def

3639

37−instance Binary Derivation where

38− get = do n <- getWord8

39− return $ case n of

40− 0 -> Json

41− 1 -> JS

42− 2 -> Binary

43− 3 -> New

44− _ -> error "Unable to decode Derivation. You may have corrupted binary files,\n\

45− \so please report an issue at <https://github.com/evancz/Elm/issues>"

46−

47− put derivation =

48− putWord8 $ case derivation of

49− Json -> 0

50− JS -> 1

51− Binary -> 2

52− New -> 3

53−

5440instance Show Assoc where

5541 show assoc =

5642 case assoc of

@@ -73,19 +59,18 @@ instance (Pretty port, Pretty def) => Pretty (Declaration' port def) where

7359 case decl of

7460 Definition def -> pretty def

7561

76− Datatype tipe tvars ctors deriveables ->

62+ Datatype tipe tvars ctors ->

7763 P.hang (P.text "data" <+> P.text tipe <+> P.hsep (map P.text tvars)) 4

78− (P.sep $ zipWith join ("=" : repeat "|") ctors) <+> prettyDeriving deriveables

64+ (P.sep $ zipWith join ("=" : repeat "|") ctors)

7965 where

8066 join c ctor = P.text c <+> prettyCtor ctor

8167 prettyCtor (name, tipes) =

8268 P.hang (P.text name) 2 (P.sep (map T.prettyParens tipes))

8369

84− TypeAlias name tvars tipe deriveables ->

85− alias <+> prettyDeriving deriveables

70+ TypeAlias name tvars tipe ->

71+ P.hang (P.text "type" <+> name' <+> P.equals) 4 (pretty tipe)

8672 where

8773 name' = P.text name <+> P.hsep (map P.text tvars)

88− alias = P.hang (P.text "type" <+> name' <+> P.equals) 4 (pretty tipe)

8974

9075 Port port -> pretty port

9176

@@ -112,11 +97,3 @@ instance Pretty Port where

11297

11398prettyPort :: (Pretty a) => String -> String -> a -> Doc

11499prettyPort name op e = P.text "port" <+> P.text name <+> P.text op <+> pretty e

115−

116−prettyDeriving :: [Derivation] -> Doc

117−prettyDeriving deriveables =

118− case deriveables of

119− [] -> P.empty

120− [d] -> P.text "deriving" <+> P.text (show d)

121− ds -> P.text "deriving" <+>

122− P.parens (P.hsep $ P.punctuate P.comma $ map (P.text . show) ds)

compiler/SourceSyntax/Module.hs+16−11

@@ -47,20 +47,23 @@ data MetadataModule =

4747 , fixities :: [(Assoc, Int, String)]

4848 , aliases :: [Alias]

4949 , datatypes :: [ADT]

50+ , ports :: [String]

5051 } deriving Show

5152

5253type Interfaces = Map.Map String ModuleInterface

53−type ADT = (String, [String], [(String,[Type])], [Derivation])

54−type Alias = (String, [String], Type, [Derivation])

54+type ADT = (String, [String], [(String,[Type])])

55+type Alias = (String, [String], Type)

5556

56−data ModuleInterface = ModuleInterface {

57− iVersion :: Version.Version,

58− iTypes :: Map.Map String Type,

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

60− iAdts :: [ADT],

61− iAliases :: [Alias],

62− iFixities :: [(Assoc, Int, String)]

63−} deriving Show

57+data ModuleInterface =

58+ ModuleInterface

59+ { iVersion :: Version.Version

60+ , iTypes :: Map.Map String Type

61+ , iImports :: [(String, ImportMethod)]

62+ , iAdts :: [ADT]

63+ , iAliases :: [Alias]

64+ , iFixities :: [(Assoc, Int, String)]

65+ , iPorts :: [String]

66+ } deriving Show

6467

6568metaToInterface :: MetadataModule -> ModuleInterface

6669metaToInterface metaModule =

@@ -71,10 +74,11 @@ metaToInterface metaModule =

7174 , iAdts = datatypes metaModule

7275 , iAliases = aliases metaModule

7376 , iFixities = fixities metaModule

77+ , iPorts = ports metaModule

7478 }

7579

7680instance Binary ModuleInterface where

77− get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get

81+ get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get <*> get

7882 put modul = do

7983 put (iVersion modul)

8084 put (iTypes modul)

@@ -82,3 +86,4 @@ instance Binary ModuleInterface where

8286 put (iAdts modul)

8387 put (iAliases modul)

8488 put (iFixities modul)

89+ put (iPorts modul)

compiler/Transform/Canonicalize.hs+8−7

@@ -25,13 +25,14 @@ interface moduleName iface =

2525 , iAdts = map (both prefix renameCtors) (iAdts iface)

2626 , iAliases = map (both prefix renameType') (iAliases iface)

2727 , iFixities = iFixities iface -- cannot have canonicalized operators while parsing

28+ , iPorts = iPorts iface

2829 }

2930 where

30− both f g (a,b,c,d) = (f a, b, g c, d)

31+ both f g (a,b,c) = (f a, b, g c)

3132 prefix name = moduleName ++ "." ++ name

3233

3334 pair name = (name, moduleName ++ "." ++ name)

34− canon (name,_,_,_) = pair name

35+ canon (name,_,_) = pair name

3536 canons = Map.fromList $ concat

3637 [ map canon (iAdts iface), map canon (iAliases iface) ]

3738

@@ -56,24 +57,24 @@ metadataModule ifaces modul =

5657 [] -> Right ()

5758 missings -> Left [ P.text $ "The following imports were not found: " ++ List.intercalate ", " missings ]

5859 program' <- rename initialEnv (program modul)

59− aliases' <- mapM (three4 renameType') (aliases modul)

60− datatypes' <- mapM (three4 (mapM (two2 (mapM renameType')))) (datatypes modul)

60+ aliases' <- mapM (three3 renameType') (aliases modul)

61+ datatypes' <- mapM (three3 (mapM (two2 (mapM renameType')))) (datatypes modul)

6162 return $ modul { program = program'

6263 , aliases = aliases'

6364 , datatypes = datatypes' }

6465 where

6566 two2 f (a,b) = (,) a <$> f b

66− three4 f (a,b,c,d) = (,,,) a b <$> f c <*> return d

67+ three3 f (a,b,c) = (,,) a b <$> f c

6768 renameType' =

6869 Either.either (\err -> Left [P.text err]) return . renameType (replace "type" initialEnv)

6970

70− get1 (a,_,_,_) = a

71+ get1 (a,_,_) = a

7172 canon (name, importMethod) =

7273 let pair pre var = (pre ++ drop (length name + 1) var, var)

7374 iface = ifaces Map.! name

7475 allNames = concat [ Map.keys (iTypes iface)

7576 , map get1 (iAliases iface)

76− , concat [ n : map fst ctors | (n,_,ctors,_) <- iAdts iface ] ]

77+ , concat [ n : map fst ctors | (n,_,ctors) <- iAdts iface ] ]

7778 in case importMethod of

7879 As alias -> map (pair (alias ++ ".")) allNames

7980 Hiding vars -> map (pair "") $ filter (flip Set.notMember vs) allNames

compiler/Transform/Check.hs+10−32

@@ -21,8 +21,7 @@ mistakes decls =

2121 concat [ infiniteTypeAliases decls

2222 , illFormedTypes decls

2323 , map P.text (duplicateConstructors decls)

24− , map P.text (duplicates decls)

25− , badDerivations decls ]

24+ , map P.text (duplicates decls) ]

2625

2726dups :: Ord a => [a] -> [a]

2827dups = map head . filter ((>1) . length) . List.group . List.sort

@@ -67,35 +66,14 @@ duplicateConstructors decls =

6766 map (dupErr "definition of type constructor") (dups typeCtors) ++

6867 map (dupErr "definition of data constructor") (dups dataCtors)

6968 where

70− typeCtors = [ name | D.Datatype name _ _ _ <- decls ]

71− dataCtors = concat [ map fst patterns | D.Datatype _ _ patterns _ <- decls ]

72−

73−badDerivations :: [D.Declaration] -> [Doc]

74−badDerivations decls = concatMap badDerivation derivations

75− where

76− derivations =

77− [ (decl, tvars, derives) | decl@(D.TypeAlias _ tvars _ derives) <- decls ] ++

78− [ (decl, tvars, derives) | decl@(D.Datatype _ tvars _ derives) <- decls ]

79−

80− badDerivation (decl, tvars, derives) =

81− case (tvars, derives) of

82− (_:_, _)

83− | D.Json `elem` derives -> [report decl D.Json]

84− | D.Binary `elem` derives -> [report decl D.Binary]

85− _ -> []

86−

87− report decl derive =

88− P.vcat [ P.text $ "Error: cannot derive '" ++ show derive ++ "' from this type alias."

89− , P.text "Make sure all type variables are replaced with concrete types:"

90− , P.text "\n"

91− , nest 4 (pretty decl)

92− ]

69+ typeCtors = [ name | D.Datatype name _ _ <- decls ]

70+ dataCtors = concat [ map fst patterns | D.Datatype _ _ patterns <- decls ]

9371

9472illFormedTypes :: [D.Declaration] -> [Doc]

9573illFormedTypes decls = map report (Maybe.mapMaybe isIllFormed (aliases ++ adts))

9674 where

97− aliases = [ (decl, tvars, [tipe]) | decl@(D.TypeAlias _ tvars tipe _) <- decls ]

98− adts = [ (decl, tvars, concatMap snd ctors) | decl@(D.Datatype _ tvars ctors _) <- decls ]

75+ aliases = [ (decl, tvars, [tipe]) | decl@(D.TypeAlias _ tvars tipe) <- decls ]

76+ adts = [ (decl, tvars, concatMap snd ctors) | decl@(D.Datatype _ tvars ctors) <- decls ]

9977

10078 freeVars tipe =

10179 case tipe of

@@ -138,8 +116,8 @@ illFormedTypes decls = map report (Maybe.mapMaybe isIllFormed (aliases ++ adts))

138116

139117infiniteTypeAliases :: [D.Declaration] -> [Doc]

140118infiniteTypeAliases decls =

141− [ report name tvars tipe ds | D.TypeAlias name tvars tipe ds <- decls

142− , infiniteType name tipe ]

119+ [ report name tvars tipe | D.TypeAlias name tvars tipe <- decls

120+ , infiniteType name tipe ]

143121 where

144122 infiniteType name tipe =

145123 let infinite = infiniteType name in

@@ -152,11 +130,11 @@ infiniteTypeAliases decls =

152130 indented :: D.Declaration -> Doc

153131 indented decl = P.text "\n " <> pretty decl <> P.text "\n"

154132

155− report name args tipe derivations =

133+ report name args tipe =

156134 P.vcat [ P.text $ eightyCharLines 0 msg1

157− , indented $ D.TypeAlias name args tipe derivations

135+ , indented $ D.TypeAlias name args tipe

158136 , P.text $ eightyCharLines 0 msg2

159− , indented $ D.Datatype name args [(name,[tipe])] derivations

137+ , indented $ D.Datatype name args [(name,[tipe])]

160138 , P.text $ eightyCharLines 0 msg3 ++ "\n"

161139 ]

162140 where

compiler/Transform/Declaration.hs+4−4

@@ -23,11 +23,11 @@ combineAnnotations = go

2323 -- simple cases, pass them through with no changes

2424 [] -> return []

2525

26− Datatype name tvars ctors ds : rest ->

27− (:) (Datatype name tvars ctors ds) <$> go rest

26+ Datatype name tvars ctors : rest ->

27+ (:) (Datatype name tvars ctors) <$> go rest

2828

29− TypeAlias name tvars alias ds : rest ->

30− (:) (TypeAlias name tvars alias ds) <$> go rest

29+ TypeAlias name tvars alias : rest ->

30+ (:) (TypeAlias name tvars alias) <$> go rest

3131

3232 Fixity assoc prec op : rest ->

3333 (:) (Fixity assoc prec op) <$> go rest

compiler/Transform/SafeNames.hs+3−3

@@ -64,9 +64,9 @@ metadataModule modul =

6464 , imports = map (first var) (imports modul)

6565 , program = expression (program modul)

6666 , aliases =

67− let makeSafe (name,tvars,tipe,ds) = (var name, tvars, tipe, ds)

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

6868 in map makeSafe (aliases modul)

6969 , datatypes =

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

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

7171 in map makeSafe (datatypes modul)

72− }

72+ }

compiler/Type/Alias.hs+3−3

@@ -21,7 +21,7 @@ collect interfaces moduleAliases =

2121 rawAliases =

2222 moduleAliases ++ concatMap iAliases (Map.elems interfaces)

2323

24− isPrimitive (_,_,tipe,_) =

24+ isPrimitive (_,_,tipe) =

2525 case tipe of

2626 Data _ [] -> True

2727 _ -> False

@@ -68,7 +68,7 @@ canonicalRealias aliases tipe =

6868 [] -> if tipe == tipe' then tipe else f tipe'

6969 tipes -> f (bestType tipes)

7070 where

71− tryRealias (name, args, aliasTipe, _) =

71+ tryRealias (name, args, aliasTipe) =

7272 case diff aliasTipe tipe of

7373 Nothing -> []

7474 Just kvs ->

@@ -136,4 +136,4 @@ collectFields fields =

136136 foldr (\(f,t) fs -> Map.insertWith (++) f [t] fs) Map.empty fields

137137

138138flattenFields fields =

139− concatMap (\(f,ts) -> map ((,) f) ts) (Map.toList fields)

139+ concatMap (\(f,ts) -> map ((,) f) ts) (Map.toList fields)

compiler/Type/Constrain/Declaration.hs+4−5

@@ -15,7 +15,7 @@ toDefs decl =

1515 case decl of

1616 Definition def -> [def]

1717

18− Datatype name tvars constructors _ -> concatMap toDefs' constructors

18+ Datatype name tvars constructors -> concatMap toDefs' constructors

1919 where

2020 toDefs' (ctor, tipes) =

2121 let vars = take (length tipes) arguments

@@ -23,7 +23,7 @@ toDefs decl =

2323 body = L.none . E.Data ctor $ map (L.none . E.Var) vars

2424 in [ definition ctor (buildFunction body vars) (foldr T.Lambda tbody tipes) ]

2525

26− TypeAlias name _ tipe@(T.Record fields ext) _ ->

26+ TypeAlias name _ tipe@(T.Record fields ext) ->

2727 [ definition name (buildFunction record vars) (foldr T.Lambda tipe args) ]

2828 where

2929 args = map snd fields ++ maybe [] (\x -> [T.Var x]) ext

@@ -38,8 +38,7 @@ toDefs decl =

3838

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

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

41− -- TODO: with the ability to derive code, you may need to generate stuff!

42− TypeAlias _ _ _ _ -> []

41+ TypeAlias _ _ _ -> []

4342

4443 Port port ->

4544 case port of

@@ -60,4 +59,4 @@ buildFunction body@(L.L s _) vars =

6059 foldr (\p e -> L.L s (E.Lambda p e)) body (map P.PVar vars)

6160

6261definition :: String -> E.LExpr -> T.Type -> E.Def

63−definition name expr tipe = E.Definition (P.PVar name) expr (Just tipe)

62+definition name expr tipe = E.Definition (P.PVar name) expr (Just tipe)

compiler/Type/Environment.hs+4−4

@@ -29,7 +29,7 @@ data Environment = Environment {

2929initialEnvironment :: [ADT] -> [Alias] -> IO Environment

3030initialEnvironment datatypes aliases = do

3131 types <- makeTypes datatypes

32− let aliases' = Map.fromList $ map (\(a,b,c,_) -> (a,(b,c))) aliases

32+ let aliases' = Map.fromList $ map (\(a,b,c) -> (a,(b,c))) aliases

3333 env = Environment {

3434 constructor = Map.empty,

3535 value = Map.empty,

@@ -42,7 +42,7 @@ makeTypes :: [ADT] -> IO TypeDict

4242makeTypes datatypes =

4343 Map.fromList <$> mapM makeCtor (builtins ++ map nameAndKind datatypes)

4444 where

45− nameAndKind (name, tvars, _, _) = (name, length tvars)

45+ nameAndKind (name, tvars, _) = (name, length tvars)

4646

4747 makeCtor (name, _) = do

4848 ctor <- VarN <$> namedVar Constant name

@@ -84,7 +84,7 @@ makeConstructors env datatypes = Map.fromList builtins

8484

8585

8686ctorToType :: Environment -> ADT -> [ (String, IO (Int, [Variable], [Type], Type)) ]

87−ctorToType env (name, tvars, ctors, _) =

87+ctorToType env (name, tvars, ctors) =

8888 zip (map fst ctors) (map inst ctors)

8989 where

9090 inst :: (String, [Src.Type]) -> IO (Int, [Variable], [Type], Type)

@@ -167,4 +167,4 @@ instantiator env sourceType = go sourceType

167167 ext' <- case ext of

168168 Nothing -> return $ TermN EmptyRecord1

169169 Just x -> go (Src.Var x)

170− return $ TermN (Record1 fields' ext')

170+ return $ TermN (Record1 fields' ext')

libraries/Native/List.js+3−3

@@ -55,7 +55,7 @@ Elm.Native.List.make = function(elm) {

5555 function append(xs,ys) {

5656 // append Text

5757 if (xs.text || ys.text) {

58− return Utils.txt(Utils.makeText('',xs) + Utils.makeText('',ys));

58+ return Utils.txt(Utils.makeText(xs) + Utils.makeText(ys));

5959 }

6060

6161 // append Strings

@@ -270,10 +270,10 @@ Elm.Native.List.make = function(elm) {

270270

271271 function join(sep, xss) {

272272 if (sep.text) {

273− sep = Utils.makeText('',sep);

273+ sep = Utils.makeText(sep);

274274 xss = toArray(xss);

275275 for (var i = xss.length; i--; ) {

276− xss[i] = Utils.makeText('',xss[i]);

276+ xss[i] = Utils.makeText(xss[i]);

277277 }

278278 return Utils.txt(xss.join(sep));

279279 }

libraries/Native/Text.js+7−5

@@ -91,10 +91,11 @@ Elm.Native.Text.make = function(elm) {

9191 function position(align) {

9292 function create(text) {

9393 var raw = {

94− ctor:'RawHtml',

95− html: Utils.makeText('text-align:' + align + ';', text),

96− guid: null,

97− args: [],

94+ ctor :'RawHtml',

95+ html : Utils.makeText(text),

96+ align: align,

97+ guid : null,

98+ args : [],

9899 };

99100 var pos = A2(Utils.htmlHeight, 0, raw);

100101 return A3(Element.newElement, pos._0, pos._1, raw);

@@ -106,6 +107,7 @@ Elm.Native.Text.make = function(elm) {

106107 var raw = {

107108 ctor:'RawHtml',

108109 html: text,

110+ align: null,

109111 guid: guid,

110112 args: [],

111113 };

@@ -145,4 +147,4 @@ Elm.Native.Text.make = function(elm) {

145147

146148 asText : asText,

147149 };

148−};

150+};

libraries/Native/Utils.js+2−2

@@ -74,8 +74,8 @@ Elm.Native.Utils.make = function(elm) {

7474 return t;

7575 }

7676

77− function makeText(style, text) {

78− var style = style;

77+ function makeText(text) {

78+ var style = '';

7979 var line = '';

8080 var href = '';

8181 while (true) {

libraries/Signal.elm+12−9

@@ -106,13 +106,13 @@ countIf = Native.Signal.countIf

106106

107107{-| Keep only events that satisfy the given predicate. Elm does not allow

108108undefined signals, so a base case must be provided in case the predicate is

109−never satisfied. -}

109+not satisfied initially. -}

110110keepIf : (a -> Bool) -> a -> Signal a -> Signal a

111111keepIf = Native.Signal.keepIf

112112

113113{-| Drop events that satisfy the given predicate. Elm does not allow undefined

114−signals, so a base case must be provided in case the predicate is never

115−satisfied. -}

114+signals, so a base case must be provided in case the predicate is satisfied

115+initially. -}

116116dropIf : (a -> Bool) -> a -> Signal a -> Signal a

117117dropIf = Native.Signal.dropIf

118118

@@ -120,21 +120,24 @@ dropIf = Native.Signal.dropIf

120120becomes true, the most recent value of the second signal will be propagated.

121121Until the first signal becomes false again, all events will be propagated. Elm

122122does not allow undefined signals, so a base case must be provided in case the

123−first signal is never true. -}

123+first signal is not true initially. -}

124124keepWhen : Signal Bool -> a -> Signal a -> Signal a

125125keepWhen = Native.Signal.keepWhen

126126

127127{-| Drop events when the first signal is true. When the first signal becomes

128128false, the most recent value of the second signal will be propagated. Until the

129129first signal becomes true again, all events will be propagated. Elm does not

130−allow undefined signals, so a base case must be provided in case the first

131−signal is always true. -}

130+allow undefined signals, s oa base case must be provided in case the first

131+signal is true initially. -}

132132dropWhen : Signal Bool -> a -> Signal a -> Signal a

133133dropWhen = Native.Signal.dropWhen

134134

135−{-| Drop sequential repeated values. For example, if a signal produces the

136−sequence `[1,1,2,2,1]`, it becomes `[1,2,1]` by dropping the values that are the

137−same as the previous value. -}

135+{-| Drop updates that repeat the current value of the signal.

136+

137+Imagine a signal `numbers` has initial value

138+0 and then updates with values 0, 0, 1, 1, and 2. `dropRepeats numbers`

139+is a signal that has initial value 0 and updates as follows: ignore 0,

140+ignore 0, update to 1, ignore 1, update to 2. -}

138141dropRepeats : Signal a -> Signal a

139142dropRepeats = Native.Signal.dropRepeats

140143

libraries/Time.elm+7−3

@@ -81,9 +81,13 @@ each mouse click and false otherwise.

8181since : Time -> Signal a -> Signal Bool

8282since = Native.Time.since

8383

84−{-| Add a timestamp to any signal. Timestamps increase monotonically. Each

85−timestamp is related to a specfic event, so `Mouse.x` and `Mouse.y` will always

86−have the same timestamp because they both rely on the same underlying event.

84+{-| Add a timestamp to any signal. Timestamps increase monotonically. When you

85+create `(timestamp Mouse.x)`, an initial timestamp is produced. The timestamp

86+updates whenever `Mouse.x` updates.

87+

88+Timestamp updates are tied to individual events, so

89+`(timestamp Mouse.x)` and `(timestamp Mouse.y)` will always have the same

90+timestamp because they rely on the same underlying event (`Mouse.position`).

8791-}

8892timestamp : Signal a -> Signal (Time, a)

8993timestamp = Native.Time.timestamp

runtime/Init.js+5−4

@@ -220,14 +220,15 @@ function initGraphics(elm, Module) {

220220 elm.node.appendChild(Render.render(currentScene));

221221

222222 // set up updates so that the DOM is adjusted as necessary.

223− function domUpdate(newScene, currentScene) {

223+ var savedScene = currentScene;

224+ function domUpdate(newScene) {

224225 ElmRuntime.draw(function(_) {

225− Render.update(elm.node.firstChild, currentScene, newScene);

226+ Render.update(elm.node.firstChild, savedScene, newScene);

226227 if (elm.Native.Window) elm.Native.Window.values.resizeIfNeeded();

228+ savedScene = newScene;

227229 });

228− return newScene;

229230 }

230− var renderer = A3(Signal.foldp, F2(domUpdate), currentScene, signalGraph);

231+ var renderer = A2(Signal.lift, domUpdate, signalGraph);

231232

232233 // must check for resize after 'renderer' is created so

233234 // that changes show up.

runtime/Render/Element.js+2

@@ -158,10 +158,12 @@ function rawHtml(elem) {

158158 var html = elem.html;

159159 var args = elem.args;

160160 var guid = elem.guid;

161+ var align = elem.align;

161162

162163 var div = newElement('div');

163164 div.innerHTML = html;

164165 div.style.visibility = "hidden";

166+ if (align) div.style.textAlign = align;

165167 document.body.appendChild(div);

166168

167169 for (var i = args.length; i--; ) {