{-# OPTIONS -fglasgow-exts #-}

module Language.Grammars.Transformations.GramTrafo where

import Language.AbstractSyntax.TTTAS
import Language.Grammars.Grammar

newtype MapA_X env a env'
  = MapA_X (forall x t. Symbol x t env -> Maybe (Ref (x -> a) env'))

emptyMap :: MapA_X env a env'
emptyMap  = MapA_X (const Nothing)

extendMap :: Symbol x t env -> MapA_X env a env'
          -> MapA_X env a (env',x->a)
extendMap  x (MapA_X m) 
       = MapA_X  (\s -> case matchSym s x of
                                     Just Eq -> Just Zero
                                     Nothing -> fmap Suc (m s)
                      )


type GramTrafo env a = Trafo (MapA_X env a) Productions


initMap :: GramTrafo env a s c d
        -> Trafo Unit Productions s c d
initMap (Trafo st) 
        = Trafo (\_ -> case st emptyMap of
                            TrafoE _ f -> TrafoE Unit f
                )

newNontR ::  forall x t env s a 
         .   Symbol x t env 
         ->  GramTrafo env a s (Productions (x->a) s) (Ref (x->a) s)
newNontR x = Trafo $ \m -> extEnv (extendMap x m)


newtype Mapping old new 
           = Mapping (Env Ref new old) 

map2trans :: Mapping env s -> T env s
map2trans (Mapping env) 
     = T (\r -> (lookupEnv r env))

mapProd  :: T env1 env2 -> Prod a env1 -> Prod a env2
mapProd _ (End x)            = End x
mapProd t (Seq (Term x) r)   = Seq  (Term x) 
                                    (mapProd t r)

mapProd t (Seq (Nont x) r)   = Seq (Nont (unT t x)) 
                                   (mapProd t r)
mapProd t (Seq NontInt r)    = Seq NontInt 
                                   (mapProd t r)
mapProd t (Seq NontChar r)   = Seq NontChar 
                                   (mapProd t r)
mapProd t (Seq NontVarid r)  = Seq NontVarid 
                                   (mapProd t r)
mapProd t (Seq NontConid r)  = Seq NontConid 
                                   (mapProd t r)
mapProd t (Seq NontOp r)     = Seq NontOp 
                                   (mapProd t r)