Add code for .panic and the <O(...)> subrule.

perl6 · Oct 19, 2009 · 2a077e8 · 2a077e8
1 parent a27d5d1
commit 2a077e8
Showing 1 changed file with 122 additions and 0 deletions.
diff --git a/src/cheats/nqp-grammar.pir b/src/cheats/nqp-grammar.pir
@@ -0,0 +1,122 @@
+.include 'cclass.pasm'
+
+.namespace ['NQP';'Grammar']
+
+.sub 'O' :method
+    .param string spec
+    .param string save         :optional
+    .param int has_save        :opt_flag
+
+    .local pmc ohash
+    ohash = get_global '%!ohash'
+    unless null ohash goto have_ohash
+    ohash = new ['Hash']
+    set_global '%!ohash', ohash
+  have_ohash:
+
+    .local pmc hash
+    hash = ohash[spec]
+    unless null hash goto hash_done
+
+    hash = new ['Hash']
+
+    .local int pos, eos
+    pos = 0
+    eos = length spec
+
+  spec_loop:
+    pos = find_not_cclass .CCLASS_WHITESPACE, spec, pos, eos
+    if pos >= eos goto spec_done
+    $S0 = substr spec, pos, 1
+    if $S0 == ',' goto spec_comma
+    if $S0 == ':' goto spec_pair
+    .local string lookup
+    .local int lpos
+    lpos = find_cclass .CCLASS_WHITESPACE, spec, pos, eos
+    $I0 = lpos - pos
+    lookup = substr spec, pos, $I0
+    .local pmc lhash, lhash_it
+    lhash = ohash[lookup]
+    if null lhash goto err_lookup
+    lhash_it = iter lhash
+  lhash_loop:
+    unless lhash_it goto lhash_done
+    $S0 = shift lhash_it
+    $P0 = lhash[$S0]
+    hash[$S0] = $P0
+    goto lhash_loop
+  lhash_done:
+    pos = lpos
+    goto spec_loop
+  spec_comma:
+    inc pos
+    goto spec_loop
+  spec_pair:
+    # eat colon
+    inc pos
+    .local string name
+    .local pmc value
+    value = new ['Boolean']
+    $S0 = substr spec, pos, 1
+    $I0 = iseq $S0, '!'
+    pos += $I0
+    $I0 = not $I0
+    value = $I0
+    lpos = find_not_cclass .CCLASS_WORD, spec, pos, eos
+    $I0 = lpos - pos
+    name = substr spec, pos, $I0
+    pos = lpos
+    $S0 = substr spec, pos, 1
+    unless $S0 == '<' goto have_value
+    inc pos
+    lpos = index spec, '>', pos
+    $I0 = lpos - pos
+    $S0 = substr spec, pos, $I0
+    value = box $S0
+    pos = lpos + 1
+  have_value:
+    hash[name] = value
+    goto spec_loop 
+  spec_done:
+    ohash[spec] = hash
+  hash_done:
+
+    if has_save goto save_hash
+    ($P0, $I0) = self.'!cursor_start'()
+    $P0.'!cursor_pass'($I0, '')
+    setattribute $P0, '$!match', hash
+    .return ($P0)
+
+  save_hash:
+    ohash[save] = hash
+    .return ()
+
+  err_lookup:
+    self.'panic'('Unknown operator precedence specification "', lookup, '"')
+.end
+
+
+.sub 'panic' :method
+    .param pmc args            :slurpy
+
+    .local int pos
+    .local pmc target
+    pos = self.'pos'()
+    target = getattribute self, '$!target'
+
+    $I1 = target.'lineof'(pos)
+    push args, ' at line '
+    push args, $I1
+
+    $S0 = target
+    $S0 = substr $S0, pos, 10
+    $S0 = escape $S0
+    push args, ', near "'
+    push args, $S0
+    push args, '"'
+
+    .local string message
+    message = join '', args
+
+    die message
+.end