diff options
author | David N. Welton <davidw@efn.org> | 1998-11-09 21:18:01 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:27 -0800 |
commit | 926b1b647ac830660933a5e63eb52d4a2552e264 (patch) | |
tree | e25db5f6e1441d67f5d9af063432018ee20a5f51 /prec.scm | |
parent | b21cac3362022718634f7086964208b2eed8e897 (diff) | |
parent | fa3f23105ddcf07c5900de47f19af43d1db1b597 (diff) | |
download | slib-926b1b647ac830660933a5e63eb52d4a2552e264.tar.gz slib-926b1b647ac830660933a5e63eb52d4a2552e264.zip |
Import Debian changes 2c3-3debian/2c3-3
slib (2c3-3) frozen unstable; urgency=low
* Fixes #16235.
* Fixes #19943.
* Fixes #20265.
* Fixes #24917.
* Fixes #27389.
slib (2c3-2) frozen unstable; urgency=low
* Re-uploaded for slink freeze.
slib (2c3-1) unstable; urgency=low
* New upstream release.
Diffstat (limited to 'prec.scm')
-rw-r--r-- | prec.scm | 38 |
1 files changed, 24 insertions, 14 deletions
@@ -72,7 +72,7 @@ (cond ((eqv? #\newline (tok:peek-char)) (tok:read-char))) ;to do newline (set! tok:column (+ tok:column pos))))) -(define (prec:warn msg) +(define (prec:warn . msgs) (do ((j (+ -1 tok:column) (+ -8 j))) ((> 8 j) (do ((i j (+ -1 i))) @@ -80,7 +80,8 @@ (display #\ ))) (display slib:tab)) (display "^ ") - (display msg) + (newline) + (for-each (lambda (x) (write x) (display #\ )) msgs) (newline)) ;; Structure of lexical records. @@ -189,9 +190,10 @@ (define (prec:delim tk) (prec:make-led tk 0 #f)) -(define (prec:nofix tk sop) - (prec:make-nud tk prec:parse-nofix sop)) -(define (prec:parse-nofix self sop) +(define (prec:nofix tk sop . binds) + (prec:make-nud tk prec:parse-nofix sop (apply append binds))) +(define (prec:parse-nofix self sop binds) + (set! *syn-rules* (prec:process-binds binds *syn-rules*)) (prec:call-or-list (or sop (prec:symbolfy self)))) (define (prec:prefix tk sop bp . binds) @@ -212,9 +214,10 @@ (prec:apply-or-cons (or sop (prec:symbolfy self)) (cons left (prec:parse-list self bp)))) -(define (prec:postfix tk sop lbp) - (prec:make-led tk lbp prec:parse-postfix sop)) -(define (prec:parse-postfix left self lbp sop) +(define (prec:postfix tk sop lbp . binds) + (prec:make-led tk lbp prec:parse-postfix sop (apply append binds))) +(define (prec:parse-postfix left self lbp sop binds) + (set! *syn-rules* (prec:process-binds binds *syn-rules*)) (prec:call-or-list (or sop (prec:symbolfy self)) left)) (define (prec:prestfix tk sop bp . binds) @@ -269,9 +272,12 @@ (cond ((equal? (force prec:token) match) (prec:advance)) ((prec:delim? (force prec:token)) - (prec:warn 'mismatched-delimiter) + (prec:warn 'mismatched-delimiter (force prec:token) + 'not match) (prec:advance)) - (else (prec:warn 'delimiter-expected--ignoring-rest) + (else (prec:warn 'delimiter-expected--ignoring-rest + (force prec:token) 'expected match + 'or-delimiter) (do () ((prec:delim? (force prec:token))) (prec:parse1 0)))) ans))))) @@ -356,15 +362,18 @@ (cons '? (prec:parse-delimited sep delim))) ((prec:delim? (force prec:token)) (if (not (equal? (force prec:token) delim)) - (prec:warn 'mismatched-delimiter)) + (prec:warn 'mismatched-delimiter (force prec:token) + 'expected delim)) (if (not sep) (prec:warn 'expression-missing)) (prec:advance) (if sep '() '(?))) (else (let ((ans (prec:parse-list sep bp))) (cond ((equal? (force prec:token) delim)) ((prec:delim? (force prec:token)) - (prec:warn 'mismatched-delimiter)) - (else (prec:warn 'delimiter-expected--ignoring-rest) + (prec:warn 'mismatched-delimiter (force prec:token) + 'expecting delim)) + (else (prec:warn 'delimiter-expected--ignoring-rest + (force prec:token) '...) (do () ((prec:delim? (force prec:token))) (prec:parse1 bp)))) (prec:advance) @@ -381,7 +390,8 @@ (let ((ans (prec:parse1 0))) (cond ((eof-object? (force prec:token))) ((equal? (force prec:token) delim)) - (else (prec:warn 'delimiter-expected--ignoring-rest) + (else (prec:warn 'delimiter-expected--ignoring-rest + (force prec:token) 'not delim) (do () ((or (equal? (force prec:token) delim) (eof-object? (force prec:token)))) (prec:advance)))) |