Patch title: Release 92 bulk changes
Abstract:
File: /language/type/text/str.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.

scope "/pliant/language/" "/pliant/install/"
module "/pliant/install/ring2.pli"


function '+=' s e
  arg_rw Str s ; arg Str e
  strong_definition
  # this is speedup only function
  s resize s:len+e:len
  memory_copy e:characters (s:characters translate Char s:len-e:len) e:len


method s search_last pattern default -> position
  arg Str s pattern ; arg Int default position
  position := default
  var Address base := s characters
  while true
    base := memory_search base (cast (s:characters translate Char s:len) Int).-.(cast base Int) pattern:characters pattern:len
    if base=null
      return
    position := (cast base Int).-.(cast s:characters Int)
    base := base translate Char 1    


function replace s pattern with -> s2
  arg Str s pattern with s2
  check pattern:len>0
  if pattern:len=with:len
    s2 := s
    var Int i := -1
    while { i := ((s2 i+1 s2:len) search pattern -(i+2))+(i+1) ; i<>(-1) }
      memory_copy with:characters (s2:characters translate Char i) with:len
  else
    var Int i := s search pattern -1
    if i>=0
      s2 := (s 0 i)+with+(replace (s i+pattern:len s:len) pattern with)
    else
      s2 := s

function repeat n pattern -> result
  arg Int n ; arg Str pattern result
  check n>=0
  var Address buffer := memory_allocate n*pattern:len addressof:result
  for (var Int i) 0 n-1
    memory_copy pattern:characters (buffer translate Char i*pattern:len) pattern:len
  result set buffer n*pattern:len true

function reverse s -> result
  arg Str s result
  var Int l := s len
  var Address buffer := memory_allocate l addressof:result
  for (var Int i) 0 l-1
    memory_copy (s:characters translate Char l-1-i) (buffer translate Char i) 1
  result set buffer l true

function left s l p -> s2
  arg Str s ; arg Int l ; arg Str p s2
  check p:len=1
  if s:len<l
    var Address buffer := memory_allocate l addressof:s2
    memory_copy s:characters buffer s:len
    for (var Int i) s:len l-1
      memory_copy p:characters (buffer translate Char i) Char:size
    s2 set buffer l true
  else
    s2 := s
    
function right s l p -> s2
  arg Str s ; arg Int l ; arg Str p s2
  check p:len=1
  if s:len<l
    var Address buffer := memory_allocate l addressof:s2
    memory_copy s:characters (buffer translate Char l-s:len) s:len
    for (var Int i) 0 l-s:len-1
      memory_copy p:characters (buffer translate Char i) Char:size
    s2 set buffer l true
  else
    s2 := s
    
function upper s -> s2
  arg Str s s2
  s2 set (memory_allocate s:len addressof:s2) s:len true
  for (var Int i) 0 s:len-1
    var Int n := s:i:number
    if n>="a":0:number and n<="z":0:number
      n := n + ("A":0:number-"a":0:number)
    s2 i := character n

function lower s -> s2
  arg Str s s2
  s2 set (memory_allocate s:len addressof:s2) s:len true
  for (var Int i) 0 s:len-1
    var Int n := s:i:number
    if n>="A":0:number and n<="Z":0:number
      n := n + ("a":0:number-"A":0:number)
    s2 i := character n


export '+=' '. search_last' replace repeat reverse left right upper lower


#----------------------------------------------------------------------


function from_string u s o may_skip skiped offset f -> status
  arg_w Universal u ; arg Str s o ; arg CBool may_skip ; arg_w Int skiped offset ; arg Function f ; arg Status status
  indirect
  

method s option_position name if_not_found -> p
  arg Str s ; arg Str name ; arg Int if_not_found p
  var Address start := s characters
  var Address stop := start translate Char s:len
  while true
    var Address id := memory_search start (cast stop Int).-.(cast start Int) name:characters name:len
    if id=null
      return if_not_found
    var Address dq := memory_search start (cast stop Int).-.(cast start Int) "[dq]":characters 1
    if dq=null or dq>id
      if id=s:characters or not ((id translate Char -1) map Char):isidentcharacter
        if (id translate Char name:len)=(s:characters translate Char s:len) or not ((id translate Char name:len) map Char):isidentcharacter
          return (cast id Int).-.(cast s:characters Int)
        else
          start := id translate Char 1
      else
        start := id translate Char 1
    else
      start := dq translate Char 1
      var CBool inside := true
      while inside
        var Address dq := memory_search start (cast stop Int).-.(cast start Int) "[dq]":characters 1
        if dq=null
          return if_not_found
        var Address lb := memory_search start (cast stop Int).-.(cast start Int) "[lb]":characters 1
        if lb=null or lb>dq
          if (memory_search start (cast dq Int).-.(cast start Int) "[rb]":characters 1)<>null
            return if_not_found
          start := dq translate Char 1
          inside := false
        else
          if (memory_search start (cast lb Int).-.(cast start Int) "[rb]":characters 1)<>null
            return if_not_found
          var Address rb := memory_search (lb translate Char 2) (cast stop Int).-.(cast lb Int)-2 "[rb]":characters 1
          if rb=null
            return if_not_found
          start := rb translate Char 1

method s option_position name instance if_not_found -> p
  arg Str s ; arg Str name ; arg Int instance if_not_found p
  check instance>=0
  var Int offset := -1
  for (var Int i) 0 instance
    var Int next := (s offset+1 s:len) option_position name if_not_found
    if next=if_not_found
      return if_not_found
    else
      offset += 1+next
  p := offset

  
method s option name -> b
  arg Str s ; arg Str name ; arg CBool b
  b := (s option_position name -1)<>(-1)


method s option_value name instance fun type default result
  arg Str s ; arg Str name ; arg Int instance ; arg Function fun ; arg Type type ; arg Universal default ; arg_w Universal result
  var Int p := s option_position name instance -1
  if p=(-1)
    type copy_instance addressof:default addressof:result
    return
  p += name:len
  while p<s:len and (s:p=" ":0 or s:p="[tab]":0)
    p += 1
  if (from_string result (s p s:len) "" false (var Int skiped) (var Int offset) fun)=failure
    type copy_instance addressof:default addressof:result

meta '. option' e
  if e:size<2 or not (e:0 cast Str) or not (e:1 cast Str) 
    return
  var Int u := 2
  var Link:Argument instance :> argument constant Int 0
  if u<e:size and (e:u cast Int)
    instance :> e:u result
    u += 1
  if u>=e:size or (e:u constant Type)=null
    return
  var Pointer:Type t :> (e:u constant Type) map Type
  u += 1
  var Pointer:Function f :> t get_generic_method (the_function '. from string' Universal Str Str CBool Int Int -> Status):generic_index
  if addressof:f=null or addressof:f=addressof:(the_function '. from string' Universal Str Str CBool Int Int -> Status)
    return
  var Link:Argument d :> new Argument
  d locate t argument_constant
  d constant := entry_new t
  from_string (d:constant map Universal) "" "" false (var Int skiped) (var Int offset) f
  if u<e:size and (e:u cast t)
    d :> e:u result
    u += 1
  if u<>e:size
    return
  for (var Int i) 0 e:size-1
    e suckup e:i
  var Link:Argument r :> argument local t
  e add (instruction (the_function '. option_value' Str Str Int Function Type Universal Universal) e:0:result e:1:result instance (argument mapped_constant Function f) (argument mapped_constant Type t) d r)
  e set_result r access_read
   
export '. option_position' '. option'


#----------------------------------------------------------------------


(gvar Array string_encoding) 'size :=' 256
gvar Dictionary string_decoding

function define_char_encoding char encoded
  arg Int char ; arg Str encoded
  var Link:Str e :> new Str ; e := encoded
  string_encoding char := addressof e
  var Link:Char c :> new Char ; c := character char
  string_decoding insert encoded true addressof:c

define_char_encoding "[lb]":0:number "[lb]lb[rb]"
define_char_encoding "[rb]":0:number "[lb]rb[rb]"
define_char_encoding "[dq]":0:number "[lb]dq[rb]"
define_char_encoding "[cr]":0:number "[lb]cr[rb]"
define_char_encoding "[lf]":0:number "[lb]lf[rb]"
define_char_encoding "[0]":0:number "[lb]0[rb]"


method data 'to string' options -> string
  arg Str data ; arg Str options ; arg Str string
  if options="raw" or options="db"
    string := data
  else
    string := "[dq]"+data+"[dq]"
    var Int i := 1
    while i<string:len-1
      var Int ch := string:i number
      if string_encoding:ch<>null
        var Pointer:Str e :> string_encoding:ch map Str
        string := (string 0 i)+e+(string i+1 string:len)
        i := i+e:len
      else
        i := i+1


method data 'from string' string options may_skip skiped offset -> status
  arg_w Str data ; arg Str string options ; arg CBool may_skip ; arg_w Int skiped offset ; arg Status status
  if options="raw" or options="db"
    data := string
    skiped := 0
    offset := string:len
    offset := string len
    return success
  var Int stop := string:len-1
  if not may_skip and stop<>(-1)
    stop := 0
  for (var Int i) 0 stop
    var Int ci := string:i number
    if ci="[dq]":0:number
      skiped := i
      var Address cursor := string:characters translate Char i+1
      var Int remain := string:len-(i+1)
      var Address dq := memory_search cursor remain "[dq]":characters 1
      var Address lb := memory_search cursor remain "[lb]":characters 1
      if dq<>null and (lb=null or dq<lb)
        # the string to decode does not contain any [ character
        var Int l := (cast dq Int).-.(cast cursor Int)
        if (memory_search cursor l "[rb]":characters 1)=null
          data set (memory_allocate l addressof:data) l true
          memory_copy cursor data:characters l
          offset := (cast dq Int) .+. 1 .-. (cast string:characters Int)
          return success
        else
          # the string contains an unmatched ] character
          return failure
      var Address buf := memory_allocate remain null
      var Address b := buf
      var CBool ok := true
      while ok
        var Int remain := (cast string:characters Int).+.string:len.-.(cast cursor Int)
        var Address dq := memory_search cursor remain "[dq]":characters 1
        if dq=null
          # no " character: this is not a valid string
          ok := false
        else
          var Address lb := memory_search cursor remain "[lb]":characters 1
          if lb=null or dq<lb
            # no more [ character
            var Int n := (cast dq Int).-.(cast cursor Int)
            if (memory_search cursor n "[rb]":characters 1)=null
              # store the remaining not encoded characters and successfully returns
              memory_copy cursor b n ; b := b translate Char n
              var Int l := (cast b Int).-.(cast buf Int)
              data set (memory_allocate l addressof:data) l true
              memory_copy buf data:characters l
              memory_free buf
              offset := (cast dq Int) .+. 1 .-. (cast string:characters Int)
              return success
            else
              # the string contains an unmatched ] character
              ok := false
          else
            var Int n := (cast lb Int).-.(cast cursor Int)
            if (memory_search cursor n "[rb]":characters 1)=null
              # stores the charcters before the first [ : they are not encoded
              memory_copy cursor b n ; b := b translate Char n
              var Address rb := memory_search (lb translate Char 2) (cast string:characters Int).+.string:len.-.(cast lb Int)-2 "[rb]":characters 1
              if rb<>null
                (var Str sub) set lb (cast rb Int).-.(cast lb Int)+1 false
                # 'sub' is the encoded character
                var Pointer:Char ch :> (string_decoding first sub) map Char
                var Char c
                if addressof:ch<>null
                  # we found it in the encoding dictionary
                  c := ch
                else
                  c := sub 1
                  if c:number>="0":0:number and c:number<="9":0:number
                    # we are looking for an integer between [ and ]
                    var Int n := 0
                    for (var Int j) 1 sub:len-2
                      c := sub:j
                      if c:number>="0":0:number and c:number<="9":0:number
                        n := n*10+c:number-"0":0:number
                      else
                        ok := false
                    if n<256
                      c := character n
                    else
                      ok := false
                  eif sub:len=3 and not (c:number>="a":0:number and c:number<="z":0:number) and not (c:number>="A":0:number and c:number<="Z":0:number)
                    # we have a single character in the middle, and it's neither a letter nor a number, so we decode it as itself
                    void
                  else
                    # this is an unsupported encoding
                    ok := false
                b map Char := c
                b := b translate Char 1
                cursor := lb translate Char sub:len
              else
                # unmatched [ character
                ok := false
            else
              # unmatched ] character
              ok := false
      # if we get there, then ok=false, so free the temporary storage area and return
      memory_free buf
      data := ""
      return failure
  data := ""
  status := failure


#----------------------------------------------------------------------


type StrMatch
  field Address current
  field Address stop
  field Address start
  field CBool exact


method sm setup s exact
  arg_w StrMatch sm ; arg Str s ; arg CBool exact
  sm start := s characters
  sm current := sm start
  sm stop := s:characters translate Char s:len
  sm exact := exact
  
((the_function '. setup' StrMatch Str CBool) arg 0):maps := 2


method sm drop_spaces
  arg_rw StrMatch sm
  while sm:current<>sm:stop and { var Char c := sm:current map Char ; c=" ":0 or c="[tab]":0 }
    sm current := sm:current translate Char 1

method sm conditional_drop_spaces
  arg_rw StrMatch sm
  if not sm:exact
    sm drop_spaces

method s drop_end_spaces
  arg_rw Str s
  var Int l := s:len
  if l<>0 and ( (s l-1)=" ":0 or (s l-1)="[tab]":0 )
    while l<>0 and (s l-1)=" ":0
      l := l-1
    s resize l
    

method sm underscore -> ok
  arg_rw StrMatch sm ; arg CBool ok
  if sm:current=sm:stop
    return false
  var Char c := sm:current map Char
  sm current := sm:current translate Char 1
  sm drop_spaces
  ok := c=" ":0 or c="[tab]":0

method sm underscore s -> ok
  arg_rw StrMatch sm ; arg_w Str s ; arg CBool ok
  var Address cur := sm current
  while sm:current<>sm:stop and { var Char c := sm:current map Char ; c<>" ":0 and c<>"[tab]":0 }
    sm current := sm:current translate Char 1
  if sm:current=sm:stop
    return false
  var Int l := (cast sm:current Int).-.(cast cur Int)
  s set (memory_allocate l addressof:s) l true
  memory_copy cur s:characters l
  sm drop_spaces
  ok := true


method sm spaces sp -> ok
  arg_rw StrMatch sm ; arg_w Str sp ; arg CBool ok
  var Address cur := sm current
  sm drop_spaces
  var Int l := (cast sm:current Int).-.(cast cur Int)
  sp set (memory_allocate l addressof:sp) l true
  memory_copy cur sp:characters l
  ok := true

method sm spaces s sp -> ok
  arg_rw StrMatch sm ; arg_w Str s sp ; arg CBool ok
  var Address cur := sm current
  while sm:current<>sm:stop and { var Char c := sm:current map Char ; c<>" ":0 and c<>"[tab]":0 }
    sm current := sm:current translate Char 1
  var Int l := (cast sm:current Int).-.(cast cur Int)
  s set (memory_allocate l addressof:s) l true
  memory_copy cur s:characters l
  var Address cur := sm current
  sm drop_spaces
  var Int l := (cast sm:current Int).-.(cast cur Int)
  sp set (memory_allocate l addressof:sp) l true
  memory_copy cur sp:characters l
  ok := true


method sm pattern p -> ok
  arg_rw StrMatch sm ; arg Str p ; arg CBool ok
  check p:len>0
  sm conditional_drop_spaces
  var Int l := (cast sm:stop Int).-.(cast sm:current Int)
  if l<p:len
    return false
  if (memory_different sm:current p:len p:characters p:len)
    return false
  sm current := sm:current translate Char p:len
  ok := true

method sm pattern s p -> ok
  arg_rw StrMatch sm ; arg_w Str s ; arg Str p ; arg CBool ok
  sm conditional_drop_spaces
  var Address a := memory_search sm:current (cast sm:stop Int).-.(cast sm:current Int) p:characters p:len
  if a=null
    return false
  var Int l := (cast a Int).-.(cast sm:current Int)
  s set (memory_allocate l addressof:s) l true
  memory_copy sm:current s:characters l
  if not sm:exact
    s drop_end_spaces
  sm current := a translate Char p:len
  ok := true


method sm word p -> ok
  arg_rw StrMatch sm ; arg Str p ; arg CBool ok
  ok := sm pattern p
  if sm:current<>sm:stop and (sm:current map Char):isidentcharacter
    ok := false

method sm word s p -> ok
  arg_rw StrMatch sm ; arg_w Str s ; arg Str p ; arg CBool ok
  sm conditional_drop_spaces
  var Address a := memory_search sm:current (cast sm:stop Int).-.(cast sm:current Int) p:characters p:len
  if a=null
    return false
  eif a<>sm:current and ((a translate Char -1) map Char):isidentcharacter
    return false
  ok := (sm pattern s p)
  if sm:current<>sm:stop and (sm:current map Char):isidentcharacter
    ok := false
 

function memory_acdifferent area1 size1 area2 size2 -> c
  arg Address area1 ; arg Int size1 ; arg Address area2 ; arg Int size2 ; arg CBool c
  # unefficient implementation
  (var Str s1) set area1 size1 false
  (var Str s2) set area2 size2 false
  c := lower:s1<>lower:s2

method sm acpattern p -> ok
  arg_rw StrMatch sm ; arg Str p ; arg CBool ok
  check p:len>0
  sm conditional_drop_spaces
  var Int l := (cast sm:stop Int).-.(cast sm:current Int)
  if l<p:len
    return false
  if (memory_acdifferent sm:current p:len p:characters p:len)
    return false
  sm current := sm:current translate Char p:len
  ok := true

function memory_acsearch address size pattern_address pattern_size -> p
  arg Address address ; arg Int size ; arg Address pattern_address ; arg Int pattern_size ; arg Address p
  # unefficient implementation
  (var Str s) set address size false
  (var Str pattern) set pattern_address pattern_size false
  var Int i := lower:s search lower:pattern -1
  if i<>(-1)
    p := address translate Byte i
  else
    p := null

method sm acpattern s p -> ok
  arg_rw StrMatch sm ; arg_w Str s ; arg Str p ; arg CBool ok
  sm conditional_drop_spaces
  var Address a := memory_acsearch sm:current (cast sm:stop Int).-.(cast sm:current Int) p:characters p:len
  if a=null
    return false
  var Int l := (cast a Int).-.(cast sm:current Int)
  s set (memory_allocate l addressof:s) l true
  memory_copy sm:current s:characters l
  if not sm:exact
    s drop_end_spaces
  sm current := a translate Char p:len
  ok := true


method sm acword p -> ok
  arg_rw StrMatch sm ; arg Str p ; arg CBool ok
  ok := sm acpattern p
  if sm:current<>sm:stop and (sm:current map Char):isidentcharacter
    ok := false

method sm acword s p -> ok
  arg_rw StrMatch sm ; arg_w Str s ; arg Str p ; arg CBool ok
  sm conditional_drop_spaces
  var Address a := memory_acsearch sm:current (cast sm:stop Int).-.(cast sm:current Int) p:characters p:len
  if a=null
    return false
  eif a<>sm:current and ((a translate Char -1) map Char):isidentcharacter
    return false
  ok := (sm acpattern s p)
  if sm:current<>sm:stop and (sm:current map Char):isidentcharacter
    ok := false
 



method sm from_string u f -> ok
  arg_rw StrMatch sm ; arg_w Universal u ; arg Function f ; arg CBool ok
  sm conditional_drop_spaces
  (var Str string) set sm:current (cast sm:stop Int).-.(cast sm:current Int) false
  if (from_string u string "" false (var Int skiped) (var Int offset) f)=success
    sm:current := sm:current translate Byte offset
    ok := true
  else
    ok := false

method sm from_string s u f -> ok
  arg_rw StrMatch sm ; arg_w Str s ; arg_w Universal u ; arg Function f ; arg CBool ok
  sm conditional_drop_spaces
  (var Str string) set sm:current (cast sm:stop Int).-.(cast sm:current Int) false
  if (from_string u string "" true (var Int skiped) (var Int offset) f)=success
    s set sm:current skiped false    
    sm:current := sm:current translate Byte offset
    ok := true
  else
    ok := false


method sm offset i
  arg_rw StrMatch sm ; arg_w Int i
  i := (cast sm:current Int).-.(cast sm:start Int)


method sm conclude initial -> ok
  arg_rw StrMatch sm ; arg Str initial ; arg CBool ok
  sm conditional_drop_spaces
  ok := sm:current=sm:stop

method sm conclude s initial -> ok
  arg_rw StrMatch sm ; arg_w Str s ; arg Str initial ; arg CBool ok
  sm conditional_drop_spaces
  var Int l := (cast sm:stop Int).-.(cast sm:current Int)
  var Address c := memory_allocate l addressof:s
  memory_copy sm:current c l
  s set c l true
  if not sm:exact
    s drop_end_spaces
  ok := true

# initial is used to prevent the matched string to be reused as a temporary string
if ((the_function '. conclude' StrMatch Str -> CBool):flags .and. function_flag_inline_instructions)<>0 or ((the_function '. conclude' StrMatch Str Str -> CBool):flags .and. function_flag_inline_instructions)<>0
  error_notify error_id_unexpected null "conclude is inline !!!"


function try_match e exact
  arg_rw Expression e ; arg CBool exact
  if e:size<1 or not (e:0 cast Str)
    return
  var Link:Argument sm :> argument local StrMatch
  var Link:Argument ok :> argument local CBool
  var Link:Instruction end :> instruction the_function:'do nothing'
  var Pointer:Argument s :> null map Argument
  e suckup e:0
  e add (instruction (the_function '. setup' StrMatch Str CBool) sm e:0:result (argument constant CBool exact))
  for (var Int i) 1 e:size-1
    if addressof:(entry_type e:i:value)=addressof:Str or addressof:(entry_type e:i:value)=addressof:Char
      var Str pattern
      if addressof:(entry_type e:i:value)=addressof:Str
        pattern := e:i:value map Str
      else
        pattern := e:i:value map Char
      if addressof:s=null
        e add (instruction (the_function '. pattern' StrMatch Str -> CBool) sm (argument constant Str pattern) ok)
      else      
        e add (instruction (the_function '. pattern' StrMatch Str Str -> CBool) sm s (argument constant Str pattern) ok)
        s :> null map Argument        
      e add (instruction (the_function 'jump if not' CBool) ok jump end)
    eif e:i:ident="_" and e:i:size=0
      if addressof:s=null
        e add (instruction (the_function '. underscore' StrMatch -> CBool) sm ok)
      else      
        e add (instruction (the_function '. underscore' StrMatch Str -> CBool) sm s ok)
        s :> null map Argument        
      e add (instruction (the_function 'jump if not' CBool) ok jump end)
    eif e:i:ident="spaces" and e:i:size=1 and (e:i:0 cast Str)
      e suckup e:i:0
      if addressof:s=null
        e add (instruction (the_function '. spaces' StrMatch Str -> CBool) sm e:i:0:result ok)
      else      
        e add (instruction (the_function '. spaces' StrMatch Str Str -> CBool) sm s e:i:0:result ok)
        s :> null map Argument        
      e add (instruction (the_function 'jump if not' CBool) ok jump end)
    eif e:i:ident="pattern" and e:i:size=1 and (e:i:0 cast Str)
      e suckup e:i:0
      if addressof:s=null
        e add (instruction (the_function '. pattern' StrMatch Str -> CBool) sm e:i:0:result ok)
      else      
        e add (instruction (the_function '. pattern' StrMatch Str Str -> CBool) sm s e:i:0:result ok)
        s :> null map Argument        
      e add (instruction (the_function 'jump if not' CBool) ok jump end)
    eif e:i:ident="word" and e:i:size=1 and (e:i:0 cast Str)
      e suckup e:i:0
      if addressof:s=null
        e add (instruction (the_function '. word' StrMatch Str -> CBool) sm e:i:0:result ok)
      else      
        e add (instruction (the_function '. word' StrMatch Str Str -> CBool) sm s e:i:0:result ok)
        s :> null map Argument        
      e add (instruction (the_function 'jump if not' CBool) ok jump end)
    eif e:i:ident="acpattern" and e:i:size=1 and (e:i:0 cast Str)
      e suckup e:i:0
      if addressof:s=null
        e add (instruction (the_function '. acpattern' StrMatch Str -> CBool) sm e:i:0:result ok)
      else      
        e add (instruction (the_function '. acpattern' StrMatch Str Str -> CBool) sm s e:i:0:result ok)
        s :> null map Argument        
      e add (instruction (the_function 'jump if not' CBool) ok jump end)
    eif e:i:ident="acword" and e:i:size=1 and (e:i:0 cast Str)
      e suckup e:i:0
      if addressof:s=null
        e add (instruction (the_function '. acword' StrMatch Str -> CBool) sm e:i:0:result ok)
      else      
        e add (instruction (the_function '. acword' StrMatch Str Str -> CBool) sm s e:i:0:result ok)
        s :> null map Argument        
      e add (instruction (the_function 'jump if not' CBool) ok jump end)
    eif e:i:ident="any" and e:i:size=0 and addressof:s=null
      s :> argument local Str
    eif e:i:ident="any" and e:i:size=1 and (e:i:0 cast Str) and addressof:s=null
      e suckup e:i:0
      s :> e:i:0:result
    eif e:i:ident="offset" and e:i:size=1 and (e:i:0 cast Int) and addressof:s=null
      e suckup e:i:0
      e add (instruction (the_function '. offset' StrMatch Int) sm e:i:0:result)
    eif { e:i compile ; (addressof e:i:result)<>null } and { var Pointer:Function function :> e:i:result:type get_generic_method (the_function '. from string' Universal Str Str CBool Int Int -> Status):generic_index ; addressof:function<>null and addressof:function<>addressof:(the_function '. from string' Universal Str Str CBool Int Int -> Status) }
      e suckup e:i
      if addressof:s=null
        e add (instruction (the_function '. from_string' StrMatch Universal Function -> CBool) sm e:i:result (argument mapped_constant Function function) ok)
      else      
        e add (instruction (the_function '. from_string' StrMatch Str Universal Function -> CBool) sm s e:i:result (argument mapped_constant Function function) ok)
        s :> null map Argument        
      e add (instruction (the_function 'jump if not' CBool) ok jump end)
    else
      return
  if addressof:s=null
    e add (instruction (the_function '. conclude' StrMatch Str -> CBool) sm e:0:result ok)
  else      
    e add (instruction (the_function '. conclude' StrMatch Str Str -> CBool) sm s e:0:result ok)
  e add end  
  e set_result ok access_read

meta '. parse' e
  try_match e false

meta '. eparse' e
  try_match e true

export '. parse' '. eparse'


#----------------------------------------------------------------------


constant to_index (the_function '. to string' Universal Str -> Str):generic_index

function to_string data options function -> string
  arg Universal data ; arg Str options ; arg Function function ; arg Str string
  indirect
  
meta string e
  if e:size<1 or e:size>2
    return
  e:0:compile ?
  if e:size=2 and not (e:1 cast Str)
    return
  var Pointer:Type type :> e:0:result:type:real_data_type
  var Pointer:Function function :> type get_generic_method to_index
  if addressof:function=null or addressof:function=addressof:(the_function '. to string' Universal Str -> Str)
    return
  e:0 cast type ?
  e suckup e:0
  var Link:Argument options
  if e:size=2
    e suckup e:1
    options :> e:1:result
  else
    options :> argument constant Str ""
  var Link:Argument result :> argument local Str
  e add (instruction (the_function to_string Universal Str Function -> Str) e:0:result options (argument mapped_constant Function function) result)
  e set_result result access_read

export string