src/Symantic/Parser/Machine.hs

   1 {-# LANGUAGE TemplateHaskell #-}
   2 module Symantic.Parser.Machine
   3  ( module Symantic.Parser.Machine
   4  , module Symantic.Parser.Machine.Instructions
   5  , module Symantic.Parser.Machine.Dump
   6  , module Symantic.Parser.Machine.Eval
   7  , module Symantic.Parser.Machine.Input
   8  ) where
   9 import Symantic.Parser.Machine.Instructions
  10 import Symantic.Parser.Machine.Dump
  11 import Symantic.Parser.Machine.Eval
  12 import Data.Either (Either(..))
  13
  14 import Data.Function ((.))
  15 -- import Data.Char (Char)
  16 import Data.Ord (Ord)
  17 import Language.Haskell.TH (CodeQ)
  18 import Symantic.Parser.Machine.Input
  19 import Symantic.Parser.Grammar
  20 import Text.Show (Show)
  21 import qualified Language.Haskell.TH.Syntax as TH
  22
  23 type Parser inp =
  24   ObserveSharing TH.Name
  25                  (OptimizeComb TH.Name
  26                                (Machine inp))
  27
  28 machine :: forall inp repr a.
  29   Ord (InputToken inp) =>
  30   Show (InputToken inp) =>
  31   TH.Lift (InputToken inp) =>
  32   -- InputToken inp ~ Char =>
  33   Executable repr =>
  34   Readable repr (InputToken inp) =>
  35   Grammar (Machine inp) =>
  36   Parser inp a ->
  37   repr inp '[] ('Succ 'Zero) a
  38 machine = runMachine . optimizeComb . observeSharing
  39
  40 runParser :: forall inp a.
  41   Ord (InputToken inp) =>
  42   Show (InputToken inp) =>
  43   TH.Lift (InputToken inp) =>
  44   -- InputToken inp ~ Char =>
  45   Input inp =>
  46   Readable Eval (InputToken inp) =>
  47   Parser inp a ->
  48   CodeQ (inp -> Either (ParsingError inp) a)
  49 runParser p = [|| \input -> $$(eval [||input||] (machine p)) ||]