home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / forst / xparse.s < prev   
Encoding:
Text File  |  1993-10-23  |  2.3 KB  |  89 lines
  1. \ xparse.s: parse the input stream until one of a set of delimiters
  2. \ (specified in a counted array) is found, or the stream is exhausted.
  3.  
  4. decimal
  5. -1 constant true
  6. 0  constant false
  7. 32 constant bl
  8. 13 constant cret
  9. -1 constant eof
  10. \ character arrays: first value is the number of chars
  11.  
  12. create punctchars 7 w,
  13.  ascii , w,  ascii ; w,  ascii ( w,  ascii ) w,  bl w,  cret w,  eof w,
  14. create endchars  3 w,
  15.  cret w,  ascii ; w,  eof w,
  16. create whitechars  4 w,
  17.  bl w,  9 w,  cret w,  10 w,
  18. create string 80 allot
  19.  
  20. : match    { 2 regargs char matchptr 2 regs #puncts result }
  21.   false  ( result on stack)  matchptr inc w@ to #puncts
  22.   for #puncts
  23.     matchptr inc w@ char =  if 1- ( make result true) leave then
  24.   next
  25.   ( return result) ;
  26.   
  27. : punct  ( char--t/f) punctchars match ;
  28. : endchar  ( char--t/f) endchars match ;
  29. : white  ( char--t/f) whitechars match ;
  30.  
  31. \ printchar: keep fetching chars until one is printable, then return it
  32.  
  33. : printchar  { 1 reg char }
  34.   begin
  35.    inchar to char
  36.    char white not
  37.    char 0< or
  38.   until  char ( return it) ;
  39.  
  40. \ xparse: skip over leading white space, then assemble a string until
  41. \ a punctuation char (defined above) is fetched, and
  42. \ return a pointer to a counted string, with the terminating char on top
  43.  
  44. : xparse  { 3 regs strpointer char #chars }
  45.   string 1+ to strpointer  0 to #chars
  46.   printchar to char  ( skip over white space)
  47.   begin
  48.     char 0<  char punct  or not
  49.   while
  50.     char strpointer inc c!  1 addto #chars
  51.     inchar to char  ( get another char)
  52.   repeat
  53.   bl strpointer inc c!  0 strpointer c! ( term with space, then null)
  54.   #chars string c!  string char ( return string and term char) ;
  55.  
  56.  
  57. \ newword: a high-level version of word, functionally equivalent
  58. \ to the the system version
  59.  
  60. : newword  { 1 regarg delim  3 regs strpointer char #chars }
  61.  
  62.   string 1+ to strpointer  0 to #chars
  63.   
  64.   delim bl =
  65.   if  printchar  else  inchar  then  to char
  66.   
  67.   begin
  68.  
  69.     char 0<  if leave then ( end of string)
  70.   
  71.     char strpointer inc c!  1 addto #chars
  72.  
  73.     inchar to char  ( get another char)
  74.         
  75.     delim bl =
  76.     if
  77.       char white
  78.     else
  79.       char delim =
  80.     then
  81.     
  82.   until
  83.  
  84.   bl strpointer inc c!  0 strpointer c! ( space, then null)
  85.   
  86.   #chars string c!
  87.   string ( return string)
  88. ;
  89.