lum/purescript-typeable
3
0
Fork 0
forked from github/purescript-typeable
Code Pull Requests Activity

Use TypeRep directly instead of TypeableDict

Browse Source
This commit is contained in:
Anupam Jain 2023-07-06 18:59:31 +05:30
parent 11e596fd26
commit 3c428f76d6
2 changed files with 13 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Data/Typeable.js
View File

@ -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;
}

29
src/Data/Typeable.purs
View File

@ -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))