ce4bd2b · rowtype-yoga/purescript-native

examples/passing/Superclasses2.purs+1

compare with golang

unifiedsplit

@@ -18,3 +18,4 @@ instance clNumber :: Cl Number where

18test :: forall a. (Cl a) => a -> [a]

19test x = su [cl x x]

20

21+main = Debug.Trace.print $ test 10 !! 0

src/Language/PureScript/Constants.hs+3

@@ -177,6 +177,9 @@ main = "main"

177_ps :: String

178_ps = "_ps"

179

180+__superclasses :: String

181+__superclasses = "__superclasses"

182+

180-- Modules

183-- Modules

181

184

182prim :: String

185prim :: String

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

@@ -27,6 +27,8 @@ import Language.PureScript.Environment

27import Language.PureScript.Errors

28import Language.PureScript.CodeGen.Common (identToJs)

29

30+import qualified Language.PureScript.Constants as C

31+

30import Control.Applicative

32import Control.Applicative

31import Control.Monad.State

33import Control.Monad.State

32import Control.Arrow (first, second)

34import Control.Arrow (first, second)

@@ -164,9 +166,12 @@ typeInstanceDictionaryDeclaration name mn deps className tys decls = do

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

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

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

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

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

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

169+ let (memberTypes', memberNames') =

170+ if null implies

171+ then (memberTypes, memberNames)

172+ else ((Ident C.__superclasses, TypeApp tyArray unit) : memberTypes, (C.__superclasses, superclasses) : memberNames)

167− let dictTy = TypeApp tyObject (rowFromList (map (first identToProperty) memberTypes, RCons "__superclasses" (TypeApp tyArray unit) REmpty))

173+ dictTy = TypeApp tyObject (rowFromList (map (first identToProperty) memberTypes', REmpty))

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

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

169− memberNames' = ("__superclasses", superclasses) : memberNames

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

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

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

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

172 where

177 where

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

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

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

358 dictionaryValueToValue (SubclassDictionaryValue dict index) =

359 App (App (Var (Qualified (Just (ModuleName [ProperName C.prelude])) (Ident (C.!!))))

360− (Accessor "__superclasses" (dictionaryValueToValue dict)))

360+ (Accessor C.__superclasses (dictionaryValueToValue dict)))

361 (NumericLiteral (Left index))

362 -- Ensure that a substitution is valid

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