9be60e1 · rowtype-yoga/purescript-native

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

Thunk type class dictionaries to fix the TC equivalent of #185

commit9be60e11746678e75d5daa10326db8172eb56cc1 authorPhil Freeman <paf31@cantab.net> dateMon 10 Feb 2014, 13:32 (13 years ago) parent473f116

3 files changed+8−5

compare with golang

unifiedsplit

examples/shouldpass/RuntimeScopeIssue.purs → examples/passing/RuntimeScopeIssue.purs src/Language/PureScript/Sugar/TypeClasses.hs+7−5 src/Language/PureScript/TypeChecker/Types.hs+1

examples/shouldpass/RuntimeScopeIssue.purs → examples/passing/RuntimeScopeIssue.pursrenamed

The content is the same.

src/Language/PureScript/Sugar/TypeClasses.hs+7−5

@@ -81,7 +81,7 @@ desugarModule (Module name decls) = Module name <$> concat <$> mapM (desugarDecl

8181--

8282-- __Test_Foo_string_foo = (\s -> s ++ s) :: String -> String

8383--

84−-- __Test_Foo_string :: Foo String

84+-- __Test_Foo_string :: {} -> Foo String

8585-- __Test_Foo_string = { foo: __Test_Foo_string_foo :: String -> String (unchecked) }

8686--

8787-- __Test_Foo_array_foo :: forall a. (Foo a) => [a] -> [a]

@@ -127,8 +127,11 @@ typeInstanceDictionaryDeclaration mn deps name ty decls = do

127127 memberNames <- mapM (memberToNameAndValue memberTypes) decls

128128 return $ ValueDeclaration entryName [] Nothing

129129 (TypedValue True

130− (foldr Abs (ObjectLiteral memberNames) (map (\n -> Ident ('_' : show n)) [1..length deps]))

131− (quantify (foldr function (TypeApp (TypeConstructor name) ty) (map (\(pn, ty') -> TypeApp (TypeConstructor pn) ty') deps)))

130+ (foldr Abs (ObjectLiteral memberNames) (map (\n -> Ident ('_' : show n)) [1..max 1 (length deps)]))

131+ (quantify (if null deps then

132+ function unit (TypeApp (TypeConstructor name) ty)

133+ else

134+ foldr function (TypeApp (TypeConstructor name) ty) (map (\(pn, ty') -> TypeApp (TypeConstructor pn) ty') deps)))

132135 )

133136 where

134137 memberToNameAndValue :: [(String, Type)] -> Declaration -> Desugar (String, Value)

@@ -136,8 +139,7 @@ typeInstanceDictionaryDeclaration mn deps name ty decls = do

136139 memberType <- lift . maybe (Left "Type class member type not found") Right $ lookup (identToJs ident) tys

137140 memberName <- mkDictionaryEntryName mn name ty ident

138141 return (identToJs ident, TypedValue False

139− (if null deps then Var (Qualified Nothing memberName)

140− else foldl App (Var (Qualified Nothing memberName)) (map (\n -> Var (Qualified Nothing (Ident ('_' : show n)))) [1..length deps]))

142+ (foldl App (Var (Qualified Nothing memberName)) (map (\n -> Var (Qualified Nothing (Ident ('_' : show n)))) [1..length deps]))

141143 (quantify memberType))

142144 memberToNameAndValue _ _ = error "Invalid declaration in type instance definition"

143145

src/Language/PureScript/TypeChecker/Types.hs+1

@@ -287,6 +287,7 @@ entails moduleName context goal@(className, ty) = do

287287 -- Make a dictionary from subgoal dictionaries by applying the correct function

288288 mkDictionary :: Qualified Ident -> Maybe [Value] -> Value

289289 mkDictionary fnName Nothing = Var fnName

290+ mkDictionary fnName (Just []) = App (Var fnName) (ObjectLiteral [])

290291 mkDictionary fnName (Just dicts) = foldl App (Var fnName) dicts

291292 -- Filter out type dictionaries which are in scope in the current module

292293 filterModule :: TypeClassDictionaryInScope -> Bool