Patch title: Release 94 bulk changes
Abstract:
File: /pliant/util/pml/io.pli
Key:
    Removed line
    Added line
module "/pliant/language/compiler.pli"
module "/pliant/language/context.pli"
submodule "/pliant/language/stream.pli"
module "/pliant/language/type/misc/blob.pli"
module "prototype.pli"
module "stream.pli"
submodule "generic.pli"

constant processor_is_intel true


method s write_count code i
  arg_rw Stream s ; arg Int code i
  check i>=0
  if processor_is_low_indian
    var Int n := shunt i<2^8 0 i<2^16 1 Int:size=4 or i<2^32 2 3
    var uInt8 u8 := code+n ; s raw_write addressof:u8 1
    s raw_write addressof:i 2^n
  else
    error "not implemented"

method s read_count header -> i
  arg_rw Stream s ; arg Int header i
  check header>=11100000b and header<256
  var Int n := 2^(header .and. 3)
  if Int:size=4 and n=8
    return undefined
  if processor_is_low_indian
    i := 0
    s raw_read addressof:i n
    if s=failure
      return undefined
  else
    error "not implemented"

method s verify_uInt8 i -> ok
  arg_rw Stream s ; arg Int i ; arg CBool ok
  ok := s:read_uInt8=i


# ------------------------------------------------------------------------
#   binary io for basic data types


method i 'to stream' stream
  arg Int i ; arg_rw Stream stream
  if i<16 and i>=(-16)
    var uInt8 u8 := 10000000b+(i .and. 31) ; stream raw_write addressof:u8 1
  eif i=undefined
    var uInt8 u8 := 11000010b ; stream raw_write addressof:u8 1
  eif processor_is_low_indian
    var Int n := shunt i<2^7 and i>=-(2^7) 0 i<2^15 and i>=-(2^15) 1 Int:size=4 or i<2^31 and i>=-(2^31) 2 3
    var uInt8 u8 := 11010000b+n ; stream raw_write addressof:u8 1
    stream raw_write addressof:i 2^n
  else
    error "not implemented"

method i 'from stream' stream inc -> ok
  arg_w Int i ; arg_rw Stream stream ; arg CBool inc ok
  var Int h := stream read_uInt8
  if (h .and. 11100000b)=10000000b
    if (h .and. 00010000b)=0
      i := h .and. 00001111b
    else
      i := -16 .or. (h .and. 00001111b)
    ok := true
  eif (h .and. 11111100b)=11010000b
    var Int n := h .and. 3
    if Int:size=4 and n=3
      return false
    if processor_is_low_indian
      i := 0
      stream raw_read addressof:i 2^n
      if stream=failure
        return false
      if (addressof:i map uInt8 2^n-1)>=128
        var Int j := -1 ; memory_copy addressof:j (addressof:i translate Byte 2^n) Int:size-2^n
      ok := true
    else
      error "not implemented"
  eif h=11000010b
    i := undefined
    ok := true
  eif (h .and. 11111100b)=11010100b
    var Int n := h .and. 3
    if Int:size=4 and n=3
      return false
    if processor_is_low_indian
      var uInt u := 0
      stream raw_read addressof:u 2^n
      if stream=failure or u>=2^(Int:size*8-1)
        return false
      i := u
      ok := true
    else
      error "not implemented"
  else
    ok := false


method s 'to stream' stream
  arg Str s ; arg_rw Stream stream
  if s:len<2^4
    var uInt8 u8 := 10100000b+s:len ; stream raw_write addressof:u8 1
  else
    stream write_count 11101000b s:len
  stream raw_write s:characters s:len

method s 'from stream' stream inc -> ok
  arg_w Str s ; arg_rw Stream stream ; arg CBool inc ok
  var Int h := stream read_uInt8
  var Int l
  if (h .and. 11110000b)=10100000b
    l := h .and. 00001111b
  eif (h .and. 11111100b)=11101000b
    l := stream read_count h
    if l=undefined
      return false
  else
    return false
  s set (memory_allocate l addressof:s) l true
  stream raw_read s:characters l
  ok := stream=success


method id 'to stream' stream
  arg Ident id ; arg_rw Stream stream
  var Pointer:Str s :> addressof:id map Str
  if s:len<2^4
    var uInt8 u8 := 10110000b+s:len ; stream raw_write addressof:u8 1
  else
    stream write_count 11101100b s:len
  stream raw_write s:characters s:len

method stream read_ident id -> ok
  arg_rw Stream stream ; arg_w Str id ; arg CBool ok
  var Int h := stream read_uInt8
  var Int l
  if (h .and. 11110000b)=10110000b
    l := h .and. 00001111b
  eif (h .and. 11111100b)=11101100b
    l := stream read_count h
    if l=undefined
      return false
  else
    return false
  id set (memory_allocate l addressof:id) l true
  stream raw_read id:characters l
  ok := stream=success

method id 'from stream' stream inc -> ok
  arg_w Ident id ; arg_rw Stream stream ; arg CBool inc ok
  ok := stream read_ident (addressof:id map Str)


method b 'to stream' stream
  arg Bool b ; arg_rw Stream stream
  stream write_uInt8 (shunt b 11000001b 11000000b)

method b 'from stream' stream inc -> ok
  arg_w Bool b ; arg_rw Stream stream ; arg CBool inc ok
  var Int h := stream read_uInt8
  ok := (h .and. 11111110b)=11000000b
  b := shunt (h .and. 1)<>0 true false


method b 'to stream' stream
  arg CBool b ; arg_rw Stream stream
  stream write_uInt8 (shunt b 11000001b 11000000b)

method b 'from stream' stream inc -> ok
  arg_w CBool b ; arg_rw Stream stream ; arg CBool inc ok
  var Int h := stream read_uInt8
  ok := (h .and. 11111110b)=11000000b
  b := shunt (h .and. 1)<>0 true false

  
method v 'to stream' stream
  arg Void v ; arg_rw Stream stream
  stream write_uInt8 11000011b

method v 'from stream' stream inc -> ok
  arg_w Void v ; arg_rw Stream stream ; arg CBool inc ok
  ok := stream:read_uInt8=11000011b

  
method d 'to stream' stream
  arg Date d ; arg_rw Stream stream
  stream write_uInt8 11001001b
  if processor_is_low_indian
    stream raw_write addressof:d 4
  else
    var uInt32_li d32 := d days
    stream raw_write addressof:d32 4

method d 'from stream' stream inc -> ok
  arg_w Date d ; arg_rw Stream stream ; arg CBool inc ok
  ok := stream:read_uInt8=11001001b
  if ok
    if processor_is_low_indian
      stream raw_read addressof:d 4
    else
      stream raw_read addressof:(var uInt32_li d32) 4
      d days := d32
    ok := stream=success
      

method t 'to stream' stream
  arg Time t ; arg_rw Stream stream
  stream write_uInt8 11001010b
  if processor_is_intel
    stream raw_write addressof:t Float:size
  else
    error "not implemented"

method t 'from stream' stream inc -> ok
  arg_w Time t ; arg_rw Stream stream ; arg CBool inc ok
  ok := stream:read_uInt8=11001010b
  if ok
    if processor_is_intel
      stream raw_read addressof:t Float:size
    else
      error "not implemented"
    ok := stream=success
      

method dt 'to stream' stream
  arg DateTime dt ; arg_rw Stream stream
  stream write_uInt8 11001011b
  if processor_is_intel
    stream raw_write addressof:dt Float:size
  else
    error "not implemented"

method dt 'from stream' stream inc -> ok
  arg_w DateTime dt ; arg_rw Stream stream ; arg CBool inc ok
  ok := stream:read_uInt8=11001011b
  if ok
    if processor_is_intel
      stream raw_read addressof:dt Float:size
    else
      error "not implemented"
    ok := stream=success
      

method f 'to stream' stream
  arg Float32 f ; arg_rw Stream stream
  stream write_uInt8 11001100b
  if processor_is_intel
    stream raw_write addressof:f Float32:size
  else
    error "not implemented"

method f 'from stream' stream inc -> ok
  arg_w Float32 f ; arg_rw Stream stream ; arg CBool inc ok
  var Int h := stream read_uInt8
  if h=11001100b
    if processor_is_intel
      stream raw_read addressof:f Float32:size
    else
      error "not implemented"
    ok := stream=success
  eif h=11001101b
    if processor_is_intel
      stream raw_read addressof:(var Float f64) Float:size
      f := f64
    else
      error "not implemented"
    ok := stream=success
  else
    ok := false


method f 'to stream' stream
  arg Float f ; arg_rw Stream stream
  stream write_uInt8 11001101b
  if processor_is_intel
    stream raw_write addressof:f Float:size
  else
    error "not implemented"

method f 'from stream' stream inc -> ok
  arg_w Float f ; arg_rw Stream stream ; arg CBool inc ok
  var Int h := stream read_uInt8
  if h=11001101b
    if processor_is_intel
      stream raw_read addressof:f Float:size
    else
      error "not implemented"
    ok := stream=success
  eif h=11001100b
    if processor_is_intel
      stream raw_read addressof:(var Float32 f32) Float32:size
      f := f32
    else
      error "not implemented"
    ok := stream=success
  else
    ok := false


method u 'to stream' stream
  arg uInt u ; arg_rw Stream stream
  if u<16
    var uInt8 u8 := 10000000b+u ; stream raw_write addressof:u8 1
  eif processor_is_low_indian
    var Int n := shunt u<2^8 0 u<2^16 1 Int:size=4 or u<2^32 2 3
    var uInt8 u8 := 11010100b+n ; stream raw_write addressof:u8 1
    stream raw_write addressof:u 2^n
  else
    error "not implemented"

method u 'from stream' stream inc -> ok
  arg_w uInt u ; arg_rw Stream stream ; arg CBool inc ok
  var Int h := stream read_uInt8
  if (h .and. 11100000b)=10000000b
    if (h .and. 00010000b)=0
      u := h .and. 00001111b
      ok := true
    else
      ok := false
  eif (h .and. 11111100b)=11010100b
    var Int n := h .and. 3
    if Int:size=4 and n=3
      return false
    if processor_is_low_indian
      u := 0
      stream raw_read addressof:u 2^n
      if stream=failure
        return false
      ok := true
    else
      error "not implemented"
  eif (h .and. 11111100b)=11010000b
    var Int n := h .and. 3
    if Int:size=4 and n=3
      return false
    if processor_is_low_indian
      var Int i := 0
      stream raw_read addressof:i 2^n
      if stream=failure
        return false
      if (addressof:i map uInt8 2^n-1)<128
        u := i
        ok := true
      else
        ok := false
    else
      error "not implemented"
  else
    ok := false


method i 'to stream' stream
  arg Intn i ; arg_rw Stream stream
  var Str s := i binary_encode
  if s:len=0 or (s s:len-1):number<>0
    check i>=0
    stream write_count 11100000b s:len
    stream raw_write s:characters s:len
  else
    check i<0
    stream write_count 11100100b s:len-1
    stream raw_write s:characters s:len-1

method i 'from stream' stream inc -> ok
  arg_w Intn i ; arg_rw Stream stream ; arg CBool inc ok
  var Int h := stream read_uInt8
  if (h .and. 11111000b)=11100000b
    var Int size := stream read_count h
    if size=undefined
      return false
    (var Str s) set (memory_allocate size addressof:s) size true
    stream raw_read s:characters s:len
    i binary_decode s true
    if (h .and. 4)<>0
      i := -1*i
    ok := stream=success
  else
    ok := false


method b 'to stream' stream
  arg Blob b ; arg_rw Stream stream
  stream write_count 11110000b b:size
  stream raw_write b:content b:size

method b 'from stream' stream inc -> ok
  arg_w Blob b ; arg_rw Stream stream ; arg CBool inc ok
  var Int h := stream read_uInt8
  if (h .and. 11111100b)=11110000b
    var Int size := stream read_count h
    if size=undefined
      return false
    b size := size
    stream raw_read b:content size
    ok := stream=success
  else
    ok := false


# ------------------------------------------------------------------------
#   high level functions


constant to_index (the_function '. to stream' Universal Stream):generic_index
constant from_index (the_function '. from stream' Universal Stream CBool -> CBool):generic_index


method s rewind_uInt8 u
  arg_rw Stream s ; arg Int u
  if s:stream_write_cur<>s:stream_write_buf and (s:stream_write_cur map uInt8 -1)=u
    s stream_write_cur := s:stream_write_cur translate Byte -1

function output e mode
  arg_rw Expression e ; arg Str mode
  if e:size<2 or not (e:0 cast Stream)
    return
  e suckup e:0
  if mode="otag"
    e add (instruction (the_function '. write_uInt8' Stream Int) e:0:result (argument constant Int 11000101b))
  eif mode="oattr"
    e add (instruction (the_function '. rewind_uInt8' Stream Int) e:0:result (argument constant Int 11000100b))
  var Int i := 1
  if mode="otag" or mode="oattr"
    if not (e:1 cast Str)
      return
    e suckup e:1
    e add (instruction (Ident get_generic_method to_index) e:1:result e:0:result)
    i += 1
  while i<e:size
    var Str id := shunt e:i:is_pure_ident e:i:ident ""
    var Int code := shunt id="open" 11000101b id="close" 11000100b id="body" 11001000b (cast undefined Int)
    if code<>undefined
      e add (instruction (the_function '. write_uInt8' Stream Int) e:0:result (argument constant Int code))
    else
      e:i compile ?
      var Pointer:Type type :> e:i:result:type:real_data_type
      e:i cast type ?
      var Pointer:Function function :> type get_generic_method to_index
      if addressof:function=null or addressof:function=addressof:(the_function '. to stream' Universal Stream)
        return
      e suckup e:i
      e add (instruction function e:i:result e:0:result)
    i += 1
  if mode="otag" or mode="oattr"
    e add (instruction (the_function '. write_uInt8' Stream Int) e:0:result (argument constant Int 11000100b))
  e set_void_result

meta '. oraw' e
  output e "oraw"

meta '. otag' e
  output e "otag"

meta '. oattr' e
  output e "oattr"


method s iavailable -> ok
  arg_rw Stream s ; arg CBool ok
  var Int h := s pick_uInt8
  if (h .and. 11110000b)=10110000b or (h .and. 11111100b)=11101100b or h=11001000b or h=11000100b
    # if we are at the begining of and Ident or a body or a close flag
    var Int l := 0
    while l>=0
      if h=11000101b
        l += 1
      eif h=11000100b
        l -= 1
      if s:iforward=failure
        return false
      h := s pick_uInt8
  ok := h=11000101b


method s iflush
  arg_rw Stream s
  var Int l := 0
  while l>=0
    var Int h := s pick_uInt8
    if h=11000101b
      l += 1
    eif h=11000100b
      l -= 1
    if s:iforward=failure
      return


method s open_iraw
  arg_rw Stream s
  s rewind_open

method s close_iraw ok 
  arg_rw Stream s ; arg CBool ok
  if not ok
    s rewind
  s rewind_close

method s close_ipick
  arg_rw Stream s
  s rewind
  s rewind_close

method s open_itag tag -> ok
  arg_rw Stream s ; arg Str tag ; arg CBool ok
  s iavailable
  s rewind_open
  ok := s:read_uInt8=11000101b and (s read_ident (var Str id)) and id=tag

method s close_itag ok
  arg_rw Stream s ; arg CBool ok
  if ok
    s rewind_close
    while { var Int h := s pick_uInt8 ; not (h=0 or (h .and. 11110000b)=10110000b or (h .and. 11111100b)=11101100b or h=11001000b or h=11000100b) }
      s iskip
  else
    s rewind
    s rewind_close

method s open_iattr attr -> ok
  arg_rw Stream s ; arg Str attr ; arg CBool ok
  s rewind_open
  while { s rewind_open ; var CBool an_ident := s read_ident (var Str id) ; s rewind ; s rewind_close ; not an_ident or id<>attr }
    if s:pick_uInt8=11001000b # separator
      return false
    if s:iskip=failure
      return false
  ok := s:iskip=success

method s close_iattr
  arg_rw Stream s
  s rewind
  s rewind_close

function input e mode
  arg_rw Expression e ; arg Str mode
  if e:size<2 or not (e:0 cast Stream)
    return
  e suckup e:0
  var Link:Argument ok :> argument local CBool
  var Link:Instruction end :> instruction the_function:'do nothing'
  var Int i := 1
  if mode="iraw"
    e add (instruction (the_function '. open_iraw' Stream) e:0:result)
  eif mode="ipick"
    e add (instruction (the_function '. rewind_open' Stream) e:0:result)
  eif mode="itag"
    if not (e:1 cast Str)
      return
    e suckup e:1
    e add (instruction (the_function '. open_itag' Stream Str -> CBool) e:0:result e:1:result ok)
    e add (instruction (the_function 'jump if not' CBool) ok jump end)
    i += 1
  eif mode="iattr"
    if not (e:1 cast Str)
      return
    e suckup e:1
    e add (instruction (the_function '. open_iattr' Stream Str -> CBool) e:0:result e:1:result ok)
    e add (instruction (the_function 'jump if not' CBool) ok jump end)
    i += 1
  while i<e:size
    var Str id := shunt e:i:is_pure_ident e:i:ident ""
    var Int code := shunt id="open" 11000101b id="close" 11000100b id="body" 11001000b (cast undefined Int)
    if mode="itag" and i=e:size-1 and e:i:ident="{}" and e:i:position:line<>e:0:position:line
      e:i compile ?
      e suckup e:i
    eif code<>undefined
      e add (instruction (the_function '. verify_uInt8' Stream Int -> CBool) e:0:result (argument constant Int code) ok)
      e add (instruction (the_function 'jump if not' CBool) ok jump end)
    else
      e:i compile ?
      var Pointer:Type type :> e:i:result:type:real_data_type
      e:i cast type ?
      var Pointer:Function function :> type get_generic_method from_index
      if addressof:function=null or addressof:function=addressof:(the_function '. from stream' Universal Stream CBool -> CBool)
        return
      e suckup e:i
      e add (instruction function e:i:result e:0:result (argument constant CBool false) ok)
      e add (instruction (the_function 'jump if not' CBool) ok jump end)
    i += 1
  e add end
  if mode="iraw"
    e add (instruction (the_function '. close_iraw' Stream CBool) e:0:result ok)
  eif mode="ipick"
    e add (instruction (the_function '. close_ipick' Stream) e:0:result)
  eif mode="itag"
    e add (instruction (the_function '. close_itag' Stream CBool) e:0:result ok)
  eif mode="iattr"
    e add (instruction (the_function '. close_iattr' Stream) e:0:result)
  e set_result ok access_read

meta '. iraw' e
  input e "iraw"

meta '. ipick' e
  input e "ipick"

meta '. itag' e
  input e "itag"

meta '. iattr' e
  input e "iattr"


export '. oraw' '. otag' '. oattr'
export '. iraw' '. ipick' '. itag' '. iattr'
export '. iavailable' '. iflush'