@@ -73,22 +73,29 @@ typeClassMemberToDictionaryAccessor _ _ _ = error "Invalid declaration in type c
7373
7474typeInstanceDictionaryDeclaration :: ModuleName -> [(Qualified ProperName, Type)] -> Qualified ProperName -> Type -> [Declaration] -> Desugar Declaration
7575typeInstanceDictionaryDeclaration mn deps name ty decls = do
76+ m <- get
77+ (arg, instanceTys) <- lift $ maybe (Left $ "Type class " ++ show name ++ " is undefined. Type class names must be qualified.") Right
78+ $ M.lookup (qualify mn name) m
79+ let memberTypes = map (replaceTypeVars arg ty) instanceTys
7680 entryName <- lift $ mkDictionaryValueName mn name ty
77− memberNames <- mapM memberToNameAndValue decls
81+ memberNames <- mapM (memberToNameAndValue memberTypes) decls
7882 return $ ValueDeclaration entryName [] Nothing
79− (TypedValue False
83+ (TypedValue True
8084 (Abs
8185 (map (\n -> Ident ('_' : show n)) [1..length deps])
8286 (ObjectLiteral memberNames))
8387 (quantify (Function (map (\(pn, ty') -> TypeApp (TypeConstructor pn) ty') deps) (TypeApp (TypeConstructor name) ty)))
8488 )
8589 where
86− memberToNameAndValue :: Declaration -> Desugar (String, Value)
87− memberToNameAndValue (ValueDeclaration ident _ _ _) = do
90+ memberToNameAndValue :: [(String, Type)] -> Declaration -> Desugar (String, Value)
91+ memberToNameAndValue tys (ValueDeclaration ident _ _ _) = do
92+ memberType <- lift . maybe (Left "Type class member type not found") Right $ lookup (identToJs ident) tys
8893 memberName <- mkDictionaryEntryName mn name ty ident
89− return (identToJs ident, if null deps then Var (Qualified Nothing memberName)
90− else App (Var (Qualified Nothing memberName)) (map (\n -> Var (Qualified Nothing (Ident ('_' : show n)))) [1..length deps]))
91− memberToNameAndValue _ = error "Invalid declaration in type instance definition"
94+ return (identToJs ident, TypedValue False
95+ (if null deps then Var (Qualified Nothing memberName)
96+ else App (Var (Qualified Nothing memberName)) (map (\n -> Var (Qualified Nothing (Ident ('_' : show n)))) [1..length deps]))
97+ (quantify memberType))
98+ memberToNameAndValue _ _ = error "Invalid declaration in type instance definition"
9299
93100typeInstanceDictionaryEntryDeclaration :: ModuleName -> [(Qualified ProperName, Type)] -> Qualified ProperName -> Type -> Declaration -> Desugar Declaration
94101typeInstanceDictionaryEntryDeclaration mn deps name ty (ValueDeclaration ident [] _ val) = do