/*
 * Copyright (c) 2004-2008 The University of Wroclaw.
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 *    1. Redistributions of source code must retain the above copyright
 *       notice, this list of conditions and the following disclaimer.
 *    2. 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.
 *    3. The name of the University may not be used to endorse or promote
 *       products derived from this software without specific prior
 *       written permission.
 * 
 * THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY ``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 UNIVERSITY 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.
 */

using Nemerle.Collections;
using Nemerle.IO;
using Nemerle.Utility;

using Nemerle.Compiler;
using Nemerle.Compiler.Typedtree;
using Nemerle.Macros;

using PT = Nemerle.Compiler.Parsetree;

namespace Nemerle.Core {

module Operators
{
  [Hygienic]
  internal cache_assign_expr (e : PT.PExpr)
  : PT.PExpr * PT.PExpr
  {
    def desc =
      match (e) {
        | <[ $tab [$idx] ]> =>
          def new_idx = <[ $(Macros.NewSymbol () : name) ]>;
          CacheDesc (<[ $tab [$new_idx] ]>, <[ def $new_idx = $idx ]>)

        | <[ $tab [.. $idxes] ]> =>
          def idx_exprs = List.Map (idxes, _ => <[ $(Macros.NewSymbol () : name) ]>);
          CacheDesc (<[ $tab [.. $idx_exprs] ]>, <[ def (.. $idx_exprs) = (.. $idxes) ]>)

        | _ =>
          CacheDesc (e, null)
      }

    ( <[ $(TExpr.Cache (desc, null) : typed) ]>, 
      <[ $(TExpr.CacheRef (desc) : typed) ]> )
  }
}


  macro @&& (e1, e2) 
  {
    <[ 
      match ($e1) {
        | false => false
        | _ => $e2
      }
    ]>
  }

  macro @|| (e1, e2) 
  {
    <[ 
      match ($e1) {
        | true => true
        | _ => $e2
      }
    ]>
  }

  macro @%|| (e1, e2)
  {
    <[ ($e1 | $e2) != 0 ]>                                    
  }

  macro @%&& (e1, e2)
  {
    <[ ($e1 & $e2) != 0 ]>                                    
  }

  macro @%^^ (e1, e2)
  {
    <[ ($e1 ^ $e2) != 0 ]>                                    
  }

  macro @++ (e) {
    def (cached, safe) = Operators.cache_assign_expr (e);
    <[ $cached; $safe = _N_op_Increment ($safe) ]>
  }

  macro @-- (e) {
    def (cached, safe) = Operators.cache_assign_expr (e);
    <[ $cached; $safe = _N_op_Decrement ($safe) ]>
  }

  macro @+= (e, val) {
    def (cached, safe) = Operators.cache_assign_expr (e);
    <[ $cached; $safe = $safe + $val ]>
  }

  macro @-= (e, val) {
    def (cached, safe) = Operators.cache_assign_expr (e);
    <[ $cached; $safe = $safe - $val ]>
  }

  macro @*= (e, val) {
    def (cached, safe) = Operators.cache_assign_expr (e);
    <[ $cached; $safe = $safe * $val ]>
  }

  macro @/= (e, val) {
    def (cached, safe) = Operators.cache_assign_expr (e);
    <[ $cached; $safe = $safe / $val ]>
  }

  macro @<<= (e, val) {
    def (cached, safe) = Operators.cache_assign_expr (e);
    <[ $cached; $safe = $safe << $val ]>
  }

  macro @>>= (e, val) {
    def (cached, safe) = Operators.cache_assign_expr (e);
    <[ $cached; $safe = $safe >> $val ]>
  }

  macro @%= (e, val) {
    def (cached, safe) = Operators.cache_assign_expr (e);
    <[ $cached; $safe = $safe % $val ]>
  }

  macro @|= (e, val) {
    def (cached, safe) = Operators.cache_assign_expr (e);
    <[ $cached; $safe = $safe %| $val ]>
  }

  macro @&= (e, val) {
    def (cached, safe) = Operators.cache_assign_expr (e);
    <[ $cached; $safe = $safe %& $val ]>
  }

  macro @^= (e, val) {
    def (cached, safe) = Operators.cache_assign_expr (e);
    <[ $cached; $safe = $safe %^ $val ]>
  }
  
  macro @<-> (e1, e2)
  {
    def (cached1, safe1) = Operators.cache_assign_expr (e1);
    def (cached2, safe2) = Operators.cache_assign_expr (e2);    
    <[
      $cached1;
      $cached2;
      def tmp = $safe1;
      $safe1 = $safe2;
      $safe2 = tmp;
    ]>
  }

  macro @::= (e1, e2) {
    def (cached, safe) = Operators.cache_assign_expr (e1);
    <[ $cached; $safe = $e2 :: $safe ]>
  }
  
  macro @=> (parmsExpr, body) {
    def convert_to_parm (x)
    {
      mutable tyLoc = Location.Default;
      def param = match (x)
      {
        | <[ _ ]>                  => <[ parameter: $(Util.tmpname ("_") : dyn) ]>
        | <[ $(nm : name) ]>       => <[ parameter: $(nm : name) ]>
        | <[ _ : $ty ]>            => tyLoc = ty.Location;
                                      <[ parameter: $(Util.tmpname ("_") : dyn) : $ty ]>
        | <[ $(nm : name) : $ty ]> => tyLoc = ty.Location;
                                      <[ parameter: $(nm : name) : $ty ]>
        | _ =>
          Message.Error (x.Location, $"unsupported syntax for parameter of 'parms => body' lambda expression: $x");
          <[ parameter: $(Util.tmpname ("_") : dyn) ]>
      };
      param.Location = x.Location;
      param.name.loc = x.Location;
      param.ty.Location = tyLoc;
      param
    }

    def convert_to_ref (x) {
      | <[ parameter: $(nm : name) ]> => PT.PExpr.Ref (x.Location, nm)
      | _ => Message.FatalError (x.Location, "illegal spliced parameter?")
    }

    def convert_body (body, parms, loc) {
      match(body) {
        | <[ match($(null)) { ..$cases } ]> =>
          def match_val = match (parms) {
            | [] => null
            | [<[ parameter: $(nm : name) ]> as x] => PT.PExpr.Ref (x.Location, nm)
            | _ :: _ :: _ => PT.PExpr.Tuple (loc, parms.Map (convert_to_ref))
            | x :: _ => Message.FatalError (x.Location, "illegal spliced parameter?")
          }
          PT.PExpr.Match (body.Location, match_val, cases)
        | _ => body
      }
    }

    def loc = parmsExpr.Location;
    def generatedParms = match (parmsExpr) {
      | <[ () ]> => []
      | <[ (..$parmsList) ]> => parmsList.Map (convert_to_parm)
      | _ => [convert_to_parm (parmsExpr)]
    }
    def func = <[ fun (..$generatedParms) $(convert_body (body, generatedParms, loc)) ]>;
    func.decl.header.Location = loc;
    func
  }

  macro @?? (exprA, exprB) 
  {
    def typer = Macros.ImplicitCTX ();      
    def tnullable = typer.InternalType.Generic_Nullable_tc;
    def toption = typer.InternalType.Nemerle_option_tc;

    def isNullable = tnullable.Equals(_);
    def isOption (t)
    {
      toption.Equals (t) 
      || (t.BaseType != null && toption.Equals (t.BaseType))
    }

    def hA = typer.TypeExpr (exprA).Type.Hint;
    def hB = typer.TypeExpr (exprB).Type.Hint;

    def resolve (tiA, check)
    {
      match (hB) {
        | Some (Class (tiB, _)) =>
            def v = if (check(tiB)) <[ $exprA ]> else <[ $exprA.Value ]>;
            <[ match ($exprA.HasValue) { | true => $v | _ => $exprB } ]>
        | None => 
            Message.FatalError (exprB.Location, $"Operator `??' cannot be"
                                " applied to operands of type `$tiA' and "
                                "`_UNKNOWN_TYPE_'");
        | _ =>
            <[ if ($exprA != null) $exprA else $exprB ]>;
      }
    }

    match (hA) {
      | None 
      | Some (Class (tiA, _)) when tiA.IsValueType && !isNullable(tiA) =>
          Message.FatalError (exprA.Location, 
                              $"Left operand ($exprA) of the `??' operator should be "
                              "reference or nullable type ");
      | Some (Class (tiA, _)) when isNullable (tiA) => resolve (tiA, isNullable)
      | Some (Class (tiA, _)) when isOption (tiA) => resolve (tiA, isOption)
      | _ => <[ if ($exprA != null) $exprA else $exprB ]>;
    }
  }

  macro @** (e1, e2) {
    <[ System.Math.Pow ($e1, $e2) ]>
  }
}