9be60e1 · rowtype-yoga/purescript-native

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

on golang help sign in

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

9be60e1Phil Freeman13 years ago

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

compare with golang

unifiedsplit

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

81--

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

83--

84−-- __Test_Foo_string :: Foo String

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

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

86--

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

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

127 memberNames <- mapM (memberToNameAndValue memberTypes) decls

128 return $ ValueDeclaration entryName [] Nothing

129 (TypedValue True

130− (foldr Abs (ObjectLiteral memberNames) (map (\n -> Ident ('_' : show n)) [1..length 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

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

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

132 )

135 )

133 where

136 where

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

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

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

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

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

137 memberName <- mkDictionaryEntryName mn name ty ident

140 memberName <- mkDictionaryEntryName mn name ty ident

138 return (identToJs ident, TypedValue False

141 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]))

141 (quantify memberType))

143 (quantify memberType))

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

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

143

145

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

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

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

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

289 mkDictionary fnName Nothing = Var fnName

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

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

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

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

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

292 filterModule :: TypeClassDictionaryInScope -> Bool

293 filterModule :: TypeClassDictionaryInScope -> Bool