mbutterick
/
br-parser-tools
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

warning to stderr, not stdout

Browse Source 
See PR 11691
  Merge to release branch

original commit: fd3595e7d30b7fcabba84185f8d5c4e6d63aa239
tokens
Ryan Culpepper 13 years ago
parent 8252d4d2b6 5d47014554 a2dba0a992
commit 5a8f4925ee
13 changed files with 49 additions and 49 deletions
Show Stats Download Patch File Download Diff File

2
collects/parser-tools/examples/calc.rkt
Unescape Escape View File

@ -82,7 +82,7 @@
(lambda ()
(let ((result (calcp (lambda () (calcl ip)))))
(when result
(printf "~a~n" result)
(printf "~a\n" result)
(one-line))))))
(one-line)))

10
collects/parser-tools/lex.rkt
Unescape Escape View File

@ -113,7 +113,7 @@
(let ((next-check (vector-ref next 1)))
(or (>= next-check max-char-num)
(loop (add1 next-check) (cdr nexts))))))))))
(printf "Warning: lexer at ~a can accept the empty string.~n" stx)))
(eprintf "Warning: lexer at ~a can accept the empty string.\n" stx)))
(with-syntax ((start-state-stx start)
(trans-table-stx trans)
(no-lookahead-stx no-look)
@ -230,7 +230,7 @@
(lambda (ip)
(let ((first-pos (get-position ip))
(first-char (peek-char-or-special ip 0)))
;(printf "(peek-char-or-special port 0) = ~e~n" first-char)
;(printf "(peek-char-or-special port 0) = ~e\n" first-char)
(cond
((eof-object? first-char)
(do-match ip first-pos eof-action (read-char-or-special ip)))
@ -279,7 +279,7 @@
(let* ((act (vector-ref actions next-state))
(next-length-bytes (+ (char-utf-8-length char) length-bytes))
(next-char (peek-char-or-special ip next-length-bytes)))
#;(printf "(peek-char-or-special port ~e) = ~e~n"
#;(printf "(peek-char-or-special port ~e) = ~e\n"
next-length-bytes next-char)
(lexer-loop next-state
next-char
@ -312,13 +312,13 @@
(position-offset first-pos)
(- (position-offset end-pos) (position-offset first-pos)))))
(let ((match (read-string longest-match-length lb)))
;(printf "(read-string ~e port) = ~e~n" longest-match-length match)
;(printf "(read-string ~e port) = ~e\n" longest-match-length match)
(do-match lb first-pos longest-match-action match)))
(define file-path (make-parameter #f))
(define (do-match ip first-pos action value)
#;(printf "(action ~a ~a ~a ~a)~n"
#;(printf "(action ~a ~a ~a ~a)\n"
(position-offset first-pos) (position-offset (get-position ip)) value ip)
(action first-pos (get-position ip) value ip))

2
collects/parser-tools/parser-tools.scrbl
Unescape Escape View File

@ -140,7 +140,7 @@ are a few examples, using @scheme[:] prefixed SRE syntax:
@item{@schemeblock0[(:: "/*" (:* (complement "*/")) "*/")]
Matches any string that starts with @scheme["/*"] and and ends with
Matches any string that starts with @scheme["/*"] and ends with
@scheme["*/"], including @scheme["/* */ */ */"].
@scheme[(complement "*/")] matches any string except @scheme["*/"].
This includes @scheme["*"] and @scheme["/"] separately. Thus

10
collects/parser-tools/private-lex/deriv.rkt
Unescape Escape View File

@ -281,13 +281,13 @@
(else (loop old-states new-states all-states (cdr cs))))))))))
(define (print-dfa x)
(printf "number of states: ~a~n" (dfa-num-states x))
(printf "start state: ~a~n" (dfa-start-state x))
(printf "final states: ~a~n" (map car (dfa-final-states/actions x)))
(printf "number of states: ~a\n" (dfa-num-states x))
(printf "start state: ~a\n" (dfa-start-state x))
(printf "final states: ~a\n" (map car (dfa-final-states/actions x)))
(for-each (lambda (trans)
(printf "state: ~a~n" (car trans))
(printf "state: ~a\n" (car trans))
(for-each (lambda (rule)
(printf " -~a-> ~a~n"
(printf " -~a-> ~a\n"
(is:integer-set-contents (car rule))
(cdr rule)))
(cdr trans)))

2
collects/parser-tools/private-lex/front.rkt
Unescape Escape View File

@ -170,7 +170,7 @@
(vector->list x))))
(vector->list table))
(length (hash-table-map ht cons)))))
(printf "~a states, ~aKB~n"
(printf "~a states, ~aKB\n"
num-states
(/ (* 4.0 (+ 2 num-states (* 2 num-vectors) num-entries
(* 5 num-different-entries))) 1024)))

2
collects/parser-tools/private-lex/util.rkt
Unescape Escape View File

@ -14,7 +14,7 @@
(let* defs
(let ((real-ans code))
(unless (equal? real-ans right-ans)
(printf "Test failed: ~e gave ~e. Expected ~e~n"
(printf "Test failed: ~e gave ~e. Expected ~e\n"
'code real-ans 'right-ans))) ...))))
(define-syntax test-block

8
collects/parser-tools/private-yacc/lalr.rkt
Unescape Escape View File

@ -149,14 +149,14 @@
(print-input-st-prod l "LA" a g print-output-terms))
(define (print-input-st-sym f name a g print-output)
(printf "~a:~n" name)
(printf "~a:\n" name)
(send a for-each-state
(lambda (state)
(for-each
(lambda (non-term)
(let ((res (f (make-trans-key state non-term))))
(if (not (null? res))
(printf "~a(~a, ~a) = ~a~n"
(printf "~a(~a, ~a) = ~a\n"
name
state
(gram-sym-symbol non-term)
@ -165,7 +165,7 @@
(newline))
(define (print-input-st-prod f name a g print-output)
(printf "~a:~n" name)
(printf "~a:\n" name)
(send a for-each-state
(lambda (state)
(for-each
@ -174,7 +174,7 @@
(lambda (prod)
(let ((res (f state prod)))
(if (not (null? res))
(printf "~a(~a, ~a) = ~a~n"
(printf "~a(~a, ~a) = ~a\n"
name
(kernel-index state)
(prod-index prod)

4
collects/parser-tools/private-yacc/lr0.rkt
Unescape Escape View File

@ -167,7 +167,7 @@
;; build-LR0-automaton: grammar -> LR0-automaton
;; Constructs the kernels of the sets of LR(0) items of g
(define (build-lr0-automaton grammar)
; (printf "LR(0) automaton:~n")
; (printf "LR(0) automaton:\n")
(letrec (
(epsilons (make-hash-table 'equal))
(grammar-symbols (append (send grammar get-non-terms)
@ -304,7 +304,7 @@
(set! automaton-non-term (cons (cons (make-trans-key kernel gs)
unique-kernel)
automaton-non-term))))
#;(printf "~a -> ~a on ~a~n"
#;(printf "~a -> ~a on ~a\n"
(kernel->string kernel)
(kernel->string unique-kernel)
(gram-sym-symbol gs))

4
collects/parser-tools/private-yacc/parser-builder.rkt
Unescape Escape View File

@ -91,9 +91,9 @@
(hash-table-put! ht x #t)))
(map cdr (apply append (vector->list table))))
(length (hash-table-map ht void)))))
(printf "~a states, ~a grammar symbols, ~a hash-table entries, ~a reduces~n"
(printf "~a states, ~a grammar symbols, ~a hash-table entries, ~a reduces\n"
num-states num-gram-syms num-ht-entries num-reduces)
(printf "~a -- ~aKB, previously ~aKB~n"
(printf "~a -- ~aKB, previously ~aKB\n"
(/ (+ 2 num-states
(* 4 num-states) (* 2 1.5 num-ht-entries)
(* 5 num-reduces)) 256.0)

20
collects/parser-tools/private-yacc/table.rkt
Unescape Escape View File

@ -97,16 +97,16 @@
(for-each
(lambda (prod)
(fprintf port
"~a\t~a\t=\t~a~n"
"~a\t~a\t=\t~a\n"
(prod-index prod)
(gram-sym-symbol (prod-lhs prod))
(map gram-sym-symbol (vector->list (prod-rhs prod)))))
prods)
(send a for-each-state
(lambda (state)
(fprintf port "State ~a~n" (kernel-index state))
(fprintf port "State ~a\n" (kernel-index state))
(for-each (lambda (item)
(fprintf port "\t~a~n" (item->string item)))
(fprintf port "\t~a\n" (item->string item)))
(kernel-items state))
(newline port)
(for-each
@ -118,22 +118,22 @@
((null? (cdr act))
(print-entry sym (car act) port))
(else
(fprintf port "begin conflict:~n")
(fprintf port "begin conflict:\n")
(when (> (count reduce? act) 1)
(set! RR-conflicts (add1 RR-conflicts)))
(when (> (count shift? act) 0)
(set! SR-conflicts (add1 SR-conflicts)))
(map (lambda (x) (print-entry sym x port)) act)
(fprintf port "end conflict~n")))))
(fprintf port "end conflict\n")))))
(vector-ref grouped-table (kernel-index state)))
(newline port)))
(when (> SR-conflicts 0)
(fprintf port "~a shift/reduce conflict~a~n"
(fprintf port "~a shift/reduce conflict~a\n"
SR-conflicts
(if (= SR-conflicts 1) "" "s")))
(when (> RR-conflicts 0)
(fprintf port "~a reduce/reduce conflict~a~n"
(fprintf port "~a reduce/reduce conflict~a\n"
RR-conflicts
(if (= RR-conflicts 1) "" "s")))))
@ -159,7 +159,7 @@
(loop (car rest) (cdr rest)))
((accept? (car rest))
(fprintf (current-error-port)
"accept/reduce or accept/shift conflicts. Check the grammar for useless cycles of productions~n")
"accept/reduce or accept/shift conflicts. Check the grammar for useless cycles of productions\n")
(loop current-guess (cdr rest)))
(else (loop current-guess (cdr rest)))))))))
@ -180,12 +180,12 @@
(unless suppress
(when (> SR-conflicts 0)
(fprintf (current-error-port)
"~a shift/reduce conflict~a~n"
"~a shift/reduce conflict~a\n"
SR-conflicts
(if (= SR-conflicts 1) "" "s")))
(when (> RR-conflicts 0)
(fprintf (current-error-port)
"~a reduce/reduce conflict~a~n"
"~a reduce/reduce conflict~a\n"
RR-conflicts
(if (= RR-conflicts 1) "" "s"))))
table))

14
collects/parser-tools/private-yacc/yacc-helper.rkt
Unescape Escape View File

@ -74,7 +74,7 @@
(car rhs))
(if (= 3 (length rhs))
(p "%prec ~a" (cadadr rhs)))
(p "~n"))))
(p "\n"))))
(for-each
(lambda (t)
(for-each
@ -86,7 +86,7 @@
(lambda (t)
(for-each
(lambda (t)
(p "%token ~a~n" t)
(p "%token ~a\n" t)
(hash-table-put! term-table t (format "~a" t)))
(syntax-object->datum (terminals-def-t t))))
terms)
@ -96,10 +96,10 @@
(for-each (lambda (tok)
(p " ~a" (hash-table-get term-table tok)))
(cdr prec))
(p "~n"))
(p "\n"))
precs))
(p "%start ~a~n" start)
(p "%%~n")
(p "%start ~a\n" start)
(p "%%\n")
(for-each (lambda (prod)
(let ((nt (car prod)))
@ -109,9 +109,9 @@
(p "| ")
(display-rhs rhs))
(cddr prod))
(p ";~n")))
(p ";\n")))
grammar)
(p "%%~n"))))
(p "%%\n"))))
)

4
collects/parser-tools/yacc-to-scheme.rkt
Unescape Escape View File

@ -8,14 +8,14 @@
(define match-double-string
(lexer
((:* (:~ #\" #\\)) (append (string->list lexeme)
((:+ (:~ #\" #\\)) (append (string->list lexeme)
(match-double-string input-port)))
((:: #\\ any-char) (cons (string-ref lexeme 1) (match-double-string input-port)))
(#\" null)))
(define match-single-string
(lexer
((:* (:~ #\' #\\)) (append (string->list lexeme)
((:+ (:~ #\' #\\)) (append (string->list lexeme)
(match-single-string input-port)))
((:: #\\ any-char) (cons (string-ref lexeme 1) (match-single-string input-port)))
(#\' null)))

16
collects/parser-tools/yacc.rkt
Unescape Escape View File

@ -174,7 +174,7 @@
(lambda (e)
(fprintf
(current-error-port)
"Cannot write yacc-output to file \"~a\"~n"
"Cannot write yacc-output to file \"~a\"\n"
yacc-output)))]
(call-with-output-file yacc-output
(lambda (port)
@ -271,14 +271,14 @@
(let ((a (find-action stack tok val start-pos end-pos)))
(cond
((runtime-shift? a)
;; (printf "shift:~a~n" (runtime-shift-state a))
;; (printf "shift:~a\n" (runtime-shift-state a))
(cons (make-stack-frame (runtime-shift-state a)
val
start-pos
end-pos)
stack))
(else
;; (printf "discard input:~a~n" tok)
;; (printf "discard input:~a\n" tok)
(let-values (((tok val start-pos end-pos)
(extract (get-token))))
(remove-input tok val start-pos end-pos))))))))
@ -286,7 +286,7 @@
(let ((a (find-action stack 'error #f start-pos end-pos)))
(cond
((runtime-shift? a)
;; (printf "shift:~a~n" (runtime-shift-state a))
;; (printf "shift:~a\n" (runtime-shift-state a))
(set! stack
(cons
(make-stack-frame (runtime-shift-state a)
@ -296,7 +296,7 @@
stack))
(remove-input tok val start-pos end-pos))
(else
;; (printf "discard state:~a~n" (car stack))
;; (printf "discard state:~a\n" (car stack))
(cond
((< (length stack) 2)
(raise-read-error "parser: Cannot continue after error"
@ -330,7 +330,7 @@
(let ((action (find-action stack tok val start-pos end-pos)))
(cond
((runtime-shift? action)
;; (printf "shift:~a~n" (runtime-shift-state action))
;; (printf "shift:~a\n" (runtime-shift-state action))
(parsing-loop (cons (make-stack-frame (runtime-shift-state action)
val
start-pos
@ -338,7 +338,7 @@
stack)
(get-token)))
((runtime-reduce? action)
;; (printf "reduce:~a~n" (runtime-reduce-prod-num action))
;; (printf "reduce:~a\n" (runtime-reduce-prod-num action))
(let-values (((new-stack args)
(reduce-stack stack
(runtime-reduce-rhs-length action)
@ -367,7 +367,7 @@
new-stack)
ip))))
((runtime-accept? action)
;; (printf "accept~n")
;; (printf "accept\n")
(stack-frame-value (car stack)))
(else
(if src-pos

Write Preview
Loading…
Cancel
Save