b2a7bd1 · elk · git.iko.soy

git.iko.soy/elk

Implement type aliases.

commitb2a7bd1c6e85403e84817cebcad9616e1053d9c3 authorevancz <info@elm-lang.org> dateWed 6 Feb 2013, 03:04 (14 years ago) parent1848c95

7 files changed+55−14

compare with master

unifiedsplit

elm/src/Ast.hs+1−1 elm/src/Gen/CompileToJS.hs+3−3 elm/src/Initialize.hs+5−2 elm/src/Parse/Types.hs+10−3 elm/src/Rename.hs+2−2 elm/src/Types/Constrain.hs+1−2 elm/src/Types/Substitutions.hs+33−1

elm/src/Ast.hs+1−1

@@ -52,7 +52,7 @@ data Def = FnDef String [String] CExpr

5252

5353data Statement = Definition Def

5454 | Datatype String [X] [(String,[Type])]

55− | TypeAlias String Type

55+ | TypeAlias String [X] Type

5656 | TypeAnnotation String Type

5757 | ImportEvent String CExpr String Type

5858 | ExportEvent String String Type

elm/src/Gen/CompileToJS.hs+3−3

@@ -99,7 +99,7 @@ getExports names stmts = ret . braces $ intercalate ",\n" (op : map fnPair fns)

9999 Datatype _ _ tcs -> map (Left . fst) tcs

100100 ImportEvent _ _ x _ -> [ Left x ]

101101 ExportEvent _ _ _ -> []

102− TypeAlias _ _ -> []

102+ TypeAlias _ _ _ -> []

103103 TypeAnnotation _ _ -> []

104104

105105

@@ -138,7 +138,7 @@ stmtsToJS stmts = run (concat `liftM` mapM toJS (sortBy cmpStmt stmts))

138138 if derename f == "main" then 5 else 4

139139 Definition _ -> 3

140140 ExportEvent _ _ _ -> 6

141− TypeAlias _ _ -> 0

141+ TypeAlias _ _ _ -> 0

142142 TypeAnnotation _ _ -> 0

143143

144144class ToJS a where

@@ -172,7 +172,7 @@ instance ToJS Statement where

172172 , "e.value = v;"

173173 , "document.dispatchEvent(e); return v; })(", elm, ");" ]

174174 toJS (TypeAnnotation _ _) = return ""

175− toJS (TypeAlias _ _) = return ""

175+ toJS (TypeAlias _ _ _) = return ""

176176

177177toJS' :: CExpr -> GuidCounter String

178178toJS' (C txt span expr) =

elm/src/Initialize.hs+5−2

@@ -10,13 +10,16 @@ import Rename

1010import Types.Types ((-:))

1111import Types.Hints (hints)

1212import Types.Unify

13+import Types.Substitutions (dealias)

1314import Optimize

1415

1516

1617initialize str =

17− do modul@(Module name ex im stmts) <- parseProgram str

18+ do Module name ex im stmts <- parseProgram str

19+ let stmts' = dealias stmts

20+ modul = Module name ex im stmts'

1821 (escapees, subs) <- unify hints modul

19− let modul' = optimize . renameModule $ Module name ex im' stmts

22+ let modul' = optimize . renameModule $ Module name ex im' stmts'

2023 where im' | any ((=="Prelude") . fst) im = im

2124 | otherwise = ("Prelude", Hiding []) : im

2225 subs `seq` return (escapees, modul')

elm/src/Parse/Types.hs+10−3

@@ -57,8 +57,9 @@ typeExpr :: IParser ParseType

5757typeExpr = do

5858 t1 <- typeVar <|> typeApp <|> typeUnambiguous

5959 whitespace ; arr <- optionMaybe arrow ; whitespace

60− case arr of Just _ -> LambdaPT t1 <$> typeExpr

61− Nothing -> return t1

60+ case arr of

61+ Just _ -> LambdaPT t1 <$> typeExpr

62+ Nothing -> return t1

6263

6364typeConstructor :: IParser (String, [ParseType])

6465typeConstructor = (,) <$> (capVar <?> "another type constructor")

@@ -67,9 +68,15 @@ typeConstructor = (,) <$> (capVar <?> "another type constructor")

6768typeAlias :: IParser Statement

6869typeAlias = do

6970 reserved "type" <?> "type alias (type Point = {x:Int, y:Int})"

71+ forcedWS

7072 alias <- capVar

73+ args <- spacePrefix lowVar

7174 whitespace ; string "=" ; whitespace

72− TypeAlias alias <$> toType <$> typeExpr

75+ let n = length args

76+ tipe <- typeExpr

77+ case toTypeWith alias (zip args [1..n]) tipe of

78+ Right t -> return (TypeAlias alias [1..n] t)

79+ Left msg -> fail msg

7380

7481typeAnnotation :: IParser Statement

7582typeAnnotation = TypeAnnotation <$> try start <*> (toType <$> typeExpr)

elm/src/Rename.hs+2−2

@@ -37,7 +37,7 @@ instance Rename Statement where

3737 Definition def -> Definition `liftM` rename env def

3838 Datatype name args tcs ->

3939 return $ Datatype name args $ map (first env) tcs

40− TypeAlias n t -> return (TypeAlias n t)

40+ TypeAlias n xs t -> return (TypeAlias n xs t)

4141 TypeAnnotation n t -> return (TypeAnnotation (env n) t)

4242 ImportEvent js base elm tipe ->

4343 do base' <- rename env base

@@ -144,4 +144,4 @@ renameLet env defs e = do env' <- extends env $ concatMap getNames defs

144144 defs' <- mapM (rename env') defs

145145 Let defs' `liftM` rename env' e

146146 where getNames (FnDef n _ _) = [n]

147− getNames (OpDef _ _ _ _) = []

147+ getNames (OpDef _ _ _ _) = []

elm/src/Types/Constrain.hs+1−2

@@ -305,5 +305,4 @@ stmtGen stmt =

305305 do schm <- generalize [] (Forall [] [] tipe)

306306 return (Map.empty, Set.empty, Map.singleton name schm)

307307

308− _ -> return (Map.empty, Set.empty, Map.empty)

309−

308+ TypeAlias _ _ _ -> return (Map.empty, Set.empty, Map.empty)

elm/src/Types/Substitutions.hs+33−1

@@ -4,10 +4,13 @@ module Types.Substitutions (subst,

44 freeVars,

55 concretize,

66 rescheme,

7− generalize) where

7+ generalize,

8+ dealias) where

10+import Ast

911import Context

1012import Control.DeepSeq (NFData (..), deepseq)

13+import Control.Arrow (second)

1114import Control.Monad (liftM)

1215import Data.List (foldl')

1316import qualified Data.Set as Set

@@ -87,3 +90,32 @@ generalize :: [X] -> Scheme -> GuidCounter Scheme

8790generalize exceptions (Forall xs cs t) = rescheme (Forall (xs ++ frees) cs t)

8891 where allFrees = Set.fromList $ freeVars t ++ concatMap freeVars cs

8992 frees = Set.toList $ Set.difference allFrees (Set.fromList exceptions)

93+

94+dealias :: [Statement] -> [Statement]

95+dealias stmts = map dealiasS stmts

96+ where

97+ getAliases :: [Statement] -> Map.Map String ([X],Type)

98+ getAliases stmts = Map.fromList (concatMap getAlias stmts)

99+ where getAlias stmt = case stmt of

100+ TypeAlias alias xs t -> [(alias, (xs,t))]

101+ _ -> []

102+

103+ dealiasT :: Type -> Type

104+ dealiasT t =

105+ case t of

106+ ADT name ts -> case Map.lookup name (getAliases stmts) of

107+ Just (xs,t) -> dealiasT (subst (zip xs ts) t)

108+ Nothing -> ADT name (map dealiasT ts)

109+ LambdaT t u -> LambdaT (dealiasT t) (dealiasT u)

110+ RecordT r t -> RecordT (Map.map (map dealiasT) r) (dealiasT t)

111+ _ -> t

112+

113+ dealiasS :: Statement -> Statement

114+ dealiasS s =

115+ case s of

116+ Datatype n xs tcs -> Datatype n xs (map (second (map dealiasT)) tcs)

117+ ExportEvent js elm tipe -> ExportEvent js elm (dealiasT tipe)

118+ ImportEvent js e elm tipe -> ImportEvent js e elm (dealiasT tipe)

119+ TypeAnnotation name tipe -> TypeAnnotation name (dealiasT tipe)

120+ Definition _ -> s

121+ TypeAlias _ _ _ -> s