symantic-grammar/Language/Symantic/Grammar/Meta.hs

   1 {-# LANGUAGE DefaultSignatures #-}
   2 {-# LANGUAGE UndecidableInstances #-}
   3 module Language.Symantic.Grammar.Meta where
   4
   5 import Language.Symantic.Grammar.Source
   6
   7 -- * Type 'Gram_Reader'
   8 class Gram_Reader st g where
   9         askBefore :: g (st -> a) -> g a
  10         askAfter  :: g (st -> a) -> g a
  11
  12 -- * Type 'Gram_State'
  13 class Gram_State st g where
  14         stateBefore :: g (st -> (st, a)) -> g a
  15         stateAfter  :: g (st -> (st, a)) -> g a
  16         getBefore   :: g (st -> a) -> g a
  17         getAfter    :: g (st -> a) -> g a
  18         put         :: g (st, a) -> g a
  19         default getBefore :: Functor g => g (st -> a) -> g a
  20         default getAfter  :: Functor g => g (st -> a) -> g a
  21         default put       :: Functor g => g (st, a) -> g a
  22         getBefore g = stateBefore ((\f st -> (st, f st)) <$> g)
  23         getAfter  g = stateAfter ((\f st -> (st, f st)) <$> g)
  24         put       g = stateAfter ((\(st, a) -> const (st, a)) <$> g)
  25
  26 -- * Class 'Gram_Error'
  27 -- | Symantics for handling errors at the semantic level (not the syntaxic one).
  28 class Gram_Error err g where
  29         catch :: g (Either err a) -> g a
  30
  31 -- * Class 'Gram_Source'
  32 class
  33  ( Gram_Reader (Source_Input src) g
  34  , Inj_Source (Span (Source_Input src)) src
  35  ) => Gram_Source src g where
  36         source :: Functor g => g (src -> a) -> g a
  37         source g =
  38                 askAfter $ askBefore $
  39                  (\f (beg::Source_Input src) (end::Source_Input src) ->
  40                         f (inj_Source $ Span beg end::src))
  41                  <$> g
  42 instance
  43  ( Gram_Reader (Source_Input src) g
  44  , Inj_Source (Span (Source_Input src)) src
  45  ) => Gram_Source src g