src/antimony/antimony_reader.sb

   1 # Functions for reading Antimony code from streams.
   2
   3 section data
   4 export _antimony_reader_eof
   5
   6 var _antimony_reader_eof = -1
   7
   8
   9 section functions
  10 export read_antimony
  11 import eq ge gt le lt ne true false
  12 import allocate_bytes array array_length array_nth array_t \
  13   blob_builder blob_builder_append_byte \
  14   blob_builder_to_blob block dynarray dynarray_add dynarray_to_array \
  15   get_namespace make_blob make_comment namespace_intern \
  16   read_byte_from_stream type_of *namespace*
  17 import get_namespace_absolute
  18
  19 function read_antimony stream {
  20   let lookahead auto-words 1
  21   set @lookahead read_byte_from_stream stream
  22   let expr read_stmt stream lookahead
  23   return expr
  24 }
  25
  26 function decode_escape b stream {
  27   if (eq b 34) {                 # "
  28     return b
  29   } else if (eq b 92) {  # backslash
  30     return b
  31   } else if (eq b 110) {         # n
  32     return 10                    # newline
  33   } else if (eq b 114) {         # r
  34     return 13                    # carriage return
  35   } else if (eq b 116) {         # t
  36     return 8                     # tab
  37   } else if (eq b 120) {    # x
  38     var value = 0
  39     set b read_byte_from_stream stream
  40     if (lt b 48) {               # 0
  41     } else if (le b 58) {        # 9
  42       set value sub b 48
  43     } else if (lt b 97) {        # a
  44     } else if (le b 102) {  # f
  45       set value sub b 87
  46     }
  47     set value shl value 4
  48     set b read_byte_from_stream stream
  49     if (lt b 48) {               # 0
  50     } else if (le b 58) {        # 9
  51       set value or value (sub b 48)
  52     } else if (lt b 97) {        # a
  53     } else if (le b 102) {  # f
  54       set value or value (sub b 87)
  55     }
  56     return value
  57   }
  58   return b
  59 }
  60
  61 function read_blob stream lookahead {
  62   let builder (blob_builder)
  63   loop {
  64     var b = 0
  65     do
  66     set b read_byte_from_stream stream
  67     while (ne b 34)     # "
  68     if (eq b 92) {              # backslash
  69       set b read_blob_escape stream
  70     }
  71     blob_builder_append_byte builder b
  72   }
  73   set @lookahead read_byte_from_stream stream
  74   return (blob_builder_to_blob builder)
  75 }
  76
  77 function read_blob_escape stream {
  78   var b = read_byte_from_stream stream
  79   return (decode_escape b stream)
  80 }
  81
  82 function read_block stream lookahead {
  83   let exprs dynarray 0 0
  84   let expr 0
  85   set @lookahead read_byte_from_stream stream
  86   loop {
  87     var looping = @true
  88     do
  89     if (eq @lookahead 125) {   # }
  90       set @lookahead read_byte_from_stream stream
  91       set looping @false
  92     }
  93     while looping
  94     while (ne @lookahead -1)
  95     set expr read_expr stream lookahead
  96     if (ne expr -1) {
  97       dynarray_add exprs expr
  98     }
  99   }
 100   let arr dynarray_to_array exprs
 101   return (block arr)
 102 }
 103
 104 function read_comment stream lookahead {
 105   var builder = (blob_builder)
 106   blob_builder_append_byte builder 35   # #
 107   loop {
 108     do
 109     while (eq @lookahead 35)   # #
 110     blob_builder_append_byte builder @lookahead
 111     set @lookahead read_byte_from_stream stream
 112   }
 113   if (eq @lookahead 32) {        # space
 114     blob_builder_append_byte builder @lookahead
 115     set @lookahead read_byte_from_stream stream
 116   }
 117   let marker blob_builder_to_blob builder
 118   set builder (blob_builder)
 119   loop {
 120     do
 121     while (ne @lookahead 10)   # newline
 122     while (ne @lookahead -1)
 123     blob_builder_append_byte builder @lookahead
 124     set @lookahead read_byte_from_stream stream
 125   }
 126   return (make_comment marker (blob_builder_to_blob builder))
 127 }
 128
 129 function read_expr stream lookahead {
 130   var params = dynarray 0 0
 131   var i = 0
 132   loop {
 133     var item = 0
 134     var looping = @true
 135     do
 136     while (ne @lookahead 41)   # )
 137     while (ne @lookahead 125)  # }
 138     if (eq @lookahead 10) {    # newline
 139       if (gt i 0) {
 140         set looping @false
 141       } else {
 142         set @lookahead read_byte_from_stream stream
 143       }
 144     } else if (eq @lookahead 9) {   # tab
 145       set @lookahead read_byte_from_stream stream
 146     } else if (eq @lookahead 32) {  # space
 147       set @lookahead read_byte_from_stream stream
 148     } else {
 149       set item read_item stream lookahead
 150       if (eq item _antimony_reader_eof) {
 151         set looping @false
 152       } else {
 153         dynarray_add params item
 154         set i add i 1
 155       }
 156     }
 157     while looping
 158   }
 159
 160   if (eq i 0) {
 161     return -1
 162   } else {
 163     return (dynarray_to_array params)
 164   }
 165 }
 166
 167 function read_item stream lookahead {
 168   let c @lookahead
 169   if (ge c 48) {    # 0
 170     if (le c 57) {  # 9
 171       return (read_number stream lookahead)
 172     }
 173   }
 174   if (eq c 45) {    # -
 175     return (read_number stream lookahead)
 176   }
 177   if (eq c 34) {    # "
 178     return (read_blob stream lookahead)
 179   }
 180   if (eq c 35) {    # #
 181     return (read_special stream lookahead)
 182   }
 183   if (eq c 40) {    # (
 184     set @lookahead read_byte_from_stream stream
 185     let expr read_expr stream lookahead
 186     if (eq @lookahead 41) {  # )
 187       set @lookahead read_byte_from_stream stream
 188     }
 189     return expr
 190   }
 191   if (eq c 92) {    # backslash
 192     set c read_byte_from_stream stream
 193     if (eq c 10) {  # newline
 194       # Read until there is no more whitespace.
 195       loop {
 196         var looping = @true
 197         do
 198         while looping
 199         set c read_byte_from_stream stream
 200         set looping @false
 201         if (eq c 32) {
 202           set looping @true
 203         }
 204         if (eq c 9) {
 205           set looping @true
 206         }
 207       }
 208       set @lookahead c
 209       return (read_item stream lookahead)
 210     } else {
 211       let builder (blob_builder)
 212       blob_builder_append_byte (decode_escape c stream)
 213       set @lookahead read_byte_from_stream stream
 214       return (read_symbol1 stream lookahead builder)
 215     }
 216   }
 217   if (eq c 123) {   # {
 218     return (read_block stream lookahead)
 219   }
 220   if (eq c 10) {
 221     return _antimony_reader_eof
 222   }
 223   if (eq c -1) {
 224     return _antimony_reader_eof
 225   }
 226   return (read_symbol stream lookahead)
 227 }
 228
 229 function read_number stream lookahead {
 230   let c @lookahead
 231   let value 0
 232   if (eq c 45) {    # -
 233     set c read_number_aux stream 0 lookahead
 234     set value sub 0 c
 235   } else {
 236     set value sub c 48   # 0
 237     set value read_number_aux stream value lookahead
 238   }
 239   set value shl value 2
 240   set value or value 1
 241   return value
 242 }
 243
 244 function read_number_aux stream value lookahead {
 245   let c 0
 246   loop {
 247     do
 248     set c read_byte_from_stream stream
 249     while (ge c 48)  # 0
 250     while (le c 57)  # 9
 251     set value mul value 10
 252     set c sub c 48
 253     set value add value c
 254   }
 255   set @lookahead c
 256   return value
 257 }
 258
 259 function read_special stream lookahead {
 260   let c read_byte_from_stream stream
 261   if (eq c 32) {         # space
 262     set @lookahead c
 263     return (read_comment stream lookahead)
 264   } else if (eq c 35) {  # #
 265     set @lookahead c
 266     return (read_comment stream lookahead)
 267   } else if (eq c 96) {  # `
 268     set @lookahead read_byte_from_stream stream
 269     let expr read_item stream lookahead
 270     let items auto-words 2
 271     set-word items 0 (namespace_intern @*namespace* "quote")
 272     set-word items 1 expr
 273     return (array 2 items)
 274   }
 275   let bytes allocate_bytes 1
 276   set-byte bytes 0 @lookahead
 277   set @lookahead c
 278   return (namespace_intern @*namespace* (make_blob bytes 1))
 279 }
 280
 281 function read_stmt stream lookahead {
 282   let result read_expr stream lookahead
 283   if (eq (type_of result) array_t) {
 284     if (eq (array_length result) 1) {
 285       return (array_nth result 0)
 286     }
 287   }
 288   return result
 289 }
 290
 291 function read_symbol stream lookahead {
 292   let builder (blob_builder)
 293   return (read_symbol1 stream lookahead builder)
 294 }
 295
 296 function read_symbol1 stream lookahead builder {
 297   let c @lookahead
 298   let namespace @*namespace*
 299   loop {
 300     do
 301     while (ge c 33)    # !
 302     while (ne c 41)    # )
 303     while (ne c 125)   # }
 304     while (ne c 40)    # (
 305     while (ne c 123)   # {
 306     if (eq c 46) {     # .
 307       let name blob_builder_to_blob builder
 308       let sym namespace_intern namespace name
 309       set namespace get_namespace sym
 310       set builder (blob_builder)
 311       set c read_byte_from_stream stream
 312     } else if (eq c 92) {  # backlash
 313       set c read_byte_from_stream stream
 314       blob_builder_append_byte builder (decode_escape c stream)
 315       set c read_byte_from_stream stream
 316     } else {
 317       blob_builder_append_byte builder c
 318       set c read_byte_from_stream stream
 319     }
 320   }
 321   set @lookahead c
 322   let name blob_builder_to_blob builder
 323   return (namespace_intern namespace name)
 324 }