ce4bd2b · rowtype-yoga/purescript-native

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

Fix example, do not generate __superclasses field if there are no superclasses.

commitce4bd2bdbbf9c9a2c0271ac8823c12393976cd9c authorPhil Freeman <paf31@cantab.net> dateSat 5 Apr 2014, 18:23 (13 years ago) parent4dc1c58

4 files changed+12−3

compare with golang

unifiedsplit

examples/passing/Superclasses2.purs+1 src/Language/PureScript/Constants.hs+3 src/Language/PureScript/Sugar/TypeClasses.hs+7−2 src/Language/PureScript/TypeChecker/Types.hs+1−1

examples/passing/Superclasses2.purs+1

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

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

1919test x = su [cl x x]

2020

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

src/Language/PureScript/Constants.hs+3

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

177177_ps :: String

178178_ps = "_ps"

179179

180+__superclasses :: String

181+__superclasses = "__superclasses"

182+

180183-- Modules

181184

182185prim :: String

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

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

2727import Language.PureScript.Errors

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

2929

30+import qualified Language.PureScript.Constants as C

31+

3032import Control.Applicative

3133import Control.Monad.State

3234import Control.Arrow (first, second)

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

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

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

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

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

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)

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

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

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

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

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

172177 where

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

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

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

358358 dictionaryValueToValue (SubclassDictionaryValue dict index) =

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

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

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

361361 (NumericLiteral (Left index))

362362 -- Ensure that a substitution is valid

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