From 3c428f76d6c11d6475323173937b9ef9d516bcfe Mon Sep 17 00:00:00 2001 From: Anupam Jain Date: Thu, 6 Jul 2023 18:59:31 +0530 Subject: [PATCH] Use TypeRep directly instead of TypeableDict --- src/Data/Typeable.js | 10 ++++------ src/Data/Typeable.purs | 29 +++++++++-------------------- 2 files changed, 13 insertions(+), 26 deletions(-) diff --git a/src/Data/Typeable.js b/src/Data/Typeable.js index 584937f..0a4c8dd 100644 --- a/src/Data/Typeable.js +++ b/src/Data/Typeable.js @@ -1,7 +1,6 @@ // var _tag_id_counter = 1; export function typeRepDefault0Impl(t) { - // if(t.__uniqueId == undefined) t.__uniqueId = _tag_id_counter++; return t; } @@ -21,9 +20,9 @@ export const proxyTFromTagTImpl = pack('tagT'); function pack(tagName) { return function(origTag) { let unwrappedTag = origTag[tagName]; - return function(dict) { - if (unwrappedTag.tag) return { tag: unwrappedTag.tag, args: unwrappedTag.args.concat(dict) }; - return { tag: origTag, args: [dict] }; + return function(typeRep) { + if (unwrappedTag.tag) return { tag: unwrappedTag.tag, args: unwrappedTag.args.concat(typeRep) }; + return { tag: origTag, args: [typeRep] }; }; }; }; @@ -54,7 +53,6 @@ export const typeRowNil = { record: [] }; function eqTypeRepHelper(t1, t2) { if (t1.tagT) return t1 === t2; - if (t1.tag !== t2.tag) return false; if (t1.record) { if (!t2.record) return false; if (t1.record.length !== t2.record.length) return false; @@ -67,7 +65,7 @@ function eqTypeRepHelper(t1, t2) { if (!t1.args) return false; if (t1.args.length !== t2.args.length) return false; for (var i = 0; i < t1.args.length; i++) { - if (!eqTypeRepHelper(t1.args[i].typeRep, t2.args[i].typeRep)) return false; + if (!eqTypeRepHelper(t1.args[i], t2.args[i])) return false; } return true; } diff --git a/src/Data/Typeable.purs b/src/Data/Typeable.purs index a48ea28..979f947 100644 --- a/src/Data/Typeable.purs +++ b/src/Data/Typeable.purs @@ -49,9 +49,6 @@ class Typeable :: forall k. k -> Constraint class Typeable a where typeRep :: TypeRep a -data TypeableDict :: forall k. k -> Type -data TypeableDict a - instance showTypeRepInstance :: Show (TypeRep a) where show t = showTypeRep t @@ -111,27 +108,23 @@ eqSomeTypeRep s1 s2 = unwrapSomeTypeRep s1 \t1 -> unwrapSomeTypeRep s2 \t2 -> eq -- MACHINERY + INSTANCES +-- Coerce must have a type sig, and must not be inlined else it won't get passed the dicts +coerceTagDict :: forall a r. (TagTDict a -> r) -> (TagT a => r) +coerceTagDict = unsafeCoerce + -- HACK: For https://github.com/purescript/purescript/pull/4240 typeRepDefault0 :: forall a. TagT a => TypeRep a -typeRepDefault0 = coerce typeRepDefault0Impl - where - -- Coerce must have a type sig, and must not be inlined else it won't get passed the dicts - coerce :: (TagTDict a -> TypeRep a) -> (TagT a => TypeRep a) - coerce = unsafeCoerce +typeRepDefault0 = coerceTagDict typeRepDefault0Impl -- typeRepDefaultImpl :: forall a. TagT a => TypeRep a foreign import typeRepDefault0Impl :: forall a. TagTDict a -> TypeRep a -- HACK: For https://github.com/purescript/purescript/pull/4240 typeRepFromTag1 :: forall a b. TagT a => Typeable b => TypeRep (a b) -typeRepFromTag1 = coerce typeRepFromTag1Impl - where - -- Coerce must have a type sig, and must not be inlined else it won't get passed the dicts - coerce :: (TagTDict a -> TypeableDict b -> TypeRep (a b)) -> (TagT a => Typeable b => TypeRep (a b)) - coerce = unsafeCoerce +typeRepFromTag1 = coerceTagDict typeRepFromTag1Impl typeRep -- typeRepFromTag1Impl :: forall a b. TagT a => Typeable b => TypeRep (a b) -foreign import typeRepFromTag1Impl :: forall a b. TagTDict a -> TypeableDict b -> TypeRep (a b) +foreign import typeRepFromTag1Impl :: forall a b. TagTDict a -> TypeRep b -> TypeRep (a b) foreign import showTypeRep :: forall a. TypeRep a -> String @@ -153,14 +146,10 @@ data TagTDict t -- HACK: For https://github.com/purescript/purescript/pull/4240 proxyTFromTagT :: forall t a. TagT t => Typeable a => ProxyT (t a) -proxyTFromTagT = coerce proxyTFromTagTImpl - where - -- Coerce must have a type sig, and must not be inlined else it won't get passed the dicts - coerce :: (TagTDict t -> TypeableDict a -> ProxyT (t a)) -> (TagT t => Typeable a => ProxyT (t a)) - coerce = unsafeCoerce +proxyTFromTagT = coerceTagDict proxyTFromTagTImpl typeRep -- foreign import proxyTFromTagTImpl :: forall t a. TagT t => Typeable a => ProxyT (t a) -foreign import proxyTFromTagTImpl :: forall t a. TagTDict t -> TypeableDict a -> ProxyT (t a) +foreign import proxyTFromTagTImpl :: forall t a. TagTDict t -> TypeRep a -> ProxyT (t a) instance typeableRecord :: (RL.RowToList rs ls, TypeableRecordFields ls) => Typeable (Record rs) where typeRep = typeRowToTypeRep (typeableRecordFields (Proxy :: _ ls))