{-
 - Copyright (c) 2009, ERICSSON AB All rights reserved.
 - 
 - Redistribution and use in source and binary forms, with or without
 - modification, are permitted provided that the following conditions
 - are met:
 - 
 -     * Redistributions of source code must retain the above copyright
 -     notice,
 -       this list of conditions and the following disclaimer.
 -     * Redistributions in binary form must reproduce the above copyright
 -       notice, this list of conditions and the following disclaimer
 -       in the documentation and/or other materials provided with the
 -       distribution.
 -     * Neither the name of the ERICSSON AB nor the names of its
 -     contributors
 -       may be used to endorse or promote products derived from this
 -       software without specific prior written permission.
 - 
 - THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 - "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 - LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 - A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 - HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 - SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 - LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 - DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 - THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 - (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 - OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 -}

module Feldspar.Compiler.Optimization.Replace where

import Feldspar.Compiler.Imperative.Representation

--This class for the replace of a variable to an other variable, an expression or a leftvalue in any datatypes.
class Replace a where
    replaceVar :: a -> (String,String) -> a
    replaceUExpr :: a -> (String,UntypedExpression) -> a
    replaceLExpr :: a -> (String,LeftValue) -> a

instance Replace ImpLangExpr where
    replaceVar (Expr exprCore exprType) re = Expr (replaceVar exprCore re) exprType
    replaceUExpr (Expr exprCore exprType) re = Expr (replaceUExpr exprCore re) exprType
    replaceLExpr (Expr exprCore exprType) re = Expr (replaceLExpr exprCore re) exprType

instance Replace Variable where
    replaceVar (Var s k t) (s0,s1)
        | s == s0   = (Var s1 k t)
        | otherwise = (Var s k t)
    replaceUExpr v _ = v
    replaceLExpr v _ = v

instance Replace LeftValue where
    replaceVar (LVar v) re = LVar (replaceVar v re)
    replaceVar (ArrayElem lv i) re = ArrayElem (replaceVar lv re) (replaceVar i re)
    replaceVar (PointedVal lv) re = PointedVal (replaceVar lv re)
    replaceUExpr (LVar v) re = LVar v
    replaceUExpr (ArrayElem lv i) re = ArrayElem lv (replaceUExpr i re)
    replaceUExpr (PointedVal lv) re = PointedVal (replaceUExpr lv re)
    replaceLExpr (LVar v) (n,l)
        | n == name v   = l
        | otherwise     = LVar v
    replaceLExpr (ArrayElem lv i) re = ArrayElem (replaceLExpr lv re) (replaceLExpr i re)
    replaceLExpr (PointedVal lv) re = PointedVal (replaceLExpr lv re)

instance Replace Constant where
    replaceVar (IntConst i) (s0,s1)
        | s0 == (show i) = IntConst (read s1::Int)
        | otherwise = IntConst i
    replaceVar (FloatConst i) (s0,s1)
        | s0 == (show i) = FloatConst (read s1::Float)
        | otherwise = FloatConst i
    replaceVar (BoolConst b) (s0,s1)
        | s0 == (show b) = BoolConst (read s1::Bool)
        | otherwise = BoolConst b
    replaceVar a@(ArrayConst i cs) _ = a
    replaceUExpr c _ = c -- error "Error in replace: 'repaceUExpr' called on a constant."
    replaceLExpr c _ = c -- error "Error in replace: 'repaceLExpr' called on a constant."
  
instance Replace UntypedExpression where
    replaceVar (LeftExpr lv) re = LeftExpr (replaceVar lv re)
    replaceVar (AddressOf lv) re = AddressOf (replaceVar lv re)
    replaceVar (ConstExpr c) re = ConstExpr (replaceVar c re)
    replaceVar (FunCall r s is) re = FunCall r s (replaceVar is re)
    replaceUExpr (LeftExpr (LVar (Var varname k t))) (name,expr)
        | varname == name = expr
        | otherwise = (LeftExpr (LVar (Var varname k t))) 
    replaceUExpr (LeftExpr l) re = LeftExpr (replaceUExpr l re)
    replaceUExpr (AddressOf l) re = AddressOf $ replaceUExpr l re
    replaceUExpr (ConstExpr s) _ = (ConstExpr s)
    replaceUExpr (FunCall r s is) re = (FunCall r s (replaceUExpr is re))
    replaceLExpr (LeftExpr lv) re = LeftExpr (replaceLExpr lv re)
    replaceLExpr (AddressOf lv) re = AddressOf (replaceLExpr lv re)
    replaceLExpr (ConstExpr c) re = ConstExpr (replaceLExpr c re)
    replaceLExpr (FunCall r s is) re = FunCall r s (replaceLExpr is re)
  
instance Replace Instruction where
    replaceVar (Assign lv i) re = Assign (replaceVar lv re) (replaceVar i re)
    replaceVar (CFun s ps) re = CFun s (replaceVar ps re)
    replaceUExpr (Assign lv i) re = Assign (replaceUExpr lv re) (replaceUExpr i re)
    replaceUExpr (CFun s ps) re = CFun s (replaceUExpr ps re)
    replaceLExpr (Assign lv i) re = Assign (replaceLExpr lv re) (replaceLExpr i re)
    replaceLExpr (CFun s ps) re = CFun s (replaceLExpr ps re)

instance Replace Parameter where
    replaceVar (In i) re = In (replaceVar i re)
    replaceVar (Out (pk,i)) re = Out (pk, (replaceVar i re))
    replaceUExpr (In i) re = In (replaceUExpr i re)
    replaceUExpr (Out (pk,i)) re = Out (pk, (replaceUExpr i re))
    replaceLExpr (In i) re = In (replaceLExpr i re)
    replaceLExpr (Out (pk,i)) re = Out (pk, (replaceLExpr i re))

instance Replace ImpFunction where
  replaceVar (Fun funName inParamteters outParameters prg) re = Fun funName (replaceVar inParamteters re) (replaceVar outParameters re) (replaceVar prg re)
  replaceUExpr (Fun funName inParamteters outParameters prg) re = Fun funName (replaceUExpr inParamteters re) (replaceUExpr outParameters re) (replaceUExpr prg re)
  replaceLExpr (Fun funName inParamteters outParameters prg) re = Fun funName (replaceLExpr inParamteters re) (replaceLExpr outParameters re) (replaceLExpr prg re)

instance Replace CompleteProgram where
  replaceVar (CompPrg locals body) re = CompPrg (replaceVar locals re) (replaceVar body re)
  replaceUExpr (CompPrg locals body) re = CompPrg (replaceUExpr locals re) (replaceUExpr body re)
  replaceLExpr (CompPrg locals body) re = CompPrg (replaceLExpr locals re) (replaceLExpr body re)

instance Replace Declaration where
  replaceVar (Decl var declType initval sem) re = Decl (replaceVar var re) declType (replaceVar initval re) sem
  replaceUExpr (Decl var declType initval sem) re = Decl var declType (replaceUExpr initval re) sem
  replaceLExpr (Decl var declType initval sem) re = Decl var declType (replaceLExpr initval re) sem

instance Replace Program where
  replaceVar (Primitive i inf) re = Primitive (replaceVar i re) inf
  replaceVar (Seq ps inf) re = Seq (replaceVar ps re) inf
  replaceVar (IfThenElse v cpt cpe inf) re = IfThenElse (replaceVar v re) (replaceVar cpt re) (replaceVar cpe re) inf
  replaceVar (ParLoop v max step cp inf) re = ParLoop (replaceVar v re) max step (replaceVar cp re) inf
  replaceVar (SeqLoop cond calcCp bodyCp inf) re = SeqLoop (replaceVar cond re) (replaceVar calcCp re) (replaceVar bodyCp re) inf  
  replaceVar Empty _ = Empty
  replaceUExpr (Primitive i inf) re = Primitive (replaceUExpr i re) inf
  replaceUExpr (Seq ps inf) re = Seq (replaceUExpr ps re) inf
  replaceUExpr (IfThenElse v cpt cpe inf) re = IfThenElse (replaceUExpr v re) (replaceUExpr cpt re) (replaceUExpr cpe re) inf
  replaceUExpr (ParLoop v max step cp inf) re = ParLoop (replaceUExpr v re) max step (replaceUExpr cp re) inf
  replaceUExpr (SeqLoop cond calcCp bodyCp inf) re = SeqLoop (replaceUExpr cond re) (replaceUExpr calcCp re) (replaceUExpr bodyCp re) inf
  replaceUExpr Empty _ = Empty
  replaceLExpr (Primitive i inf) re = Primitive (replaceLExpr i re) inf
  replaceLExpr (Seq ps inf) re = Seq (replaceLExpr ps re) inf
  replaceLExpr (IfThenElse v cpt cpe inf) re = IfThenElse (replaceLExpr v re) (replaceLExpr cpt re) (replaceLExpr cpe re) inf
  replaceLExpr (ParLoop v max step cp inf) re = ParLoop (replaceLExpr v re) max step (replaceLExpr cp re) inf
  replaceLExpr (SeqLoop cond calcCp bodyCp inf) re = SeqLoop (replaceLExpr cond re) (replaceLExpr calcCp re) (replaceLExpr bodyCp re) inf
  replaceLExpr Empty _ = Empty

instance Replace Array where
  replaceVar (Array v t i) re = Array (replaceVar v re) t i
  replaceUExpr (Array v t i) re = Array v t i
  replaceLExpr (Array v t i) re = Array v t i

instance (Replace a) => Replace [a] where
  replaceVar l re = map (\x -> replaceVar x re) l
  replaceUExpr l re = map (\x -> replaceUExpr x re) l
  replaceLExpr l re = map (\x -> replaceLExpr x re) l

instance (Replace a) => Replace (Maybe a) where
  replaceVar l re = fmap (\x -> replaceVar x re) l
  replaceUExpr l re = fmap (\x -> replaceUExpr x re) l
  replaceLExpr l re = fmap (\x -> replaceLExpr x re) l

instance (Replace a, Replace b) => Replace (a, b) where
  replaceVar (x, y) re = (replaceVar x re, replaceVar y re) 
  replaceUExpr (x, y) re = (replaceUExpr x re, replaceUExpr y re) 
  replaceLExpr (x, y) re = (replaceLExpr x re, replaceLExpr y re) 

instance (Replace a, Replace b, Replace c) => Replace (a, b, c) where
  replaceVar (x, y, z) re = (replaceVar x re, replaceVar y re, replaceVar z re)
  replaceUExpr (x, y, z) re = (replaceUExpr x re, replaceUExpr y re, replaceUExpr z re)
  replaceLExpr (x, y, z) re = (replaceLExpr x re, replaceLExpr y re, replaceLExpr z re)