diff options
Diffstat (limited to 'src/AST/Weaken/Auto.hs')
-rw-r--r-- | src/AST/Weaken/Auto.hs | 25 |
1 files changed, 7 insertions, 18 deletions
diff --git a/src/AST/Weaken/Auto.hs b/src/AST/Weaken/Auto.hs index 0deec71..eecb6f3 100644 --- a/src/AST/Weaken/Auto.hs +++ b/src/AST/Weaken/Auto.hs @@ -18,8 +18,7 @@ {-# OPTIONS_GHC -Wno-partial-type-signatures #-} module AST.Weaken.Auto ( autoWeak, - GivenSegment(..), - ($..), + ($..), auto, Layout(..), ) where @@ -51,25 +50,15 @@ data SSegments (segments :: [(Symbol, [t])]) where SSegNil :: SSegments '[] SSegCons :: SSymbol name -> SList (Const ()) ts -> SSegments list -> SSegments ('(name, ts) : list) -class ToSegments k a | a -> k where - type SegmentsOf k a :: [(Symbol, [k])] - toSegments :: a -> SSegments (SegmentsOf k a) +instance (KnownSymbol name, name ~ name', segs ~ '[ '(name', ts)]) => IsLabel name (SList f ts -> SSegments segs) where + fromLabel = \spine -> SSegCons symbolSing (slistMap (\_ -> Const ()) spine) SSegNil -instance ToSegments k (SSegments (segments :: [(Symbol, [k])])) where - type SegmentsOf k (SSegments segments) = segments - toSegments = id - -data GivenSegment name ts = forall f. KnownSymbol name => Seg (SList f ts) - | (KnownSymbol name, KnownListSpine ts) => Seg' - -instance ToSegments k (GivenSegment name (ts :: [k])) where - type SegmentsOf k (GivenSegment name (ts :: [k])) = '[ '(name, ts)] - toSegments (Seg list) = SSegCons symbolSing (slistMap (\_ -> Const ()) list) SSegNil - toSegments Seg' = SSegCons symbolSing knownListSpine SSegNil +auto :: KnownListSpine list => SList (Const ()) list +auto = knownListSpine infixr $.. -($..) :: (ToSegments k a, ToSegments k b) => a -> b -> SSegments (Append (SegmentsOf k a) (SegmentsOf k b)) -x $.. y = ssegmentsAppend (toSegments x) (toSegments y) +($..) :: SSegments segs1 -> SSegments segs2 -> SSegments (Append segs1 segs2) +($..) = ssegmentsAppend where ssegmentsAppend :: SSegments a -> SSegments b -> SSegments (Append a b) ssegmentsAppend SSegNil l2 = l2 |