6ad7aa1 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Generate prototypes for typeclasses

commit6ad7aa14095660954cc12cec85f5dd0de4f88628 authorGary Burgess <gary.burgess@gmail.com> dateThu 10 Jul 2014, 00:10 (12 years ago) parent63d7784

10 files changed+93−38

compare with golang

unifiedsplit

examples/passing/TypeClassMemberOrderChange.purs+11 src/Language/PureScript/CodeGen/Common.hs+2−3 src/Language/PureScript/CodeGen/JS.hs+32−6 src/Language/PureScript/Constants.hs+2−2 src/Language/PureScript/DeadCodeElimination.hs+2 src/Language/PureScript/Declarations.hs+11 src/Language/PureScript/Optimizer/Inliner.hs+3−2 src/Language/PureScript/Pretty/Values.hs+7−2 src/Language/PureScript/Sugar/TypeClasses.hs+15−18 src/Language/PureScript/TypeChecker/Types.hs+8−5

examples/passing/TypeClassMemberOrderChange.pursnew file+11

@@ -0,0 +1,11 @@

1+module Main where

3+class Test a where

4+ fn :: a -> a -> a

5+ val :: a

7+instance testBoolean :: Test Boolean where

8+ val = true

9+ fn x y = y

10+

11+main = Debug.Trace.trace (show (fn true val))

src/Language/PureScript/CodeGen/Common.hs+2−3

@@ -131,11 +131,10 @@ nameIsJsReserved name =

131131 , "yield" ]

132132

133133-- |

134−-- Test if a string is a valid JS identifier (may return false negatives)

134+-- Test if a string is a valid JS identifier.

135135--

136136isIdent :: String -> Bool

137−isIdent s@(first : rest) | not (nameIsJsReserved s) && (isAlpha first || first == '_') && all isAlphaNum rest = True

138−isIdent _ = False

137+isIdent s = identToJs (Ident s) == s

139138

140139moduleNameToJs :: ModuleName -> String

141140moduleNameToJs (ModuleName pns) = intercalate "_" (runProperName `map` pns)

src/Language/PureScript/CodeGen/JS.hs+32−6

@@ -25,7 +25,7 @@ module Language.PureScript.CodeGen.JS (

2525

2626import Data.Maybe (catMaybes, fromJust, fromMaybe)

2727import Data.Function (on)

28−import Data.List (nub, (\\), delete)

28+import Data.List (nub, (\\), delete, sortBy)

2929

3030import Control.Monad (replicateM, forM)

3131import Control.Applicative

@@ -42,7 +42,6 @@ import Language.PureScript.CodeGen.Common

4242import Language.PureScript.Environment

4343import Language.PureScript.Supply

4444import Language.PureScript.Traversals (sndM)

45−

4645import qualified Language.PureScript.Constants as C

4746

4847-- |

@@ -89,6 +88,7 @@ imports other =

8988 collectV :: Value -> [ModuleName]

9089 collectV (Var (Qualified (Just mn) _)) = [mn]

9190 collectV (Constructor (Qualified (Just mn) _)) = [mn]

91+ collectV (TypeClassDictionaryConstructorApp (Qualified (Just mn) _) _) = [mn]

9292 collectV _ = []

9393 collectB :: Binder -> [ModuleName]

9494 collectB (ConstructorBinder (Qualified (Just mn) _) _) = [mn]

@@ -109,16 +109,16 @@ declToJs opts mp (BindingGroupDeclaration vals) e = do

109109declToJs _ _ (DataDeclaration _ _ ctors) _ = do

110110 return $ Just $ flip concatMap ctors $ \(pn@(ProperName ctor), tys) ->

111111 let _ctor = '_' : ctor

112− in [ JSVariableIntroduction _ctor (Just (makeConstructor (length tys)))

112+ in [ makeConstructor _ctor (length tys)

113113 , JSVariableIntroduction ctor (Just (go pn 0 (length tys) []))

114114 ]

115115 where

116− makeConstructor :: Int -> JS

117− makeConstructor n =

116+ makeConstructor :: String -> Int -> JS

117+ makeConstructor ctorName n =

118118 let

119119 args = [ "value" ++ show index | index <- [0..n-1] ]

120120 body = [ JSAssignment (JSAccessor arg (JSVar "this")) (JSVar arg) | arg <- args ]

121− in JSFunction Nothing args (JSBlock body)

121+ in JSFunction (Just ctorName) args (JSBlock body)

122122 go :: ProperName -> Int -> Int -> [JS] -> JS

123123 go pn _ 0 values = JSApp (JSNew (JSVar ('_' : runProperName pn))) (reverse values)

124124 go pn index n values =

@@ -127,6 +127,27 @@ declToJs _ _ (DataDeclaration _ _ ctors) _ = do

127127declToJs opts mp (DataBindingGroupDeclaration ds) e = do

128128 jss <- mapM (\decl -> declToJs opts mp decl e) ds

129129 return $ Just $ concat $ catMaybes jss

130+declToJs _ _ (TypeClassDeclaration name _ supers members) _ =

131+ return $ Just $ [

132+ JSFunction (Just $ runProperName name) (identToJs `map` args)

133+ (JSBlock $ assn `map` args)]

134+ where

135+ assn :: Ident -> JS

136+ assn arg = JSAssignment (accessor arg (JSVar "this")) (var arg)

137+ args :: [Ident]

138+ args = sortBy (compare `on` runIdent) $ memberNames ++ superNames

139+ memberNames :: [Ident]

140+ memberNames = memberToName `map` members

141+ superNames :: [Ident]

142+ superNames = [ toSuperName superclass index

143+ | (index, (superclass, _)) <- zip [0..] supers

144+ ]

145+ toSuperName :: Qualified ProperName -> Integer -> Ident

146+ toSuperName pn index = Ident $ C.__superclass_ ++ show pn ++ "_" ++ show index

147+ memberToName :: Declaration -> Ident

148+ memberToName (TypeDeclaration ident _) = ident

149+ memberToName (PositionedDeclaration _ d) = memberToName d

150+ memberToName _ = error "Invalid declaration in type class definition"

130151declToJs _ _ (ExternDeclaration _ _ (Just js) _) _ = return $ Just [js]

131152declToJs opts mp (PositionedDeclaration _ d) e = declToJs opts mp d e

132153declToJs _ _ _ _ = return Nothing

@@ -138,6 +159,7 @@ exportToJs :: DeclarationRef -> [(String, JS)]

138159exportToJs (TypeRef _ (Just dctors)) = concatMap ((\n -> [('_' : n, var (Ident ('_' : n))), (n, var (Ident n))]) . runProperName) dctors

139160exportToJs (ValueRef name) = [(runIdent name, var name)]

140161exportToJs (TypeInstanceRef name) = [(runIdent name, var name)]

162+exportToJs (TypeClassRef name) = [(runProperName name, var $ Ident $ runProperName name)]

141163exportToJs _ = []

142164

143165-- |

@@ -169,6 +191,10 @@ valueToJs _ _ _ (StringLiteral s) = return $ JSStringLiteral s

169191valueToJs _ _ _ (BooleanLiteral b) = return $ JSBooleanLiteral b

170192valueToJs opts m e (ArrayLiteral xs) = JSArrayLiteral <$> mapM (valueToJs opts m e) xs

171193valueToJs opts m e (ObjectLiteral ps) = JSObjectLiteral <$> mapM (sndM (valueToJs opts m e)) ps

194+valueToJs opts m e (TypeClassDictionaryConstructorApp name (TypedValue _ (ObjectLiteral ps) _)) =

195+ JSApp (JSNew (qualifiedToJS m (Ident . runProperName) name)) <$> mapM (valueToJs opts m e . snd) (sortBy (compare `on` fst) ps)

196+valueToJs _ _ _ TypeClassDictionaryConstructorApp{} =

197+ error "TypeClassDictionaryConstructorApp did not contain object literal"

172198valueToJs opts m e (ObjectUpdate o ps) = do

173199 obj <- valueToJs opts m e o

174200 sts <- mapM (sndM (valueToJs opts m e)) ps

src/Language/PureScript/Constants.hs+2−2

@@ -186,8 +186,8 @@ main = "main"

186186

187187-- Code Generation

188188

189−__superclasses :: String

190−__superclasses = "__superclasses"

189+__superclass_ :: String

190+__superclass_ = "__superclass_"

191191

192192-- Modules

193193

src/Language/PureScript/DeadCodeElimination.hs+2

@@ -80,6 +80,8 @@ dependencies moduleName =

8080 values (Var ident) = let (mn, name) = qualify moduleName ident in [(mn, Left name)]

8181 values (Constructor (Qualified (Just mn) name)) = [(mn, Right name)]

8282 values (Constructor (Qualified Nothing _)) = error "Found unqualified data constructor"

83+ values (TypeClassDictionaryConstructorApp (Qualified (Just mn) name) _) = [(mn, Right name)]

84+ values (TypeClassDictionaryConstructorApp (Qualified Nothing _) _) = error "Found unqualified class dictionary constructor"

8385 values _ = []

8486

8587isUsed :: ModuleName -> Graph -> (Key -> Maybe Vertex) -> [Vertex] -> Declaration -> Bool

src/Language/PureScript/Declarations.hs+11

@@ -332,6 +332,11 @@ data Value

332332 --

333333 | Do [DoNotationElement]

334334 -- |

335+ -- An application of a typeclass dictionary constructor. The value should be

336+ -- an ObjectLiteral.

337+ --

338+ | TypeClassDictionaryConstructorApp (Qualified ProperName) Value

339+ -- |

335340 -- A placeholder for a type class dictionary to be inserted later. At the end of type checking, these

336341 -- placeholders will be replaced with actual expressions representing type classes dictionaries which

337342 -- can be evaluated at runtime. The constructor arguments represent (in order): whether or not to look

@@ -483,6 +488,7 @@ everywhereOnValues f g h = (f', g', h')

483488 g' (Parens v) = g (Parens (g' v))

484489 g' (ArrayLiteral vs) = g (ArrayLiteral (map g' vs))

485490 g' (ObjectLiteral vs) = g (ObjectLiteral (map (fmap g') vs))

491+ g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))

486492 g' (Accessor prop v) = g (Accessor prop (g' v))

487493 g' (ObjectUpdate obj vs) = g (ObjectUpdate (g' obj) (map (fmap g') vs))

488494 g' (Abs name v) = g (Abs name (g' v))

@@ -538,6 +544,7 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)

538544 g' (Parens v) = Parens <$> (g v >>= g')

539545 g' (ArrayLiteral vs) = ArrayLiteral <$> mapM (g' <=< g) vs

540546 g' (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g' <=< g)) vs

547+ g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')

541548 g' (Accessor prop v) = Accessor prop <$> (g v >>= g')

542549 g' (ObjectUpdate obj vs) = ObjectUpdate <$> (g obj >>= g') <*> mapM (sndM (g' <=< g)) vs

543550 g' (Abs name v) = Abs name <$> (g v >>= g')

@@ -587,6 +594,7 @@ everywhereOnValuesM f g h = (f' <=< f, g' <=< g, h' <=< h)

587594 g' (Parens v) = (Parens <$> g' v) >>= g

588595 g' (ArrayLiteral vs) = (ArrayLiteral <$> mapM g' vs) >>= g

589596 g' (ObjectLiteral vs) = (ObjectLiteral <$> mapM (sndM g') vs) >>= g

597+ g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g

590598 g' (Accessor prop v) = (Accessor prop <$> g' v) >>= g

591599 g' (ObjectUpdate obj vs) = (ObjectUpdate <$> g' obj <*> mapM (sndM g') vs) >>= g

592600 g' (Abs name v) = (Abs name <$> g' v) >>= g

@@ -639,6 +647,7 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')

639647 g' v@(Parens v1) = g v <> g' v1

640648 g' v@(ArrayLiteral vs) = foldl (<>) (g v) (map g' vs)

641649 g' v@(ObjectLiteral vs) = foldl (<>) (g v) (map (g' . snd) vs)

650+ g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1

642651 g' v@(Accessor _ v1) = g v <> g' v1

643652 g' v@(ObjectUpdate obj vs) = foldl (<>) (g v <> g' obj) (map (g' . snd) vs)

644653 g' v@(Abs _ v1) = g v <> g' v1

@@ -702,6 +711,7 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'

702711 g' s (Parens v1) = (g'' s) v1

703712 g' s (ArrayLiteral vs) = foldl (<>) r0 (map (g'' s) vs)

704713 g' s (ObjectLiteral vs) = foldl (<>) r0 (map (g'' s . snd) vs)

714+ g' s (TypeClassDictionaryConstructorApp _ v1) = (g'' s) v1

705715 g' s (Accessor _ v1) = (g'' s) v1

706716 g' s (ObjectUpdate obj vs) = foldl (<>) ((g'' s) obj) (map (g'' s . snd) vs)

707717 g' s (Abs _ v1) = (g'' s) v1

@@ -767,6 +777,7 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j

767777 g' s (Parens v) = Parens <$> g'' s v

768778 g' s (ArrayLiteral vs) = ArrayLiteral <$> mapM (g'' s) vs

769779 g' s (ObjectLiteral vs) = ObjectLiteral <$> mapM (sndM (g'' s)) vs

780+ g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g'' s) v

770781 g' s (Accessor prop v) = Accessor prop <$> g'' s v

771782 g' s (ObjectUpdate obj vs) = ObjectUpdate <$> g'' s obj <*> mapM (sndM (g'' s)) vs

772783 g' s (Abs name v) = Abs name <$> g'' s v

src/Language/PureScript/Optimizer/Inliner.hs+3−2

@@ -49,6 +49,8 @@ etaConvert = everywhereOnJS convert

4949 not (any (`isRebound` block) (map JSVar idents)) &&

5050 not (any (`isRebound` block) args)

5151 = JSBlock (map (replaceIdents (zip idents args)) body)

52+ convert (JSFunction Nothing ["_"] (JSBlock [JSReturn (JSApp fn@JSVar{} [JSObjectLiteral []])]))

53+ = fn

5254 convert js = js

5355

5456unThunk :: JS -> JS

@@ -153,7 +155,6 @@ inlineCommonOperators = applyAll $

153155 isOp _ = False

154156 isOpDict dictName (JSApp (JSAccessor prop (JSVar prelude)) [JSObjectLiteral []]) = prelude == C.prelude && prop == dictName

155157 isOpDict _ _ = False

156−

157158 mkFn :: Int -> JS -> JS

158159 mkFn 0 = everywhereOnJS convert

159160 where

@@ -170,7 +171,7 @@ inlineCommonOperators = applyAll $

170171 Nothing -> orig

171172 convert other = other

172173 collectArgs :: Int -> [String] -> JS -> Maybe ([String], [JS])

173− collectArgs 1 acc (JSFunction Nothing [oneArg] (JSBlock js)) | length acc == n - 1 = Just (reverse (oneArg : acc), js)

174+ collectArgs 1 acc (JSFunction Nothing [oneArg] (JSBlock js)) | length acc == n - 1 = Just (reverse (oneArg : acc), js)

174175 collectArgs m acc (JSFunction Nothing [oneArg] (JSBlock [JSReturn ret])) = collectArgs (m - 1) (oneArg : acc) ret

175176 collectArgs _ _ _ = Nothing

176177

src/Language/PureScript/Pretty/Values.hs+7−2

@@ -51,6 +51,11 @@ literals = mkPattern' match

5151 , currentIndent

5252 , return "}"

5353 ]

54+ match (TypeClassDictionaryConstructorApp className ps) = fmap concat $ sequence

55+ [ return ((show className) ++ "(\n")

56+ , match ps

57+ , return ")"

58+ ]

5459 match (Constructor name) = return $ show name

5560 match (Case values binders) = fmap concat $ sequence

5661 [ return "case "

@@ -73,8 +78,8 @@ literals = mkPattern' match

7378 , withIndent $ prettyPrintMany prettyPrintDoNotationElement els

7479 , currentIndent

7580 ]

76− match (TypeClassDictionary _ _ _) = return "<<dict>>"

77− match (SuperClassDictionary _ _) = return "<<superclass dict>>"

81+ match (TypeClassDictionary name _ _) = return $ "<<dict " ++ show name ++ ">>"

82+ match (SuperClassDictionary name _) = return $ "<<superclass dict " ++ show name ++ ">>"

7883 match (TypedValue _ val _) = prettyPrintValue' val

7984 match (PositionedValue _ val) = prettyPrintValue' val

8085 match _ = mzero

src/Language/PureScript/Sugar/TypeClasses.hs+15−18

@@ -126,19 +126,15 @@ memberToNameAndType (TypeDeclaration ident ty) = (ident, ty)

126126memberToNameAndType (PositionedDeclaration _ d) = memberToNameAndType d

127127memberToNameAndType _ = error "Invalid declaration in type class definition"

128128

129−identToProperty :: Ident -> String

130−identToProperty (Ident name) = name

131−identToProperty (Op op) = op

132−

133129typeClassDictionaryDeclaration :: ProperName -> [String] -> [(Qualified ProperName, [Type])] -> [Declaration] -> Declaration

134130typeClassDictionaryDeclaration name args implies members =

135− let superclassesType = TypeApp tyObject (rowFromList ([ (fieldName, function unit tySynApp)

136− | (index, (superclass, tyArgs)) <- zip [0..] implies

137− , let tySynApp = foldl TypeApp (TypeConstructor superclass) tyArgs

138− , let fieldName = mkSuperclassDictionaryName superclass index

139− ], REmpty))

140− members' = map (first identToProperty . memberToNameAndType) members

141− mtys = if null implies then members' else (C.__superclasses, superclassesType) : members'

131+ let superclassTypes = [ (fieldName, function unit tySynApp)

132+ | (index, (superclass, tyArgs)) <- zip [0..] implies

133+ , let tySynApp = foldl TypeApp (TypeConstructor superclass) tyArgs

134+ , let fieldName = mkSuperclassDictionaryName superclass index

135+ ]

136+ members' = map (first runIdent . memberToNameAndType) members

137+ mtys = members' ++ superclassTypes

142138 in TypeSynonymDeclaration name args (TypeApp tyObject $ rowFromList (mtys, REmpty))

143139

144140typeClassMemberToDictionaryAccessor :: ModuleName -> ProperName -> [String] -> Declaration -> Declaration

@@ -151,7 +147,7 @@ typeClassMemberToDictionaryAccessor mn name args (PositionedDeclaration pos d) =

151147typeClassMemberToDictionaryAccessor _ _ _ _ = error "Invalid declaration in type class definition"

152148

153149mkSuperclassDictionaryName :: Qualified ProperName -> Integer -> String

154−mkSuperclassDictionaryName pn index = show pn ++ "_" ++ show index

150+mkSuperclassDictionaryName pn index = C.__superclass_ ++ show pn ++ "_" ++ show index

155151

156152unit :: Type

157153unit = TypeApp tyObject REmpty

@@ -175,25 +171,26 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls =

175171 -- Replace the type arguments with the appropriate types in the member types

176172 let memberTypes = map (second (replaceAllTypeVars (zip args tys))) instanceTys

177173 -- Create values for the type instance members

178− memberNames <- map (first identToProperty) <$> mapM (memberToNameAndValue memberTypes) decls

174+ memberNames <- map (first runIdent) <$> mapM (memberToNameAndValue memberTypes) decls

179175 -- Create the type of the dictionary

180176 -- The type is an object type, but depending on type instance dependencies, may be constrained.

181177 -- The dictionary itself is an object literal, but for reasons related to recursion, the dictionary

182178 -- must be guarded by at least one function abstraction. For that reason, if the dictionary has no

183179 -- dependencies, we introduce an unnamed function parameter.

184− let superclasses = ObjectLiteral

180+ let superclasses =

185181 [ (fieldName, Abs (Left (Ident "_")) (SuperClassDictionary superclass tyArgs))

186182 | (index, (superclass, suTyArgs)) <- zip [0..] implies

187183 , let tyArgs = map (replaceAllTypeVars (zip args tys)) suTyArgs

188184 , let fieldName = mkSuperclassDictionaryName superclass index

189185 ]

190186

191− let memberNames' = if null implies then memberNames else (C.__superclasses, superclasses) : memberNames

187+ let memberNames' = ObjectLiteral (memberNames ++ superclasses)

192188 dictTy = foldl TypeApp (TypeConstructor className) tys

193189 constrainedTy = quantify (if null deps then function unit dictTy else ConstrainedType deps dictTy)

194− dict = if null deps then Abs (Left (Ident "_")) (ObjectLiteral memberNames') else ObjectLiteral memberNames'

195−

196− return $ ValueDeclaration name TypeInstanceDictionaryValue [] Nothing (TypedValue True dict constrainedTy)

190+ dict = TypeClassDictionaryConstructorApp className memberNames'

191+ dict' = if null deps then Abs (Left (Ident "_")) dict else dict

192+ result = ValueDeclaration name TypeInstanceDictionaryValue [] Nothing (TypedValue True dict' constrainedTy)

193+ return result

197194

198195 where

199196

src/Language/PureScript/TypeChecker/Types.hs+8−5

@@ -317,7 +317,7 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt

317317 filterModule (TypeClassDictionaryInScope { tcdName = Qualified (Just mn) _ }) | mn == moduleName = True

318318 filterModule (TypeClassDictionaryInScope { tcdName = Qualified Nothing _ }) = True

319319 filterModule _ = False

320−

320+

321321 solve context' (className, tys) trySuperclasses =

322322 let

323323 dicts = go trySuperclasses className tys

@@ -336,7 +336,7 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt

336336 , subst <- maybeToList . (>>= verifySubstitution) . fmap concat $ zipWithM (typeHeadsAreEqual moduleName env) tys' (tcdInstanceTypes tcd)

337337 -- Solve any necessary subgoals

338338 , args <- solveSubgoals subst (tcdDependencies tcd) ] ++

339−

339+

340340 -- Look for implementations via superclasses

341341 [ SubclassDictionaryValue suDict superclass index

342342 | trySuperclasses'

@@ -350,7 +350,7 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt

350350 -- Finally, satisfy the subclass constraint

351351 , args' <- maybeToList $ mapM (flip lookup subst) args

352352 , suDict <- go True subclassName args' ]

353−

353+

354354 -- Create dictionaries for subgoals which still need to be solved by calling go recursively

355355 -- E.g. the goal (Show a, Show b) => Show (Either a b) can be satisfied if the current type

356356 -- unifies with Either a b, and we can satisfy the subgoals Show a and Show b recursively.

@@ -370,8 +370,8 @@ entails env moduleName context = solve (sortedNubBy canonicalizeDictionary (filt

370370 dictionaryValueToValue (GlobalDictionaryValue fnName) = App (Var fnName) (ObjectLiteral [])

371371 dictionaryValueToValue (DependentDictionaryValue fnName dicts) = foldl App (Var fnName) (map dictionaryValueToValue dicts)

372372 dictionaryValueToValue (SubclassDictionaryValue dict superclassName index) =

373− App (Accessor (show superclassName ++ "_" ++ show index)

374− (Accessor C.__superclasses (dictionaryValueToValue dict)))

373+ App (Accessor (C.__superclass_ ++ show superclassName ++ "_" ++ show index)

374+ (dictionaryValueToValue dict))

375375 (ObjectLiteral [])

376376 -- Ensure that a substitution is valid

377377 verifySubstitution :: [(String, Type)] -> Maybe [(String, Type)]

@@ -939,6 +939,9 @@ check' (ObjectLiteral ps) t@(TypeApp obj row) | obj == tyObject = do

939939 ensureNoDuplicateProperties ps

940940 ps' <- checkProperties ps row False

941941 return $ TypedValue True (ObjectLiteral ps') t

942+check' (TypeClassDictionaryConstructorApp name ps) t = do

943+ ps' <- check' ps t

944+ return $ TypedValue True (TypeClassDictionaryConstructorApp name ps') t

942945check' (ObjectUpdate obj ps) t@(TypeApp o row) | o == tyObject = do

943946 ensureNoDuplicateProperties ps

944947 us <- zip (map fst ps) <$> replicateM (length ps) fresh