using Nemerle.Compiler;
using Nemerle.Compiler.Parsetree;
using Nemerle.Macros;
using Nemerle.Collections;

/**
   MARK BITS
 */
 [System.Flags]
 enum MarkBits {
   | B_0 = 0x001
   | B_1 = 0x002
   | B_2 = 0x004
   | B_FOOD = 0x008
   | B_ENEMY = 0x010
   | B_FORBID = 0x020

   // marked directions
   | V_0 = 0b110
   | V_1 = 0b001
   | V_2 = 0b010
   | V_3 = 0b011
   | V_4 = 0b111
   | V_5 = 0b101
 }
 
/// macros inlining procedures written in ants language
module more_macros {

  /// returns code for signing ground with current compass position
  /// (compass is stored in ants' state and direction is encoded binary
  ///  using ant mark)
  public mark_compass () : PExpr {
    <[
       if (compass == 0) mark (V_0)
       else if (compass == 1) mark (V_1)
       else if (compass == 2) mark (V_2)
       else if (compass == 3) mark (V_3)           
       else if (compass == 4) mark (V_4)
       else mark (V_5)
    ]>
  }

  /// returns code for signing ground with reversed compass position
  /// (compass is stored in ants' state and direction is encoded binary
  ///  using ant mark)
  public mark_rev_compass () : PExpr {
    <[
       if (compass == 0) mark (V_3)
       else if (compass == 1) mark (V_4)
       else if (compass == 2) mark (V_5)
       else if (compass == 3) mark (V_0)           
       else if (compass == 4) mark (V_1)
       else mark (V_2)
    ]>
  }

  /// read direction mark from ground and synchronize ant's direction
  /// with it (using compass remembered in state)
  public align_to_mark () : PExpr {
    def nn1 = Macros.NewSymbol ();
    def nn2 = Macros.NewSymbol ();
    def nn3 = Macros.NewSymbol ();
    def n1 = <[ $(nn1 : name) ]>;
    def n2 = <[ $(nn2 : name) ]>;
    def n3 = <[ $(nn3 : name) ]>;

    <[
       vars ($n1 (2), $n2 (2), $n3 (2), {
         label ($(Macros.NewSymbol () : name));
         if (marker (B_0) ^ here) set ($(nn1 : name) = 1) else set ($(nn1 : name) = 0);
         if (marker (B_1) ^ here) set ($(nn2 : name) = 1) else set ($(nn2 : name) = 0);
         if (marker (B_2) ^ here) set ($(nn3 : name) = 1) else set ($(nn3 : name) = 0);
         if ($n3 == 1 && $n2 == 1 && $n1 == 0)         // V_0 = 0b110
         {
           if (compass == 0) {}
           else if (compass == 1) { turn (left) }
           else if (compass == 2) { turn (left); turn (left) }
           else if (compass == 3) { turn (left); turn (left); turn (left) }             
           else if (compass == 4) { turn (right); turn (right) }
           else turn (right);
         }
         else if ($n3 == 0 && $n2 == 0 && $n1 == 1)    // V_1 = 0b001
         {
           if (compass == 1) {}
           else if (compass == 2) { turn (left) }
           else if (compass == 3) { turn (left); turn (left) }
           else if (compass == 4) { turn (left); turn (left); turn (left) }             
           else if (compass == 5) { turn (right); turn (right) }
           else turn (right);
         }
         else if ($n3 == 0 && $n2 == 1 && $n1 == 0)    // V_2 = 0b010
         {
           if (compass == 2) {}
           else if (compass == 3) { turn (left) }
           else if (compass == 4) { turn (left); turn (left) }
           else if (compass == 5) { turn (left); turn (left); turn (left) }             
           else if (compass == 0) { turn (right); turn (right) }
           else turn (right);
         }
         else if ($n3 == 0 && $n2 == 1 && $n1 == 1)    // V_3 = 0b011
         {
           if (compass == 3) {}
           else if (compass == 4) { turn (left) }
           else if (compass == 5) { turn (left); turn (left) }
           else if (compass == 0) { turn (left); turn (left); turn (left) }             
           else if (compass == 1) { turn (right); turn (right) }
           else turn (right);
         }
         else if ($n3 == 1 && $n2 == 1 && $n1 == 1)    // V_4 = 0b111
         {
           if (compass == 4) {}
           else if (compass == 5) { turn (left) }
           else if (compass == 0) { turn (left); turn (left) }
           else if (compass == 1) { turn (left); turn (left); turn (left) }             
           else if (compass == 2) { turn (right); turn (right) }
           else turn (right);
         }
         else                                          // V_5 = 0b101
         {
           if (compass == 5) {}
           else if (compass == 0) { turn (left) }
           else if (compass == 1) { turn (left); turn (left) }
           else if (compass == 2) { turn (left); turn (left); turn (left) }             
           else if (compass == 3) { turn (right); turn (right) }
           else turn (right);
         }
       });
    ]>
  }
  public align_to_rev_mark () : PExpr {
    def nn1 = Macros.NewSymbol ();
    def nn2 = Macros.NewSymbol ();
    def nn3 = Macros.NewSymbol ();
    def n1 = <[ $(nn1 : name) ]>;
    def n2 = <[ $(nn2 : name) ]>;
    def n3 = <[ $(nn3 : name) ]>;

    <[
       vars ($n1 (2), $n2 (2), $n3 (2), {
         label ($(Macros.NewSymbol () : name));
         if (marker (B_0) ^ here) set ($(nn1 : name) = 1) else set ($(nn1 : name) = 0);
         if (marker (B_1) ^ here) set ($(nn2 : name) = 1) else set ($(nn2 : name) = 0);
         if (marker (B_2) ^ here) set ($(nn3 : name) = 1) else set ($(nn3 : name) = 0);
         if ($n3 == 1 && $n2 == 1 && $n1 == 0)         // V_0 = 0b110
         {
           if (compass == 3) {}
           else if (compass == 4) { turn (left) }
           else if (compass == 5) { turn (left); turn (left) }
           else if (compass == 0) { turn (left); turn (left); turn (left) }             
           else if (compass == 1) { turn (right); turn (right) }
           else turn (right);
         }
         else if ($n3 == 0 && $n2 == 0 && $n1 == 1)    // V_1 = 0b001
         {
           if (compass == 4) {}
           else if (compass == 5) { turn (left) }
           else if (compass == 0) { turn (left); turn (left) }
           else if (compass == 1) { turn (left); turn (left); turn (left) }             
           else if (compass == 2) { turn (right); turn (right) }
           else turn (right);
         }
         else if ($n3 == 0 && $n2 == 1 && $n1 == 0)    // V_2 = 0b010
         {
           if (compass == 5) {}
           else if (compass == 0) { turn (left) }
           else if (compass == 1) { turn (left); turn (left) }
           else if (compass == 2) { turn (left); turn (left); turn (left) }             
           else if (compass == 3) { turn (right); turn (right) }
           else turn (right);
         }
         else if ($n3 == 0 && $n2 == 1 && $n1 == 1)    // V_3 = 0b011
         {
           if (compass == 0) {}
           else if (compass == 1) { turn (left) }
           else if (compass == 2) { turn (left); turn (left) }
           else if (compass == 3) { turn (left); turn (left); turn (left) }             
           else if (compass == 4) { turn (right); turn (right) }
           else turn (right);
         }
         else if ($n3 == 1 && $n2 == 1 && $n1 == 1)    // V_4 = 0b111
         {
           if (compass == 1) {}
           else if (compass == 2) { turn (left) }
           else if (compass == 3) { turn (left); turn (left) }
           else if (compass == 4) { turn (left); turn (left); turn (left) }             
           else if (compass == 5) { turn (right); turn (right) }
           else turn (right);
         }
         else                                          // V_5 = 0b101
         {
           if (compass == 2) {}
           else if (compass == 3) { turn (left) }
           else if (compass == 4) { turn (left); turn (left) }
           else if (compass == 5) { turn (left); turn (left); turn (left) }             
           else if (compass == 0) { turn (right); turn (right) }
           else turn (right);
         }
       });
    ]>
  }
  
  public move_timeout (x : int) : PExpr {
    def nn1 = Macros.NewSymbol ();  
  def n1 = <[ $(nn1 : name) ]>;
  def nn2 = Macros.NewSymbol ();  
  def n2 = <[ $(nn2 : name) ]>;  
  
    <[
       vars ($n2 ($(x : int)), {
      label ($n1);
      if (move) {}
      else {
        if ($n2 == $(x - 1 : int)) {
           if (rand (2)) {
          turn (right);
          turn (right);           
           }
           else {
          turn (left);
          turn (left);           
           };
           move;
        }
        else goto ($(nn2 : name) = $(nn2 : name) + 1, $n1)
      }
      });
   ]> 
  }
}

using more_macros;


/*** ants parser is a macro, which transforms code in Nemerle to
     another code in Nemerle, which creates parsetree of ants' language.
     This way we can use existing Nemerle lexer and parser, which gives
     AST to our macros. Code creating AST of ants's language is inlined
     in plase of use.
 */
macro antsparser (exps)
syntax ("ants", exps) {
  def stmts (e) {
    | <[ { ..$lst } ]> => Macros.Lift (lst, stmt)
    | _ => <[ [ $(stmt (e)) ] ]>
  }
  and mark_folder (e, marking : bool) {
    def mark_walker (x) : MarkBits {
      | <[ B_0 ]> => MarkBits.B_0
      | <[ B_1 ]> => MarkBits.B_1
      | <[ B_2 ]> => MarkBits.B_2
      | <[ B_FOOD ]> => MarkBits.B_FOOD
      | <[ B_ENEMY ]> => MarkBits.B_ENEMY
      | <[ B_FORBID ]> => MarkBits.B_FORBID

      | <[ V_0 ]> => MarkBits.V_0
      | <[ V_1 ]> => MarkBits.V_1
      | <[ V_2 ]> => MarkBits.V_2
      | <[ V_3 ]> => MarkBits.V_3
      | <[ V_4 ]> => MarkBits.V_4
      | <[ V_5 ]> => MarkBits.V_5
      | <[ $e1 %& $e2 ]> => mark_walker (e1) %& mark_walker (e2)
      | <[ $e1 %| $e2 ]> => mark_walker (e1) %| mark_walker (e2)
      | _ => Message.FatalError ("bad mark expr " + PrettyPrint.SprintExpr (None (), x))
    };
    def unfold (x) {
      mutable acc = [];
      when (x %&& MarkBits.B_0 || x %&& MarkBits.B_1 || x %&& MarkBits.B_2) {
        if (x %&& MarkBits.B_0 == marking) acc = <[ NodeAction.Mark (0) ]> :: acc;
        else acc = <[ NodeAction.Unmark (0) ]> :: acc;
        if (x %&& MarkBits.B_1 == marking) acc = <[ NodeAction.Mark (1) ]> :: acc;
        else acc = <[ NodeAction.Unmark (1) ]> :: acc;
        if (x %&& MarkBits.B_2 == marking) acc = <[ NodeAction.Mark (2) ]> :: acc;
        else acc = <[ NodeAction.Unmark (2) ]> :: acc;
      };
      when (x %&& MarkBits.B_FOOD)
        if (marking) acc = <[ NodeAction.Mark (3) ]> :: acc;
        else acc = <[ NodeAction.Unmark (3) ]> :: acc;
      when (x %&& MarkBits.B_ENEMY)
        if (marking) acc = <[ NodeAction.Mark (4) ]> :: acc;
        else acc = <[ NodeAction.Unmark (4) ]> :: acc;
      when (x %&& MarkBits.B_FORBID)
        if (marking) acc = <[ NodeAction.Mark (5) ]> :: acc;
        else acc = <[ NodeAction.Unmark (5) ]> :: acc;
      acc
    };
    match (e) {
      | <[ $(i : int) ]> =>
        if (marking)
          [ <[ NodeAction.Mark ($(i : int)) ]> ]
        else
          [ <[ NodeAction.Unmark ($(i : int)) ]> ]          
      | _ =>
        unfold (mark_walker (e))
    }
  }
  and stmt (e) {
    | <[ label ($(name : dyn)) ]> => <[ Stmt.Label ($(name : string)) ]>

    | <[ goto ( .. $exprs) ]> => 
      def loop (acc : PExpr, l : list [PExpr]) {
        match (l) {
          | <[ $(nm : name) = $expr ]> :: xs =>
            loop (<[ ($(nm.Id : string), $(parse_expr (expr))) :: $acc ]>, xs)
            
          | [<[ $(label : dyn) ]>] => 
            <[ Stmt.Goto ($acc, $(label : string)) ]>
            
          | [e] =>
            Message.FatalError ("bad goto target " + PrettyPrint.SprintExpr (None (), e))
          | x :: _  =>
            Message.FatalError ("bad goto assign " + PrettyPrint.SprintExpr (None (), x))
          | [] =>
            Message.FatalError ("no goto target");
        }
      };
      loop (<[ [] ]>, exprs)

    | <[ vars ( .. $exprs ) ]> =>
      def loop (acc : PExpr, l : list [PExpr]) {
        match (l) {
          | <[ $(name : dyn) ($(size : int)) ]> :: xs =>
            loop (<[ ($(name : string), $(size : int)) :: $acc ]>, xs)
          | [last] => 
            <[ Stmt.Vars ($acc, $(stmts (last))) ]>
          | x :: _  =>
            Message.FatalError ("bad var " + PrettyPrint.SprintExpr (None (), x))
          | _ =>
            Message.FatalError ("bad vars body");
        }
      };
      loop (<[ [] ]>, exprs)

    | <[ mark_compass ]> => stmt (mark_compass ())
    | <[ mark_rev_compass ]> => stmt (mark_rev_compass ())
    | <[ align_to_mark ]> => stmt (align_to_mark ())
    | <[ align_to_rev_mark ]> => stmt (align_to_rev_mark ())
    | <[ move_timeout ($(x : int)) ]> => stmt (move_timeout (x))
          
    | <[ mark ($i) ]> =>
      def mark_lst = mark_folder (i, true);
      def qmark_lst = Macros.Lift (mark_lst, fun (x) {
        <[ Stmt.Action ($x) ]>
      });
      <[ Stmt.If (BooleanFormula.Const (ConstantExpr.Const (1)), $qmark_lst, []) ]>

    | <[ unmark ($i) ]> =>
      def mark_lst = mark_folder (i, false);
      def qmark_lst = Macros.Lift (mark_lst, fun (x) {
        <[ Stmt.Action ($x) ]>
      });
      <[ Stmt.If (BooleanFormula.Const (ConstantExpr.Const (1)), $qmark_lst, []) ]>      

    | <[ set (..$assigns) ]> =>
      def n = Macros.NewSymbol ();
      def lab = <[ $(n.Id : dyn) ]>;
      def assigns = List.Append (assigns, [ <[ $(n.Id : dyn) ]> ]);
      def qmark_lst = stmts (<[ goto (..$assigns); label ($lab) ]>);      
      <[ Stmt.If (BooleanFormula.Const (ConstantExpr.Const (1)), $qmark_lst, []) ]>      
      
    | <[ drop ]> 
    | <[ drop () ]> => <[ Stmt.Action (NodeAction.Drop ()) ]>

    | <[ turn (left) ]> =>
      def qset = stmt (<[ set (compass = compass + 5) ]>);
      def qmark_lst = <[ [ $qset, Stmt.Action (NodeAction.Turn (true))] ]>;
      <[ Stmt.If (BooleanFormula.Const (ConstantExpr.Const (1)), $qmark_lst, []) ]>      

    | <[ turn (right) ]> => 
      def qset = stmt (<[ set (compass = compass + 1) ]>);
      def qmark_lst = <[ [ $qset, Stmt.Action (NodeAction.Turn (false))] ]>;
      <[ Stmt.If (BooleanFormula.Const (ConstantExpr.Const (1)), $qmark_lst, []) ]>      

    | <[ if ($c) $then else $els ]> =>
      <[ Stmt.If ($(parse_expr (c)), $(stmts (then)), $(stmts (els))) ]>
    
    | <[ when ($c) $then ]> =>
      <[ Stmt.If ($(parse_expr (c)), $(stmts (then)), []) ]>

    | <[ pickup ]> | <[ pickup () ]> =>
      <[ Stmt.If (BooleanFormula.Cond (NodeCondition.Pickup ()), [], []) ]> 

    | <[ move ]> | <[ move () ]> =>
      <[ Stmt.If (BooleanFormula.Cond (NodeCondition.Move ()), [], []) ]> 

    | _ => Message.FatalError ("bad ant statemnt: " + PrettyPrint.SprintExpr (None (), e))
  }
  and parse_expr (c) {
    | <[ ! $e ]> => <[ BooleanFormula.Not ($(parse_expr (e))) ]>
    | <[ $e1 && $e2 ]> => <[ BooleanFormula.And ($(parse_expr (e1)), $(parse_expr (e2))) ]>
    | <[ $e1 || $e2 ]> => <[ BooleanFormula.Or ($(parse_expr (e1)), $(parse_expr (e2))) ]>
    | <[ vector ^ $whe ]> =>
      parse_expr (<[ marker (B_0) ^ $whe || marker (B_1) ^ $whe ]>)
      
    | <[ $wh ^ $whe ]> =>
        <[ BooleanFormula.Cond (NodeCondition.Sense ($(wher (whe)), $(what (wh)))) ]>

    | <[ pickup ]> | <[ pickup () ]> => <[ BooleanFormula.Cond (NodeCondition.Pickup ()) ]>
    | <[ move ]> | <[ move () ]> => <[ BooleanFormula.Cond (NodeCondition.Move ()) ]>
    | <[ rand ($i) ]> => <[ BooleanFormula.Cond (NodeCondition.Flip ($i)) ]>
    | _ => <[ BooleanFormula.Const ($(parse_const (c))) ]>
  }
  and parse_const (c) {
    | <[ $op ($e1, $e2) ]> =>
      def (neg, op) =
        match (op) {
          | <[ @== ]> => (false, <[ BinaryOperator.Equal () ]>)
          | <[ @!= ]> => (true, <[ BinaryOperator.Equal () ]>)
          | <[ @+ ]> => (false, <[ BinaryOperator.Plus () ]>)
          | <[ @- ]> => (false, <[ BinaryOperator.Minus () ]>)
          | <[ @< ]> => (false, <[ BinaryOperator.Less_than () ]>)
          | <[ @> ]> => (false, <[ BinaryOperator.More_than () ]>)
          | <[ @>= ]> => (true, <[ BinaryOperator.Less_than () ]>)
          | <[ @<= ]> => (true, <[ BinaryOperator.More_than () ]>)
          | _ => 
            Message.FatalError ("bad ant condition: " + PrettyPrint.SprintExpr (None (), c))
        };
      def expr =
        <[ ConstantExpr.Binary ($op, $(parse_const (e1)), $(parse_const (e2))) ]>;
      if (neg)
        <[ ConstantExpr.Not ($expr) ]>
      else
        expr

    | <[ $(_ : int) ]> => <[ ConstantExpr.Const ($c) ]>
    | <[ $(x : dyn) ]> => <[ ConstantExpr.Ref ($(x : string)) ]>
    
    | _ =>
      Message.FatalError ("bad const expr " + PrettyPrint.SprintExpr (None (), c))
  }
  and what (e) {
    | <[ friend ]> => <[ What.Friend () ]>
      
    | <[ foe ]> => <[ What.Foe () ]>
      
    | <[ friend (food) ]> => <[ What.Friend_with_food () ]>
      
    | <[ foe (food) ]> => <[ What.Foe_with_food () ]>
      
    | <[ food ]> => <[ What.Food () ]>
      
    | <[ rock ]> => <[ What.Rock () ]>
      
    | <[ marker ($col) ]> =>
      match (col) {
        | <[ B_0 ]> => <[ What.Marker (0) ]>
        | <[ B_1 ]> => <[ What.Marker (1) ]>
        | <[ B_2 ]> => <[ What.Marker (2) ]>          
        | <[ B_FOOD ]> => <[ What.Marker (3) ]>
        | <[ B_ENEMY ]> => <[ What.Marker (4) ]>
        | <[ B_FORBID ]> => <[ What.Marker (5) ]>
        | _ => <[ What.Marker ($col) ]>
      }
      
    | <[ foe (marker) ]> => <[ What.Foe_marker () ]>
      
    | <[ home ]> => <[ What.Home () ]>
      
    | <[ foe (home) ]> => <[ What.Foe_home () ]>
      
    | _ => Message.FatalError ("bad ant what: " + PrettyPrint.SprintExpr (None (), e))      
  }
  and wher (e) {
    | <[ here ]> => <[ Direction.Here () ]>
      
    | <[ front ]> => <[ Direction.Ahead () ]>
      
    | <[ left ]> => <[ Direction.Left () ]>
      
    | <[ right ]> => <[ Direction.Right () ]>
      
    | _ => Message.FatalError ("bad ant where: " + PrettyPrint.SprintExpr (None (), e))
  };  
  stmts (exps)
}