src/Symantic/Parser/Grammar/Combinators.hs

   1 -- The default type signature of type class methods are changed
   2 -- to introduce a Liftable constraint and the same type class but on the 'Output' repr,
   3 -- this setup avoids to define the method with boilerplate code when its default
   4 -- definition with lift* and 'trans' does what is expected by an instance
   5 -- of the type class. This is almost as explained in:
   6 -- https://ro-che.info/articles/2016-02-03-finally-tagless-boilerplate
   7 {-# LANGUAGE DefaultSignatures #-}
   8 {-# LANGUAGE DeriveLift #-} -- For TH.Lift (ErrorItem tok)
   9 {-# LANGUAGE StandaloneDeriving #-} -- For Show (ErrorItem (InputToken inp))
  10 {-# LANGUAGE TemplateHaskell #-}
  11 -- | Semantic of the grammar combinators used to express parsers,
  12 -- in the convenient tagless-final encoding.
  13 module Symantic.Parser.Grammar.Combinators where
  14
  15 import Data.Bool (Bool(..), not, (||))
  16 import Data.Char (Char)
  17 import Data.Either (Either(..))
  18 import Data.Eq (Eq(..))
  19 import Data.Function ((.), flip, const)
  20 import Data.Kind (Constraint)
  21 import Data.Int (Int)
  22 import Data.Maybe (Maybe(..))
  23 import Data.Ord (Ord)
  24 import Data.Proxy (Proxy(..))
  25 import Data.String (String)
  26 import GHC.TypeLits (KnownSymbol, Symbol)
  27 import Text.Show (Show(..))
  28 import qualified Data.Functor as Functor
  29 import qualified Data.List as List
  30 import qualified Language.Haskell.TH as TH
  31 import qualified Language.Haskell.TH.Syntax as TH
  32
  33 import qualified Symantic.Univariant.Trans as Sym
  34 import qualified Symantic.Parser.Haskell as H
  35
  36 -- * Type 'TermGrammar'
  37 type TermGrammar = H.Term H.ValueCode
  38
  39 -- * Class 'Applicable'
  40 -- | This is like the usual 'Functor' and 'Applicative' type classes
  41 -- from the @base@ package, but using @('TermGrammar' a)@ instead of just @(a)@
  42 -- to be able to use and pattern match on some usual terms of type @(a)@ (like 'H.id')
  43 -- and thus apply some optimizations.
  44 -- @(repr)@, for "representation", is the usual tagless-final abstraction
  45 -- over the many semantics that this syntax (formed by the methods
  46 -- of type class like this one) will be interpreted.
  47 class Applicable repr where
  48   -- | @(a2b '<$>' ra)@ parses like @(ra)@ but maps its returned value with @(a2b)@.
  49   (<$>) :: TermGrammar (a -> b) -> repr a -> repr b
  50   (<$>) f = (pure f <*>)
  51
  52   -- | Like '<$>' but with its arguments 'flip'-ped.
  53   (<&>) :: repr a -> TermGrammar (a -> b) -> repr b
  54   (<&>) = flip (<$>)
  55
  56   -- | @(a '<$' rb)@ parses like @(rb)@ but discards its returned value by replacing it with @(a)@.
  57   (<$) :: TermGrammar a -> repr b -> repr a
  58   (<$) x = (pure x <*)
  59
  60   -- | @(ra '$>' b)@ parses like @(ra)@ but discards its returned value by replacing it with @(b)@.
  61   ($>) :: repr a -> TermGrammar b -> repr b
  62   ($>) = flip (<$)
  63
  64   -- | @('pure' a)@ parses the empty string, always succeeding in returning @(a)@.
  65   pure :: TermGrammar a -> repr a
  66   default pure ::
  67     Sym.Liftable repr => Applicable (Sym.Output repr) =>
  68     TermGrammar a -> repr a
  69   pure = Sym.lift . pure
  70
  71   -- | @(ra2b '<*>' ra)@ parses sequentially @(ra2b)@ and then @(ra)@,
  72   -- and returns the application of the function returned by @(ra2b)@
  73   -- to the value returned by @(ra)@.
  74   (<*>) :: repr (a -> b) -> repr a -> repr b
  75   default (<*>) ::
  76     Sym.Liftable2 repr => Applicable (Sym.Output repr) =>
  77     repr (a -> b) -> repr a -> repr b
  78   (<*>) = Sym.lift2 (<*>)
  79
  80   -- | @('liftA2' a2b2c ra rb)@ parses sequentially @(ra)@ and then @(rb)@,
  81   -- and returns the application of @(a2b2c)@ to the values returned by those parsers.
  82   liftA2 :: TermGrammar (a -> b -> c) -> repr a -> repr b -> repr c
  83   liftA2 f x = (<*>) (f <$> x)
  84
  85   -- | @(ra '<*' rb)@ parses sequentially @(ra)@ and then @(rb)@,
  86   -- and returns like @(ra)@, discarding the return value of @(rb)@.
  87   (<*) :: repr a -> repr b -> repr a
  88   (<*) = liftA2 H.const
  89
  90   -- | @(ra '*>' rb)@ parses sequentially @(ra)@ and then @(rb)@,
  91   -- and returns like @(rb)@, discarding the return value of @(ra)@.
  92   (*>) :: repr a -> repr b -> repr b
  93   x *> y = (H.id <$ x) <*> y
  94
  95   -- | Like '<*>' but with its arguments 'flip'-ped.
  96   (<**>) :: repr a -> repr (a -> b) -> repr b
  97   (<**>) = liftA2 (H.flip H..@ (H.$))
  98   {-
  99   (<**>) :: repr a -> repr (a -> b) -> repr b
 100   (<**>) = liftA2 (\a f -> f a)
 101   -}
 102 infixl 4 <$>, <&>, <$, $>, <*>, <*, *>, <**>
 103
 104 -- * Class 'Alternable'
 105 class Alternable repr where
 106   -- | @(rl '<|>' rr)@ parses @(rl)@ and return its return value or,
 107   -- if it fails, parses @(rr)@ from where @(rl)@ has left the input stream,
 108   -- and returns its return value.
 109   (<|>) :: repr a -> repr a -> repr a
 110   -- | @(empty)@ parses nothing, always failing to return a value.
 111   empty :: repr a
 112   -- | @('try' ra)@ records the input stream position,
 113   -- then parses like @(ra)@ and either returns its value it it succeeds or fails
 114   -- if it fails but with a reset of the input stream to the recorded position.
 115   -- Generally used on the first alternative: @('try' rl '<|>' rr)@.
 116   try :: repr a -> repr a
 117   default (<|>) ::
 118     Sym.Liftable2 repr => Alternable (Sym.Output repr) =>
 119     repr a -> repr a -> repr a
 120   default empty ::
 121     Sym.Liftable repr => Alternable (Sym.Output repr) =>
 122     repr a
 123   default try ::
 124     Sym.Liftable1 repr => Alternable (Sym.Output repr) =>
 125     repr a -> repr a
 126   (<|>) = Sym.lift2 (<|>)
 127   empty = Sym.lift empty
 128   try = Sym.lift1 try
 129   -- | Like @('<|>')@ but with different returning types for the alternatives,
 130   -- and a return value wrapped in an 'Either' accordingly.
 131   (<+>) :: Applicable repr => Alternable repr => repr a -> repr b -> repr (Either a b)
 132   p <+> q = H.left <$> p <|> H.right <$> q
 133 infixl 3 <|>, <+>
 134
 135 class Throwable repr where
 136   type ThrowableLabel repr (lbl::Symbol) :: Constraint
 137   --type ThrowableLabel repr lbl = ThrowableLabel (Sym.Output repr) lbl
 138   throw ::
 139     KnownSymbol lbl =>
 140     ThrowableLabel repr lbl =>
 141     Proxy lbl -> repr a
 142   default throw ::
 143     forall lbl a.
 144     Sym.Liftable repr => Alternable (Sym.Output repr) =>
 145     KnownSymbol lbl =>
 146     Throwable (Sym.Output repr) =>
 147     ThrowableLabel (Sym.Output repr) lbl =>
 148     Proxy lbl -> repr a
 149   throw lbl = Sym.lift (throw lbl)
 150
 151 optionally :: Applicable repr => Alternable repr => repr a -> TermGrammar b -> repr b
 152 optionally p x = p $> x <|> pure x
 153
 154 optional :: Applicable repr => Alternable repr => repr a -> repr ()
 155 optional = flip optionally H.unit
 156
 157 option :: Applicable repr => Alternable repr => TermGrammar a -> repr a -> repr a
 158 option x p = p <|> pure x
 159
 160 choice :: Alternable repr => [repr a] -> repr a
 161 choice = List.foldr (<|>) empty
 162  -- FIXME: Here hlint suggests to use Data.Foldable.asum,
 163  -- but at this point there is no asum for our own (<|>)
 164
 165 maybeP :: Applicable repr => Alternable repr => repr a -> repr (Maybe a)
 166 maybeP p = option H.nothing (H.just <$> p)
 167
 168 manyTill :: Applicable repr => Alternable repr => repr a -> repr b -> repr [a]
 169 manyTill p end = let go = end $> H.nil <|> p <:> go in go
 170
 171 -- * Class 'Selectable'
 172 class Selectable repr where
 173   branch :: repr (Either a b) -> repr (a -> c) -> repr (b -> c) -> repr c
 174   default branch ::
 175     Sym.Liftable3 repr => Selectable (Sym.Output repr) =>
 176     repr (Either a b) -> repr (a -> c) -> repr (b -> c) -> repr c
 177   branch = Sym.lift3 branch
 178
 179 -- * Class 'Matchable'
 180 class Matchable repr where
 181   conditional ::
 182     Eq a => repr a -> [TermGrammar (a -> Bool)] -> [repr b] -> repr b -> repr b
 183   default conditional ::
 184     Sym.Unliftable repr => Sym.Liftable1 repr => Matchable (Sym.Output repr) =>
 185     Eq a => repr a -> [TermGrammar (a -> Bool)] -> [repr b] -> repr b -> repr b
 186   conditional a ps bs = Sym.lift1 (conditional (Sym.trans a) ps (Sym.trans Functor.<$> bs))
 187
 188   match :: Eq a => repr a -> [TermGrammar a] -> (TermGrammar a -> repr b) -> repr b -> repr b
 189   match a as a2b = conditional a ((H.eq H..@) Functor.<$> as) (a2b Functor.<$> as)
 190   -- match a as a2b = conditional a (((H.eq H..@ H.qual) H..@) Functor.<$> as) (a2b Functor.<$> as)
 191
 192 -- * Class 'Foldable'
 193 class Foldable repr where
 194   chainPre :: repr (a -> a) -> repr a -> repr a
 195   chainPost :: repr a -> repr (a -> a) -> repr a
 196   {-
 197   default chainPre ::
 198     Sym.Liftable2 repr => Foldable (Sym.Output repr) =>
 199     repr (a -> a) -> repr a -> repr a
 200   default chainPost ::
 201     Sym.Liftable2 repr => Foldable (Sym.Output repr) =>
 202     repr a -> repr (a -> a) -> repr a
 203   chainPre = Sym.lift2 chainPre
 204   chainPost = Sym.lift2 chainPost
 205   -}
 206   default chainPre ::
 207     Applicable repr =>
 208     Alternable repr =>
 209     repr (a -> a) -> repr a -> repr a
 210   default chainPost ::
 211     Applicable repr =>
 212     Alternable repr =>
 213     repr a -> repr (a -> a) -> repr a
 214   chainPre op p = go <*> p where go = (H..) <$> op <*> go <|> pure H.id
 215   chainPost p op = p <**> go where go = (H..) <$> op <*> go <|> pure H.id
 216   {-
 217   chainPre op p = flip (foldr ($)) <$> many op <*> p
 218   chainPost p op = foldl' (flip ($)) <$> p <*> many op
 219   -}
 220
 221 {-
 222 conditional :: Selectable repr => [(TermGrammar (a -> Bool), repr b)] -> repr a -> repr b -> repr b
 223 conditional cs p def = match p fs qs def
 224   where (fs, qs) = List.unzip cs
 225 -}
 226
 227 -- * Class 'Satisfiable'
 228 class Satisfiable tok repr where
 229   satisfy :: [ErrorItem tok] -> TermGrammar (tok -> Bool) -> repr tok
 230   default satisfy ::
 231     Sym.Liftable repr => Satisfiable tok (Sym.Output repr) =>
 232     [ErrorItem tok] ->
 233     TermGrammar (tok -> Bool) -> repr tok
 234   satisfy es = Sym.lift . satisfy es
 235
 236   item :: repr tok
 237   item = satisfy [] (H.const H..@ H.bool True)
 238
 239 -- ** Type 'ErrorItem'
 240 data ErrorItem tok
 241   =  ErrorItemToken tok
 242   |  ErrorItemLabel String
 243   |  ErrorItemHorizon Int
 244   |  ErrorItemEnd
 245 deriving instance Eq tok => Eq (ErrorItem tok)
 246 deriving instance Ord tok => Ord (ErrorItem tok)
 247 deriving instance Show tok => Show (ErrorItem tok)
 248 deriving instance TH.Lift tok => TH.Lift (ErrorItem tok)
 249
 250 -- * Class 'Lookable'
 251 class Lookable repr where
 252   look :: repr a -> repr a
 253   negLook :: repr a -> repr ()
 254   default look :: Sym.Liftable1 repr => Lookable (Sym.Output repr) => repr a -> repr a
 255   default negLook :: Sym.Liftable1 repr => Lookable (Sym.Output repr) => repr a -> repr ()
 256   look = Sym.lift1 look
 257   negLook = Sym.lift1 negLook
 258
 259   eof :: repr ()
 260   eof = Sym.lift eof
 261   default eof :: Sym.Liftable repr => Lookable (Sym.Output repr) => repr ()
 262   -- eof = negLook (satisfy @Char [ErrorItemAny] (H.const H..@ H.bool True))
 263              -- (item @Char)
 264
 265 {-# INLINE (<:>) #-}
 266 infixl 4 <:>
 267 (<:>) :: Applicable repr => repr a -> repr [a] -> repr [a]
 268 (<:>) = liftA2 H.cons
 269
 270 sequence :: Applicable repr => [repr a] -> repr [a]
 271 sequence = List.foldr (<:>) (pure H.nil)
 272
 273 traverse :: Applicable repr => (a -> repr b) -> [a] -> repr [b]
 274 traverse f = sequence . List.map f
 275  -- FIXME: Here hlint suggests to use Control.Monad.mapM,
 276  -- but at this point there is no mapM for our own sequence
 277
 278 repeat :: Applicable repr => Int -> repr a -> repr [a]
 279 repeat n p = traverse (const p) [1..n]
 280
 281 between :: Applicable repr => repr o -> repr c -> repr a -> repr a
 282 between open close p = open *> p <* close
 283
 284 string ::
 285   Applicable repr => Alternable repr =>
 286   Satisfiable Char repr =>
 287   [Char] -> repr [Char]
 288 string = try . traverse char
 289
 290 oneOf ::
 291   TH.Lift tok => Eq tok =>
 292   Satisfiable tok repr =>
 293   [tok] -> repr tok
 294 oneOf ts = satisfy [ErrorItemLabel "oneOf"]
 295   (Sym.trans H.ValueCode
 296     { value = (`List.elem` ts)
 297     , code = [||\t -> $$(ofChars ts [||t||])||] })
 298
 299 noneOf ::
 300   TH.Lift tok => Eq tok =>
 301   Satisfiable tok repr =>
 302   [tok] -> repr tok
 303 noneOf cs = satisfy (ErrorItemToken Functor.<$> cs) (Sym.trans H.ValueCode
 304   { value = not . (`List.elem` cs)
 305   , code = [||\c -> not $$(ofChars cs [||c||])||]
 306   })
 307
 308 ofChars ::
 309   TH.Lift tok => Eq tok =>
 310   {-alternatives-}[tok] ->
 311   {-input-}TH.CodeQ tok ->
 312   TH.CodeQ Bool
 313 ofChars = List.foldr (\alt acc ->
 314   \inp -> [|| alt == $$inp || $$(acc inp) ||])
 315   (const [||False||])
 316
 317 more :: Applicable repr => Satisfiable Char repr => Lookable repr => repr ()
 318 more = look (void (item @Char))
 319
 320 char ::
 321   Applicable repr => Satisfiable Char repr =>
 322   Char -> repr Char
 323 char c = satisfy [ErrorItemToken c] (H.eq H..@ H.char c) $> H.char c
 324 -- char c = satisfy [ErrorItemToken c] (H.eq H..@ H.qual H..@ H.char c) $> H.char c
 325
 326 anyChar :: Satisfiable Char repr => repr Char
 327 anyChar = satisfy [] (H.const H..@ H.bool True)
 328
 329 token ::
 330   TH.Lift tok => Show tok => Eq tok =>
 331   Applicable repr => Satisfiable tok repr =>
 332   tok -> repr tok
 333 token tok = satisfy [ErrorItemToken tok] (H.eq H..@ H.char tok) $> H.char tok
 334 -- token tok = satisfy [ErrorItemToken tok] (H.eq H..@ H.qual H..@ H.char tok) $> H.char tok
 335
 336 tokens ::
 337   TH.Lift tok => Eq tok => Show tok =>
 338   Applicable repr => Alternable repr =>
 339   Satisfiable tok repr => [tok] -> repr [tok]
 340 tokens = try . traverse token
 341
 342 -- Composite Combinators
 343 -- someTill :: repr a -> repr b -> repr [a]
 344 -- someTill p end = negLook end *> (p <:> manyTill p end)
 345
 346 void :: Applicable repr => repr a -> repr ()
 347 void p = p *> unit
 348
 349 unit :: Applicable repr => repr ()
 350 unit = pure H.unit
 351
 352 {-
 353 constp :: Applicable repr => repr a -> repr (b -> a)
 354 constp = (H.const <$>)
 355
 356
 357 -- Alias Operations
 358 infixl 1 >>
 359 (>>) :: Applicable repr => repr a -> repr b -> repr b
 360 (>>) = (*>)
 361
 362 -- Monoidal Operations
 363
 364 infixl 4 <~>
 365 (<~>) :: Applicable repr => repr a -> repr b -> repr (a, b)
 366 (<~>) = liftA2 (H.runtime (,))
 367
 368 infixl 4 <~
 369 (<~) :: Applicable repr => repr a -> repr b -> repr a
 370 (<~) = (<*)
 371
 372 infixl 4 ~>
 373 (~>) :: Applicable repr => repr a -> repr b -> repr b
 374 (~>) = (*>)
 375
 376 -- Lift Operations
 377 liftA2 ::
 378  Applicable repr =>
 379  TermGrammar (a -> b -> c) -> repr a -> repr b -> repr c
 380 liftA2 f x = (<*>) (fmap f x)
 381
 382 liftA3 ::
 383  Applicable repr =>
 384  TermGrammar (a -> b -> c -> d) -> repr a -> repr b -> repr c -> repr d
 385 liftA3 f a b c = liftA2 f a b <*> c
 386
 387 -}
 388
 389 -- Parser Folds
 390 pfoldr ::
 391  Applicable repr => Foldable repr =>
 392  TermGrammar (a -> b -> b) -> TermGrammar b -> repr a -> repr b
 393 pfoldr f k p = chainPre (f <$> p) (pure k)
 394
 395 pfoldr1 ::
 396  Applicable repr => Foldable repr =>
 397  TermGrammar (a -> b -> b) -> TermGrammar b -> repr a -> repr b
 398 pfoldr1 f k p = f <$> p <*> pfoldr f k p
 399
 400 pfoldl ::
 401  Applicable repr => Foldable repr =>
 402  TermGrammar (b -> a -> b) -> TermGrammar b -> repr a -> repr b
 403 pfoldl f k p = chainPost (pure k) ((H.flip <$> pure f) <*> p)
 404
 405 pfoldl1 ::
 406  Applicable repr => Foldable repr =>
 407  TermGrammar (b -> a -> b) -> TermGrammar b -> repr a -> repr b
 408 pfoldl1 f k p = chainPost (f <$> pure k <*> p) ((H.flip <$> pure f) <*> p)
 409
 410 -- Chain Combinators
 411 chainl1' ::
 412  Applicable repr => Foldable repr =>
 413  TermGrammar (a -> b) -> repr a -> repr (b -> a -> b) -> repr b
 414 chainl1' f p op = chainPost (f <$> p) (H.flip <$> op <*> p)
 415
 416 chainl1 ::
 417  Applicable repr => Foldable repr =>
 418  repr a -> repr (a -> a -> a) -> repr a
 419 chainl1 = chainl1' H.id
 420
 421 {-
 422 chainr1' :: ParserOps rep => rep (a -> b) -> repr a -> repr (a -> b -> b) -> repr b
 423 chainr1' f p op = newRegister_ H.id $ \acc ->
 424   let go = bind p $ \x ->
 425            modify acc (H.flip (H..@) <$> (op <*> x)) *> go
 426        <|> f <$> x
 427   in go <**> get acc
 428
 429 chainr1 :: repr a -> repr (a -> a -> a) -> repr a
 430 chainr1 = chainr1' H.id
 431
 432 chainr :: repr a -> repr (a -> a -> a) -> TermGrammar a -> repr a
 433 chainr p op x = option x (chainr1 p op)
 434 -}
 435
 436 chainl ::
 437  Applicable repr => Alternable repr => Foldable repr =>
 438  repr a -> repr (a -> a -> a) -> TermGrammar a -> repr a
 439 chainl p op x = option x (chainl1 p op)
 440
 441 -- Derived Combinators
 442 many ::
 443  Applicable repr => Foldable repr =>
 444  repr a -> repr [a]
 445 many = pfoldr H.cons H.nil
 446
 447 manyN ::
 448  Applicable repr => Foldable repr =>
 449  Int -> repr a -> repr [a]
 450 manyN n p = List.foldr (const (p <:>)) (many p) [1..n]
 451
 452 some ::
 453  Applicable repr => Foldable repr =>
 454  repr a -> repr [a]
 455 some = manyN 1
 456
 457 skipMany ::
 458  Applicable repr => Foldable repr =>
 459  repr a -> repr ()
 460 --skipMany p = let skipManyp = p *> skipManyp <|> unit in skipManyp
 461 skipMany = void . pfoldl H.const H.unit -- the void here will encourage the optimiser to recognise that the register is unused
 462
 463 skipManyN ::
 464  Applicable repr => Foldable repr =>
 465  Int -> repr a -> repr ()
 466 skipManyN n p = List.foldr (const (p *>)) (skipMany p) [1..n]
 467
 468 skipSome ::
 469  Applicable repr => Foldable repr =>
 470  repr a -> repr ()
 471 skipSome = skipManyN 1
 472
 473 sepBy ::
 474  Applicable repr => Alternable repr => Foldable repr =>
 475  repr a -> repr b -> repr [a]
 476 sepBy p sep = option H.nil (sepBy1 p sep)
 477
 478 sepBy1 ::
 479  Applicable repr => Alternable repr => Foldable repr =>
 480  repr a -> repr b -> repr [a]
 481 sepBy1 p sep = p <:> many (sep *> p)
 482
 483 endBy ::
 484  Applicable repr => Alternable repr => Foldable repr =>
 485  repr a -> repr b -> repr [a]
 486 endBy p sep = many (p <* sep)
 487
 488 endBy1 ::
 489  Applicable repr => Alternable repr => Foldable repr =>
 490  repr a -> repr b -> repr [a]
 491 endBy1 p sep = some (p <* sep)
 492
 493 sepEndBy ::
 494  Applicable repr => Alternable repr => Foldable repr =>
 495  repr a -> repr b -> repr [a]
 496 sepEndBy p sep = option H.nil (sepEndBy1 p sep)
 497
 498 sepEndBy1 ::
 499  Applicable repr => Alternable repr => Foldable repr =>
 500  repr a -> repr b -> repr [a]
 501 sepEndBy1 p sep =
 502   let seb1 = p <**> (sep *> (H.flip H..@ H.cons <$> option H.nil seb1)
 503                  <|> pure (H.flip H..@ H.cons H..@ H.nil))
 504   in seb1
 505
 506 {-
 507 sepEndBy1 :: repr a -> repr b -> repr [a]
 508 sepEndBy1 p sep = newRegister_ H.id $ \acc ->
 509   let go = modify acc ((H.flip (H..)) H..@ H.cons <$> p)
 510          *> (sep *> (go <|> get acc) <|> get acc)
 511   in go <*> pure H.nil
 512 -}
 513
 514 {-
 515 -- Combinators interpreters for 'Sym.Any'.
 516 instance Applicable repr => Applicable (Sym.Any repr)
 517 instance Satisfiable repr => Satisfiable (Sym.Any repr)
 518 instance Alternable repr => Alternable (Sym.Any repr)
 519 instance Selectable repr => Selectable (Sym.Any repr)
 520 instance Matchable repr => Matchable (Sym.Any repr)
 521 instance Lookable repr => Lookable (Sym.Any repr)
 522 instance Foldable repr => Foldable (Sym.Any repr)
 523 -}