@@ -34,14 +34,14 @@ import Control.Monad.Supply.Class (MonadSupply)
3434import Control.Monad.Writer.Class (MonadWriter(..))
3535
3636import Data.Bifunctor (bimap)
37−import Data.Either (lefts, rights)
37+import Data.Either (partitionEithers)
3838import Data.Functor (($>))
3939import Data.List (transpose, nub, (\\), partition, delete)
4040import Data.Maybe (fromMaybe)
4141import Data.Monoid ((<>))
4242import qualified Data.Map as M
4343import qualified Data.Set as S
44−import Data.Text (Text)
44+import Data.Traversable (for)
4545
4646import Language.PureScript.AST
4747import Language.PureScript.Crash
@@ -60,7 +60,8 @@ import Language.PureScript.TypeChecker.Synonyms
6060import Language.PureScript.TypeChecker.TypeSearch
6161import Language.PureScript.TypeChecker.Unify
6262import Language.PureScript.Types
63−
63+import Language.PureScript.Label (Label(..))
64+import Language.PureScript.PSString (PSString)
6465
6566data BindingGroupType
6667 = RecursiveBindingGroup
@@ -77,9 +78,9 @@ typesOf
7778 -> m [(Ident, (Expr, Type))]
7879typesOf bindingGroupType moduleName vals = withFreshSubstitution $ do
7980 tys <- capturingSubstitution tidyUp $ do
80− (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup (Just moduleName) vals
81+ SplitBindingGroup untyped typed dict <- typeDictionaryForBindingGroup (Just moduleName) vals
8182 ds1 <- parU typed $ \e -> withoutWarnings $ checkTypedBindingGroupElement moduleName e dict
82− ds2 <- forM untyped $ \e -> withoutWarnings $ typeForBindingGroupElement e dict untypedDict
83+ ds2 <- forM untyped $ \e -> withoutWarnings $ typeForBindingGroupElement e dict
8384 return (map (False, ) ds1 ++ map (True, ) ds2)
8485
8586 inferred <- forM tys $ \(shouldGeneralize, ((ident, (val, ty)), _)) -> do
@@ -165,81 +166,101 @@ typesOf bindingGroupType moduleName vals = withFreshSubstitution $ do
165166 isHoleError (ErrorMessage _ HoleInferredType{}) = True
166167 isHoleError _ = False
167168
168−type TypeData = M.Map (Qualified Ident) (Type, NameKind, NameVisibility)
169−
170−type UntypedData = [(Ident, Type)]
171−
169+-- | A binding group contains multiple value definitions, some of which are typed
170+-- and some which are not.
171+--
172+-- This structure breaks down a binding group into typed and untyped parts.
173+data SplitBindingGroup = SplitBindingGroup
174+ { _splitBindingGroupUntyped :: [(Ident, (Expr, Type))]
175+ -- ^ The untyped expressions
176+ , _splitBindingGroupTyped :: [(Ident, (Expr, Type, Bool))]
177+ -- ^ The typed expressions, along with their type annotations
178+ , _splitBindingGroupNames :: M.Map (Qualified Ident) (Type, NameKind, NameVisibility)
179+ -- ^ A map containing all expressions and their assigned types (which might be
180+ -- fresh unification variables). These will be added to the 'Environment' after
181+ -- the binding group is checked, so the value type of the 'Map' is chosen to be
182+ -- compatible with the type of 'bindNames'.
183+ }
184+
185+-- | This function breaks a binding group down into two sets of declarations:
186+-- those which contain type annotations, and those which don't.
187+-- This function also generates fresh unification variables for the types of
188+-- declarations without type annotations, returned in the 'UntypedData' structure.
172189typeDictionaryForBindingGroup
173− :: (MonadState CheckState m)
190+ :: (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
174191 => Maybe ModuleName
175192 -> [(Ident, Expr)]
176− -> m ([(Ident, Expr)], [(Ident, (Expr, Type, Bool))], TypeData, UntypedData)
193+ -> m SplitBindingGroup
177194typeDictionaryForBindingGroup moduleName vals = do
178− let
179− -- Map each declaration to a name/value pair, with an optional type, if the declaration is typed
180− es = map isTyped vals
181− -- Filter the typed and untyped declarations
182− untyped = lefts es
183− typed = rights es
184− -- Make a map of names to typed declarations
185− typedDict = map (\(ident, (_, ty, _)) -> (ident, ty)) typed
186−
187− -- Create fresh unification variables for the types of untyped declarations
188− untypedNames <- replicateM (length untyped) freshType
189−
190− let
191− -- Make a map of names to the unification variables of untyped declarations
192− untypedDict = zip (map fst untyped) untypedNames
193− -- Create the dictionary of all name/type pairs, which will be added to the environment during type checking
194− dict = M.fromList (map (\(ident, ty) -> (Qualified moduleName ident, (ty, Private, Undefined))) $ typedDict ++ untypedDict)
195− return (untyped, typed, dict, untypedDict)
196−
195+ -- Filter the typed and untyped declarations and make a map of names to typed declarations.
196+ -- Replace type wildcards here so that the resulting dictionary of types contains the
197+ -- fully expanded types.
198+ let (untyped, typed) = partitionEithers (map splitTypeAnnotation vals)
199+ (typedDict, typed') <- fmap unzip . for typed $ \(ident, (expr, ty, checkType)) -> do
200+ ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty
201+ return ((ident, ty'), (ident, (expr, ty', checkType)))
202+ -- Create fresh unification variables for the types of untyped declarations
203+ (untypedDict, untyped') <- fmap unzip . for untyped $ \(ident, expr) -> do
204+ ty <- freshType
205+ return ((ident, ty), (ident, (expr, ty)))
206+ -- Create the dictionary of all name/type pairs, which will be added to the
207+ -- environment during type checking
208+ let dict = M.fromList [ (Qualified moduleName ident, (ty, Private, Undefined))
209+ | (ident, ty) <- typedDict <> untypedDict
210+ ]
211+ return (SplitBindingGroup untyped' typed' dict)
212+ where
213+ -- | Check if a value contains a type annotation, and if so, separate it
214+ -- from the value itself.
215+ splitTypeAnnotation :: (Ident, Expr) -> Either (Ident, Expr) (Ident, (Expr, Type, Bool))
216+ splitTypeAnnotation (name, TypedValue checkType value ty) = Right (name, (value, ty, checkType))
217+ splitTypeAnnotation (name, PositionedValue pos c value) =
218+ bimap (second (PositionedValue pos c))
219+ (second (\(e, t, b) -> (PositionedValue pos c e, t, b)))
220+ (splitTypeAnnotation (name, value))
221+ splitTypeAnnotation (name, value) = Left (name, value)
222+
223+-- | Check the type annotation of a typed value in a binding group.
197224checkTypedBindingGroupElement
198225 :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
199226 => ModuleName
200227 -> (Ident, (Expr, Type, Bool))
201− -> TypeData
228+ -- ^ The identifier we are trying to define, along with the expression and its type annotation
229+ -> M.Map (Qualified Ident) (Type, NameKind, NameVisibility)
230+ -- ^ Names brought into scope in this binding group
202231 -> m (Ident, (Expr, Type))
203−checkTypedBindingGroupElement mn (ident, (val', ty, checkType)) dict = do
204− -- Replace type wildcards
205− ty' <- replaceTypeWildcards ty
232+checkTypedBindingGroupElement mn (ident, (val, ty, checkType)) dict = do
206233 -- Kind check
207234 (kind, args) <- kindOfWithScopedVars ty
208235 checkTypeKind ty kind
209236 -- Check the type with the new names in scope
210− ty'' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty'
211− val'' <- if checkType
212− then withScopedTypeVars mn args $ bindNames dict $ TypedValue True <$> check val' ty'' <*> pure ty''
213− else return (TypedValue False val' ty'')
214− return (ident, (val'', ty''))
237+ val' <- if checkType
238+ then withScopedTypeVars mn args $ bindNames dict $ TypedValue True <$> check val ty <*> pure ty
239+ else return (TypedValue False val ty)
240+ return (ident, (val', ty))
215241
242+-- | Infer a type for a value in a binding group which lacks an annotation.
216243typeForBindingGroupElement
217244 :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
218− => (Ident, Expr)
219− -> TypeData
220− -> UntypedData
245+ => (Ident, (Expr, Type))
246+ -- ^ The identifier we are trying to define, along with the expression and its assigned type
247+ -- (at this point, this should be a unification variable)
248+ -> M.Map (Qualified Ident) (Type, NameKind, NameVisibility)
249+ -- ^ Names brought into scope in this binding group
221250 -> m (Ident, (Expr, Type))
222−typeForBindingGroupElement (ident, val) dict untypedDict = do
251+typeForBindingGroupElement (ident, (val, ty)) dict = do
223252 -- Infer the type with the new names in scope
224− TypedValue _ val' ty <- bindNames dict $ infer val
225− unifyTypes ty $ fromMaybe (internalError "name not found in dictionary") (lookup ident untypedDict)
226− return (ident, (TypedValue True val' ty, ty))
227−
228−-- | Check if a value contains a type annotation
229−isTyped :: (Ident, Expr) -> Either (Ident, Expr) (Ident, (Expr, Type, Bool))
230−isTyped (name, TypedValue checkType value ty) = Right (name, (value, ty, checkType))
231−isTyped (name, PositionedValue pos c value) =
232− bimap (second (PositionedValue pos c))
233− (second (\(e, t, b) -> (PositionedValue pos c e, t, b)))
234− (isTyped (name, value))
235−isTyped (name, value) = Left (name, value)
253+ TypedValue _ val' ty' <- bindNames dict $ infer val
254+ -- Unify the type with the unification variable we chose for this definition
255+ unifyTypes ty ty'
256+ return (ident, (TypedValue True val' ty', ty'))
236257
237258-- | Check the kind of a type, failing if it is not of kind *.
238−checkTypeKind ::
239− (MonadError MultipleErrors m) =>
240− Type ->
241− Kind ->
242− m ()
259+checkTypeKind
260+ :: MonadError MultipleErrors m
261+ => Type
262+ -> Kind
263+ -> m ()
243264checkTypeKind ty kind = guardWith (errorMessage (ExpectedType ty kind)) $ kind == kindType
244265
245266-- | Remove any ForAlls and ConstrainedType constructors in a type by introducing new unknowns
@@ -247,11 +268,11 @@ checkTypeKind ty kind = guardWith (errorMessage (ExpectedType ty kind)) $ kind =
247268--
248269-- This is necessary during type checking to avoid unifying a polymorphic type with a
249270-- unification variable.
250−instantiatePolyTypeWithUnknowns ::
251− (MonadState CheckState m, MonadError MultipleErrors m) =>
252− Expr ->
253− Type ->
254− m (Expr, Type)
271+instantiatePolyTypeWithUnknowns
272+ :: (MonadState CheckState m, MonadError MultipleErrors m)
273+ => Expr
274+ -> Type
275+ -> m (Expr, Type)
255276instantiatePolyTypeWithUnknowns val (ForAll ident ty _) = do
256277 ty' <- replaceVarWithUnknown ident ty
257278 instantiatePolyTypeWithUnknowns val ty'
@@ -262,17 +283,17 @@ instantiatePolyTypeWithUnknowns val (ConstrainedType constraints ty) = do
262283instantiatePolyTypeWithUnknowns val ty = return (val, ty)
263284
264285-- | Infer a type for a value, rethrowing any error to provide a more useful error message
265−infer ::
266− (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
267− Expr ->
268− m Expr
286+infer
287+ :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
288+ => Expr
289+ -> m Expr
269290infer val = withErrorMessageHint (ErrorInferringType val) $ infer' val
270291
271292-- | Infer a type for a value
272−infer' ::
273− (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
274− Expr ->
275− m Expr
293+infer'
294+ :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
295+ => Expr
296+ -> m Expr
276297infer' v@(Literal (NumericLiteral (Left _))) = return $ TypedValue True v tyInt
277298infer' v@(Literal (NumericLiteral (Right _))) = return $ TypedValue True v tyNumber
278299infer' v@(Literal (StringLiteral _)) = return $ TypedValue True v tyString
@@ -289,22 +310,22 @@ infer' (Literal (ArrayLiteral vals)) = do
289310infer' (Literal (ObjectLiteral ps)) = do
290311 ensureNoDuplicateProperties ps
291312 ts <- traverse (infer . snd) ps
292− let fields = zipWith (\name (TypedValue _ _ t) -> (name, t)) (map fst ps) ts
313+ let fields = zipWith (\name (TypedValue _ _ t) -> (Label name, t)) (map fst ps) ts
293314 ty = TypeApp tyRecord $ rowFromList (fields, REmpty)
294315 return $ TypedValue True (Literal (ObjectLiteral (zip (map fst ps) ts))) ty
295316infer' (ObjectUpdate o ps) = do
296317 ensureNoDuplicateProperties ps
297318 row <- freshType
298319 newVals <- zipWith (\(name, _) t -> (name, t)) ps <$> traverse (infer . snd) ps
299− let newTys = map (\(name, TypedValue _ _ ty) -> (name, ty)) newVals
300− oldTys <- zip (map fst ps) <$> replicateM (length ps) freshType
320+ let newTys = map (\(name, TypedValue _ _ ty) -> (Label name, ty)) newVals
321+ oldTys <- zip (map (Label . fst) ps) <$> replicateM (length ps) freshType
301322 let oldTy = TypeApp tyRecord $ rowFromList (oldTys, row)
302323 o' <- TypedValue True <$> check o oldTy <*> pure oldTy
303324 return $ TypedValue True (ObjectUpdate o' newVals) $ TypeApp tyRecord $ rowFromList (newTys, row)
304325infer' (Accessor prop val) = withErrorMessageHint (ErrorCheckingAccessor val prop) $ do
305326 field <- freshType
306327 rest <- freshType
307− typed <- check val (TypeApp tyRecord (RCons prop field rest))
328+ typed <- check val (TypeApp tyRecord (RCons (Label prop) field rest))
308329 return $ TypedValue True (Accessor prop typed) field
309330infer' (Abs (Left arg) ret) = do
310331 ty <- freshType
@@ -369,13 +390,13 @@ infer' (PositionedValue pos c val) = warnAndRethrowWithPositionTC pos $ do
369390 return $ TypedValue t (PositionedValue pos c v) ty
370391infer' v = internalError $ "Invalid argument to infer: " ++ show v
371392
372−inferLetBinding ::
373− (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
374− [Declaration] ->
375− [Declaration] ->
376− Expr ->
377− (Expr -> m Expr) ->
378− m ([Declaration], Expr)
393+inferLetBinding
394+ :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
395+ => [Declaration]
396+ -> [Declaration]
397+ -> Expr
398+ -> (Expr -> m Expr)
399+ -> m ([Declaration], Expr)
379400inferLetBinding seen [] ret j = (,) seen <$> withBindingGroupVisible (j ret)
380401inferLetBinding seen (ValueDeclaration ident nameKind [] (Right (tv@(TypedValue checkType val ty))) : rest) ret j = do
381402 Just moduleName <- checkCurrentModule <$> get
@@ -393,9 +414,9 @@ inferLetBinding seen (ValueDeclaration ident nameKind [] (Right val) : rest) ret
393414 bindNames (M.singleton (Qualified Nothing ident) (valTy', nameKind, Defined)) $ inferLetBinding (seen ++ [ValueDeclaration ident nameKind [] (Right val')]) rest ret j
394415inferLetBinding seen (BindingGroupDeclaration ds : rest) ret j = do
395416 Just moduleName <- checkCurrentModule <$> get
396− (untyped, typed, dict, untypedDict) <- typeDictionaryForBindingGroup Nothing (map (\(i, _, v) -> (i, v)) ds)
417+ SplitBindingGroup untyped typed dict <- typeDictionaryForBindingGroup Nothing (map (\(i, _, v) -> (i, v)) ds)
397418 ds1' <- parU typed $ \e -> checkTypedBindingGroupElement moduleName e dict
398− ds2' <- forM untyped $ \e -> typeForBindingGroupElement e dict untypedDict
419+ ds2' <- forM untyped $ \e -> typeForBindingGroupElement e dict
399420 let ds' = [(ident, Private, val') | (ident, (val', _)) <- ds1' ++ ds2']
400421 bindNames dict $ do
401422 makeBindingGroupVisible
@@ -406,11 +427,12 @@ inferLetBinding seen (PositionedDeclaration pos com d : ds) ret j = warnAndRethr
406427inferLetBinding _ _ _ _ = internalError "Invalid argument to inferLetBinding"
407428
408429-- | Infer the types of variables brought into scope by a binder
409−inferBinder :: forall m.
410− (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
411− Type ->
412− Binder ->
413− m (M.Map Ident Type)
430+inferBinder
431+ :: forall m
432+ . (MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
433+ => Type
434+ -> Binder
435+ -> m (M.Map Ident Type)
414436inferBinder _ NullBinder = return M.empty
415437inferBinder val (LiteralBinder (StringLiteral _)) = unifyTypes val tyString >> return M.empty
416438inferBinder val (LiteralBinder (CharLiteral _)) = unifyTypes val tyChar >> return M.empty
@@ -442,12 +464,12 @@ inferBinder val (LiteralBinder (ObjectLiteral props)) = do
442464 unifyTypes val (TypeApp tyRecord row)
443465 return m1
444466 where
445− inferRowProperties :: Type -> Type -> [(Text, Binder)] -> m (M.Map Ident Type)
467+ inferRowProperties :: Type -> Type -> [(PSString, Binder)] -> m (M.Map Ident Type)
446468 inferRowProperties nrow row [] = unifyTypes nrow row >> return M.empty
447469 inferRowProperties nrow row ((name, binder):binders) = do
448470 propTy <- freshType
449471 m1 <- inferBinder propTy binder
450− m2 <- inferRowProperties nrow (RCons name propTy row) binders
472+ m2 <- inferRowProperties nrow (RCons (Label name) propTy row) binders
451473 return $ m1 `M.union` m2
452474inferBinder val (LiteralBinder (ArrayLiteral binders)) = do
453475 el <- freshType
@@ -485,11 +507,11 @@ binderRequiresMonotype (PositionedBinder _ _ b) = binderRequiresMonotype b
485507binderRequiresMonotype _ = True
486508
487509-- | Instantiate polytypes only when necessitated by a binder.
488−instantiateForBinders ::
489− (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
490− [Expr] ->
491− [CaseAlternative] ->
492− m ([Expr], [Type])
510+instantiateForBinders
511+ :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
512+ => [Expr]
513+ -> [CaseAlternative]
514+ -> m ([Expr], [Type])
493515instantiateForBinders vals cas = unzip <$> zipWithM (\val inst -> do
494516 TypedValue _ val' ty <- infer val
495517 if inst
@@ -502,12 +524,12 @@ instantiateForBinders vals cas = unzip <$> zipWithM (\val inst -> do
502524-- |
503525-- Check the types of the return values in a set of binders in a case statement
504526--
505−checkBinders ::
506− (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
507− [Type] ->
508− Type ->
509− [CaseAlternative] ->
510− m [CaseAlternative]
527+checkBinders
528+ :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
529+ => [Type]
530+ -> Type
531+ -> [CaseAlternative]
532+ -> m [CaseAlternative]
511533checkBinders _ _ [] = return []
512534checkBinders nvals ret (CaseAlternative binders result : bs) = do
513535 guardWith (errorMessage $ OverlappingArgNames Nothing) $
@@ -531,11 +553,11 @@ checkBinders nvals ret (CaseAlternative binders result : bs) = do
531553-- |
532554-- Check the type of a value, rethrowing errors to provide a better error message
533555--
534−check ::
535− (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
536− Expr ->
537− Type ->
538− m Expr
556+check
557+ :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
558+ => Expr
559+ -> Type
560+ -> m Expr
539561check val ty = withErrorMessageHint (ErrorCheckingType val ty) $ check' val ty
540562
541563-- |
@@ -641,14 +663,14 @@ check' e@(ObjectUpdate obj ps) t@(TypeApp o row) | o == tyRecord = do
641663 -- We need to be careful to avoid duplicate labels here.
642664 -- We check _obj_ against the type _t_ with the types in _ps_ replaced with unknowns.
643665 let (propsToCheck, rest) = rowToList row
644− (removedProps, remainingProps) = partition (\(p, _) -> p `elem` map fst ps) propsToCheck
666+ (removedProps, remainingProps) = partition (\(p, _) -> p `elem` map (Label . fst) ps) propsToCheck
645667 us <- zip (map fst removedProps) <$> replicateM (length ps) freshType
646668 obj' <- check obj (TypeApp tyRecord (rowFromList (us ++ remainingProps, rest)))
647669 ps' <- checkProperties e ps row True
648670 return $ TypedValue True (ObjectUpdate obj' ps') t
649671check' (Accessor prop val) ty = withErrorMessageHint (ErrorCheckingAccessor val prop) $ do
650672 rest <- freshType
651− val' <- check val (TypeApp tyRecord (RCons prop ty rest))
673+ val' <- check val (TypeApp tyRecord (RCons (Label prop) ty rest))
652674 return $ TypedValue True (Accessor prop val') ty
653675check' v@(Constructor c) ty = do
654676 env <- getEnv
@@ -678,13 +700,13 @@ check' val ty = do
678700--
679701-- The @lax@ parameter controls whether or not every record member has to be provided. For object updates, this is not the case.
680702--
681−checkProperties ::
682− (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m) =>
683− Expr ->
684− [(Text, Expr)] ->
685− Type ->
686− Bool ->
687− m [(Text, Expr)]
703+checkProperties
704+ :: (MonadSupply m, MonadState CheckState m, MonadError MultipleErrors m, MonadWriter MultipleErrors m)
705+ => Expr
706+ -> [(PSString, Expr)]
707+ -> Type
708+ -> Bool
709+ -> m [(PSString, Expr)]
688710checkProperties expr ps row lax = let (ts, r') = rowToList row in go ps ts r' where
689711 go [] [] REmpty = return []
690712 go [] [] u@(TUnknown _)
@@ -694,18 +716,18 @@ checkProperties expr ps row lax = let (ts, r') = rowToList row in go ps ts r' wh
694716 go [] [] Skolem{} | lax = return []
695717 go [] ((p, _): _) _ | lax = return []
696718 | otherwise = throwError . errorMessage $ PropertyIsMissing p
697− go ((p,_):_) [] REmpty = throwError . errorMessage $ AdditionalProperty p
719+ go ((p,_):_) [] REmpty = throwError . errorMessage $ AdditionalProperty $ Label p
698720 go ((p,v):ps') ts r =
699− case lookup p ts of
721+ case lookup (Label p) ts of
700722 Nothing -> do
701723 v'@(TypedValue _ _ ty) <- infer v
702724 rest <- freshType
703− unifyTypes r (RCons p ty rest)
725+ unifyTypes r (RCons (Label p) ty rest)
704726 ps'' <- go ps' ts rest
705727 return $ (p, v') : ps''
706728 Just ty -> do
707729 v' <- check v ty
708− ps'' <- go ps' (delete (p, ty) ts) r
730+ ps'' <- go ps' (delete (Label p, ty) ts) r
709731 return $ (p, v') : ps''
710732 go _ _ _ = throwError . errorMessage $ ExprDoesNotHaveType expr (TypeApp tyRecord row)
711733
@@ -771,9 +793,9 @@ checkFunctionApplication' fn u arg = do
771793-- |
772794-- Ensure a set of property names and value does not contain duplicate labels
773795--
774−ensureNoDuplicateProperties :: (MonadError MultipleErrors m) => [(Text, Expr)] -> m ()
796+ensureNoDuplicateProperties :: (MonadError MultipleErrors m) => [(PSString, Expr)] -> m ()
775797ensureNoDuplicateProperties ps =
776798 let ls = map fst ps in
777799 case ls \\ nub ls of
778− l : _ -> throwError . errorMessage $ DuplicateLabel l Nothing
800+ l : _ -> throwError . errorMessage $ DuplicateLabel (Label l) Nothing
779801 _ -> return ()