ps/reader.ps

   1 % requires types.ps to be included first
   2
   3 /token_delim (;,"` \n{}\(\)[]) def
   4 /token_number (0123456789-) def
   5
   6 % read_number: read a single number from string/idx
   7 % string idx -> read_number -> number string new_idx
   8 /read_number { 5 dict begin
   9     %(in read_number\n) print
  10     /idx exch def
  11     /str exch def
  12     /start idx def
  13     /cnt 0 def
  14     { % loop
  15         idx str length ge { exit } if % EOF, break loop
  16         /ch str idx get def  % current character
  17         ch 48 ge ch 57 le and 45 ch eq or { %if number
  18             /cnt cnt 1 add def
  19         }{ % else
  20             exit
  21         } ifelse
  22         /idx idx 1 add def % increment idx
  23     } loop
  24
  25     str start cnt getinterval cvi % the matched number
  26     str idx % return: number string new_idx
  27 end } def
  28
  29
  30 % read_symbol: read a single symbol from string/idx
  31 % string idx -> read_symbol -> name string new_idx
  32 /read_symbol { 5 dict begin
  33     %(in read_symbol\n) print
  34     /idx exch def
  35     /str exch def
  36     /start idx def
  37     /cnt 0 def
  38     { % loop
  39         idx str length ge { exit } if % EOF, break loop
  40         /ch str idx 1 getinterval def
  41         token_delim ch search { % if token delimeter
  42             pop pop pop exit
  43         }{ % else not a delim
  44             pop
  45             /cnt cnt 1 add def
  46         } ifelse
  47         /idx idx 1 add def % increment idx
  48     } loop
  49
  50     str start cnt getinterval cvn % the matched symbol
  51     str idx % return: symbol string new_idx
  52 end } def
  53
  54
  55 % read_keyword: read a single keyword from string/idx
  56 % string idx -> read_keyword -> name string new_idx
  57 /read_keyword { 5 dict begin
  58     %(in read_keyword\n) print
  59     /idx exch def
  60     /str exch def
  61     /start idx def
  62     /cnt 0 def
  63     { % loop
  64         idx str length ge { exit } if % EOF, break loop
  65         /ch str idx 1 getinterval def
  66         token_delim ch search { % if token delimeter
  67             pop pop pop exit
  68         }{ % else not a delim
  69             pop
  70             /cnt cnt 1 add def
  71         } ifelse
  72         /idx idx 1 add def % increment idx
  73     } loop
  74
  75     str start cnt getinterval % the matched keyword string
  76     dup 0 127 put % TODO: something like (\x029e) would be better
  77     str idx % return: keyword string new_idx
  78 end } def
  79
  80
  81 % read_string: read a single string from string/idx
  82 % string idx -> read_string -> new_string string new_idx
  83 /read_string { 5 dict begin
  84     %(in read_string\n) print
  85     /idx exch 1 add def
  86     /str exch def
  87     /start idx def
  88     /cnt 0 def
  89     { % loop
  90         idx str length ge { %if EOF
  91             (unexpected EOF reading string) _throw
  92         } if
  93         /ch str idx get def  % current character
  94         /idx idx 1 add def
  95         ch 92 eq { % if \
  96             str idx get 34 eq { %if \"
  97                 /idx idx 1 add def
  98                 /cnt cnt 1 add def % 1 more below
  99             } if
 100         } if
 101         ch 34 eq { exit } if % '"' is end of string
 102         /cnt cnt 1 add def
 103     } loop
 104     str start cnt getinterval % the matched string
 105     (\\") (") replace
 106     (\\n) (\n) replace
 107     (\\\\) (\\) replace
 108     str idx % return: new_string string new_idx
 109 end } def
 110
 111
 112 % read_atom: read a single atom from string/idx
 113 % string idx -> read_atom -> int string new_idx
 114 /read_atom { 4 dict begin
 115     %(in read_atom\n) print
 116     /idx exch def
 117     /str exch def
 118     str length idx le { % ifelse
 119         exit % EOF
 120     }{
 121         /ch str idx get def  % current character
 122         str length idx 1 add le {
 123             /nextch 0 def
 124         }{
 125             /nextch str idx 1 add get def  % next character
 126         } ifelse
 127         ch 48 ge ch 57 le and { %if digit (number)
 128             str idx read_number
 129         }{ ch 45 eq nextch 48 ge nextch 57 le and and { %elseif minus and digit
 130             str idx read_number
 131         }{ ch 34 eq { %elseif double-quote (string)
 132             str idx read_string
 133         }{ ch 58 eq { %elseif colon (keyword)
 134             str idx read_keyword
 135         }{
 136             str idx read_symbol
 137             /idx exch def pop
 138             dup /nil eq { %if nil
 139                 pop null str idx
 140             }{ dup /true eq { %elseif true
 141                 pop true str idx
 142             }{ dup /false eq { %elseif false
 143                 pop false str idx
 144             }{ %else
 145                 str idx % return the original symbol/name
 146             } ifelse } ifelse } ifelse
 147         } ifelse } ifelse } ifelse } ifelse
 148     }ifelse
 149
 150     % return: atom string new_idx
 151 end } def
 152
 153 % read_until: read a list from string/idx until stopchar is found
 154 % string idx stopchar -> read_until -> list string new_idx
 155 /read_until { 3 dict begin
 156     %(in read_until\n) print
 157     /stopchar exch def
 158     /idx exch 1 add def
 159     /str exch def
 160     [
 161     { % loop
 162         str idx read_spaces /idx exch def pop
 163         str length idx le { %if EOF
 164             (unexpected EOF reading list) _throw
 165         } if
 166         /ch str idx get def  % current character
 167         ch stopchar eq { exit } if % stop at stopchar
 168         str idx read_form /idx exch def pop
 169     } loop
 170     ]
 171     str idx 1 add
 172 end } def
 173
 174 % read_spaces: advance idx to the first non-whitespace
 175 % string idx -> read_form -> string new_idx
 176 /read_spaces { 3 dict begin
 177     %(in read_spaces\n) print
 178     /idx exch def
 179     /str exch def
 180     { % loop
 181         str length idx le { exit } if % EOF, break loop
 182         /ch str idx get def  % current character
 183         %(left1.1:) print str idx str length idx sub getinterval print (\n) print
 184         % eliminate comments
 185         ch 59 eq { %if ';'
 186             { % loop
 187                 /idx idx 1 add def % increment idx
 188                 str length idx le { exit } if % EOF, break loop
 189                 /ch str idx get def  % current character
 190                 %(left1.2:) print str idx str length idx sub getinterval print (\n) print
 191                 % if newline then we are done
 192                 ch 10 eq { exit } if
 193             } loop
 194             /idx idx 1 add def
 195             str length idx le { exit } if % EOF, break loop
 196             /ch str idx get def  % current character
 197         } if
 198         % if not whitespace then exit
 199         ch 32 ne ch 10 ne ch 44 ne and and { exit } if
 200         /idx idx 1 add def % increment idx
 201     } loop
 202
 203     %(left1.3:) print str idx str length idx sub getinterval print (\n) print
 204     str idx % return: string new_idx
 205 end } def
 206
 207 % read_form: read the next form from string start at idx
 208 % string idx -> read_form -> ast string new_idx
 209 /read_form { 3 dict begin
 210     %(in read_form\n) print
 211     read_spaces
 212     /idx exch def
 213     /str exch def
 214
 215     %idx str length ge { (unexpected EOF) _throw } if % EOF
 216     idx str length ge { null str idx }{ %if EOF
 217
 218     /ch str idx get def  % current character
 219     %(LEFT2.1:) print str idx str length idx sub getinterval print (\n) print
 220     ch 39 eq { %if '\''
 221         /idx idx 1 add def
 222         str idx read_form
 223         3 -1 roll   /quote exch 2 _list   3 1 roll
 224     }{ ch 96 eq { %if '`'
 225         /idx idx 1 add def
 226         str idx read_form
 227         3 -1 roll   /quasiquote exch 2 _list   3 1 roll
 228     }{ ch 126 eq { %if '~'
 229         /idx idx 1 add def
 230         /ch str idx get def  % current character
 231         ch 64 eq { %if '~@'
 232             /idx idx 1 add def
 233             str idx read_form
 234             3 -1 roll   /splice-unquote exch 2 _list   3 1 roll
 235         }{ %else just '~'
 236             str idx read_form
 237             3 -1 roll   /unquote exch 2 _list   3 1 roll
 238         } ifelse
 239     }{ ch 94 eq { %if '^'
 240         /idx idx 1 add def
 241         str idx read_form read_form % stack: meta form str idx
 242         4 2 roll exch   /with-meta 3 1 roll 3 _list   3 1 roll
 243     }{ ch 64 eq { %if '@'
 244         /idx idx 1 add def
 245         str idx read_form
 246         3 -1 roll   /deref exch 2 _list   3 1 roll
 247     }{ ch 40 eq { %if '('
 248         str idx 41 read_until dup /idx exch def
 249         %(LEFT2.2:) print str idx str length idx sub getinterval print (\n) print
 250         3 -1 roll   _list_from_array   3 1 roll
 251         %(LEFT2.3:) print str idx str length idx sub getinterval print (\n) print
 252     }{ ch 41 eq { %elseif ')'
 253         (unexpected '\)') _throw
 254     }{ ch 91 eq { %if '['
 255         str idx 93 read_until dup /idx exch def
 256         %(LEFT2.4:) print str idx str length idx sub getinterval print (\n) print
 257         3 -1 roll   _vector_from_array   3 1 roll
 258     }{ ch 93 eq { %elseif ']'
 259         (unexpected ']') _throw
 260     }{ ch 123 eq { %elseif '{'
 261         str idx 125 read_until dup /idx exch def
 262         3 -1 roll   _hash_map_from_array   3 1 roll
 263     }{ ch 125 eq { %elseif '}'
 264         (unexpected '}') _throw
 265     }{ % else
 266         str idx read_atom
 267     } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse } ifelse
 268
 269     } ifelse % not EOF
 270
 271     % return: ast string new_idx
 272 end } def
 273
 274 % string -> read_str -> ast
 275 /read_str {
 276     %(in read_str\n) print
 277     0  % current index into the string
 278     read_form
 279
 280     pop pop  % drop the string, idx. return: ast
 281 } def