0137452 · elk · git.iko.soy

src/AST/Module.hs+15−15

compare with master

unifiedsplit

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

1module AST.Module

2 ( Interfaces

3− , Types, Aliases, ADTs

3+ , Types, Aliases, Unions

4− , AdtInfo, CanonicalAdt

4+ , UnionInfo, CanonicalUnion

5 , SourceModule, ValidModule, CanonicalModule, Optimized

6 , Module(..), Body(..)

7 , Header(..)

@@ -40,16 +40,16 @@ type Aliases =

40 Map.Map String ([String], Type.Canonical)

41

42

43−type ADTs =

43+type Unions =

44− Map.Map String (AdtInfo String)

44+ Map.Map String (UnionInfo String)

45

46

47−type AdtInfo v =

47+type UnionInfo v =

48 ( [String], [(v, [Type.Canonical])] )

49

50

51−type CanonicalAdt =

51+type CanonicalUnion =

52− ( Var.Canonical, AdtInfo Var.Canonical )

52+ ( Var.Canonical, UnionInfo Var.Canonical )

53

54

55

@@ -93,11 +93,11 @@ data Module docs imports exports body =

93

94data Body expr =

95 Body

96− { program :: expr

96+ { program :: expr

97− , types :: Types

97+ , types :: Types

98− , fixities :: [(Decl.Assoc, Int, String)]

98+ , fixities :: [(Decl.Assoc, Int, String)]

99− , aliases :: Aliases

99+ , aliases :: Aliases

100− , datatypes :: ADTs

100+ , unions :: Unions

101 }

102

103

@@ -144,7 +144,7 @@ data Interface =

144 , iExports :: [Var.Value]

145 , iTypes :: Types

146 , iImports :: [Name.Raw]

147− , iAdts :: ADTs

147+ , iUnions :: Unions

148 , iAliases :: Aliases

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

150 }

@@ -162,7 +162,7 @@ toInterface pkgName modul =

162 , iExports = exports modul

163 , iTypes = types body'

164 , iImports = imports modul

165− , iAdts = datatypes body'

165+ , iUnions = unions body'

166 , iAliases = aliases body'

167 , iFixities = fixities body'

168 }

@@ -178,6 +178,6 @@ instance Binary Interface where

178 put (iExports modul)

179 put (iTypes modul)

180 put (iImports modul)

181− put (iAdts modul)

181+ put (iUnions modul)

182 put (iAliases modul)

183 put (iFixities modul)

src/Canonicalize.hs+1−2

@@ -12,7 +12,6 @@ import AST.Module (Body(..))

12import Elm.Utils ((|>))

13

14import qualified AST.Declaration as D

15−import qualified AST.Expression.General as E

16import qualified AST.Expression.Valid as Valid

15import qualified AST.Expression.Valid as Valid

17import qualified AST.Expression.Canonical as Canonical

16import qualified AST.Expression.Canonical as Canonical

18import qualified AST.Module as Module

17import qualified AST.Module as Module

@@ -111,7 +110,7 @@ moduleHelp importDict interfaces modul@(Module.Module _ _ comment exports _ decl

111 , types =

110 , types =

112 Map.empty

111 Map.empty

113

112

114− , datatypes =

113+ , unions =

115 Map.fromList [ (name,(vars,ctors)) | D.Datatype name vars ctors <- nakedDecls ]

114 Map.fromList [ (name,(vars,ctors)) | D.Datatype name vars ctors <- nakedDecls ]

116

115

117 , fixities =

116 , fixities =

src/Canonicalize/Environment.hs+7−7

@@ -19,7 +19,7 @@ import Elm.Utils ((|>))

19data Environment = Env

20 { _home :: ModuleName.Canonical

21 , _values :: Dict Var.Canonical

22− , _adts :: Dict Var.Canonical

22+ , _unions :: Dict Var.Canonical

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

24 , _patterns :: Dict (Var.Canonical, Int)

25 }

@@ -67,7 +67,7 @@ addPatch patch env =

67 env { _values = insert name var (_values env) }

68

69 Union name var ->

70− env { _adts = insert name var (_adts env) }

70+ env { _unions = insert name var (_unions env) }

71

72 Alias name var ->

73 env { _aliases = insert name var (_aliases env) }

@@ -111,9 +111,9 @@ builtinPatches =

111-- TO TYPE DEALIASER

112

113toDealiaser :: Environment -> Map.Map String String

114−toDealiaser (Env _ _ adts aliases _) =

114+toDealiaser (Env _ _ unions aliases _) =

115 let

116− dealiasAdt (localName, canonicalSet) =

116+ dealiasUnion (localName, canonicalSet) =

117 case Set.toList canonicalSet of

118 [canonicalName] ->

119 Just (Var.toString canonicalName, localName)

@@ -127,8 +127,8 @@ toDealiaser (Env _ _ adts aliases _) =

127 _ ->

128 Nothing

129

130− adtPairs =

130+ unionPairs =

131− Maybe.mapMaybe dealiasAdt (Map.toList adts)

131+ Maybe.mapMaybe dealiasUnion (Map.toList unions)

132

133 aliasPairs =

134 Maybe.mapMaybe dealiasAlias (Map.toList aliases)

@@ -136,5 +136,5 @@ toDealiaser (Env _ _ adts aliases _) =

136 add (key,value) dict =

137 Map.insertWith (\v v' -> if length v < length v' then v else v') key value dict

138 in

139− adtPairs ++ aliasPairs

139+ unionPairs ++ aliasPairs

140 |> foldr add Map.empty

src/Canonicalize/Setup.hs+7−7

@@ -124,7 +124,7 @@ interfacePatches moduleName prefix interface =

124 (Var.fromModule moduleName name, length args)

125

126 ctors =

127− concatMap snd (Map.elems (Module.iAdts interface))

127+ concatMap snd (Map.elems (Module.iUnions interface))

128

129 ctorNames =

130 map fst ctors

@@ -132,7 +132,7 @@ interfacePatches moduleName prefix interface =

132 concat

133 [ map (patch Env.Value) (Map.keys (Module.iTypes interface))

134 , map (patch Env.Value) ctorNames

135− , map (patch Env.Union) (Map.keys (Module.iAdts interface))

135+ , map (patch Env.Union) (Map.keys (Module.iUnions interface))

136 , map aliasPatch (Map.toList (Module.iAliases interface))

137 , map patternPatch ctors

138 ]

@@ -182,7 +182,7 @@ valueToPatches region moduleName interface value =

182 else [alias]

183

184 Nothing ->

185− case Map.lookup x (Module.iAdts interface) of

185+ case Map.lookup x (Module.iUnions interface) of

186 Just (_,_) ->

187 Result.ok [patch Env.Union x]

188

@@ -194,7 +194,7 @@ valueToPatches region moduleName interface value =

194 notFound getNames x

195

196 Var.Union givenName (Var.Listing givenCtorNames open) ->

197− case Map.lookup givenName (Module.iAdts interface) of

197+ case Map.lookup givenName (Module.iUnions interface) of

198 Nothing ->

199 notFound (map fst . Var.getUnions) givenName

200

@@ -374,7 +374,7 @@ restrictToPublicApi interface =

374 (get (Module.iAliases interface))

375 (Var.getAliases exports)

376

377− , Module.iAdts =

377+ , Module.iUnions =

378 Map.fromList

379 (Maybe.mapMaybe (trimUnions interface) unions)

380 }

@@ -405,9 +405,9 @@ get dict key =

405trimUnions

406 :: Module.Interface

407 -> (String, Var.Listing String)

408− -> Maybe (String, Module.AdtInfo String)

408+ -> Maybe (String, Module.UnionInfo String)

409trimUnions interface (name, Var.Listing exportedCtors _) =

410− case Map.lookup name (Module.iAdts interface) of

410+ case Map.lookup name (Module.iUnions interface) of

411 Nothing ->

412 Nothing

413

src/Canonicalize/Variable.hs+4−4

@@ -51,13 +51,13 @@ tvar

51 (Var.Canonical, [String], Type.Canonical)

52 )

53tvar region env var =

54− case adts ++ aliases of

54+ case unions ++ aliases of

55− [] -> notFound region "type" (Map.keys (Env._adts env) ++ Map.keys (Env._aliases env)) var

55+ [] -> notFound region "type" (Map.keys (Env._unions env) ++ Map.keys (Env._aliases env)) var

56 [v] -> Result.var' extract v

57 vs -> preferLocals' region env extract "type" vs var

58 where

59− adts =

59+ unions =

60− map Left (maybe [] Set.toList (Map.lookup var (Env._adts env)))

60+ map Left (maybe [] Set.toList (Map.lookup var (Env._unions env)))

61

62 aliases =

63 map Right (maybe [] Set.toList (Map.lookup var (Env._aliases env)))

src/Nitpick/PatternMatches.hs+6−6

@@ -31,7 +31,7 @@ patternMatches interfaces modul =

31 name = Module.name modul

32 body = Module.body modul

33 tagDict =

34− toTagDict interfaces name (Module.datatypes body)

34+ toTagDict interfaces name (Module.unions body)

35 in

36 const (Map.map (Map.map length) tagDict)

37 <$> checkExpression tagDict (Module.program body)

@@ -52,8 +52,8 @@ data TagInfo = TagInfo

52 }

53

54

55−toTagDict :: Module.Interfaces -> ModuleName.Canonical -> Module.ADTs -> TagDict

55+toTagDict :: Module.Interfaces -> ModuleName.Canonical -> Module.Unions -> TagDict

56−toTagDict interfaces localName localAdts =

56+toTagDict interfaces localName localUnions =

57 let

58 listTags =

59 [ TagInfo "::" 2

@@ -76,14 +76,14 @@ toTagDict interfaces localName localAdts =

76

77 interfaceDict =

78 interfaces

79− |> Map.map (toTagMapping . Module.iAdts)

79+ |> Map.map (toTagMapping . Module.iUnions)

80 |> Map.mapKeysMonotonic Var.Module

81− |> Map.insert (Var.Module localName) (toTagMapping localAdts)

81+ |> Map.insert (Var.Module localName) (toTagMapping localUnions)

82 in

83 Map.union builtinDict interfaceDict

84

85

86−toTagMapping :: Module.ADTs -> Map.Map Tag [TagInfo]

86+toTagMapping :: Module.Unions -> Map.Map Tag [TagInfo]

87toTagMapping adts =

88 let

89 toTagAndArity (_tvars, tagInfoList) =

src/Type/Environment.hs+8−8

@@ -31,7 +31,7 @@ data Environment = Environment

31 }

32

33

34−initialize :: [Module.CanonicalAdt] -> IO Environment

34+initialize :: [Module.CanonicalUnion] -> IO Environment

35initialize datatypes =

36 do types <- makeTypes datatypes

37 let env =

@@ -43,13 +43,13 @@ initialize datatypes =

43 return $ env { _constructor = makeConstructors env datatypes }

44

45

46−makeTypes :: [Module.CanonicalAdt] -> IO TypeDict

46+makeTypes :: [Module.CanonicalUnion] -> IO TypeDict

47makeTypes datatypes =

48− do adts <- mapM makeImported datatypes

48+ do unions <- mapM makeImported datatypes

49− bs <- mapM makeBuiltin builtins

49+ bs <- mapM makeBuiltin builtins

50− return (Map.fromList (adts ++ bs))

50+ return (Map.fromList (unions ++ bs))

51 where

52− makeImported :: (V.Canonical, Module.AdtInfo V.Canonical) -> IO (String, Type)

52+ makeImported :: (V.Canonical, Module.UnionInfo V.Canonical) -> IO (String, Type)

53 makeImported (name, _) =

54 do tvar <- mkAtom name

55 return (V.toString name, VarN tvar)

@@ -73,7 +73,7 @@ makeTypes datatypes =

73

74makeConstructors

75 :: Environment

76− -> [Module.CanonicalAdt]

76+ -> [Module.CanonicalUnion]

77 -> Map.Map String (IO (Int, [Variable], [Type], Type))

78makeConstructors env datatypes =

79 Map.fromList builtins

@@ -101,7 +101,7 @@ makeConstructors env datatypes =

101

102ctorToType

103 :: Environment

104− -> (V.Canonical, Module.AdtInfo V.Canonical)

104+ -> (V.Canonical, Module.UnionInfo V.Canonical)

105 -> [(String, IO (Int, [Variable], [Type], Type))]

106ctorToType env (name, (tvars, ctors)) =

107 zip (map (V.toString . fst) ctors) (map inst ctors)

src/Type/Inference.hs+12−12

@@ -44,7 +44,7 @@ genConstraints

44 -> Module.CanonicalModule

45 -> IO (Map.Map String T.Type, T.TypeConstraint)

46genConstraints interfaces modul =

47− do env <- Env.initialize (canonicalizeAdts interfaces modul)

47+ do env <- Env.initialize (canonicalizeUnions interfaces modul)

48

49 ctors <-

50 forM (Env.ctorNames env) $ \name ->

@@ -80,24 +80,24 @@ canonicalizeValues env (moduleName, iface) =

80 )

81

82

83−canonicalizeAdts :: Module.Interfaces -> Module.CanonicalModule -> [CanonicalAdt]

83+canonicalizeUnions :: Module.Interfaces -> Module.CanonicalModule -> [CanonicalUnion]

84−canonicalizeAdts interfaces modul =

84+canonicalizeUnions interfaces modul =

85− localAdts ++ importedAdts

85+ localUnions ++ importedUnions

86 where

87− localAdts :: [CanonicalAdt]

87+ localUnions :: [CanonicalUnion]

88− localAdts =

88+ localUnions =

89− format (Module.name modul, datatypes (body modul))

89+ format (Module.name modul, unions (body modul))

90

91− importedAdts :: [CanonicalAdt]

91+ importedUnions :: [CanonicalUnion]

92− importedAdts =

92+ importedUnions =

93− concatMap (format . second iAdts) (Map.toList interfaces)

93+ concatMap (format . second iUnions) (Map.toList interfaces)

94

95

96−format :: (ModuleName.Canonical, Module.ADTs) -> [CanonicalAdt]

96+format :: (ModuleName.Canonical, Module.Unions) -> [CanonicalUnion]

97format (home, adts) =

98 map canonical (Map.toList adts)

99 where

100− canonical :: (String, AdtInfo String) -> CanonicalAdt

100+ canonical :: (String, UnionInfo String) -> CanonicalUnion

101 canonical (name, (tvars, ctors)) =

102 ( toVar name

103 , (tvars, map (first toVar) ctors)