Patch title: Release 85 bulk changes
Abstract:
File: /pliant/language/type/set/each.pli
Key:
    Removed line
    Added line
   
# Copyright  Patrice Ossona de Mendez pom@ehess.fr
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


meta each e
  if e:size<3 or not e:0:is_pure_ident
    return
  var Pointer:Expression filter :> null map Expression
  var CBool reversed := false
  var Int i := 2
  while i<e:size-1
    if e:i:ident="filter" and i+1<e:size-1
      filter :> e i+1
      i += 2
    eif e:i:ident="reversed"
      reversed := true
      i += 1
    else
      return
  e:1 compile ?
  var Pointer:Type set :> e:1:result:type real_data_type
  if not (e:1 cast set)
    return
  var Str cat := set category
  if cat<>"List" and cat<>"Array" and cat<>"Index" and cat<>
    return
  var Pointer:Type key_type :> set key_type
  var Pointer:Type value_type :> set value_type
  var Link:Argument finished :> argument local CBool
# Copyright  Patrice Ossona de Mendez pom@ehess.fr
#
# This program is free software; you can redistribute it and
# modify it under the terms of the GNU General Public Licens
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be us
# but WITHOUT ANY WARRANTY; without even the implied warrant
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public 
# version 2 along with this program; if not, write to the Fr
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 


meta each e
  if e:size<3 or not e:0:is_pure_ident
    return
  var Pointer:Expression filter :> null map Expression
  var CBool reversed := false
  var Int i := 2
  while i<e:size-1
    if e:i:ident="filter" and i+1<e:size-1
      filter :> e i+1
      i += 2
    eif e:i:ident="reversed"
      reversed := true
      i += 1
    else
      return
  e:1 compile ?
  var Pointer:Type set :> e:1:result:type real_data_type
  if not (e:1 cast set)
    return
  var Str cat := set category
  if cat<>"List" and cat<>"Array" and cat<>"Index" and cat<>
    return
  var Pointer:Type key_type :> set key_type
  var Pointer:Type value_type :> set value_type
  var Link:Argument finished :> argument local CBool
  var Link:Argument item :> e local_variable e:0:ident point
  var Link:Argument item :> e local_variable e:0 pointerto:value_type
  if not exists:item
    return
  if exists:filter and not (filter cast CBool)
    return
  e:(e:size-1) compile ?
  var Link:Argument cursor :> argument indirect value_type i
  var Link:Instruction next :> instruction the_function:'do 
  var Link:Instruction end :> instruction the_function:'do n
  var List lt
  lt append addressof:set
  var Pointer:Function first :> (find_function e:module (shu
  check exists:first
  lt append addressof:value_type
  var Pointer:Function gonext :> (find_function e:module (sh
  check exists:gonext
  e suckup e:1
  e add (instruction first e:1:result cursor)
  e add (instruction (the_function is_null Address -> CBool)
  e add (instruction (the_function 'jump if' CBool) finished
  var Link:Instruction body :> instruction the_function:'do 
  e add body
  if exists:filter
    e suckup filter
    e add (instruction (the_function 'jump if not' CBool) fi
  e suckup (e e:size-1)
  if exists:filter
    e add next
  e add (instruction gonext  e:1:result cursor cursor)
  e add (instruction (the_function is_null Address -> CBool)
  e add (instruction (the_function 'jump if not' CBool) fini
  e add end
  e set_void_result

export each
  if not exists:item
    return
  if exists:filter and not (filter cast CBool)
    return
  e:(e:size-1) compile ?
  var Link:Argument cursor :> argument indirect value_type i
  var Link:Instruction next :> instruction the_function:'do 
  var Link:Instruction end :> instruction the_function:'do n
  var List lt
  lt append addressof:set
  var Pointer:Function first :> (find_function e:module (shu
  check exists:first
  lt append addressof:value_type
  var Pointer:Function gonext :> (find_function e:module (sh
  check exists:gonext
  e suckup e:1
  e add (instruction first e:1:result cursor)
  e add (instruction (the_function is_null Address -> CBool)
  e add (instruction (the_function 'jump if' CBool) finished
  var Link:Instruction body :> instruction the_function:'do 
  e add body
  if exists:filter
    e suckup filter
    e add (instruction (the_function 'jump if not' CBool) fi
  e suckup (e e:size-1)
  if exists:filter
    e add next
  e add (instruction gonext  e:1:result cursor cursor)
  e add (instruction (the_function is_null Address -> CBool)
  e add (instruction (the_function 'jump if not' CBool) fini
  e add end
  e set_void_result

export each