git.iko.soy/elk
on master help sign in
Disallow equivalent representations of the same type

This is a very roundabout way to fix a big that manifested in elm diff. When comparing types, some would be generated as (Type “Int”) and others would be (App (Type “Int”) []) which are the same in meaning, but different in structure. The core change is to make (Type “Int” []) the only representation. Change the binary representation of types. If there is a list of arguments in (Type name args) we will save ourselves 64 bits whenever (length args < 256) roughly. Start using IsString instance of Doc, so (text “(“) becomes “(“ in some cases.

commit52e43bb268d1e21342c0d76ce601d13ad8e16dbe authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 30 Jun 2017, 16:12 (9 years ago) parent309a8f8
32 files changed+464−610
compare with master
unifiedsplit
src/AST/Literal.hs+19−10 src/AST/Type.hs+30−33 src/AST/Variable.hs+99−24 src/Canonicalize/Body.hs+1−3 src/Canonicalize/Effects.hs+25−13 src/Canonicalize/Environment.hs+25−20 src/Canonicalize/Setup.hs+2−5 src/Canonicalize/Type.hs+11−29 src/Elm/Compiler/Type.hs+18−30 src/Elm/Compiler/Type/Extract.hs+5−8 src/Elm/Package.hs+11−1 src/Nitpick/Pattern.hs+2−2 src/Nitpick/PatternMatches.hs+3−7 src/Nitpick/TopLevelTypes.hs+7−7 src/Optimize/Port.hs+8−8 src/Parse/Type.hs+11−16 src/Reporting/Error/Canonicalize.hs+2−5 src/Reporting/Error/Type.hs+2−2 src/Reporting/Helpers.hs+2−3 src/Reporting/Render/Type.hs+35−54 src/Type/Constrain/Effects.hs+21−19 src/Type/Constrain/Expression.hs+6−6 src/Type/Constrain/Literal.hs+9−9 src/Type/Constrain/Pattern.hs+1−1 src/Type/Environment.hs+28−81 src/Type/Inference.hs+1−2 src/Type/Occurs.hs+2−5 src/Type/Solve.hs+6−5 src/Type/State.hs+6−16 src/Type/Type.hs+6−32 src/Type/Unify.hs+56−144 src/Validate.hs+4−10
src/AST/Literal.hs+19−10
@@ -3,7 +3,7 @@
33module AST.Literal
44 ( Literal(..)
55 , toBuilder
6− , GLType(..), glTypeToText, Shader(..)
6+ , GLType(..), glTypeToVar, Shader(..)
77 )
88 where
99
@@ -16,6 +16,10 @@ import Data.Text.Lazy.Builder (Builder, fromText)
1616import Data.Text.Lazy.Builder.Int (decimal)
1717import Data.Text.Lazy.Builder.RealFloat (realFloat)
1818
19+import qualified AST.Module.Name as ModuleName
20+import qualified AST.Variable as Var
21+import qualified Elm.Package as Pkg
22+
1923
2024
2125-- LITERALS
@@ -64,16 +68,21 @@ data GLType
6468 deriving (Eq)
6569
6670
67−glTypeToText :: GLType -> Text
68−glTypeToText glTipe =
71+glTypeToVar :: GLType -> Var.Canonical
72+glTypeToVar glTipe =
6973 case glTipe of
70− V2 -> "Math.Vector2.Vec2"
71− V3 -> "Math.Vector3.Vec3"
72− V4 -> "Math.Vector4.Vec4"
73− M4 -> "Math.Matrix4.Mat4"
74− Int -> "Int"
75− Float -> "Float"
76− Texture -> "WebGL.Texture"
74+ V2 -> inLinearAlgebra "Math.Vector2" "Vec2"
75+ V3 -> inLinearAlgebra "Math.Vector3" "Vec3"
76+ V4 -> inLinearAlgebra "Math.Vector4" "Vec4"
77+ M4 -> inLinearAlgebra "Math.Matrix4" "Mat4"
78+ Int -> Var.int
79+ Float -> Var.float
80+ Texture -> Var.fromModule (ModuleName.Canonical Pkg.webgl "WebGL") "Texture"
81+
82+
83+inLinearAlgebra :: ModuleName.Raw -> Text -> Var.Canonical
84+inLinearAlgebra moduleName tipe =
85+ Var.fromModule (ModuleName.Canonical Pkg.linearAlgebra moduleName) tipe
7786
7887
7988
src/AST/Type.hs+30−33
@@ -10,7 +10,7 @@ module AST.Type
1010 where
1111
1212import Control.Arrow (second)
13−import Control.Monad (liftM, liftM2, liftM3)
13+import Control.Monad (liftM, liftM2, liftM3, replicateM)
1414import Data.Binary
1515import qualified Data.Map as Map
1616import Data.Text (Text)
@@ -33,16 +33,14 @@ type Raw =
3333data Raw'
3434 = RLambda Raw Raw
3535 | RVar Text
36− | RType Var.Raw
37− | RApp Raw [Raw]
36+ | RType (A.Located Var.Raw) [Raw]
3837 | RRecord [(A.Located Text, Raw)] (Maybe Raw)
3938
4039
4140data Canonical
4241 = Lambda Canonical Canonical
4342 | Var Text
44− | Type Var.Canonical
45− | App Canonical [Canonical]
43+ | Type Var.Canonical [Canonical]
4644 | Record [(Text, Canonical)] (Maybe Canonical)
4745 | Aliased Var.Canonical [(Text, Canonical)] (Aliased Canonical)
4846 deriving (Eq, Ord)
@@ -64,7 +62,7 @@ tuple region types =
6462 name =
6563 Var.Raw (Help.makeTuple (length types))
6664 in
67− A.A region (RApp (A.A region (RType name)) types)
65+ A.A region (RType (A.A region name) types)
6866
6967
7068cmd :: ModuleName.Canonical -> Text -> Canonical
@@ -80,8 +78,8 @@ sub =
8078effect :: Var.Canonical -> ModuleName.Canonical -> Text -> Canonical
8179effect effectName moduleName tipe =
8280 Lambda
83− (App (Type (Var.fromModule moduleName tipe)) [Var "msg"])
84− (App (Type effectName) [Var "msg"])
81+ (Type (Var.fromModule moduleName tipe) [Var "msg"])
82+ (Type effectName [Var "msg"])
8583
8684
8785
@@ -103,11 +101,8 @@ deepDealias tipe =
103101 Aliased _name args tipe' ->
104102 deepDealias (dealias args tipe')
105103
106− Type _ ->
107− tipe
108−
109− App f args ->
110− App (deepDealias f) (map deepDealias args)
104+ Type name args ->
105+ Type name (map deepDealias args)
111106
112107
113108iteratedDealias :: Canonical -> Canonical
@@ -149,11 +144,8 @@ dealiasHelp typeTable tipe =
149144 Aliased original args t' ->
150145 Aliased original (map (second go) args) t'
151146
152− Type _ ->
153− tipe
154−
155− App f args ->
156− App (go f) (map go args)
147+ Type name args ->
148+ Type name (map go args)
157149
158150
159151
@@ -183,28 +175,33 @@ instance Binary Canonical where
183175 Var x ->
184176 putWord8 1 >> put x
185177
186− Type name ->
187− putWord8 2 >> put name
188−
189− App t1 t2 ->
190− putWord8 3 >> put t1 >> put t2
191−
192178 Record fs ext ->
193− putWord8 4 >> put fs >> put ext
179+ putWord8 2 >> put fs >> put ext
194180
195181 Aliased var args t ->
196− putWord8 5 >> put var >> put args >> put t
182+ putWord8 3 >> put var >> put args >> put t
183+
184+ Type name ts ->
185+ let
186+ potentialWord =
187+ length ts + 5
188+ in
189+ if potentialWord <= fromIntegral (maxBound :: Word8) then
190+ do putWord8 (fromIntegral potentialWord)
191+ put name
192+ mapM_ put ts
193+ else
194+ putWord8 4 >> put name >> put ts
197195
198196 get =
199− do n <- getWord8
200− case n of
197+ do word <- getWord8
198+ case word of
201199 0 -> liftM2 Lambda get get
202200 1 -> liftM Var get
203− 2 -> liftM Type get
204− 3 -> liftM2 App get get
205− 4 -> liftM2 Record get get
206− 5 -> liftM3 Aliased get get get
207− _ -> error "Error reading a valid type from serialized string"
201+ 2 -> liftM2 Record get get
202+ 3 -> liftM3 Aliased get get get
203+ 4 -> liftM2 Type get get
204+ n -> liftM2 Type get (replicateM (fromIntegral (n - 5)) get)
208205
209206
210207instance Binary t => Binary (Aliased t) where
src/AST/Variable.hs+99−24
@@ -4,22 +4,26 @@ module AST.Variable
44 ( Raw(..)
55 , Canonical(..), Home(..)
66 , Global(..)
7− , local, topLevel, builtin, fromModule
8− , inCore, inHtml, cmd, sub
7+ , local, topLevel, fromModule
8+ , inCore, inHtml
9+ , int, float, char, string, tuple
10+ , list, cons, nil
11+ , bool, true, false
12+ , never, task, cmd, sub, router, shader
913 , isLocalHome, isCons
1014 , is, isJson, isMaybe, isArray, isTask, isList
11− , isKernel, isTuple, isPrimitive, isPrim, isLocal
15+ , isKernel, isTuple, isPrim, isLocal
1216 , rawToText, toText
1317 )
1418 where
1519
1620import Data.Binary
1721import Data.Monoid ((<>))
18−import qualified Data.Set as Set
1922import Data.Text (Text)
2023
2124import qualified AST.Helpers as Help
2225import qualified AST.Module.Name as ModuleName
26+import qualified Elm.Package as Pkg
2327
2428
2529
@@ -72,11 +76,6 @@ topLevel home x =
7276 Canonical (TopLevel home) x
7377
7478
75−builtin :: Text -> Canonical
76−builtin x =
77− Canonical BuiltIn x
78−
79−
8079fromModule :: ModuleName.Canonical -> Text -> Canonical
8180fromModule home name =
8281 Canonical (Module home) name
@@ -92,6 +91,87 @@ inHtml home name =
9291 Canonical (Module (ModuleName.inHtml home)) name
9392
9493
94+
95+-- BUILT IN TYPES
96+
97+
98+int :: Canonical
99+int =
100+ Canonical BuiltIn "Int"
101+
102+
103+float :: Canonical
104+float =
105+ Canonical BuiltIn "Float"
106+
107+
108+char :: Canonical
109+char =
110+ Canonical BuiltIn "Char"
111+
112+
113+string :: Canonical
114+string =
115+ Canonical BuiltIn "String"
116+
117+
118+tuple :: Int -> Canonical
119+tuple size =
120+ Canonical BuiltIn (Help.makeTuple size)
121+
122+
123+
124+-- LIST
125+
126+
127+list :: Canonical
128+list =
129+ Canonical BuiltIn "List"
130+
131+
132+cons :: Canonical
133+cons =
134+ Canonical BuiltIn "::"
135+
136+
137+nil :: Canonical
138+nil =
139+ Canonical BuiltIn "[]"
140+
141+
142+
143+-- BOOLEANS
144+
145+
146+bool :: Canonical
147+bool =
148+ Canonical BuiltIn "Bool"
149+
150+
151+true :: Canonical
152+true =
153+ Canonical BuiltIn "True"
154+
155+
156+false :: Canonical
157+false =
158+ Canonical BuiltIn "False"
159+
160+
161+
162+-- CORE TYPES
163+
164+
165+never :: Canonical
166+never =
167+ inCore "Basics" "Never"
168+
169+
170+task :: Canonical
171+task =
172+ inCore "Platform" "Task"
173+
174+
95175cmd :: Canonical
96176cmd =
97177 inCore "Platform.Cmd" "Cmd"
@@ -102,6 +182,16 @@ sub =
102182 inCore "Platform.Sub" "Sub"
103183
104184
185+router :: Canonical
186+router =
187+ inCore "Platform" "Router"
188+
189+
190+shader :: Canonical
191+shader =
192+ fromModule (ModuleName.Canonical Pkg.webgl "WebGL") "Shader"
193+
194+
105195
106196-- VARIABLE RECOGNIZERS
107197
@@ -181,21 +271,6 @@ isTuple var =
181271 False
182272
183273
184−isPrimitive :: Canonical -> Bool
185−isPrimitive var =
186− case var of
187− Canonical BuiltIn name ->
188− Set.member name primitiveSet
189−
190− _ ->
191− False
192−
193−
194−primitiveSet :: Set.Set Text
195−primitiveSet =
196− Set.fromList ["Int","Float","String","Bool"]
197−
198−
199274isPrim :: Text -> Canonical -> Bool
200275isPrim prim (Canonical home name) =
201276 case home of
src/Canonicalize/Body.hs+1−3
@@ -57,9 +57,7 @@ unionToDefs moduleName (A.A (region,_) (Decl.Type name tvars constructors)) =
5757 generateArgs (length tipes) []
5858
5959 tbody =
60− Type.App
61− (Type.Type (Var.fromModule moduleName name))
62− (map Type.Var tvars)
60+ Type.Type (Var.fromModule moduleName name) (map Type.Var tvars)
6361
6462 body =
6563 A.A region $
src/Canonicalize/Effects.hs+25−13
@@ -8,6 +8,7 @@ module Canonicalize.Effects
88 where
99
1010import qualified Data.Foldable as F
11+import qualified Data.Set as Set
1112import Data.Text (Text)
1213
1314import qualified AST.Effects as Effects
@@ -69,12 +70,12 @@ canonicalizeRawPort env (A.A ann (Effects.PortRaw name rawType)) =
6970figureOutKind :: R.Region -> Text -> T.Canonical -> Result Effects.Kind
7071figureOutKind region name rootType =
7172 case T.deepDealias rootType of
72− T.Lambda outgoingType (T.App (T.Type effect) [T.Var _])
73+ T.Lambda outgoingType (T.Type effect [T.Var _])
7374 | effect == Var.cmd ->
7475 pure (Effects.Outgoing outgoingType)
7576 <* checkPortType (makeError region name) outgoingType
7677
77− T.Lambda (T.Lambda incomingType (T.Var msg1)) (T.App (T.Type effect) [T.Var msg2])
78+ T.Lambda (T.Lambda incomingType (T.Var msg1)) (T.Type effect [T.Var msg2])
7879 | effect == Var.sub && msg1 == msg2 ->
7980 pure (Effects.Incoming incomingType)
8081 <* checkPortType (makeError region name) incomingType
@@ -109,26 +110,22 @@ checkPortType mkError tipe =
109110 T.Aliased _ args aliasedType ->
110111 check (T.dealias args aliasedType)
111112
112− T.Type name ->
113− if Var.isJson name || Var.isPrimitive name || Var.isTuple name then
113+ T.Type name [] ->
114+ if Var.isJson name || isPrimitive name || Var.isTuple name then
114115 return ()
115116
116117 else
117118 throw Nothing
118119
119− T.App name [] ->
120− check name
121−
122− T.App (T.Type name) [arg]
120+ T.Type name [arg]
123121 | Var.isMaybe name -> check arg
124122 | Var.isArray name -> check arg
125123 | Var.isList name -> check arg
126124
127− T.App (T.Type name) args
128− | Var.isTuple name ->
129− F.traverse_ check args
130−
131− T.App _ _ ->
125+ T.Type name args ->
126+ if Var.isTuple name then
127+ F.traverse_ check args
128+ else
132129 throw Nothing
133130
134131 T.Var _ ->
@@ -142,3 +139,18 @@ checkPortType mkError tipe =
142139
143140 T.Record fields Nothing ->
144141 F.traverse_ (\(k,v) -> (,) k <$> check v) fields
142+
143+
144+isPrimitive :: Var.Canonical -> Bool
145+isPrimitive var =
146+ case var of
147+ Var.Canonical Var.BuiltIn name ->
148+ Set.member name primitiveSet
149+
150+ _ ->
151+ False
152+
153+
154+primitiveSet :: Set.Set Text
155+primitiveSet =
156+ Set.fromList ["Int","Float","String","Bool"]
src/Canonicalize/Environment.hs+25−20
@@ -115,27 +115,32 @@ insert key value =
115115
116116builtinPatches :: [Patch]
117117builtinPatches =
118− concat
119− [ map (patch Value) tupleNames
120− , map (patch Union) (tupleNames ++ ["List","Int","Float","Char","Bool","String"])
121− , map (patternPatch) (tuples ++ [ ("::", 2), ("[]", 0) ])
122− ]
118+ valuePatches ++ unionPatches ++ patternPatches
123119 where
124− patch mkPatch name =
125− mkPatch name (Var.builtin name)
126−
127− patternPatch (name, args) =
128− Pattern name (Var.builtin name, args)
129−
130− tupleNames =
131− map fst tuples
132−
133− tuples =
134− map toTuple [0..9]
135−
136− toTuple :: Int -> (Text, Int)
137− toTuple n =
138− ( Help.makeTuple n, n )
120+ validTupleSizes =
121+ [0..9]
122+
123+ valuePatches :: [Patch]
124+ valuePatches =
125+ map (\n -> Value (Help.makeTuple n) (Var.tuple n)) validTupleSizes
126+
127+ unionPatches :: [Patch]
128+ unionPatches =
129+ [ Union "List" Var.list
130+ , Union "Int" Var.int
131+ , Union "Float" Var.float
132+ , Union "Char" Var.char
133+ , Union "Bool" Var.bool
134+ , Union "String" Var.string
135+ ]
136+ ++ map (\n -> Union (Help.makeTuple n) (Var.tuple n)) validTupleSizes
137+
138+ patternPatches :: [Patch]
139+ patternPatches =
140+ [ Pattern "::" (Var.cons, 2)
141+ , Pattern "[]" (Var.nil, 0)
142+ ]
143+ ++ map (\n -> Pattern (Help.makeTuple n) (Var.tuple n, n)) validTupleSizes
139144
140145
141146
src/Canonicalize/Setup.hs+2−5
@@ -264,11 +264,8 @@ node region name tvars alias =
264264 Type.RVar _ ->
265265 []
266266
267− Type.RType (Var.Raw x) ->
268− [x]
269−
270− Type.RApp t ts ->
271− edges t ++ concatMap edges ts
267+ Type.RType (A.A _ (Var.Raw x)) args ->
268+ x : concatMap edges args
272269
273270 Type.RRecord fs ext ->
274271 maybe [] edges ext ++ concatMap (edges . snd) fs
src/Canonicalize/Type.hs+11−29
@@ -19,7 +19,7 @@ import qualified Reporting.Result as Result
1919
2020
2121tipe :: Env.Env -> T.Raw -> Result T.Canonical
22−tipe env annType@(A.A _ typ) =
22+tipe env (A.A _ typ) =
2323 let
2424 go =
2525 tipe env
@@ -31,11 +31,8 @@ tipe env annType@(A.A _ typ) =
3131 T.RVar x ->
3232 Result.ok (T.Var x)
3333
34− T.RType _ ->
35− canonicalizeApp env annType []
36−
37− T.RApp t ts ->
38− canonicalizeApp env t ts
34+ T.RType name args ->
35+ canonicalizeApp env name args
3936
4037 T.RLambda a b ->
4138 T.Lambda <$> go a <*> go b
@@ -44,30 +41,15 @@ tipe env annType@(A.A _ typ) =
4441 T.Record <$> traverse goField fields <*> traverse go ext
4542
4643
47−canonicalizeApp :: Env.Env -> T.Raw -> [T.Raw] -> Result T.Canonical
48−canonicalizeApp env annFunc@(A.A region func) args =
49− case func of
50− T.RType (Var.Raw rawName) ->
51− canonicalizeWithTvar =<< Canonicalize.tvar region env rawName
52−
53− _ ->
54− T.App
55− <$> tipe env annFunc
56− <*> traverse (tipe env) args
57−
58− where
59− canonicalizeWithTvar tvar =
60− case tvar of
61− Right alias ->
62− canonicalizeAlias region env alias args
63−
64− Left name ->
65− case args of
66− [] ->
67− Result.ok (T.Type name)
44+canonicalizeApp :: Env.Env -> A.Located Var.Raw -> [T.Raw] -> Result T.Canonical
45+canonicalizeApp env (A.A region (Var.Raw rawName)) args =
46+ do tvar <- Canonicalize.tvar region env rawName
47+ case tvar of
48+ Right alias ->
49+ canonicalizeAlias region env alias args
6850
69− _ ->
70− T.App (T.Type name) <$> traverse (tipe env) args
51+ Left name ->
52+ T.Type name <$> traverse (tipe env) args
7153
7254
7355canonicalizeAlias
src/Elm/Compiler/Type.hs+18−30
@@ -35,8 +35,7 @@ import Json.Encode ((==>))
3535data Type
3636 = Lambda Type Type
3737 | Var Text
38− | Type Text
39− | App Type [Type]
38+ | Type Text [Type]
4039 | Record [(Text, Type)] (Maybe Type)
4140
4241
@@ -88,17 +87,14 @@ toDoc context tipe =
8887 Var name ->
8988 P.text (Text.unpack name)
9089
91− Type name ->
92− P.text (Text.unpack (if name == Help.zeroTuple then "()" else name))
90+ Type name [] ->
91+ P.text (if name == Help.zeroTuple then "()" else Text.unpack name)
9392
94− App (Type name) args ->
95− if name == Help.zeroTuple then
96− P.text "()"
97−
98− else if Help.isTuple name then
93+ Type name arguments@(arg:args) ->
94+ if Help.isTuple name then
9995 P.sep
100− [ P.cat (zipWith (<+>) (P.lparen : repeat P.comma) (map (toDoc None) args))
101− , P.rparen
96+ [ P.cat ("(" <+> toDoc None arg : map (\a -> "," <+> toDoc None a) args)
97+ , ")"
10298 ]
10399
104100 else
@@ -107,20 +103,15 @@ toDoc context tipe =
107103 P.hang
108104 (P.text (Text.unpack name))
109105 2
110− (P.sep $ map (toDoc InType) args)
106+ (P.sep $ map (toDoc InType) arguments)
111107 in
112− case (context, args) of
113− (InType, _ : _) ->
108+ case context of
109+ InType ->
114110 P.parens application
115111
116112 _ ->
117113 application
118114
119− App _ _ ->
120− error $
121− "Somehow ended up with an unexpected type, please post a minimal example that\n"
122− ++ "reproduces this error to <https://github.com/elm-lang/elm-compiler/issues>"
123−
124115 Record _ _ ->
125116 case flattenRecord tipe of
126117 ([], Nothing) ->
@@ -128,22 +119,22 @@ toDoc context tipe =
128119
129120 (fields, Nothing) ->
130121 P.sep
131− [ P.cat (zipWith (<+>) (P.lbrace : repeat P.comma) (map prettyField fields))
132− , P.rbrace
122+ [ P.cat (zipWith (<+>) ("{" : repeat ",") (map prettyField fields))
123+ , "}"
133124 ]
134125
135126 (fields, Just x) ->
136127 P.hang
137− (P.lbrace <+> P.text (Text.unpack x) <+> P.text "|")
128+ ("{" <+> P.text (Text.unpack x) <+> "|")
138129 4
139130 (P.sep
140− [ P.sep (P.punctuate P.comma (map prettyField fields))
141− , P.rbrace
131+ [ P.sep (P.punctuate "," (map prettyField fields))
132+ , "}"
142133 ]
143134 )
144135 where
145136 prettyField (field, fieldType) =
146− P.text (Text.unpack field) <+> P.text ":" <+> toDoc None fieldType
137+ P.text (Text.unpack field) <+> ":" <+> toDoc None fieldType
147138
148139
149140collectLambdas :: Type -> [Type]
@@ -200,11 +191,8 @@ fromRawType (A.A _ astType) =
200191 Type.RVar x ->
201192 Var x
202193
203− Type.RType var ->
204− Type (Var.rawToText var)
205−
206− Type.RApp t ts ->
207− App (fromRawType t) (map fromRawType ts)
194+ Type.RType (A.A _ name) args ->
195+ Type (Var.rawToText name) (map fromRawType args)
208196
209197 Type.RRecord fields ext ->
210198 Record (map (A.drop *** fromRawType) fields) (fmap fromRawType ext)
src/Elm/Compiler/Type/Extract.hs+5−8
@@ -50,12 +50,9 @@ extractHelp astType =
5050 T.Var x ->
5151 return (Var x)
5252
53− T.Type var ->
53+ T.Type var args ->
5454 do Writer.tell ( Set.empty, Set.singleton var )
55− return (Type (Var.toText var))
56−
57− T.App constructor args ->
58− App <$> extractHelp constructor <*> traverse extractHelp args
55+ Type (Var.toText var) <$> traverse extractHelp args
5956
6057 T.Record fields ext ->
6158 Record
@@ -65,7 +62,7 @@ extractHelp astType =
6562 T.Aliased name args aliasedType ->
6663 do Writer.tell ( Set.singleton name, Set.empty )
6764 _ <- extractHelp (T.dealias args aliasedType)
68− App (Type (Var.toText name)) <$> traverse (extractHelp . snd) args
65+ Type (Var.toText name) <$> traverse (extractHelp . snd) args
6966
7067
7168
@@ -79,8 +76,8 @@ extractProgram interfaces name =
7976
8077 message <-
8178 case T.deepDealias mainType of
82− T.App _program [_flags, _model, msg] -> Just msg
83− T.App _node [msg] -> Just msg
79+ T.Type _program [_flags, _model, msg] -> Just msg
80+ T.Type _node [msg] -> Just msg
8481 _ -> Nothing
8582
8683 let (msgType, msgDeps) = Writer.runWriter (extractHelp message)
src/Elm/Package.hs+11−1
@@ -3,7 +3,7 @@
33module Elm.Package
44 ( Name(..)
55 , Package(..)
6− , dummyName, core, virtualDom, html
6+ , dummyName, core, virtualDom, html, webgl, linearAlgebra
77 , toString, toText, toUrl, toFilePath
88 , fromText
99 , Version(..)
@@ -77,6 +77,16 @@ html =
7777 Name "elm-lang" "html"
7878
7979
80+webgl :: Name
81+webgl =
82+ Name "elm-community" "webgl"
83+
84+
85+linearAlgebra :: Name
86+linearAlgebra =
87+ Name "elm-community" "linear-algebra"
88+
89+
8090toString :: Name -> String
8191toString name =
8292 Text.unpack (toText name)
src/Nitpick/Pattern.hs+2−2
@@ -49,10 +49,10 @@ fromCanonicalPattern (A.A _ pattern) =
4949 Anything
5050
5151 P.Literal (L.Boolean True) ->
52− Ctor (Var.builtin "True") []
52+ Ctor Var.true []
5353
5454 P.Literal (L.Boolean False) ->
55− Ctor (Var.builtin "False") []
55+ Ctor Var.false []
5656
5757 P.Literal literal ->
5858 Literal literal
src/Nitpick/PatternMatches.hs+3−7
@@ -405,10 +405,10 @@ builtinDict :: ArityDict
405405builtinDict =
406406 let
407407 listInfo =
408− ArityInfo 2 [ (Var.builtin "::", 2), (Var.builtin "[]", 0) ]
408+ ArityInfo 2 [ (Var.cons, 2), (Var.nil, 0) ]
409409
410410 boolInfo =
411− ArityInfo 2 [ (Var.builtin "True", 0), (Var.builtin "False", 0) ]
411+ ArityInfo 2 [ (Var.true, 0), (Var.false, 0) ]
412412 in
413413 Map.singleton Var.BuiltIn $ Map.fromList $
414414 [ ("::", listInfo)
@@ -421,11 +421,7 @@ builtinDict =
421421
422422makeTupleInfo :: Int -> ( Text, ArityInfo )
423423makeTupleInfo n =
424− let
425− name =
426− Help.makeTuple n
427− in
428− ( name, ArityInfo 1 [ (Var.builtin name, n) ] )
424+ ( Help.makeTuple n, ArityInfo 1 [ (Var.tuple n, n) ] )
429425
430426
431427toArityEntry :: ModuleName.Canonical -> Module.Unions -> Map.Map Text ArityInfo
src/Nitpick/TopLevelTypes.hs+7−7
@@ -87,11 +87,11 @@ checkMain typeEnv (Can.Def facts pattern@(A.A region _) body maybeType) =
8787
8888 getMainKind =
8989 case Type.deepDealias mainType of
90− Type.App name [_]
90+ Type.Type name [_]
9191 | name == vdomNode ->
9292 return Can.VDom
9393
94− Type.App name [flags, _, _]
94+ Type.Type name [flags, _, _]
9595 | name == program && flags == never ->
9696 return Can.NoFlags
9797
@@ -107,21 +107,21 @@ checkMain typeEnv (Can.Def facts pattern@(A.A region _) body maybeType) =
107107 return (Can.Def facts pattern newBody maybeType)
108108
109109
110−program :: Type.Canonical
110+program :: Var.Canonical
111111program =
112− Type.Type (Var.inCore "Platform" "Program")
112+ Var.inCore "Platform" "Program"
113113
114114
115115never :: Type.Canonical
116116never =
117− Type.Type (Var.inCore "Basics" "Never")
117+ Type.Type (Var.inCore "Basics" "Never") []
118118
119119
120−vdomNode :: Type.Canonical
120+vdomNode :: Var.Canonical
121121vdomNode =
122122 let
123123 vdom =
124124 ModuleName.Canonical Pkg.virtualDom "VirtualDom"
125125 in
126− Type.Type (Var.fromModule vdom "Node")
126+ Var.fromModule vdom "Node"
127127
src/Optimize/Port.hs+8−8
@@ -38,7 +38,7 @@ toEncoder tipe =
3838 T.Var _ ->
3939 error "toEncoder: type variable"
4040
41− T.Type name
41+ T.Type name []
4242 | Var.isPrim "Float" name -> encode "float"
4343 | Var.isPrim "Int" name -> encode "int"
4444 | Var.isPrim "Bool" name -> encode "bool"
@@ -47,16 +47,16 @@ toEncoder tipe =
4747 | Var.isTuple name -> encode "null"
4848 | otherwise -> error "toEncoder: bad type"
4949
50− T.App (T.Type name) [arg]
50+ T.Type name [arg]
5151 | Var.isMaybe name -> encodeMaybe arg
5252 | Var.isList name -> encodeList arg
5353 | Var.isArray name -> encodeArray arg
5454 | otherwise -> error "toEncoder: bad union type"
5555
56− T.App (T.Type name) args
56+ T.Type name args
5757 | Var.isTuple name -> encodeTuple args
5858
59− T.App _ _ ->
59+ T.Type _ _ ->
6060 error "toEncoder: bad union type"
6161
6262 T.Record _ (Just _) ->
@@ -142,7 +142,7 @@ toDecoder tipe =
142142 T.Aliased _ args t ->
143143 toDecoder (T.dealias args t)
144144
145− T.Type name
145+ T.Type name []
146146 | Var.isPrim "Float" name -> decode "float"
147147 | Var.isPrim "Int" name -> decode "int"
148148 | Var.isPrim "Bool" name -> decode "bool"
@@ -151,16 +151,16 @@ toDecoder tipe =
151151 | Var.isTuple name -> decodeTuple0
152152 | otherwise -> error "toDecoder: bad type"
153153
154− T.App (T.Type name) [arg]
154+ T.Type name [arg]
155155 | Var.isMaybe name -> decodeMaybe arg
156156 | Var.isList name -> decodeList arg
157157 | Var.isArray name -> decodeArray arg
158158 | otherwise -> error "toDecoder: bad union type"
159159
160− T.App (T.Type name) args
160+ T.Type name args
161161 | Var.isTuple name -> decodeTuple args
162162
163− T.App _ _ ->
163+ T.Type _ _ ->
164164 error "toDecoder: bad union type"
165165
166166 T.Record _ (Just _) ->
src/Parse/Type.hs+11−16
@@ -21,7 +21,7 @@ term =
2121 hint E.Type $
2222 do start <- getPosition
2323 oneOf
24− [ constructor
24+ [ app0
2525 , variable start
2626 , tuple start
2727 , record start
@@ -67,28 +67,23 @@ expression =
6767-- TYPE CONSTRUCTORS
6868
6969
70−constructor :: Parser Type.Raw
71−constructor =
72− addLocation $
73− fmap (Type.RType . Var.Raw) qualifiedCapVar
70+app0 :: Parser Type.Raw
71+app0 =
72+ do start <- getPosition
73+ name <- qualifiedCapVar
74+ end <- getPosition
75+ return (A.at start end (Type.RType (A.at start end (Var.Raw name)) []))
7476
7577
7678app :: R.Position -> SParser Type.Raw
7779app start =
78− do ctor <- constructor
80+ do ctor <- qualifiedCapVar
7981 ctorEnd <- getPosition
82+ let name = A.at start ctorEnd (Var.Raw ctor)
8083 ctorPos <- whitespace
8184 (args, end, pos) <- eatArgs [] ctorEnd ctorPos
82− case args of
83− [] ->
84− return ( ctor, end, pos )
85−
86− _ ->
87− let
88− tipe =
89− A.at start end (Type.RApp ctor args)
90− in
91− return ( tipe, end, pos )
85+ let tipe = A.at start end (Type.RType name args)
86+ return ( tipe, end, pos )
9287
9388
9489unionConstructor :: SParser (Text, [Type.Raw])
src/Reporting/Error/Canonicalize.hs+2−5
@@ -361,11 +361,8 @@ unsafePromote (A.A _ rawType) =
361361 Type.RVar x ->
362362 Type.Var x
363363
364− Type.RType (Var.Raw name) ->
365− Type.Type (Var.local name)
366−
367− Type.RApp func args ->
368− Type.App (unsafePromote func) (map unsafePromote args)
364+ Type.RType (A.A _ (Var.Raw name)) args ->
365+ Type.Type (Var.local name) (map unsafePromote args)
369366
370367 Type.RRecord fields ext ->
371368 Type.Record (map (A.drop *** unsafePromote) fields) (fmap unsafePromote ext)
src/Reporting/Error/Type.hs+2−2
@@ -24,7 +24,7 @@ import qualified Reporting.Render.Type as RenderType
2424import qualified Reporting.Report as Report
2525import qualified Reporting.Helpers as Help
2626import Reporting.Helpers
27− ( Doc, (<>), (<+>), capitalize, colon, dullyellow, fillSep, functionName
27+ ( Doc, (<>), (<+>), capitalize, dullyellow, fillSep, functionName
2828 , i2t, indent, ordinalize, reflowParagraph, stack, text, underline, vcat
2929 )
3030
@@ -847,7 +847,7 @@ doubleRigidError maybeLeftName maybeRightName =
847847
848848hintDoc :: Doc
849849hintDoc =
850− underline (text "Hint") <> colon
850+ underline (text "Hint") <> ":"
851851
852852
853853toHint :: Text -> Doc
src/Reporting/Helpers.hs+2−3
@@ -3,9 +3,8 @@
33module Reporting.Helpers
44 ( (|>)
55 -- re-exports
6− , Doc, (<+>), (<>), cat, colon, comma, dullyellow, equals, fillSep, hang
7− , hsep, indent, lbrace, lparen, parens, rbrace, rparen, sep, text, underline
8− , vcat
6+ , Doc, (<+>), (<>), cat, dullyellow, fillSep, hang
7+ , hsep, indent, parens, sep, text, underline, vcat
98 -- custom helpers
109 , i2t
1110 , functionName, args
src/Reporting/Render/Type.hs+35−54
@@ -19,10 +19,7 @@ import qualified AST.Helpers as Help
1919import qualified AST.Type as Type
2020import qualified AST.Variable as Var
2121import qualified Reporting.Helpers as Help
22−import Reporting.Helpers
23− ( Doc, (<+>), cat, colon, comma, dullyellow, equals, hang, hsep
24− , lbrace, lparen, parens, rbrace, rparen, sep, text, vcat
25− )
22+import Reporting.Helpers ( Doc, (<+>), cat, dullyellow, hang, hsep, parens, sep, text, vcat )
2623
2724
2825
@@ -51,11 +48,9 @@ decl localizer name vars tags =
5148 hang 2 (sep (text tag : map (docType localizer App) args))
5249 in
5350 hang 4 $ vcat $
54− (hsep (text "type" : map text (name : vars)))
51+ (hsep ("type" : map text (name : vars)))
5552 :
56− zipWith (<+>)
57− (equals : repeat (text "|"))
58− (map docTag tags)
53+ zipWith (<+>) ("=" : repeat "|") (map docTag tags)
5954
6055
6156annotation :: Localizer -> Text -> Type.Canonical -> Doc
@@ -69,12 +64,12 @@ annotation localizer name tipe =
6964 hang 4 $ sep $
7065 docName
7166 : zipWith (<+>)
72− (colon : repeat (text "->"))
67+ (":" : repeat "->")
7368 (map (docType localizer Func) parts)
7469
7570 _ ->
7671 hang 4 $ sep $
77− [ docName <+> colon
72+ [ docName <+> ":"
7873 , docType localizer None tipe
7974 ]
8075
@@ -185,10 +180,7 @@ diff localizer context leftType rightType =
185180 (Type.Var x, Type.Var y) | x == y ->
186181 pure (text x)
187182
188− (Type.Type leftName, Type.Type rightName) | leftName == rightName ->
189− pure (varToDoc localizer leftName)
190−
191− (Type.App (Type.Type leftName) leftArgs, Type.App (Type.Type rightName) rightArgs) ->
183+ (Type.Type leftName leftArgs, Type.Type rightName rightArgs) ->
192184 if leftName /= rightName || length leftArgs /= length rightArgs then
193185 difference
194186 (docApp localizer context leftName leftArgs)
@@ -202,9 +194,6 @@ diff localizer context leftType rightType =
202194 docAppHelp localizer context leftName
203195 <$> sequenceA (zipWith (go subContext) leftArgs rightArgs)
204196
205− (Type.App _ _, Type.App _ _) ->
206− error "Type applications without concrete names should not get here."
207−
208197 (Type.Record outerLeftFields outerLeftExt, Type.Record outerRightFields outerRightExt) ->
209198 let
210199 (leftFields, leftExt) =
@@ -404,15 +393,9 @@ docType localizer context tipe =
404393 Type.Var x ->
405394 text x
406395
407− Type.Type name ->
408− varToDoc localizer name
409−
410− Type.App (Type.Type name) args ->
396+ Type.Type name args ->
411397 docApp localizer context name args
412398
413− Type.App _ _ ->
414− error "type applications should start with a type atom"
415−
416399 Type.Record outerFields outerExt ->
417400 let
418401 (fields, ext) =
@@ -436,13 +419,13 @@ docLambda context docs =
436419 arg:rest ->
437420 case context of
438421 None ->
439− sep (arg : map (text "->" <+>) rest)
422+ sep (arg : map ("->" <+>) rest)
440423
441424 _ ->
442425 cat
443− [ lparen
444− , sep (arg : map (text "->" <+>) rest)
445− , rparen
426+ [ "("
427+ , sep (arg : map ("->" <+>) rest)
428+ , ")"
446429 ]
447430
448431
@@ -457,27 +440,25 @@ docApp localizer context name args =
457440
458441
459442docAppHelp :: Localizer -> Context -> Var.Canonical -> [Doc] -> Doc
460−docAppHelp localizer context name args =
461− if Var.isTuple name then
462− sep
463− [ cat (zipWith (<+>) (lparen : repeat comma) args)
464− , rparen
465− ]
466−
467− else if null args then
468− varToDoc localizer name
469−
470− else
471− case context of
472− App ->
473− cat
474− [ lparen
475− , hang 4 (sep (varToDoc localizer name : args))
476− , rparen
477− ]
443+docAppHelp localizer context name arguments =
444+ case arguments of
445+ [] ->
446+ if Var.isTuple name then "()" else varToDoc localizer name
478447
479− _ ->
480− hang 4 (sep (varToDoc localizer name : args))
448+ arg : args ->
449+ if Var.isTuple name then
450+ sep
451+ [ cat ("(" <+> arg : map ("," <+>) args)
452+ , ")"
453+ ]
454+
455+ else
456+ case context of
457+ App ->
458+ cat [ "(", hang 4 (sep (varToDoc localizer name : arg : args)), ")" ]
459+
460+ _ ->
461+ hang 4 (sep (varToDoc localizer name : arg : args))
481462
482463
483464
@@ -490,7 +471,7 @@ docRecord :: Style -> [(Doc,Doc)] -> Maybe Doc -> Doc
490471docRecord style fields maybeExt =
491472 let
492473 docField (name, tipe) =
493− hang 4 (sep [ name <+> colon, tipe ])
474+ hang 4 (sep [ name <+> ":", tipe ])
494475
495476 elision =
496477 case style of
@@ -509,16 +490,16 @@ docRecord style fields maybeExt =
509490
510491 (_, Nothing) ->
511492 sep
512− [ cat (zipWith (<+>) (lbrace : repeat comma) fieldDocs)
513− , rbrace
493+ [ cat (zipWith (<+>) ("{" : repeat ",") fieldDocs)
494+ , "}"
514495 ]
515496
516497 (_, Just ext) ->
517498 sep
518499 [ hang 4 $ sep $
519− [ lbrace <+> ext
520− , cat (zipWith (<+>) (text "|" : repeat comma) fieldDocs)
500+ [ "{" <+> ext
501+ , cat (zipWith (<+>) (text "|" : repeat ",") fieldDocs)
521502 ]
522− , rbrace
503+ , "}"
523504 ]
524505
src/Type/Constrain/Effects.hs+21−19
@@ -3,16 +3,15 @@
33module Type.Constrain.Effects (constrain) where
44
55import qualified Data.Map as Map
6−import Data.Monoid ((<>))
76
87import qualified AST.Effects as Effects
98import qualified AST.Module.Name as ModuleName
9+import qualified AST.Variable as Var
1010import qualified Reporting.Annotation as A
1111import qualified Reporting.Error.Type as Error
12−import qualified Type.Environment as Env
1312import Type.Type
14− ( Variable, Type(VarN), Constraint(..), Scheme(Scheme)
15− , (==>), (<|), mkVar
13+ ( Variable, Type(AppN,VarN), Constraint(..)
14+ , Scheme(Scheme), (==>), mkVar
1615 )
1716
1817
@@ -20,8 +19,8 @@ import Type.Type
2019-- CONSTRAIN EFFECTS
2120
2221
23−constrain :: Env.Env -> ModuleName.Canonical -> Effects.Canonical -> IO Constraint
24−constrain env moduleName effects =
22+constrain :: ModuleName.Canonical -> Effects.Canonical -> IO Constraint
23+constrain moduleName effects =
2524 case effects of
2625 Effects.None ->
2726 return CSaveEnv
@@ -30,17 +29,22 @@ constrain env moduleName effects =
3029 return CSaveEnv
3130
3231 Effects.Manager _ info ->
33− constrainHelp env moduleName info
32+ constrainHelp moduleName info
3433
3534
36−constrainHelp :: Env.Env -> ModuleName.Canonical -> Effects.Info -> IO Constraint
37−constrainHelp env moduleName (Effects.Info tagRegion r0 r1 r2 managerType) =
35+never :: Type
36+never =
37+ AppN Var.never []
38+
39+
40+constrainHelp :: ModuleName.Canonical -> Effects.Info -> IO Constraint
41+constrainHelp moduleName (Effects.Info tagRegion r0 r1 r2 managerType) =
3842 let
3943 task t =
40− Env.getType env "Platform.Task" <| Env.getType env "Basics.Never" <| VarN t
44+ AppN Var.task [ never, VarN t ]
4145
4246 router msg selfMsg =
43− Env.getType env "Platform.Router" <| VarN msg <| VarN selfMsg
47+ AppN Var.router [ VarN msg, VarN selfMsg ]
4448 in
4549 do v0 <- mkVar Nothing
4650 v1 <- mkVar Nothing
@@ -62,7 +66,7 @@ constrainHelp env moduleName (Effects.Info tagRegion r0 r1 r2 managerType) =
6266
6367 onEffectsType =
6468 router msg1 selfMsg1
65− ==> addEffectArgs env moduleName managerType msg1
69+ ==> addEffectArgs moduleName managerType msg1
6670 (VarN state1 ==> task state1)
6771
6872 onSelfMsgType =
@@ -85,20 +89,18 @@ constrainHelp env moduleName (Effects.Info tagRegion r0 r1 r2 managerType) =
8589
8690
8791addEffectArgs
88− :: Env.Env
89− -> ModuleName.Canonical
92+ :: ModuleName.Canonical
9093 -> Effects.RawManagerType
9194 -> Variable
9295 -> Type
9396 -> Type
94−addEffectArgs env moduleName managerType msg result =
97+addEffectArgs moduleName managerType msg result =
9598 let
96− toTypeName (A.A _ name) =
97− ModuleName.canonicalToText moduleName <> "." <> name
99+ toVar (A.A _ name) =
100+ Var.fromModule moduleName name
98101
99102 effectList fxName =
100− Env.getType env "List" <|
101− (Env.getType env (toTypeName fxName) <| VarN msg)
103+ AppN Var.list [AppN (toVar fxName) [VarN msg]]
102104 in
103105 case managerType of
104106 Effects.CmdManager cmd ->
src/Type/Constrain/Expression.hs+6−6
@@ -28,7 +28,7 @@ constrain :: Env.Env -> C.Expr -> Type -> IO Constraint
2828constrain env annotatedExpr@(A.A region expression) tipe =
2929 case expression of
3030 C.Literal lit ->
31− Literal.constrain env region lit tipe
31+ Literal.constrain region lit tipe
3232
3333 C.Cmd _ _ ->
3434 return CTrue
@@ -46,17 +46,17 @@ constrain env annotatedExpr@(A.A region expression) tipe =
4646 error "DANGER - Program AST nodes should not be in type inference."
4747
4848 C.SaveEnv moduleName effects ->
49− Effects.constrain env moduleName effects
49+ Effects.constrain moduleName effects
5050
5151 C.GLShader _uid _src glType ->
5252 exists $ \attr ->
5353 exists $ \unif ->
5454 let
5555 shaderTipe a u v =
56− Env.getType env "WebGL.Shader" <| a <| u <| v
56+ AppN V.shader [a, u, v]
5757
5858 glToType gl =
59− Env.getType env (Lit.glTypeToText gl)
59+ AppN (Lit.glTypeToVar gl) []
6060
6161 makeRec accessor baseRec =
6262 let decls = accessor glType
@@ -299,7 +299,7 @@ constrainList env region exprs tipe =
299299 return ( (var, region'), con )
300300
301301 varToCon var =
302− CEqual Error.List region (Env.getType env "List" <| VarN var) tipe
302+ CEqual Error.List region (AppN V.list [VarN var]) tipe
303303
304304
305305
@@ -328,7 +328,7 @@ constrainIf env region branches finally tipe =
328328 return $ ex (condVars ++ vars) (CAnd (condCons ++ branchExprCons ++ cons))
329329 where
330330 bool =
331− Env.getType env "Bool"
331+ AppN V.bool []
332332
333333 constrainCondition condition@(A.A condRegion _) =
334334 do condVar <- mkVar Nothing
src/Type/Constrain/Literal.hs+9−9
@@ -3,23 +3,23 @@
33module Type.Constrain.Literal where
44
55import qualified AST.Literal as L
6+import qualified AST.Variable as Var
67import qualified Reporting.Error.Type as Error
78import qualified Reporting.Region as R
89import qualified Type.Type as T
9−import qualified Type.Environment as Env
1010
1111
1212
1313-- CONSTRAIN LITERALS
1414
1515
16−constrain :: Env.Env -> R.Region -> L.Literal -> T.Type -> IO T.Constraint
17−constrain env region literal tipe =
16+constrain :: R.Region -> L.Literal -> T.Type -> IO T.Constraint
17+constrain region literal tipe =
1818 do definiteType <- litType
1919 return (T.CEqual (Error.Literal name) region definiteType tipe)
2020 where
21− prim tipeName =
22− return (Env.getType env tipeName)
21+ prim var =
22+ return (T.AppN var [])
2323
2424 (name, litType) =
2525 case literal of
@@ -30,20 +30,20 @@ constrain env region literal tipe =
3030
3131 L.FloatNum _ ->
3232 ( "float"
33− , prim "Float"
33+ , prim Var.float
3434 )
3535
3636 L.Chr _ ->
3737 ( "character"
38− , prim "Char"
38+ , prim Var.char
3939 )
4040
4141 L.Str _ ->
4242 ( "string"
43− , prim "String"
43+ , prim Var.string
4444 )
4545
4646 L.Boolean _ ->
4747 ( "boolean"
48− , prim "Bool"
48+ , prim Var.bool
4949 )
src/Type/Constrain/Pattern.hs+1−1
@@ -70,7 +70,7 @@ constrain env (A.A region pattern) tipe =
7070 return emptyInfo
7171
7272 P.Literal lit ->
73− do c <- Literal.constrain env region lit tipe
73+ do c <- Literal.constrain region lit tipe
7474 return $ emptyInfo { _cons = c }
7575
7676 P.Var name ->
src/Type/Environment.hs+28−81
@@ -4,13 +4,12 @@ module Type.Environment
44 ( Env
55 , Dict
66 , initialize
7− , get, getType, freshDataScheme, ctorNames
7+ , get, freshDataScheme, ctorNames
88 , addValues
99 , instantiateType
1010 )
1111 where
1212
13−import Control.Monad (foldM)
1413import qualified Control.Monad.State.Strict as State
1514import qualified Data.List as List
1615import qualified Data.Map as Map
@@ -31,7 +30,6 @@ import Type.Type
3130data Env =
3231 Env
3332 { _ctor :: Dict Instantiator
34− , _types :: Dict Type
3533 , _value :: Dict Type
3634 }
3735
@@ -44,61 +42,20 @@ type Dict a =
4442 Map.Map Text a
4543
4644
47−initialize :: [Module.CanonicalUnion] -> IO Env
45+initialize :: [Module.CanonicalUnion] -> Env
4846initialize unions =
49− do types <- makeTypes unions
50− let env =
51− Env
52− { _ctor = Map.empty
53− , _value = Map.empty
54− , _types = types
55− }
56− return $ env { _ctor = makeCtors env unions }
57−
58−
59−
60−-- TYPES
61−
62−
63−makeTypes :: [Module.CanonicalUnion] -> IO (Dict Type)
64−makeTypes unions =
65− do builtinDict <- Map.fromList <$> mapM makeBuiltin builtinTypes
66− foldM addImported builtinDict unions
67−
68−
69−addImported :: Dict Type -> (Var.Canonical, unionInfo) -> IO (Dict Type)
70−addImported dict ( var, _ ) =
71− do atom <- mkAtom var
72− return (Map.insert (Var.toText var) (VarN atom) dict)
73−
74−
75−makeBuiltin :: (Text, Int) -> IO (Text, Type)
76−makeBuiltin (name, _) =
77− do atom <- mkAtom (Var.builtin name)
78− return (name, VarN atom)
79−
80−
81−builtinTypes :: [(Text, Int)]
82−builtinTypes =
83− concat
84− [ map tuple [0..9]
85− , kind 1 ["List"]
86− , kind 0 ["Int","Float","Char","String","Bool"]
87− ]
88− where
89− tuple size = ( Help.makeTuple size, size )
90− kind n names = map (\name -> (name, n)) names
47+ Env (makeCtors unions) Map.empty
9148
9249
9350
9451-- CONSTRUCTORS
9552
9653
97−makeCtors :: Env -> [Module.CanonicalUnion] -> Dict Instantiator
98−makeCtors env unions =
54+makeCtors :: [Module.CanonicalUnion] -> Dict Instantiator
55+makeCtors unions =
9956 let
10057 list t =
101− getType env "List" <| t
58+ AppN Var.list [t]
10259
10360 inst :: Int -> ([Type] -> ([Type], Type)) -> Instantiator
10461 inst numTVars tipe =
@@ -111,7 +68,7 @@ makeCtors env unions =
11168 name =
11269 Help.makeTuple size
11370 in
114− (name, inst size $ \vs -> (vs, foldl (<|) (getType env name) vs))
71+ (name, inst size $ \vs -> (vs, AppN (Var.tuple size) vs))
11572
11673 builtins :: Dict Instantiator
11774 builtins =
@@ -121,15 +78,15 @@ makeCtors env unions =
12178 ]
12279 ++ map tupleCtor [0..9]
12380 in
124− List.foldl' (makeCtorsHelp env) builtins unions
81+ List.foldl' makeCtorsHelp builtins unions
12582
12683
12784type VarDict =
12885 Map.Map Text Variable
12986
13087
131−makeCtorsHelp :: Env -> Dict Instantiator -> Module.CanonicalUnion -> Dict Instantiator
132−makeCtorsHelp env constructorDict ( var, (rawTypeVars, ctors) ) =
88+makeCtorsHelp :: Dict Instantiator -> Module.CanonicalUnion -> Dict Instantiator
89+makeCtorsHelp constructorDict ( var, (rawTypeVars, ctors) ) =
13390 let
13491 inst :: Dict Instantiator -> (Var.Canonical, [T.Canonical]) -> Dict Instantiator
13592 inst ctorDict (name, rawArgs) =
@@ -145,8 +102,8 @@ makeCtorsHelp env constructorDict ( var, (rawTypeVars, ctors) ) =
145102
146103 go :: [T.Canonical] -> State.StateT VarDict IO ([Type], Type)
147104 go args =
148− do types <- mapM (instantiator Flex env) args
149− returnType <- instantiator Flex env (T.App (T.Type var) tvars)
105+ do types <- mapM (instantiator Flex Map.empty) args
106+ returnType <- instantiator Flex Map.empty (T.Type var tvars)
150107 return (types, returnType)
151108 in
152109 List.foldl' inst constructorDict ctors
@@ -162,11 +119,6 @@ get dict var =
162119 dict Map.! var
163120
164121
165−getType :: Env -> Text -> Type
166−getType env var =
167− get (_types env) var
168−
169−
170122freshDataScheme :: Env -> Text -> Instantiator
171123freshDataScheme env var =
172124 get (_ctor env) var
@@ -192,19 +144,19 @@ addValues newValues env =
192144
193145instantiateType :: Flex -> Env -> T.Canonical -> IO (Type, VarDict)
194146instantiateType flex env sourceType =
195− State.runStateT (instantiator flex env sourceType) Map.empty
147+ State.runStateT (instantiator flex (_value env) sourceType) Map.empty
196148
197149
198−instantiator :: Flex -> Env -> T.Canonical -> State.StateT VarDict IO Type
199−instantiator flex env sourceType =
200− instantiatorHelp flex env Set.empty sourceType
150+instantiator :: Flex -> Dict Type -> T.Canonical -> State.StateT VarDict IO Type
151+instantiator flex values sourceType =
152+ instantiatorHelp flex values Set.empty sourceType
201153
202154
203−instantiatorHelp :: Flex -> Env -> Set.Set Text -> T.Canonical -> State.StateT VarDict IO Type
204−instantiatorHelp flex env aliasVars sourceType =
155+instantiatorHelp :: Flex -> Dict Type -> Set.Set Text -> T.Canonical -> State.StateT VarDict IO Type
156+instantiatorHelp flex values aliasVars sourceType =
205157 let
206158 go =
207− instantiatorHelp flex env aliasVars
159+ instantiatorHelp flex values aliasVars
208160 in
209161 case sourceType of
210162 T.Lambda t1 t2 ->
@@ -215,12 +167,12 @@ instantiatorHelp flex env aliasVars sourceType =
215167 return (PlaceHolder name)
216168
217169 else
218− do dict <- State.get
219− case Map.lookup name (_value env) of
220− Just tipe ->
221− return tipe
170+ case Map.lookup name values of
171+ Just tipe ->
172+ return tipe
222173
223− Nothing ->
174+ Nothing ->
175+ do dict <- State.get
224176 case Map.lookup name dict of
225177 Just variable ->
226178 return (VarN variable)
@@ -235,20 +187,15 @@ instantiatorHelp flex env aliasVars sourceType =
235187 realType <-
236188 case aliasType of
237189 T.Filled tipe ->
238− instantiatorHelp flex env Set.empty tipe
190+ instantiatorHelp flex values Set.empty tipe
239191
240192 T.Holey tipe ->
241− instantiatorHelp flex env (Set.fromList (map fst args)) tipe
193+ instantiatorHelp flex values (Set.fromList (map fst args)) tipe
242194
243195 return (AliasN name targs realType)
244196
245− T.Type name ->
246− return (getType env (Var.toText name))
247−
248− T.App func args ->
249− do tfunc <- go func
250− targs <- traverse go args
251− return $ foldl (<|) tfunc targs
197+ T.Type name args ->
198+ AppN name <$> traverse go args
252199
253200 T.Record fields ext ->
254201 do tfields <- traverse go (Map.fromList fields)
src/Type/Inference.hs+1−2
@@ -46,8 +46,7 @@ genConstraints
4646 -> Module.Canonical
4747 -> IO (Map.Map Text T.Type, T.Constraint)
4848genConstraints interfaces modul =
49− do env <-
50− Env.initialize (canonicalizeUnions interfaces modul)
49+ do let env = Env.initialize (canonicalizeUnions interfaces modul)
5150
5251 ctors <-
5352 forM (Env.ctorNames env) $ \name ->
src/Type/Occurs.hs+2−5
@@ -25,9 +25,6 @@ occursHelp seen var =
2525 else
2626 do desc <- UF.descriptor var
2727 case _content desc of
28− Atom _ ->
29− return False
30−
3128 Var _ _ _ ->
3229 return False
3330
@@ -43,8 +40,8 @@ occursHelp seen var =
4340 go = occursHelp (var:seen)
4441 in
4542 case term of
46− App1 a b ->
47− (||) <$> go a <*> go b
43+ App1 _ args ->
44+ or <$> traverse go args
4845
4946 Fun1 a b ->
5047 (||) <$> go a <*> go b
src/Type/Solve.hs+6−5
@@ -122,9 +122,6 @@ adjustRankContent youngMark visitedMark groupRank content =
122122 Error _ ->
123123 return groupRank
124124
125− Atom _ ->
126− return groupRank
127−
128125 Var _ _ _ ->
129126 return groupRank
130127
@@ -133,8 +130,12 @@ adjustRankContent youngMark visitedMark groupRank content =
133130 do realRank <- go realVar
134131 foldM (\rank (_, argVar) -> max rank <$> go argVar) realRank args
135132
136− Structure (App1 func arg) ->
137− max <$> go func <*> go arg
133+ Structure (App1 _ []) ->
134+ return groupRank
135+
136+ Structure (App1 _ (first:rest)) ->
137+ do firstRank <- go first
138+ foldM (\rank arg -> max rank <$> go arg) firstRank rest
138139
139140 Structure (Fun1 arg result) ->
140141 max <$> go arg <*> go result
src/Type/State.hs+6−16
@@ -22,7 +22,7 @@ module Type.State
2222 where
2323
2424
25−import Control.Monad (liftM2)
25+import Control.Monad (liftM, liftM2)
2626import Control.Monad.Trans (MonadIO, liftIO)
2727import qualified Data.Map as Map
2828import Data.Map ((!))
@@ -219,10 +219,9 @@ flattenHelp aliasDict termN =
219219 VarN v ->
220220 return v
221221
222− AppN a b ->
223− do flatA <- flattenHelp aliasDict a
224− flatB <- flattenHelp aliasDict b
225− makeFlatType (Structure (App1 flatA flatB))
222+ AppN name args ->
223+ do flatArgs <- traverse (flattenHelp aliasDict) args
224+ makeFlatType (Structure (App1 name flatArgs))
226225
227226 FunN a b ->
228227 do flatA <- flattenHelp aliasDict a
@@ -323,9 +322,6 @@ makeCopyHelp (Descriptor content rank mark copy) alreadyCopiedMark variable =
323322 do newTerm <- traverseFlatType (makeCopy alreadyCopiedMark) term
324323 setContent (Structure newTerm)
325324
326− Atom _ ->
327− return ()
328−
329325 Var Rigid maybeSuper maybeName ->
330326 setContent (Var Flex maybeSuper maybeName)
331327
@@ -351,9 +347,6 @@ needsCopy content =
351347 Structure _ ->
352348 True
353349
354− Atom _ ->
355− False
356−
357350 Var _ _ _ ->
358351 True
359352
@@ -397,9 +390,6 @@ restoreContent alreadyCopiedMark content =
397390 Structure term ->
398391 Structure <$> traverseFlatType go term
399392
400− Atom _ ->
401− return content
402−
403393 Var _ _ _ ->
404394 return content
405395
@@ -419,8 +409,8 @@ restoreContent alreadyCopiedMark content =
419409traverseFlatType :: (Variable -> Solver Variable) -> FlatType -> Solver FlatType
420410traverseFlatType f flatType =
421411 case flatType of
422− App1 a b ->
423− liftM2 App1 (f a) (f b)
412+ App1 name args ->
413+ liftM (App1 name) (traverse f args)
424414
425415 Fun1 a b ->
426416 liftM2 Fun1 (f a) (f b)
src/Type/Type.hs+6−32
@@ -28,7 +28,7 @@ type Variable =
2828
2929
3030data FlatType
31− = App1 Variable Variable
31+ = App1 Var.Canonical [Variable]
3232 | Fun1 Variable Variable
3333 | EmptyRecord1
3434 | Record1 (Map.Map Text Variable) Variable
@@ -38,7 +38,7 @@ data Type
3838 = PlaceHolder Text
3939 | AliasN Var.Canonical [(Text, Type)] Type
4040 | VarN Variable
41− | AppN Type Type
41+ | AppN Var.Canonical [Type]
4242 | FunN Type Type
4343 | EmptyRecordN
4444 | RecordN (Map.Map Text Type) Type
@@ -59,7 +59,6 @@ data Descriptor =
5959
6060data Content
6161 = Structure FlatType
62− | Atom Var.Canonical
6362 | Var Flex (Maybe Super) (Maybe Text)
6463 | Alias Var.Canonical [(Text,Variable)] Variable
6564 | Error Text
@@ -142,12 +141,6 @@ infixr 9 ==>
142141 FunN
143142
144143
145−{-# INLINE (<|) #-}
146−(<|) :: Type -> Type -> Type
147−(<|) =
148− AppN
149−
150−
151144
152145-- VARIABLE CREATION
153146
@@ -162,11 +155,6 @@ mkDescriptor content =
162155 }
163156
164157
165−mkAtom :: Var.Canonical -> IO Variable
166−mkAtom name =
167− UF.fresh $ mkDescriptor (Atom name)
168−
169−
170158mkVar :: Maybe Super -> IO Variable
171159mkVar maybeSuper =
172160 UF.fresh $ mkDescriptor (Var Flex maybeSuper Nothing)
@@ -268,9 +256,6 @@ contentToSrcType variable content =
268256 Structure term ->
269257 termToSrcType term
270258
271− Atom name ->
272− return (T.Type name)
273−
274259 Var _ _ (Just name) ->
275260 return (T.Var name)
276261
@@ -292,15 +277,8 @@ contentToSrcType variable content =
292277termToSrcType :: FlatType -> StateT NameState IO T.Canonical
293278termToSrcType term =
294279 case term of
295− App1 func arg ->
296− do srcFunc <- variableToSrcType func
297− srcArg <- variableToSrcType arg
298− case srcFunc of
299− T.App f args ->
300− return (T.App f (args ++ [srcArg]))
301−
302− _ ->
303− return (T.App srcFunc [srcArg])
280+ App1 name args ->
281+ T.Type name <$> traverse variableToSrcType args
304282
305283 Fun1 a b ->
306284 T.Lambda
@@ -431,9 +409,6 @@ getVarNames var =
431409 False ->
432410 do liftIO $ UF.setDescriptor var (desc { _mark = getVarNamesMark })
433411 case _content desc of
434− Atom _ ->
435− return ()
436−
437412 Error _ ->
438413 return ()
439414
@@ -449,9 +424,8 @@ getVarNames var =
449424 do mapM_ (getVarNames . snd) args
450425 getVarNames realVar
451426
452− Structure (App1 func arg) ->
453− do getVarNames func
454− getVarNames arg
427+ Structure (App1 _ args) ->
428+ mapM_ getVarNames args
455429
456430 Structure (Fun1 arg body) ->
457431 do getVarNames arg
src/Type/Unify.hs+56−144
@@ -234,9 +234,6 @@ actuallyUnify context@(Context _ _ firstDesc _ secondDesc) =
234234 Var Rigid maybeSuper maybeName ->
235235 unifyRigid context maybeSuper maybeName firstContent secondContent
236236
237− Atom name ->
238− unifyAtom context name secondContent
239−
240237 Alias name args realVar ->
241238 unifyAlias context name args realVar secondContent
242239
@@ -260,9 +257,6 @@ unifyFlex context otherContent =
260257 Var Rigid _ _ ->
261258 merge context otherContent
262259
263− Atom _ ->
264− merge context otherContent
265−
266260 Alias _ _ _ ->
267261 merge context otherContent
268262
@@ -298,9 +292,6 @@ unifyRigid context maybeSuper maybeName content otherContent =
298292 mismatch context $ Just $
299293 doubleBad (Error.Rigid maybeName) (Error.Rigid otherMaybeName)
300294
301− Atom _ ->
302− mismatch context (Just (badRigid maybeName))
303−
304295 Alias _ _ _ ->
305296 mismatch context (Just (badRigid maybeName))
306297
@@ -318,12 +309,6 @@ unifyFlexSuper context super content otherContent =
318309 Structure term ->
319310 unifyFlexSuperStructure context super term
320311
321− Atom name ->
322− if atomMatchesSuper super name then
323− merge context otherContent
324− else
325− mismatch context (Just (badSuper super))
326−
327312 Var Rigid Nothing maybeName ->
328313 mismatch context (Just (doubleBad (errorSuper super) (Error.Rigid maybeName)))
329314
@@ -379,71 +364,71 @@ combineRigidSupers rigid flex =
379364 || (rigid == CompAppend && (flex == Comparable || flex == Appendable))
380365
381366
382−isPrimitiveFrom :: [Text] -> Var.Canonical -> Bool
383−isPrimitiveFrom prims var =
384− any (\p -> Var.isPrim p var) prims
385−
386−
387367atomMatchesSuper :: Super -> Var.Canonical -> Bool
388368atomMatchesSuper super name =
389369 case super of
390370 Number ->
391− isPrimitiveFrom ["Int", "Float"] name
371+ elem name [ Var.int, Var.float ]
392372
393373 Comparable ->
394− isPrimitiveFrom ["Int", "Float", "Char", "String"] name
374+ elem name [ Var.string, Var.int, Var.float, Var.char]
395375
396376 Appendable ->
397− Var.isPrim "String" name
377+ name == Var.string
398378
399379 CompAppend ->
400− Var.isPrim "String" name
380+ name == Var.string
401381
402382
403383unifyFlexSuperStructure :: Context -> Super -> FlatType -> Unify ()
404384unifyFlexSuperStructure context super term =
405− do appStructure <- liftIO (collectApps term)
406− case appStructure of
407− Other ->
385+ do case term of
386+ App1 name [] ->
387+ if atomMatchesSuper super name then
388+ merge context (Structure term)
389+ else
408390 mismatch context (Just (badSuper super))
409391
410− List variable ->
411− case super of
412− Number ->
413− mismatch context (Just (badSuper super))
392+ App1 name [variable] | name == Var.list ->
393+ case super of
394+ Number ->
395+ mismatch context (Just (badSuper super))
414396
415− Appendable ->
416− merge context (Structure term)
397+ Appendable ->
398+ merge context (Structure term)
417399
418− Comparable ->
419− do comparableOccursCheck context
420− merge context (Structure term)
421− unifyComparableRecursive (_orientation context) variable
400+ Comparable ->
401+ do comparableOccursCheck context
402+ merge context (Structure term)
403+ unifyComparableRecursive (_orientation context) variable
422404
423− CompAppend ->
424− do comparableOccursCheck context
425− merge context (Structure term)
426− unifyComparableRecursive (_orientation context) variable
405+ CompAppend ->
406+ do comparableOccursCheck context
407+ merge context (Structure term)
408+ unifyComparableRecursive (_orientation context) variable
427409
428− Tuple entries ->
429− case super of
430− Number ->
431− mismatch context (Just (badSuper super))
410+ App1 name args | Var.isTuple name ->
411+ case super of
412+ Number ->
413+ mismatch context (Just (badSuper super))
432414
433− Appendable ->
434− mismatch context (Just (badSuper super))
415+ Appendable ->
416+ mismatch context (Just (badSuper super))
435417
436− Comparable ->
437− if length entries > 6 then
438− mismatch context (Just (Error.TooLongComparableTuple (length entries)))
418+ Comparable ->
419+ if length args > 6 then
420+ mismatch context (Just (Error.TooLongComparableTuple (length args)))
439421
440− else
441− do comparableOccursCheck context
442− merge context (Structure term)
443− mapM_ (unifyComparableRecursive (_orientation context)) entries
422+ else
423+ do comparableOccursCheck context
424+ merge context (Structure term)
425+ mapM_ (unifyComparableRecursive (_orientation context)) args
444426
445− CompAppend ->
446− mismatch context (Just (badSuper super))
427+ CompAppend ->
428+ mismatch context (Just (badSuper super))
429+
430+ _ ->
431+ mismatch context (Just (badSuper super))
447432
448433
449434-- TODO: is there some way to avoid doing this?
@@ -472,38 +457,6 @@ unifyComparableRecursive orientation var =
472457 guardedUnify orientation compVar var
473458
474459
475−data AppStructure
476− = List Variable
477− | Tuple [Variable]
478− | Other
479−
480−
481−collectApps :: FlatType -> IO AppStructure
482−collectApps term =
483− case term of
484− App1 func arg ->
485− collectAppsHelp [arg] =<< getContent func
486−
487− _ ->
488− return Other
489−
490−
491−collectAppsHelp :: [Variable] -> Content -> IO AppStructure
492−collectAppsHelp args content =
493− case (content, args) of
494− (Structure (App1 func arg), _) ->
495− collectAppsHelp (arg : args) =<< getContent func
496−
497− (Atom name, [arg]) | Var.isList name ->
498− return (List arg)
499−
500− (Atom name, _) | Var.isTuple name ->
501− return (Tuple (reverse args))
502−
503− _ ->
504− return Other
505−
506−
507460collectArgs :: Variable -> IO [Variable]
508461collectArgs variable =
509462 collectArgsHelp [] variable
@@ -526,52 +479,6 @@ getContent variable =
526479
527480
528481
529−-- UNIFY ATOMS
530−
531−
532−unifyAtom :: Context -> Var.Canonical -> Content -> Unify ()
533−unifyAtom context name otherContent =
534− case otherContent of
535− Error _ ->
536− return ()
537−
538− Var Flex Nothing _ ->
539− merge context (Atom name)
540−
541− Var Flex (Just super) _ ->
542− if atomMatchesSuper super name then
543− merge context (Atom name)
544−
545− else
546− mismatch context (Just ((Error.flipReason (badSuper super))))
547−
548− Var Rigid _ maybeName ->
549− mismatch context (Just (Error.flipReason (badRigid maybeName)))
550−
551− Atom otherName ->
552− if name == otherName then
553− merge context otherContent
554−
555− else
556− mismatch context $
557− if isIntFloat name otherName || isIntFloat otherName name then
558− Just Error.IntFloat
559− else
560− Nothing
561−
562− Alias _ _ realVar ->
563− subUnify context (_first context) realVar
564−
565− Structure _ ->
566− mismatch context Nothing
567−
568−
569−isIntFloat :: Var.Canonical -> Var.Canonical -> Bool
570−isIntFloat name otherName =
571− Var.isPrim "Int" name && Var.isPrim "Float" otherName
572−
573−
574−
575482-- UNIFY ALIASES
576483
577484
@@ -587,9 +494,6 @@ unifyAlias context name args realVar otherContent =
587494 Var _ _ _ ->
588495 subUnify context realVar (_second context)
589496
590− Atom _ ->
591− subUnify context realVar (_second context)
592−
593497 Alias otherName otherArgs otherRealVar ->
594498 if name == otherName then
595499 do zipWithM_ (subUnify context) (map snd args) (map snd otherArgs)
@@ -621,18 +525,21 @@ unifyStructure context term content otherContent =
621525 Var Rigid _ maybeName ->
622526 mismatch context (Just (Error.flipReason (badRigid maybeName)))
623527
624− Atom _ ->
625− mismatch context Nothing
626−
627528 Alias _ _ realVar ->
628529 subUnify context (_first context) realVar
629530
630531 Structure otherTerm ->
631532 case (term, otherTerm) of
632− (App1 func arg, App1 otherFunc otherArg) ->
633− do subUnify context func otherFunc
634− subUnify context arg otherArg
635− merge context otherContent
533+ (App1 name args, App1 otherName otherArgs) ->
534+ if name == otherName then
535+ do zipWithM_ (subUnify context) args otherArgs
536+ merge context otherContent
537+
538+ else if isIntFloat name otherName || isIntFloat otherName name then
539+ mismatch context (Just Error.IntFloat)
540+
541+ else
542+ mismatch context Nothing
636543
637544 (Fun1 arg result, Fun1 otherArg otherResult) ->
638545 do subUnify context arg otherArg
@@ -657,6 +564,11 @@ unifyStructure context term content otherContent =
657564 mismatch context Nothing
658565
659566
567+isIntFloat :: Var.Canonical -> Var.Canonical -> Bool
568+isIntFloat name otherName =
569+ Var.isPrim "Int" name && Var.isPrim "Float" otherName
570+
571+
660572
661573-- UNIFY RECORDS
662574
src/Validate.hs+4−10
@@ -687,11 +687,8 @@ freeVars (A.A region tipe) =
687687 Type.RVar x ->
688688 Result.ok [A.A region x]
689689
690− Type.RType _ ->
691− Result.ok []
692−
693− Type.RApp t ts ->
694− concat <$> traverse freeVars (t:ts)
690+ Type.RType _ args ->
691+ concat <$> traverse freeVars args
695692
696693 Type.RRecord fields ext ->
697694 do checkDuplicateFields region fields
@@ -709,11 +706,8 @@ checkDuplicateFieldsInType (A.A region tipe) =
709706 Type.RVar _ ->
710707 Result.ok ()
711708
712− Type.RType _ ->
713− Result.ok ()
714−
715− Type.RApp t ts ->
716− F.traverse_ checkDuplicateFieldsInType (t:ts)
709+ Type.RType _ args ->
710+ F.traverse_ checkDuplicateFieldsInType args
717711
718712 Type.RRecord fields ext ->
719713 do checkDuplicateFields region fields