source: to-imperative/trunk/java/refal/refal/plus/List2.rf @ 4029

// $Id: List2.rf 4029 2008-11-10 14:15:41Z yura $

$module "refal.plus.List2";

$use Apply Access Arithm Box Compare Table;

$func SimplifyFunction t.func e.arg = s.func e.arg;
SimplifyFunction t.func e.arg =
  t.func e.arg $iter {
    t.func : (t.func1 e.arg1) = t.func1 e.arg1 e.arg;
  } :: t.func e.arg, t.func : s.funcRef =
  s.funcRef e.arg;

$public $func TryFunc t.func e.res = e.res;
TryFunc t.func e.res = { <Apply t.func>; e.res; };

$public $func? Apply t.func e.arg = e.res;
Apply t.func e.arg = <Apply.Apply <SimplifyFunction t.func e.arg>>;

$public $func PApply t.func e.arg = t.func;
PApply t.func e.arg = <SimplifyFunction t.func e.arg> :: s.func e.arg,
  {
    e.arg : /* empty */ = s.func;
    = (s.func e.arg);
  };

$public $func Ints s.start s.end = e.list;
Ints s.start s.end =
  {
    <Le (s.start) (s.end)> =
      s.start $iter e.list s.start <Add s.start 1> :: e.list s.start,
      s.start : s.end =
      e.list;
    = s.start $iter e.list s.start <Sub s.start 1> :: e.list s.start,
      s.start : s.end =
      e.list;
  };

$public $func MapWithContext t.func e.list = e.list;
MapWithContext t.func e.list =
  <Box> :: s.box,
  {
    e.list : e.left t.term e.right,
      <Put s.box <Apply t.func (e.left) t.term (e.right)>>,
      $fail;
    <Get s.box>;
  };

$public $func? Head e.list = t.elem;
Head t.elem e.tail = t.elem;

$public $func? Tail e.list = e.list;
Tail t.elem e.tail = e.tail;

$public $func? Init e.list = e.list;
Init e.init t.last = e.init;

$public $func? Last e.list = t.elem;
Last e.init t.last = t.last;

$public $func SwapR e.list = e.list;
SwapR {
  e.init t.last = t.last e.init;
  e.list = e.list;
};

$public $func SwapL e.list = e.list;
SwapL {
  t.head e.tail = e.tail t.head;
  e.list = e.list;
};

$public $func? Map t.func e.list = e.list;
Map t.func e.list =
  () e.list $iter {
    e.list : t.head e.tail = (e.new_list <Apply t.func t.head>) e.tail;
  } :: (e.new_list) e.list, e.list : /*empty*/ =
  e.new_list;

$func? MapInHelp t.func t.term = t.term;
MapInHelp t.func (e.expr) = (<Apply t.func e.expr>);

$public $func? MapIn t.func e.list = e.list;
MapIn t.func e.list = <Map (&MapInHelp t.func) e.list>;

$func? ConcatMapInHelp t.func t.term = e.list;
ConcatMapInHelp t.func (e.expr) = <Apply t.func e.expr>;

$public $func? ConcatMapIn t.func e.list = e.list;
ConcatMapIn t.func e.list = <Map (&ConcatMapInHelp t.func) e.list>;

$func FilterHelp t.func t.term = e.term_or_empty;
FilterHelp t.func t.term = { <Apply t.func t.term> :: e = t.term; ; };

$public $func Filter t.func e.list = e.list;
Filter t.func e.list = <Map (&FilterHelp t.func) e.list>;

$func? FilterInHelp t.func t.term = e.term_or_empty;
FilterInHelp t.func t.term = t.term : (e.expr), { <Apply t.func e.expr> :: e = t.term; ; };

$public $func FilterIn t.func e.list = e.list;
FilterIn t.func e.list = <Map (&FilterInHelp t.func) e.list>;

$func FilterWithContextHelp t.func (e.left) t.term (e.right) = e.term_or_empty;
FilterWithContextHelp t.func (e.left) t.term (e.right) = { <Apply t.func (e.left) t.term (e.right)> :: e = t.term; ; };

$public $func FilterWithContext t.func e.list = e.list;
FilterWithContext t.func e.list = <MapWithContext (&FilterWithContextHelp t.func) e.list>;

$public $func Split t.func e.list = (e.true_list) (e.false_list);
Split t.func e.list =
  () () e.list $iter {
    e.list : t.head e.tail, {
      <Apply t.func t.head> :: e = (e.true_list t.head) (e.false_list) e.tail;
      = (e.true_list) (e.false_list t.head) e.tail;
    };
  } :: (e.true_list) (e.false_list) e.list, e.list : /*empty*/ =
  (e.true_list) (e.false_list);


$public $func Paren e.expr = t.expr_with_paren;
Paren e.expr = (e.expr);

$public $func Zip (e.list1) (e.list2) = e.list;
Zip (e.list1) (e.list2) = <ZipWith &Paren (e.list1) (e.list2)>; 

$public $func? ZipWith t.func (e.list1) (e.list2) = e.list;
ZipWith t.func (e.list1) (e.list2) =
  /*empty*/ (e.list1) (e.list2) $iter {
    e.list1 : t.first1 e.rest1,
      e.list2 : t.first2 e.rest2 =
      e.new_list <Apply t.func t.first1 t.first2> (e.rest1) (e.rest2);
  } :: e.new_list (e.list1) (e.list2), # \{ e.list1 : v, e.list2 : v; } =
  e.new_list;

$public $func Transpose e.lists = e.lists;
Transpose e.lists = <TransposeWith &Paren e.lists>;

$func? TransposeWithHelp e.lists = (e.heads) e.tails;
TransposeWithHelp e.lists =
  () () e.lists $iter {
    e.lists : (e.listsHead) e.listsTail =
      e.listsHead : t.head e.tail,
      (e.heads t.head) (e.tails (e.tail)) e.listsTail;
  } :: (e.heads) (e.tails) e.lists, e.lists : /* empty */ =
  (e.heads) e.tails;
  
$public $func? TransposeWith t.func e.lists = e.list;
TransposeWith t.func e.lists =
  (e.lists) $iter {
    <TransposeWithHelp e.lists> :: (e.heads) e.lists = 
      e.out <Apply t.func e.heads> (e.lists);
    e.out ();    
  } :: e.out (e.lists), e.lists : /* empty */ =
  e.out; 

$public $func Product (e.list1) (e.list2) = e.list;
Product (e.list1) (e.list2) = <ProductWith &Paren (e.list1) (e.list2)>; 

$public $func? ProductWith t.func (e.list1) (e.list2) = e.list;
ProductWith t.func (e.list1) (e.list2) =
  <Box> :: s.box, {
    e.list1 : e t.term1 e,
      e.list2 : e t.term2 e,
      <Put s.box <Apply t.func t.term1 t.term2>>,
      $fail;
    <Get s.box>;
  };

$public $func Products e.lists = e.lists;
Products {
  /* empty */ = /* empty */;
  (e.list) = <Map &Paren e.list>;
  (e.list) e.lists = <Product (e.list) (<Products e.lists>)>;
}; 

$func? DirectProductWithHelp s.box t.func (e.args) e.lists = ;
DirectProductWithHelp s.box t.func (e.args) e.lists = e.lists : {
  /* empty */ = <Put s.box <Apply t.func e.args>>;
  (e.head) e.tail =
    { 
      e.head : e t.term e, 
        <DirectProductWithHelp s.box t.func (e.args t.term) e.tail>,
        $fail;;
    };
};

$public $func? DirectProductWith t.func e.lists = e.list;
DirectProductWith t.func e.lists = {
  e.lists : /* empty */ = /* empty */;
  = <Box> :: s.box, <DirectProductWithHelp s.box t.func () e.lists>, <Get s.box>;
};

$public $func? IsElem e.list t.item = ;
IsElem e t.item e t.item;

$public $func Foldl t.func (e.value) e.list = e.value;
Foldl t.func (e.value) e.list =
  (e.value) e.list $iter {
    e.list : t.head e.tail = (<Apply t.func e.value t.head>) e.tail;
  } :: (e.value) e.list, e.list : /*empty*/ =
  e.value;

$public $func Foldl1 t.func v.list = e.value;
Foldl1 t.func t.head e.tail = <Foldr t.func (t.head) e.tail>;

$public $func Foldr t.func (e.value) e.list = e.value;
Foldr t.func (e.value) e.list =
  (e.value) e.list $iter {
    e.list : e.init t.last = (<Apply t.func t.last e.value>) e.init;
  } :: (e.value) e.list, e.list : /*empty*/ =
  e.value;

$public $func Foldr1 t.func v.list = e.value;
Foldr1 t.func e.init t.last = <Foldr t.func (t.last) e.init>;

$public $func? All t.func e.list = ;
All t.func e.list =
  e.list $iter {
    e.list : t.head e.tail = <Apply t.func t.head> :: e, e.tail;
  } :: e.list, e.list : /*empty*/;

$public $func? Any t.func e.list = ;
Any t.func e.list = # \{
  e.list $iter {
    e.list : t.head e.tail = # \{ <Apply t.func t.head > :: e; }, e.tail;
  } :: e.list, e.list : /*empty*/;
};

$public $func Subtract (e.list1) (e.list2) = e.list;
Subtract (e.list1) (e.list2) =
  /*empty*/ (e.list1) $iter {
    e.list1 : term e.rest,
      {
        e.list2 : e term e =  e.not (e.rest);
        = e.not term (e.rest);
      };
  } ::  e.not (e.list1), e.list1 : /*empty*/ =
  e.not;

//$const Concat = (&Map &Deparen_Term);
//
//<Const e.list> ~~~ <Apply &Concat e.list>;

//Paren expr = <Map &Paren_Term (expr)>;
//
//Reverse {
//  term e.list = <Reverse e.list> term;
//  /*empty*/ = /*empty*/;
//};

$public $func Intersperse (e.sep) e.list = e.list;
Intersperse {
  (e.sep) /*empty*/ = /*empty*/;
  (e.sep) t.head0 = t.head0;
  (e.sep) t.head0 e.tail0 =
    (t.head0 e.sep) e.tail0 $iter {
      e.list : t.head e.tail = (e.new_list t.head e.sep) e.tail;
    } :: (e.new_list) e.list, e.list : t.last =
    e.new_list t.last;
};

$public $func Separate (e.sep) e.list = e.listOfLists;
Separate (e.sep) e.list =
  () e.list $iter {
    e.list : e.before e.sep e.after = (e.ll (e.before)) e.after;
    = (e.ll (e.list));
  } :: (e.ll) e.list, e.list : /*empty*/ =
  e.ll;

$func ConcatHelp t.term = e.expr;
ConcatHelp {
  (e.expr) = e.expr;
  t.term   = t.term;
};

$public $func Id e.expr = e.expr;
Id e.expr = e.expr;

$public $func Concat e.lists = e.list;
Concat e.lists = <Map &ConcatHelp e.lists>;

$public $func? EqTerms t.term t.term = ;
EqTerms t1 t1;

$public $func Nub e.list = e.list;
Nub e.list = <NubBy &EqTerms e.list>;

$public $func NubBy t.eqTerms e.list = e.list;
NubBy t.eqTerms e.list =
  () e.list $iter {
    e.list : t.head e.tail, {
      <Any (t.eqTerms t.head) e.new_list> = (e.new_list) e.tail;
      = (e.new_list t.head) e.tail;
    };
  } :: (e.new_list) e.list, e.list : /*empty*/ =
  e.new_list;

$func FrequenciesHelp (e.expr) (s.num) = s.num e.expr;
FrequenciesHelp (e.expr) (s.num) = s.num e.expr;
  
$public $func Frequencies e.list = e.list;
Frequencies e.list =
  <Table> :: s.table,
  {
    e.list : e t.term e,
      { <Lookup s.table t.term>; 0; } : s.num,
      <Bind s.table (t.term) (<Add s.num 1>)>,
      $fail;
    <Sort <MapIn &FrequenciesHelp <Entries s.table>>>;
  };

$public $func SumNumbers e.list = e.list;
SumNumbers e.list =
  <Table> :: s.table,
  {
    e.list : e (s.n e.expr) e,
      { <Lookup s.table e.expr>; 0; } : s.num,
      <Bind s.table (e.expr) (<Add s.num s.n>)>,
      $fail;
    <Sort <MapIn &FrequenciesHelp <Entries s.table>>>;
  };

//Replicate s.n e.expr =
//  s.n /*e.list*/ $iter
//    <Arithm.Sub s.n 1> e.list e.expr
//  :: s.n e.list,
//  <Le (s.n) (0)> =
//  e.list;

$public $func CompareTerms t.term t.term = s.cmp;
CompareTerms t.term1 t.term2 = <Compare (t.term1) (t.term2)>;

$func QSort_Split t.cmpTerm e.list = (e.smaller) (e.equal) (e.greater);
QSort_Split t.cmpTerm e.list,
  () () () e.list $iter {
    e.list : t.head e.tail, 
      <Apply t.cmpTerm t.head> : {
        '<' = (e.smaller) (e.equal) (e.greater t.head) e.tail;
        '=' = (e.smaller) (e.equal t.head) (e.greater) e.tail;
        '>' = (e.smaller t.head) (e.equal) (e.greater) e.tail;
    };
  } :: (e.smaller) (e.equal) (e.greater) e.list, e.list : /*empty*/ =
  (e.smaller) (e.equal) (e.greater);

$public $func QSortBy t.cmpTerms e.list = e.list;
QSortBy t.cmpTerms e.list = e.list : {
  /* empty */   = /* empty */;
  t.head e.tail = <QSort_Split (t.cmpTerms t.head) e.tail> :: (e.smaller) (e.equal) (e.greater),
    <QSort e.smaller> t.head e.equal <QSort e.greater>;
};

$public $func QSort e.list = e.list;
QSort e.list = <QSortBy &CompareTerms e.list>;

$public $func QSortAndNubBy t.cmpTerms e.list = e.list;
QSortAndNubBy t.cmpTerms e.list = e.list : {
  /* empty */   = /* empty */;
  t.head e.tail = <QSort_Split (t.cmpTerms t.head) e.tail> :: (e.smaller) t (e.greater),
    <QSortAndNubBy t.cmpTerms e.smaller> t.head <QSortAndNubBy t.cmpTerms e.greater>;
};

$public $func QSortAndNub e.list = e.list;
QSortAndNub e.list = <QSortAndNubBy &CompareTerms e.list>;

$public $func Sort e.list = e.list;
Sort e.list = <SortBy &CompareTerms e.list>;

$public $func SortBy t.cmpTerms e.list = e.list;
SortBy t.cmpTerms e.list =
  <Div <Length e.list> 2> : {
    0 = e.list;
    s.k = <Merge t.cmpTerms (<SortBy t.cmpTerms <Left 0 s.k e.list>>) (<SortBy t.cmpTerms <Middle s.k 0 e.list>>)>;
  };

$func Merge t.cmpTerms (e.left) (e.right) = e.merged_list;
Merge t.cmpTerms (e.left) (e.right) =
  (e.left) (e.right) $iter {
    e.left : t.l e.left_rest, e.right : t.r e.right_rest = {
     <Apply t.cmpTerms t.l t.r> : '<' = e.merged t.l (e.left_rest) (e.right);
      = e.merged t.r (e.left) (e.right_rest);
    };
  } :: e.merged (e.left) (e.right),
  \{
    e.left  : /*empty*/ = e.merged e.right;
    e.right : /*empty*/ = e.merged e.left;
  };

$public $func SortAndNub e.list = e.list;
SortAndNub e.list = <SortBy &CompareTerms e.list>;

$public $func SortAndNubBy t.cmpTerms e.list = e.list;
SortAndNubBy t.cmpTerms e.list =
  <Div <Length e.list> 2> : {
    0 = e.list;
    s.k = <MergeAndNub t.cmpTerms (<SortAndNubBy t.cmpTerms <Left 0 s.k e.list>>) (<SortAndNubBy t.cmpTerms <Middle s.k 0 e.list>>)>;
  };

$func MergeAndNub t.cmpTerms (e.left) (e.right) = e.merged_list;
MergeAndNub t.cmpTerms (e.left) (e.right) =
  (e.left) (e.right) $iter {
    e.left : t.l e.left_rest, e.right : t.r e.right_rest = <Apply t.cmpTerms t.l t.r> : {
     '<' = e.merged t.l (e.left_rest) (e.right);
     '>' = e.merged t.r (e.left) (e.right_rest);
     '=' = e.merged (e.left) (e.right_rest);
    };
  } :: e.merged (e.left) (e.right),
  \{
    e.left  : /*empty*/ = e.merged e.right;
    e.right : /*empty*/ = e.merged e.left;
  };