{- $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