{-# OPTIONS -fglasgow-exts #-}

module Text.GRead.Transformations.GramTrafo where

import Language.TTTAS
import Text.GRead.Grammar

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

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

extendMap :: Symbol x 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 env s a 
         .   Symbol x 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 (Nont x) r)  = Seq (Nont (unT t x)) 
                                  (mapProd t r)
mapProd t (Seq (Term x) r)  = Seq (Term x) 
                                  (mapProd t r)