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

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