Patch title: Release 96 bulk changes
Abstract:
File: /pliant/language/data/fields.pli
Key:
    Removed line
    Added line
# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License version 2
# as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# version 2 along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

module "/pliant/language/compiler.pli"


method e parse_one obj i all flags -> offset
  arg_rw Expression e ; arg Argument obj ; arg Int i ; arg_rw Expression all ; arg Int flags ; arg Int offset
  var Link:Expression one :> new Expression
  if i+1<e:size # field :> value
    var Link:Expression try :> expression immediat ('()' 'the object' field :> value) substitute field e:i substitute value e:(i+1) near e:i
    check try:0:0:ident="the object"
    try:0:0 set_result obj access_read+access_write+flags
    one might_compile_as try
    if one:is_compiled
      all suckup one
      return 2
  if i+1<e:size # field := value
    var Link:Expression try :> expression immediat ('()' 'the object' field := value) substitute field e:i substitute value e:(i+1) near e:i
    check try:0:0:ident="the object"
    try:0:0 set_result obj access_read+access_write+flags
    one might_compile_as try
    if one:is_compiled
      all suckup one
      return 2
  var Int j := e:size-i
  while j>=1
    if j=1 # field := true
      var Link:Expression try :> expression immediat ('()' 'the object' field := true) substitute field e:i near e:i
      check try:0:0:ident="the object"
      try:0:0 set_result obj access_read+access_write+flags
      one might_compile_as try
      if one:is_compiled
        all suckup one
        return 1
    # method with j-1 arguments
    var Link:Expression try :> expression immediat ('()' 'the object' fields) substitute fields (e i j) near e:i
    check try:0:ident="the object"
    try:0 set_result obj access_read+access_write+flags
    one might_compile_as try
    if one:is_compiled
      all suckup one
      return j
    j -= 1
  offset := 0

method e parse_fields obj first flags -> status
  arg_rw Expression e ; arg Argument obj ; arg Int first flags ; arg Status status
  var Link:Expression all :> new Expression
  var Int i := first
  while i<e:size
    var Int o := e parse_one obj i all flags
    if o=0
      return failure
    i += o
  e suckup all
  status := success


method e construct_local_data t
  arg_rw Expression e ; arg Type t
  var Link:Argument a :> argument local t
  if (e parse_fields a 0 0)=success
    e set_result a access_read

meta constructor e
  if e:size<>2 or (e:0 constant Type)=null or e:1:ident=""
    return
  e compile_as (expression immediat (meta name e {(e construct_local_data type)}) substitute name e:1 substitute type e:0)
  
  
export '. parse_fields' '. construct_local_data' constructor