{- $Id: URA.hs,v 1.28.2.23 2009/02/20 18:00:02 orlov Exp $ -}
{- vim: set syntax=haskell expandtab tabstop=4: -}

module URA (
 Tab,
 tab, int, ura, sura
) where

import Prelude
import XSG
import PPT

------------------------------ DATA ------------------------------
type Tab = [(Subst, Exps)]

------------------------------ SHOW ------------------------------
instance MyShow (Subst, Exps) where
 myShow (cd, es) = (myShow cd)++" :=> "++(myShow es)

instance MyShow Tab where
 myShow tab = intersperseShow "\n\n" tab

instance MyShow [Exps] where
 myShow es = intersperseShow "\n\n" es

instance MyShow [Subst] where
 myShow tab = intersperseShow "\n\n" tab

------------------------------ TAB -------------------------------
tab :: Prog -> Exps -> Index -> Tab
tab prog arg idx = mapFst (simplifySubst arg) $ tabTree [([], tr)]
 where tr = ppt prog arg idx

tabTree :: [(Subst, Tree)] -> Tab
tabTree []                   = []
tabTree ((s, LEAF es   ):ps) = (s, es):(tabTree ps)
tabTree ((s, NODE _ brs):ps) = tabTree (ps++(mapFst (s`o`) brs))

mapFst :: (a -> b) -> [(a, c)] -> [(b, c)]
mapFst f = map (\(x, y) -> (f x, y))

simplifySubst :: Exps -> Subst -> Subst
simplifySubst cls = filter (\(v:->_) -> v `elem` (getVars cls))

------------------------------ INT -------------------------------
int :: Prog -> Exps -> Index -> [Exps]
int prog arg = map snd . tab prog arg

------------------------------ URA -------------------------------
ura :: Prog -> IOExps -> Index -> [Subst]
ura prog (arg, res) = map fst . tab (main:prog) (arg++res)
 where f:_   = prog
       vPs_x = fresh (funcArity f  ) W idx1
       vPs_y = fresh (funcCoarity f) W idx2
       vPs_f = fresh (funcCoarity f) L idx3
       main  = FUNC "$URA$" (vPs_x++vPs_y) [(
                [vPs_f:=(funcName f, v2e vPs_x)],
                zipWith (:=:) (v2e vPs_f) (v2e vPs_y),
                [C ("$NULL$", idx4) []] )]
       idx1:idx2:idx3:idx4:_ = newIdxs initIdx

------------------------------ SURA ------------------------------
sura :: Prog -> IOExps -> Index -> [Subst]
sura prog (argF, argG) = map fst . tab (main:prog) (argF++argG)
 where f:g:_ = prog
       vPs_x = fresh (funcArity f  ) W idx1
       vPs_y = fresh (funcArity g  ) W idx2
       vPs_f = fresh (funcCoarity f) L idx3
       vPs_g = fresh (funcCoarity g) L idx4
       main  = FUNC "$URA$" (vPs_x++vPs_y) [(
                [vPs_f:=(funcName f, v2e vPs_x),
                 vPs_g:=(funcName g, v2e vPs_y)],
                zipWith (:=:) (v2e vPs_f) (v2e vPs_g),
                [C ("$NULL$", idx5) []] )]
       idx1:idx2:idx3:idx4:idx5:_ = newIdxs initIdx