{-------------------------------------------------------------------------------------
-
- Preprocess abstract syntax trees, remove backward steps and optimize
- Programmer: Leonidas Fegaras
- Email: fegaras@cse.uta.edu
- Web: http://lambda.uta.edu/
- Creation: 05/01/08, last update: 06/30/08
- 
- Copyright (c) 2008 by Leonidas Fegaras, the University of Texas at Arlington. All rights reserved.
- This material is provided as is, with absolutely no warranty expressed or implied.
- Any use is at your own risk. Permission is hereby granted to use or copy this program
- for any purpose, provided the above notices are retained on all copies.
-
--------------------------------------------------------------------------------------}


module XML.HXQ.Optimizer(optimize) where

--import Debug.Trace
import System.IO.Unsafe
import Control.Monad
import Char(toLower)
import Database.HDBC
import HXML(AttList)
import XML.HXQ.Parser
import XML.HXQ.XTree
import XML.HXQ.DB
import XML.HXQ.DBConnect



paths = [ "current_step", "child_step", "descendant_step", "attribute_step", "attribute_descendant_step" ]


distinct :: Eq a => [a] -> [a]
distinct = foldl (\r a -> if elem a r then r else r++[a]) []


{-# NOINLINE publishXmlDoc #-}
-- get an XML document stored in a relational database
publishXmlDoc :: FilePath -> String -> Ast
publishXmlDoc filepath name
    = let query = unsafePerformIO (publishWrapper filepath name)
          [ast] = parse (scan query)
      in ast
    where publishWrapper filepath name
              = do let prefix = map toLower name
                   db <- connect filepath
                   table <- findSchema db prefix
                   let query = publishTable table
                   disconnect db
                   return query


-- collect attribute constructions inside element constructions
collect_attributes :: Ast -> (Ast,[Ast])
collect_attributes (Ast "attribute_construction" [attr,value])
    = (Ast "call" [Avar "empty"],[Ast "pair" [attr,value]])
collect_attributes (Ast "call" [Avar "concatenate",x,y])
    = let (cx,ax) = collect_attributes x
          (cy,ay) = collect_attributes y
      in (Ast "call" [Avar "concatenate",cx,cy],ax++ay)
collect_attributes (Ast "append" es)
    = let (s,a) = foldr (\e (r,ar) -> let (cx,ax) = collect_attributes e in (cx:r,ax++ar)) ([],[]) es
      in (Ast "append" s,a)
collect_attributes (Ast "step" (e:es))
    = let (ce,ae) = collect_attributes e
      in (Ast "step" (ce:es),ae)
collect_attributes e = (e,[])


-- does the expression contain a $var/.. ?
parentOfVar :: Ast -> String -> Bool
parentOfVar (Ast "step" [Ast "parent_step" [Ast "step" [Avar x]]]) var = x == var
parentOfVar (Ast "let" [Avar v,s,_]) var | var == v = parentOfVar s var
parentOfVar (Ast "for" [Avar v,Avar i,s,_]) var | var == v || var == i = parentOfVar s var
parentOfVar (Ast _ args) var = or (map (\x -> parentOfVar x var) args)
parentOfVar _ _ = False


-- replace $var/.. with $nvar
replaceParentOfVar :: Ast -> String -> String -> Ast
replaceParentOfVar (Ast "step" [Ast "parent_step" [Ast "step" [Avar x]]]) var nvar
    | x == var
    = Avar nvar
replaceParentOfVar (Ast "let" [Avar v,s,b]) var nvar | var == v
    = Ast "let" [Avar v,replaceParentOfVar s var nvar,b]
replaceParentOfVar (Ast "for" [Avar v,Avar i,s,b]) var nvar | var == v || var == i
    = Ast "for" [Avar v,Avar i,replaceParentOfVar s var nvar,b]
replaceParentOfVar (Ast f args) var nvar
    = Ast f (map (\x -> replaceParentOfVar x var nvar) args)
replaceParentOfVar e _ _ = e


-- Rules to extract the parent of an XQuery expression
-- For every XQuery x and predicates p1 ... pn and for s in [tag,*,@attr]:
--    x/s[p1]...[pn]/..   ->  x[s[p1]...[pn]]
--    x//s[p1]...[pn]/..  ->  x//*[s[p1]...[pn]]
removeParent :: Ast -> (Ast,Ast,Bool,Ast)
removeParent (Ast "predicate" [c,x])
         = let (nx,cond,childp,tag) = removeParent x
           in (Ast "predicate" [c,nx],cond,childp,tag)
removeParent (Ast "step" ((Ast "child_step" [tag,x]):preds))
    = (Ast "step" ((Ast "child_step" [tag,Avar "."]):preds),x,True,tag)
removeParent (Ast "step" ((Ast "descendant_step" [tag,x]):preds))
    = (Ast "step" ((Ast "child_step" [tag,Avar "."]):preds),
       Ast "step" [Ast "descendant_step" [Astring "*",x]],True,tag)
removeParent (Ast "step" ((Ast "attribute_step" [tag,x]):preds))
    = (Ast "step" ((Ast "attribute_step" [tag,Avar "."]):preds),x,False,tag)
removeParent (Ast "step" ((Ast "descendant_attribute_step" [tag,x]):preds))
    = (Ast "step" ((Ast "attribute_step" [tag,Avar "."]):preds),
       Ast "step" ((Ast "descendant_step" [Astring "*",x]):preds),False,tag)
removeParent (Ast "step" (x:xs))
         = let (nx,cond,childp,tag) = removeParent x
           in (Ast "step" (nx:xs),cond,childp,tag)
removeParent e = error ("Cannot remove this parent step "++(show e))


tagged_children :: String -> Ast -> [Tag]
tagged_children context (Ast "step" ((Ast "child_step" [Astring tag,Avar "."]):_))
    | context == "."
    = [tag]
tagged_children context (Ast "step" ((Ast "child_step" [Astring tag,Ast "step" ((Avar v):_)]):_))
    | v == context
    = [tag]
tagged_children _ (Ast "step" ((Ast "descendant_any" _):_)) = []
tagged_children _ (Ast "step" ((Ast step _):_))
    | elem step paths = []
tagged_children context (Ast _ xs) = concatMap (tagged_children context) xs
tagged_children _ _ = []


empty = Ast "call" [Avar "empty"]


simplify :: Ast -> Ast
-- must be done bottom-up:    /../..
simplify (Ast "step" [Ast "parent_step" [Ast "step" [Ast "parent_step" x]]])
    = let nx = simplify (Ast "step" [Ast "parent_step" x])
      in simplify (Ast "step" [Ast "parent_step" [nx]])
-- get rid of a parent step
simplify (Ast "step" [Ast "parent_step" [x]])
    = let (cond,nx,_,_) = removeParent x
      in Ast "predicate" [simplify cond,simplify nx]
-- remove $var/.. in a let-FLWOR
simplify (Ast "let" [Avar var,source,body])
    | parentOfVar body var
    = let (cond,nx,childp,tag) = removeParent source
      in simplify (Ast "let" [Avar (var++"_parent"),Ast "predicate" [cond,nx],
                              Ast "let" [Avar var,
                                         Ast "step" [ Ast (if childp
                                                           then "child_step"
                                                           else "attribute_step")
                                                      [tag,Avar (var++"_parent")] ],
                                         replaceParentOfVar body var (var++"_parent")]])
-- remove $var/.. from a for-FLWOR
simplify (Ast "for" [Avar var,Avar "$",source,body])
    | parentOfVar body var
    = let (cond,nx,childp,tag) = removeParent source
      in simplify (Ast "for" [Avar (var++"_parent"),Avar "$",Ast "predicate" [cond,nx],
                              Ast "for" [Avar var,Avar "$",
                                         Ast "step" [ Ast (if childp
                                                           then "child_step"
                                                           else "attribute_step")
                                                      [tag,Avar (var++"_parent")] ],
                                         replaceParentOfVar body var (var++"_parent")]])
-- pull out attributes from a general element construction
simplify (Ast "element_construction" [tag,Ast "attributes" as,content])
    = let (nc,attrs) = collect_attributes content
      in simplify (Ast "construction" [tag,Ast "attributes" (as++attrs),nc])
-- if //* collect all children tagnames to use descendant_any_with_tagged_children
simplify (Ast "for" [Avar var,i,Ast "step" [Ast "step" ((Ast "descendant_step" [Astring "*",path]):preds)],body])
    | not (null ((tagged_children var body))) || any (not . null . (tagged_children ".")) preds
    = let ctags = distinct ((tagged_children var body)++(concatMap (tagged_children ".") preds))
          tags = map Avar ctags
      in simplify (Ast "for" [Avar var,i,Ast "step" [Ast "step" ((Ast "descendant_any" (path:tags)):preds)],body])
simplify (Ast "step" ((Ast "child_step" [Astring tag,Ast "step" ((Ast "descendant_step" [Astring "*",path]):preds)]):preds2))
    = let ctags = distinct(tag:(concatMap (tagged_children ".") preds))
          tags = map Avar ctags
      in simplify (Ast "step" ((Ast "child_step" [Astring tag,Ast "step" ((Ast "descendant_any" (path:tags)):preds)]):preds2))
simplify (Ast "step" ((Ast "descendant_step" [Astring "*",path]):preds))
    | any (not . null . (tagged_children ".")) preds
    = let ctags = distinct (concatMap (tagged_children ".") preds)
          tags = map Avar ctags
      in simplify (Ast "step" ((Ast "descendant_any" (path:tags)):preds))
-- expand the wrapper of a stored document
simplify (Ast "call" [Avar "publish",Astring dbpath,Astring name])
    = simplify (publishXmlDoc dbpath name)
-- default
simplify (Ast n args) = Ast n (map simplify args)
simplify e = e


taggedElement :: [Ast] -> String -> Maybe [Ast]
taggedElement (e@(Ast "construction" [Astring ctag,_,x]):xs) tag
    | ctag == tag || tag == "*"
    = case taggedElement xs tag of
        Nothing -> Nothing
        Just s -> Just (e:s)
taggedElement ((Ast "construction" [_,_,_]):xs) tag
    = taggedElement xs tag
taggedElement ((Ast "call" [Avar "concatenate",x,y]):xs) tag
    = case (taggedElement (x:xs) tag,taggedElement (y:xs) tag) of
        (Just tx,Just ty) -> Just (tx++ty)
        _ -> Nothing
taggedElement ((Astring _):xs) tag
    = taggedElement xs tag
taggedElement ((Aint _):xs) tag
    = taggedElement xs tag
taggedElement (e:xs) tag = Nothing
taggedElement [] _ = Just []


findAttr :: String -> [Ast] -> Ast
findAttr tag ((Ast "pair" [Astring a,v]):_) | a==tag || tag=="*" = v
findAttr tag (_:xs) = findAttr tag xs
findAttr _ [] = empty


andAll :: [Ast] -> Ast
andAll [x] = x
andAll (x:xs) = foldl (\a r -> call "and" [a,r]) x xs


occursContext :: Ast -> Int
occursContext e
    = case e of
        Avar "." -> 1
        Ast "let" _ -> 0
        Ast "for" _ -> 0
        Ast "call" [Avar "SQL",s,f,w]
            -> occursContext w
        Ast "descendant_any" (x:tags)
            -> occursContext x
        Ast step [tag,x]
            | elem step paths
            -> occursContext x
        Ast n xs -> sum (map occursContext xs)
        _ -> 0


substContext :: Ast -> Ast -> Ast
substContext e b
    = case b of
        Avar "." -> e
        Ast "let" _ -> b
        Ast "for" _ -> b
        Ast "call" [Avar "SQL",s,f,w]
            -> Ast "call" [Avar "SQL",s,f,substContext e w]
        Ast "descendant_any" (x:tags)
            -> Ast "descendant_any" ((substContext e x):tags)
        Ast step [tag,x]
            | elem step paths
            -> Ast step [tag,substContext e x]
        Ast n xs -> Ast n (map (substContext e) xs)
        _ -> b


occurs :: String -> Ast -> Int
occurs v e
    = case e of
        Avar w | v==w -> 1
        Ast "let" [Avar w,_,_] | v==w -> 0
        Ast "for" [Avar w,Avar i,_,_] | v==w || v==i -> 0
        Ast "call" [Avar "SQL",s,f,w]
            -> occurs v w
        Ast n xs -> sum (map (occurs v) xs)
        _ -> 0


subst :: String -> Ast -> Ast -> Ast
subst v e b
    = case b of
        Avar w | v==w -> e
        Ast "let" [Avar w,_,_] | v==w -> b
        Ast "for" [Avar w,Avar i,_,_] | v==w || v==i -> b
        Ast "call" [Avar "SQL",s,f,w]
            -> Ast "call" [Avar "SQL",s,f,subst v e w]
        Ast n xs -> Ast n (map (subst v e) xs)
        _ -> b


dependsOnPosition :: Bool -> Ast -> Bool
dependsOnPosition contextp e
    = case e of
        Avar "." -> contextp
        Ast "call" [Avar "position"] -> True
        Ast "call" [Avar "last"] -> True
        Ast "call" ((Avar "step"):x:_)
            -> dependsOnPosition contextp x
        Ast _ xs -> any (dependsOnPosition contextp) xs
        _ -> False


wellFormedPredicate :: Bool -> Ast -> Bool
wellFormedPredicate contextp e
    = case e of
        Ast "call" ((Avar "step"):x:_)
            -> not (dependsOnPosition contextp x)
        Ast step xs
            | elem step paths || step == "descendant_any"
            -> not (any (dependsOnPosition contextp) xs)
        Ast "construction" xs
            -> not (any (dependsOnPosition contextp) xs)
        Ast "call" [Avar "not",x]
            -> not (dependsOnPosition contextp x)
        Ast "call" [Avar cmp,x,y]
            | any (\(f,_) -> f==cmp) (sqlComparisson++sqlBoolean)
            -> not (dependsOnPosition contextp x)
               && not (dependsOnPosition contextp y)
        _ -> False


splitSqlPredicate :: [String] -> Ast -> Maybe(Ast,Ast)
splitSqlPredicate tables (Ast "call" [Avar "and",p1,p2])
    = case (splitSqlPredicate tables p1,splitSqlPredicate tables p2) of
        (Nothing,Nothing) -> Nothing
        (Nothing,Just(pp1,pp2)) -> Just(pp1,Ast "call" [Avar "and",p1,pp2])
        (Just(pp1,pp2),Nothing) -> Just(pp1,Ast "call" [Avar "and",p2,pp2])
splitSqlPredicate tables pred
    | sqlPredicate tables pred
    = Just(pred,Ast "call" [Avar "true"])
splitSqlPredicate tables pred = Nothing


-- Normalization
normalize :: Ast -> Bool -> Int -> (Ast,Bool,Int)
normalize exp changed count
    = case exp of
        Ast "step" [x]
            -> normalize x True count
        Ast "step" (x:(Ast "call" [Avar "true"]):xs)
            -> norm (Ast "step" (x:xs))
        Ast "step" (x:(Ast "call" [Avar "false"]):xs)
            -> (empty,True,count)
        Ast "for" [v,i,Ast "call" [Avar "empty"],b]
            -> (empty,True,count)
        Ast "for" [v,i,s,Ast "call" [Avar "empty"]]
            -> (empty,True,count)
        Ast "descendant_any" ((Astring _):_)
            -> (empty,True,count)
        Ast "descendant_any" ((Aint _):_)
            -> (empty,True,count)
        Ast "descendant_any" ((Afloat _):_)
            -> (empty,True,count)
        Ast "descendant_any" ((Ast "call" [Avar "text",_]):_)
            -> (empty,True,count)
        Ast "descendant_any" ((Ast "call" [Avar "empty"]):_)
            -> (empty,True,count)
        Ast step [_,Astring _]
            | elem step paths
            -> (empty,True,count)
        Ast step [_,Aint _]
            | elem step paths
            -> (empty,True,count)
        Ast step [_,Afloat _]
            | elem step paths
            -> (empty,True,count)
        Ast step [_,Ast "call" [Avar "text",_]]
            | elem step paths
            -> (empty,True,count)
        Ast step [_,Ast "call" [Avar "empty"]]
            | elem step paths
            -> (empty,True,count)
        Ast "call" [Avar "and",Ast "call" [Avar "true"],x]
            -> norm x
        Ast "call" [Avar "and",x,Ast "call" [Avar "true"]]
            -> norm x
        -- (x,())  ->  x
        Ast "call" [Avar "concatenate",x,Ast "call" [Avar "empty"]]
            -> norm x
        -- ((),x)  ->  x
        Ast "call" [Avar "concatenate",Ast "call" [Avar "empty"],x]
            -> norm x
        -- for $v1 in (for $v2 in s2 return b2) return b1  -->  for $v2 in s2, for $v1 in b2 return b1
        Ast "for" [v1,i1,Ast "for" [v2,i2,s2,b2],b1]
            -> norm (Ast "for" [v2,i2,s2,Ast "for" [v1,i1,b2,b1]])
        -- (for $v in s return b)/tag  -->  for $v in s return b/tag  -->  
        Ast "descendant_any" ((Ast "for" [v,i,s,b]):tags)
            -> norm (Ast "for" [v,i,s,Ast "descendant_any" (b:tags)])
        Ast step [tag,Ast "for" [v,i,s,b]]
            | elem step paths
            -> norm (Ast "for" [v,i,s,Ast step [tag,b]])
        -- (x,y)/tag  -->  (x/tag,y/tag)
        Ast "descendant_any" ((Ast "call" [Avar "concatenate",x,y]):tags)
            -> norm (Ast "call" [Avar "concatenate",Ast "descendant_any" (x:tags),Ast "descendant_any" (y:tags)])
        Ast step [tag,Ast "call" [Avar "concatenate",x,y]]
            | elem step paths
            -> norm (Ast "call" [Avar "concatenate",Ast step [tag,x],Ast step [tag,y]])
        -- for $v in (x,y) return b  -->  (for $v in x return b,for $v in y return b)
        Ast "for" [v,i@(Avar "$"),Ast "call" [Avar "concatenate",x,y],b]
            -> norm (Ast "call" [Avar "concatenate",Ast "for" [v,i,x,b],Ast "for" [v,i,y,b]])
        -- for $v in <a>...</a> return b  -->  b[$v/(<a>...</a>)]
        Ast "for" [Avar v,Avar i,e,b]
            | case e of Ast "construction" _ -> True; Ast _ _ -> False; _ -> True
            -> norm (if i == "$"
                     then subst v e b
                     else subst v e (subst i (Aint 1) b))
        --Ast "for" [Avar v,Avar i,Ast "predicate" [pred,e],b]
        --    -> norm (Ast "for" [Avar v,Avar i,e,Ast "predicate" [pred,b]])
        Ast "for" [Avar v,Avar i,Ast "predicate" [pred,e],b]
            | occurs v pred == 0 && occurs i pred == 0 && occursContext pred == 0
            -> norm (Ast "predicate" [pred,Ast "for" [Avar v,Avar i,e,b]])
        -- unfold linear let
        Ast "let" [Avar v,e,b]
            | occurs v b < 2
            -> norm (subst v e b)
        -- (if c then t else e)/A  -->  if c then t/A else e/A
        Ast "descendant_any" ((Ast "predicate" [c,e]):tags)
            | wellFormedPredicate True c
            -> norm (Ast "predicate" [c,Ast "descendant_any" (e:tags)])
        Ast step [tag,Ast "predicate" [c,e]]
            | elem step paths && wellFormedPredicate True c
            -> norm (Ast "predicate" [c,Ast step [tag,e]])
        -- if p doesn't depend on context:  (e[p])/A  -->  (e/A)[p]
        Ast "descendant_any" ((Ast "step" (x:xs@(_:_))):tags)
            | all (wellFormedPredicate True) xs
            -> norm (Ast "step" ((Ast "descendant_any" (x:tags)):xs))
        Ast step [tag,Ast "step" (x:xs@(_:_))]
            | elem step paths && all (wellFormedPredicate True) xs
            -> norm (Ast "step" ((Ast step [tag,x]):xs))
        -- normalize predicate
        Ast "predicate" [pred,x]
            | occursContext pred > 0
            -> let v = "x"++show count
               in normalize (Ast "for" [Avar v,Avar "$",x,Ast "predicate" [substContext (Avar v) pred,Avar v]]) True (count+1)
        Ast "step" [x,pred]
            | occursContext pred > 0
            -> let v = "x"++show count
               in normalize (Ast "for" [Avar v,Avar "$",x,Ast "predicate" [substContext (Avar v) pred,Avar v]]) True (count+1)
        Ast "predicate" [p1,Ast "predicate" [p2,e]]
            -> norm (Ast "predicate" [Ast "call" [Avar "and",p1,p2],e])
        Ast "predicate" [Ast "call"[Avar "false"],x]
            -> (empty,True,count)
        Ast "predicate" [Ast "call"[Avar "true"],x]
            -> (x,True,count)
        Ast "predicate" [x,Ast "call"[Avar "empty"]]
            -> (empty,True,count)
        Ast "step" ((Ast "call" [Avar "empty"]):xs)
            -> (empty,True,count)
        -- promote well-formed predicates; but note:  (x,y)[1] <> (x[1],y[1])
        Ast "step" ((Ast "call" [Avar "concatenate",x,y]):xs)
            | all (wellFormedPredicate False) xs
            -> norm (Ast "call" [Avar "concatenate",Ast "step" (x:xs),Ast "step" (y:xs)])
        Ast "predicate" [pred,Ast "for" [v,i,s,b]]
            | wellFormedPredicate False pred
            -> norm (Ast "for" [v,i,s,Ast "predicate" [pred,b]])
        Ast "step" ((Ast "for" [v,i,s,b]):xs)
            | all (wellFormedPredicate False) xs
            -> norm (Ast "for" [v,i,s,Ast "predicate" [andAll xs,b]])
        Ast "step" (e@(Ast "construction" [_,_,_]):xs)
            -> if sum (map occursContext xs) > 0
               then norm (Ast "predicate" [andAll (map (substContext e) xs),e])
               else let (r,b,c) = foldr (\a (r,b,c) -> let (x,s,i) = normalize a b c in (x:r,s,i))
                                        ([],changed,count) (e:xs)
                    in (Ast "step" r,b,c)
        Ast "call" [Avar "=",x,y]
            | x == empty || y == empty
            -> (Ast "call"[Avar "true"],True,count)
        -- (<ctag>...<tag>...</tag>...</ctag>)/tag  -->  ...<tag>...</tag>...
        Ast "child_step" [Astring tag,Ast "construction" [_,_,Ast "append" x]]
            | taggedElement x tag /= Nothing
            -> case taggedElement x tag of
                 Just [] -> (empty,True,count)
                 Just s -> norm (concatenateAll s)
        Ast "child_step" [Astring tag,Ast "construction" [_,_,Ast "append" x]]
            -> norm (Ast "current_step" [Astring tag,concatenateAll x])
        Ast "current_step" [Astring tag1,e@(Ast "construction" [Astring tag2,_,Ast "append" x])]
            -> if tag1 == tag2 || tag1 == "*"
               then norm e
               else (empty,True,count)
        -- (<tag>x</tag>)//tag  --> (x,x//tag)
        Ast "descendant_any" (z@(Ast "construction" [Astring ctag,_,Ast "append" x]):tags)
            -> norm (Ast "call" [Avar "concatenate",z,Ast "descendant_any" ((concatenateAll x):tags)])
        Ast "descendant_step" [Astring tag,z@(Ast "construction" [Astring ctag,_,Ast "append" x])]
            -> norm (if tag == ctag || tag == "*"
                     then Ast "call" [Avar "concatenate",z,Ast "descendant_step" [Astring tag,concatenateAll x]]
                     else Ast "descendant_step" [Astring tag,concatenateAll x])
        -- (<tag A=s>x</tag>)/@A  --> s
        Ast "attribute_step" [Astring tag,Ast "construction" [ctag,Ast "attributes" as,x]]
            -> (findAttr tag as,True,count)
        -- (<tag A=s>x</tag>)//@A  --> (s,x//@A)
        Ast "attribute_descendant_step" [Astring tag,Ast "construction" [ctag,Ast "attributes" as,Ast "append" x]]
            -> norm (Ast "call" [Avar "concatenate",findAttr tag as,
                                 Ast "attribute_descendant_step" [Astring tag,concatenateAll x]])
        -- SQL folding
        Ast "for" [Avar v1,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s1),Ast "call" ((Avar "from"):f1),pred1],
                   Ast "for" [Avar v2,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s2),Ast "call" ((Avar "from"):f2),pred2],b]]
            | occurs v1 b == 0
            -> norm (Ast "for" [Avar v2,Avar "$",
                                Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):(s1++s2)),
                                            Ast "call" ((Avar "from"):(f1++f2)),Ast "call" [Avar "and",pred1,pred2]],
                                b])
        Ast "for" [Avar v,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s),Ast "call" ((Avar "from"):tables),pred1],
                   Ast "predicate" [pred2,x]]
            | splitSqlPredicate [ v | Avar v <- tables ] pred2 /= Nothing
            -> let Just(pred3,pred4) = splitSqlPredicate [ v | Avar v <- tables ] pred2
               in norm (Ast "for" [Avar v,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s),
                                                               Ast "call" ((Avar "from"):tables),Ast "call" [Avar "and",pred1,pred3]],
                                   Ast "predicate" [pred4,x]])
        Ast "for" [Avar v1,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s1),Ast "call" ((Avar "from"):f1),pred1],
                   Ast "for" [Avar v2,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s2),Ast "call" ((Avar "from"):f2),pred2],
                              Ast "predicate" [predd,b]]]
            | occurs v1 b == 0 && splitSqlPredicate [ v | Avar v <- f1 ] predd /= Nothing
            -> let Just(pred3,pred4) = splitSqlPredicate [ v | Avar v <- f1 ] predd
               in norm (Ast "for" [Avar v1,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s1),
                                                                Ast "call" ((Avar "from"):f1),Ast "call" [Avar "and",pred1,pred3]],
                                   Ast "for" [Avar v2,Avar "$",Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):s2),Ast "call" ((Avar "from"):f2),pred2],
                                              Ast "predicate" [pred4,b]]])
        -- default
        Ast n args
            -> let (r,b,c) = foldr (\a (r,b,c) -> let (x,s,i) = normalize a b c in (x:r,s,i))
                                   ([],changed,count) args
               in (Ast n r,b,c)
        _ -> (exp,changed,count)
    where norm e = normalize e True count
          --tnorm e = trace ("*** "++show exp++"\n--> "++ppAst e) (normalize e True count)


foldSQL :: Ast -> Ast
foldSQL e
    = case e of
        Ast "call" [Avar "SQL",Ast "call" ((Avar "select"):cols),Ast "call" ((Avar "from"):tables),pred]
            -> let (sql,args) = makeSQL tables pred cols
               in Ast "call" [Avar "sql",Astring sql,concatenateAll args]
        Ast n args -> Ast n (map foldSQL args)
        _ -> e


optimizeLoop :: Ast -> Int -> (Ast,Int)
optimizeLoop e c = let (ne,b,c') = normalize e False c
                   in if b
                      then optimizeLoop ne c'
                      else (ne,c)


optimize :: Ast -> Ast
optimize e = foldSQL (fst (optimizeLoop (simplify e) 0))