39b8aac · tix · git.iko.soy

git.iko.soy/tix

on master help sign in

Dropped Data and traces

39b8aaciko6 years ago

src/Tix/Typechecker.hs−2

compare with master

unifiedsplit

@@ -20,7 +20,6 @@ import Control.Monad.Freer.TreeTracer

20import Control.Monad.Freer.Writer

21import Data.Act

22import qualified Data.Aeson as A

23−import Data.Data (Data)

24import Data.Fix

23import Data.Fix

25import Data.Foldable

24import Data.Foldable

26import Data.Functor.Contravariant

25import Data.Functor.Contravariant

@@ -156,7 +155,6 @@ instance Free (MKM.Map Pred) where

156

155

157newtype Substitution = Substitution {unSubstitution :: Map TypeVariable NType}

156newtype Substitution = Substitution {unSubstitution :: Map TypeVariable NType}

158 deriving newtype (Eq, Ord, Show)

157 deriving newtype (Eq, Ord, Show)

159− deriving stock (Data)

160

158

161prettySubstitution :: Substitution -> A.Value

159prettySubstitution :: Substitution -> A.Value

162prettySubstitution = A.toJSON . M.mapKeysMonotonic (TL.pack . show) . fmap renderPretty . unSubstitution

160prettySubstitution = A.toJSON . M.mapKeysMonotonic (TL.pack . show) . fmap renderPretty . unSubstitution

src/Tix/Types.hs+17−12

@@ -18,8 +18,6 @@ import Control.Lens hiding (List)

18import Control.Monad.Freer

19import Control.Monad.Freer.Reader

20import Data.Bifunctor

21−import Data.Data (Data)

22−import Data.Data.Lens

23import Data.Map (Map)

21import Data.Map (Map)

24import qualified Data.Map as M

22import qualified Data.Map as M

25import qualified Data.Map.MultiKey.Strict as MKM

23import qualified Data.Map.MultiKey.Strict as MKM

@@ -27,7 +25,6 @@ import Data.Set (Set)

27import qualified Data.Set as S

25import qualified Data.Set as S

28import Data.Text (Text)

26import Data.Text (Text)

29import qualified Data.Text as T

27import qualified Data.Text as T

30−import Debug.Trace

31import GHC.Exts

28import GHC.Exts

32import Generic.Data

29import Generic.Data

33import Prettyprinter

30import Prettyprinter

@@ -42,11 +39,20 @@ data Pred

42 !NType

39 !NType

43 -- ^ z

40 -- ^ z

44 | !NType `HasField` !(Text, Scheme)

41 | !NType `HasField` !(Text, Scheme)

45− deriving stock (Eq, Ord, Show, Data, Generic)

42+ deriving stock (Eq, Ord, Show, Generic)

47instance MKM.Keyable Pred where

44instance MKM.Keyable Pred where

48 type Key Pred = TypeVariable

45 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+ )

51-- this seems bad. It should not drop constraints.

57-- this seems bad. It should not drop constraints.

52(//) :: NType -> NType -> NType -> Pred

58(//) :: NType -> NType -> NType -> Pred

@@ -54,11 +60,11 @@ instance MKM.Keyable Pred where

54{-# INLINE (//) #-}

60{-# INLINE (//) #-}

56data Scheme = Preds :=> !NType

62data Scheme = Preds :=> !NType

57− deriving stock (Eq, Ord, Show, Data, Generic)

63+ deriving stock (Eq, Ord, Show, Generic)

59newtype Preds = Preds {unPreds :: [Pred]}

65newtype Preds = Preds {unPreds :: [Pred]}

60 deriving newtype (Show, Eq, Ord, Semigroup, Monoid, IsList)

66 deriving newtype (Show, Eq, Ord, Semigroup, Monoid, IsList)

61− deriving stock (Data, Generic)

67+ deriving stock (Generic)

63scheme :: NType -> Scheme

69scheme :: NType -> Scheme

64scheme t = [] :=> t

70scheme t = [] :=> t

@@ -124,7 +130,7 @@ data NType

124 | !NType :-> !NType

130 | !NType :-> !NType

125 | List !NType

131 | List !NType

126 | NAttrSet !(Map Text Scheme)

132 | NAttrSet !(Map Text Scheme)

127− deriving stock (Eq, Ord, Show, Data, Generic)

133+ deriving stock (Eq, Ord, Show, Generic)

128

134

129data AtomicType

135data AtomicType

130 = Integer

136 = Integer

@@ -134,17 +140,16 @@ data AtomicType

134 | Path

140 | Path

135 | Null

141 | Null

136 | URI

142 | URI

137− deriving stock (Eq, Ord, Show, Data, Generic)

143+ deriving stock (Eq, Ord, Show, Generic)

138

144

139instance Pretty AtomicType where

145instance Pretty AtomicType where

140 pretty = viaShow

146 pretty = viaShow

141

147

142data DeBruijn = DeBruijn !Int !Int

148data DeBruijn = DeBruijn !Int !Int

143− deriving stock (Show, Eq, Ord, Data)

149+ deriving stock (Show, Eq, Ord)

144

150

145newtype TypeVariable = TypeVariable Int

151newtype TypeVariable = TypeVariable Int

146 deriving newtype (Eq, Ord, Enum, Bounded)

152 deriving newtype (Eq, Ord, Enum, Bounded)

147− deriving stock (Data)

148

153

149instance Show TypeVariable where

154instance Show TypeVariable where

150 show (TypeVariable n) = "〚" <> show n <> "〛"

155 show (TypeVariable n) = "〚" <> show n <> "〛"

@@ -214,7 +219,7 @@ prettyScheme :: Scheme -> PrettyM (Doc ann)

214prettyScheme u@(Preds cs :=> t) = do

219prettyScheme u@(Preds cs :=> t) = do

215 greekVars <- ask @(Map DeBruijn Text)

220 greekVars <- ask @(Map DeBruijn Text)

216 foralls <-

221 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

218 [] -> mempty

223 [] -> mempty

219 foralls -> "∀" <+> fillSep (pretty <$> foralls) <> "." <> line

224 foralls -> "∀" <+> fillSep (pretty <$> foralls) <> "." <> line

220 descend $ do

225 descend $ do