{-# LANGUAGE StandaloneDeriving #-}


-- UUAGC 0.9.52.1 (src/GLL/Types/Abstract.ag)
module GLL.Types.Grammar where

import Data.Text

-- | Identifier for nonterminals.
type Nt  = Text 
-- Prod ---------------------------------------------------------

-- | 
-- A production binds a nonterminal identifier (left-hand side) to a list of symbols 
--(the right-hand side of the production).
data Prod t = Prod (Nt) (Symbols t)
-- Prods --------------------------------------------------------
-- | A list of 'Prod's.
type Prods t = [Prod t]
-- Grammar -----------------------------------------------------
-- |
-- A grammar is a start symbol and a list of productions. 
type Grammar t = (Nt, Prods t)
-- Slot --------------------------------------------------------
-- | 
-- A grammar slot acts as a label to identify progress of matching a production.
-- As such, a slot is a "Prod" with its right-hand side split in two: 
-- a part before and a part after 'the dot'.
-- The dot indicates which part of the right-hand side has been processed thus far.
data Slot t = Slot (Nt) (([Symbol t])) (([Symbol t]))
-- Symbol ------------------------------------------------------

-- | 
-- A 'Symbol' is either a nonterminal or a terminal,
-- where a terminal contains some arbitrary token.
data Symbol t   = Nt Nt
                | Term t
--                | Error (Token) (Token)
-- Symbols -----------------------------------------------------

-- | 
-- A list of 'Symbol's
type Symbols t = [Symbol t]
-- Token -------------------------------------------------------

-- |
-- A datatype for representing tokens with some builtins 
-- and an aribitrary Token constructor.
-- This datatype stores (optional) lexemes.
data Token = Char       Char
           | Keyword    String
           | EOS
           | Epsilon
           | IntLit     (Maybe Int)
           | FloatLit   (Maybe Double)
           | BoolLit    (Maybe Bool)
           | StringLit  (Maybe String)
           | CharLit    (Maybe Char)
           | IDLit      (Maybe String)
           -- | alternative identifiers, for example functions vs. constructors (as in Haskell).
           | AltIDLit   (Maybe String) 
           | Token String (Maybe String)
-- Tokens ------------------------------------------------------
-- | 
-- A list of 'Token's
type Tokens = [Token]

-- | Class that captures elements of an input string (tokens).
-- 
-- * 'eos' is the end-of-string symbol  
-- * 'eps' is the empty-string symbol
--
-- Both 'eos' and 'eps' must be distinct from eachother and from all 
-- tokens in the input string.
-- The show instance is required to throw error messages.
class (Ord a, Eq a, Show a) => Parseable a where
    eos :: a
    eps :: a 

    -- | This function is used for matching grammar tokens and input tokens.
    -- Override this method if, for example, your input tokens store lexemes
    -- while the grammar tokens do not
    matches :: a -> a -> Bool

    -- | This function pretty-prints the Parseable type by displaying its lexeme.
    -- Default implementation is 'show', which should be replaced for prettier error messages.
    unlex :: a -> String
    unlex = forall a. Show a => a -> String
show

-- | Class whose members are super-types of 'Token'.
class SubsumesToken a where
    upcast :: Token -> a
    downcast :: a -> Maybe Token

instance SubsumesToken Token where
    upcast :: Token -> Token
upcast = forall a. a -> a
id
    downcast :: Token -> Maybe Token
downcast = forall a. a -> Maybe a
Just

deriving instance Ord Token
deriving instance Eq Token

instance Show Token where
    show :: Token -> String
show (Char Char
c)             = String
"keychar('" forall a. [a] -> [a] -> [a]
++ [Char
c] forall a. [a] -> [a] -> [a]
++ String
"')"
    show (Keyword String
s)          = String
"keyword(\"" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"\")"
    show (Token
EOS)                = String
"<end-of-string>"
    show (Token
Epsilon)            = String
"<epsilon>"
    show (IntLit (Just Int
i))    = String
"int(" forall a. [a] -> [a] -> [a]
++  forall a. Show a => a -> String
show Int
i forall a. [a] -> [a] -> [a]
++ String
")"
    show (IntLit Maybe Int
_)           = String
"<int>"
    show (FloatLit (Just Double
i))  = String
"float(" forall a. [a] -> [a] -> [a]
++  forall a. Show a => a -> String
show Double
i forall a. [a] -> [a] -> [a]
++ String
")"
    show (FloatLit Maybe Double
_)         = String
"<float>"
    show (BoolLit (Just Bool
b))   = String
"bool(" forall a. [a] -> [a] -> [a]
++  forall a. Show a => a -> String
show Bool
b forall a. [a] -> [a] -> [a]
++ String
")"
    show (BoolLit Maybe Bool
_)          = String
"<bool>"
    show (StringLit (Just String
s)) = String
"string(\"" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"\")"
    show (StringLit Maybe String
_)        = String
"<string>"
    show (CharLit (Just Char
c))   = String
"char('" forall a. [a] -> [a] -> [a]
++ [Char
c] forall a. [a] -> [a] -> [a]
++ String
"')"
    show (CharLit Maybe Char
Nothing)    = String
"<char>"
    show (AltIDLit (Just String
id)) = String
"altid(\"" forall a. [a] -> [a] -> [a]
++ String
id forall a. [a] -> [a] -> [a]
++ String
"\")"
    show (AltIDLit Maybe String
Nothing)   = String
"<altid>"
    show (IDLit  (Just String
id))   = String
"id(\"" forall a. [a] -> [a] -> [a]
++ String
id forall a. [a] -> [a] -> [a]
++ String
"\")"
    show (IDLit Maybe String
Nothing)      = String
"<id>"
    show (Token String
nm (Just String
s))  = String
nm forall a. [a] -> [a] -> [a]
++ String
"(\"" forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"\")"
    show (Token String
nm Maybe String
_)         = String
"<" forall a. [a] -> [a] -> [a]
++ String
nm forall a. [a] -> [a] -> [a]
++ String
">"
    
instance Parseable Token where
    eos :: Token
eos = Token
EOS
    eps :: Token
eps = Token
Epsilon

    unlex :: Token -> String
unlex = Token -> String
unlexToken

    Token String
k Maybe String
_   matches :: Token -> Token -> Bool
`matches` Token String
k' Maybe String
_   = String
k' forall a. Eq a => a -> a -> Bool
== String
k
    Char Char
c      `matches` Char Char
c'      = Char
c' forall a. Eq a => a -> a -> Bool
== Char
c
    Keyword String
k   `matches` Keyword String
k'   = String
k' forall a. Eq a => a -> a -> Bool
== String
k
    Token
EOS         `matches` Token
EOS          = Bool
True
    Token
Epsilon     `matches` Token
Epsilon      = Bool
True
    StringLit Maybe String
_ `matches` StringLit Maybe String
_  = Bool
True
    CharLit Maybe Char
_   `matches` CharLit Maybe Char
_    = Bool
True
    IntLit Maybe Int
_    `matches` IntLit Maybe Int
_     = Bool
True
    FloatLit Maybe Double
_  `matches` FloatLit Maybe Double
_   = Bool
True
    BoolLit Maybe Bool
_   `matches` BoolLit Maybe Bool
_    = Bool
True
    AltIDLit Maybe String
_  `matches` AltIDLit Maybe String
_   = Bool
True
    IDLit Maybe String
_     `matches` IDLit Maybe String
_      = Bool
True
    Token
_           `matches` Token
_            = Bool
False


-- | Pretty-prints a list of 'Token's as a concatenation of their lexemes.
unlexTokens :: [Token] -> String
unlexTokens :: [Token] -> String
unlexTokens = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
Prelude.concatMap Token -> String
unlexToken 

unlexToken :: Token -> String
unlexToken :: Token -> String
unlexToken Token
t = case Token
t of 
          Char Char
c              -> [Char
c]
          Keyword String
s           -> String
s
          IntLit (Just Int
i)     -> forall a. Show a => a -> String
show Int
i
          BoolLit (Just Bool
b)    -> forall a. Show a => a -> String
show Bool
b
          StringLit (Just String
s)  -> String
s
          CharLit (Just Char
c)    -> [Char
c]
          AltIDLit (Just String
s)   -> String
s
          IDLit (Just String
s)      -> String
s
          Token String
_ (Just String
s)    -> String
s
          Token
_                   -> String
""

-- some helpers

isNt :: Symbol t -> Bool
isNt (Nt Nt
_) = Bool
True
isNt Symbol t
_      = Bool
False

isTerm :: Symbol t -> Bool
isTerm (Term t
_) = Bool
True
isTerm Symbol t
_        = Bool
False

instance (Show t) => Show (Slot t) where
    show :: Slot t -> String
show (Slot Nt
x [Symbol t]
alpha [Symbol t]
beta) = forall a. Show a => a -> String
show Nt
x forall a. [a] -> [a] -> [a]
++ String
" ::= " forall a. [a] -> [a] -> [a]
++ forall {a}. Show a => [Symbol a] -> String
showRhs [Symbol t]
alpha forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ forall {a}. Show a => [Symbol a] -> String
showRhs [Symbol t]
beta    
     where  showRhs :: [Symbol a] -> String
showRhs [] = String
""
            showRhs ((Term a
t):[Symbol a]
rhs) = forall a. Show a => a -> String
show a
t forall a. [a] -> [a] -> [a]
++ [Symbol a] -> String
showRhs [Symbol a]
rhs
            showRhs ((Nt Nt
x):[Symbol a]
rhs)   = forall a. Show a => a -> String
show Nt
x forall a. [a] -> [a] -> [a]
++ [Symbol a] -> String
showRhs [Symbol a]
rhs

instance (Show t) => Show (Symbol t) where
    show :: Symbol t -> String
show (Nt Nt
s)         = Nt -> String
unpack Nt
s
    show (Term t
t)       = forall a. Show a => a -> String
show t
t

deriving instance (Ord t) => Ord (Slot t)
deriving instance (Eq t) => Eq (Slot t)
deriving instance (Show t) => Show (Prod t)
deriving instance (Ord t) => Ord (Prod t)
deriving instance (Eq t) => Eq (Prod t)
deriving instance (Eq t) => Eq (Symbol t)
deriving instance (Ord t) => Ord (Symbol t)