module SSA(compileNodes) where

-- Combines recursive terms with memoization of Term (==) to recover
-- node sharing and explicitly name each node (static single
-- assignment).

import Term
import Shared

-- Combine the cached (==) used in extendShared with the recursive
-- Term type to produce a list of representative terms and an
-- environment of unique nodes.

type Env a = Shared (Term a)
envFold :: (Eq a) => [Term a] -> Env a -> ([Term a], Env a)
envFold = f [] where
    f rs [] d = (reverse rs, d)
    f rs (t:ts) d =
        case t of
          Op rator rands -> 
              let (rands',d') = f [] rands d   -- recurse on operands
                  t' = Op rator rands'         -- transform term
                  (t'',d'') = extendShared t' d'  -- extend env w. txd term
              in f (t'' : rs) ts d''
          _ -> f (t:rs) ts d


-- Convert list of nodes into flattened and named dictionary.
compileNodes outNames tmpNames ts = nodes where
    (ts', env) = envFold ts nullShared
    nodes = nameNodes outNames tmpNames ts' env

-- Create a list of named nodes from Shared, using: foldShared + nameShared
nameNodes outNames tmpNames ts env = ((map refOp ts), (reverse locals))
    where
      ref = nameShared (zip ts outNames) tmpNames env

      -- Substitute Op terms with register names; leave other.
      refOp t@(Op _ _) = ref t
      refOp t = t

      locals = foldShared (\t@(Op c as) locs ->
                            (ref t, Op c $ map refOp as) : locs)
               [] env