From 3d6a6d8d5217df68a48277445282866d57f82cf3 Mon Sep 17 00:00:00 2001 From: Adam Megacz Date: Sun, 8 May 2011 21:22:47 -0700 Subject: [PATCH] Private.hs: make datacon name different from tycon name, add explicit foralls --- GHC/HetMet/Private.hs | 64 +++++++++++++++++++++++++------------------------ 1 file changed, 33 insertions(+), 31 deletions(-) diff --git a/GHC/HetMet/Private.hs b/GHC/HetMet/Private.hs index aee3ad6..c27f78b 100644 --- a/GHC/HetMet/Private.hs +++ b/GHC/HetMet/Private.hs @@ -36,39 +36,41 @@ import GHC.HetMet.GArrow ------------------------------------------------------------------------- -- Used internally by the compiler, subject to change without notice!! -newtype PGArrow x y = PGArrow { unG :: forall g. GArrowSTKC g (,) () => g x y } +newtype PGArrow g x y = PGArrowD { unG :: GArrowSTKC g (,) () => g x y } -pga_id :: PGArrow x x -pga_id = PGArrow { unG = Control.Category.id } -pga_comp :: forall x y z. PGArrow x y -> PGArrow y z -> PGArrow x z -pga_comp f g = PGArrow { unG = unG f >>> unG g } -pga_first :: PGArrow x y -> PGArrow (x , z) (y , z) -pga_first f = PGArrow { unG = ga_first $ unG f } -pga_second :: PGArrow x y -> PGArrow (z , x) (z , y) -pga_second f = PGArrow { unG = ga_second $ unG f } -pga_cancell :: PGArrow ((),x) x -pga_cancell = PGArrow { unG = ga_cancell } -pga_cancelr :: PGArrow (x,()) x -pga_cancelr = PGArrow { unG = ga_cancelr } -pga_uncancell :: PGArrow x ((),x) -pga_uncancell = PGArrow { unG = ga_uncancell } -pga_uncancelr :: PGArrow x (x,()) -pga_uncancelr = PGArrow { unG = ga_uncancelr } -pga_assoc :: PGArrow ((x, y),z ) ( x,(y ,z)) -pga_assoc = PGArrow { unG = ga_assoc } -pga_unassoc :: PGArrow ( x,(y ,z)) ((x, y),z ) -pga_unassoc = PGArrow { unG = ga_unassoc } -pga_copy :: PGArrow x (x,x) -pga_copy = PGArrow { unG = ga_copy } -pga_drop :: PGArrow x () -pga_drop = PGArrow { unG = ga_drop } -pga_swap :: PGArrow (x,y) (y,x) -pga_swap = PGArrow { unG = ga_swap } -pga_applyl :: PGArrow (x,(x->y) ) y +pga_id :: forall g x. PGArrow g x x +pga_id = PGArrowD { unG = Control.Category.id } +pga_comp :: forall g x y z. PGArrow g x y -> PGArrow g y z -> PGArrow g x z +pga_comp f g = PGArrowD { unG = unG f >>> unG g } +pga_first :: forall g x y z . PGArrow g x y -> PGArrow g (x , z) (y , z) +pga_first f = PGArrowD { unG = ga_first $ unG f } +pga_second :: forall g x y z . PGArrow g x y -> PGArrow g (z , x) (z , y) +pga_second f = PGArrowD { unG = ga_second $ unG f } +pga_cancell :: forall g x . PGArrow g ((),x) x +pga_cancell = PGArrowD { unG = ga_cancell } +pga_cancelr :: forall g x . PGArrow g (x,()) x +pga_cancelr = PGArrowD { unG = ga_cancelr } +pga_uncancell :: forall g x . PGArrow g x ((),x) +pga_uncancell = PGArrowD { unG = ga_uncancell } +pga_uncancelr :: forall g x . PGArrow g x (x,()) +pga_uncancelr = PGArrowD { unG = ga_uncancelr } +pga_assoc :: forall g x y z . PGArrow g ((x, y),z ) ( x,(y ,z)) +pga_assoc = PGArrowD { unG = ga_assoc } +pga_unassoc :: forall g x y z . PGArrow g ( x,(y ,z)) ((x, y),z ) +pga_unassoc = PGArrowD { unG = ga_unassoc } +pga_copy :: forall g x . PGArrow g x (x,x) +pga_copy = PGArrowD { unG = ga_copy } +pga_drop :: forall g x . PGArrow g x () +pga_drop = PGArrowD { unG = ga_drop } +pga_swap :: forall g x y . PGArrow g (x,y) (y,x) +pga_swap = PGArrowD { unG = ga_swap } +pga_applyl :: forall g x y . PGArrow g (x,(x->y) ) y pga_applyl = error "not implemented" -pga_applyr :: PGArrow ( (x->y),x) y +pga_applyr :: forall g x y . PGArrow g ( (x->y),x) y pga_applyr = error "not implemented" -pga_curryl :: PGArrow (x,y) z -> PGArrow x (y->z) +pga_curryl :: forall g x y z . PGArrow g (x,y) z -> PGArrow g x (y->z) pga_curryl = error "not implemented" -pga_curryr :: PGArrow (x,y) z -> PGArrow y (x->z) +pga_curryr :: forall g x y z . PGArrow g (x,y) z -> PGArrow g y (x->z) pga_curryr = error "not implemented" +--pga_kappa :: forall g x y . (g u x -> g u y) -> g x y +--pga_kappa = error "not implemented" -- 1.7.10.4