@@ -18,8 +18,6 @@ import Control.Lens hiding (List)
1818import Control.Monad.Freer
1919import Control.Monad.Freer.Reader
2020import Data.Bifunctor
21−import Data.Data (Data)
22−import Data.Data.Lens
2321import Data.Map (Map)
2422import qualified Data.Map as M
2523import qualified Data.Map.MultiKey.Strict as MKM
@@ -27,7 +25,6 @@ import Data.Set (Set)
2725import qualified Data.Set as S
2826import Data.Text (Text)
2927import qualified Data.Text as T
30−import Debug.Trace
3128import GHC.Exts
3229import Generic.Data
3330import Prettyprinter
@@ -42,11 +39,20 @@ data Pred
4239 !NType
4340 -- ^ z
4441 | !NType `HasField` !(Text, Scheme)
45− deriving stock (Eq, Ord, Show, Data, Generic)
42+ deriving stock (Eq, Ord, Show, Generic)
4643
4744instance MKM.Keyable Pred where
4845 type Key Pred = TypeVariable
49− getKeys p = p ^.. template @_ @TypeVariable
46+ getKeys p =
47+ S.toList $
48+ p
49+ ^. traverseNTypes
50+ . to
51+ ( \case
52+ TAtomic _ -> S.empty
53+ TTypeVariable t -> S.singleton t
54+ TBruijn _ -> S.empty
55+ )
5056
5157-- this seems bad. It should not drop constraints.
5258(//) :: NType -> NType -> NType -> Pred
@@ -54,11 +60,11 @@ instance MKM.Keyable Pred where
5460{-# INLINE (//) #-}
5561
5662data Scheme = Preds :=> !NType
57− deriving stock (Eq, Ord, Show, Data, Generic)
63+ deriving stock (Eq, Ord, Show, Generic)
5864
5965newtype Preds = Preds {unPreds :: [Pred]}
6066 deriving newtype (Show, Eq, Ord, Semigroup, Monoid, IsList)
61− deriving stock (Data, Generic)
67+ deriving stock (Generic)
6268
6369scheme :: NType -> Scheme
6470scheme t = [] :=> t
@@ -124,7 +130,7 @@ data NType
124130 | !NType :-> !NType
125131 | List !NType
126132 | NAttrSet !(Map Text Scheme)
127− deriving stock (Eq, Ord, Show, Data, Generic)
133+ deriving stock (Eq, Ord, Show, Generic)
128134
129135data AtomicType
130136 = Integer
@@ -134,17 +140,16 @@ data AtomicType
134140 | Path
135141 | Null
136142 | URI
137− deriving stock (Eq, Ord, Show, Data, Generic)
143+ deriving stock (Eq, Ord, Show, Generic)
138144
139145instance Pretty AtomicType where
140146 pretty = viaShow
141147
142148data DeBruijn = DeBruijn !Int !Int
143− deriving stock (Show, Eq, Ord, Data)
149+ deriving stock (Show, Eq, Ord)
144150
145151newtype TypeVariable = TypeVariable Int
146152 deriving newtype (Eq, Ord, Enum, Bounded)
147− deriving stock (Data)
148153
149154instance Show TypeVariable where
150155 show (TypeVariable n) = "〚" <> show n <> "〛"
@@ -214,7 +219,7 @@ prettyScheme :: Scheme -> PrettyM (Doc ann)
214219prettyScheme u@(Preds cs :=> t) = do
215220 greekVars <- ask @(Map DeBruijn Text)
216221 foralls <-
217− getDepthedDeBurjins (traceShowId u) <&> \s -> case M.elems . M.restrictKeys greekVars $ traceShowId s of
222+ getDepthedDeBurjins u <&> \s -> case M.elems . M.restrictKeys greekVars $ s of
218223 [] -> mempty
219224 foralls -> "∀" <+> fillSep (pretty <$> foralls) <> "." <> line
220225 descend $ do