Revert "lib/lalr-debug.scm"
This reverts commit 084d1bea33d45f0653cdc6bef44dc295faef6b72.
This commit is contained in:
Jan Nieuwenhuizen
parent
300c997d43
commit
ccb1d842f3
105
lib/lalr.scm
105
lib/lalr.scm
|
|
@ -281,14 +281,11 @@
|
|||
(eq? driver-name 'lr-driver))
|
||||
|
||||
(define (gen-tables! tokens gram )
|
||||
(display "gen-tables!") (newline)
|
||||
(initialize-all)
|
||||
(display "gen-tables!2") (newline)
|
||||
(rewrite-grammar
|
||||
tokens
|
||||
gram
|
||||
(lambda (terms terms/prec vars gram gram/actions)
|
||||
(display "inside kee") (newline)
|
||||
(set! the-terminals/prec (list->vector terms/prec))
|
||||
(set! the-terminals (list->vector terms))
|
||||
(set! the-nonterminals (list->vector vars))
|
||||
|
|
@ -300,21 +297,13 @@
|
|||
(if (null? l)
|
||||
count
|
||||
(loop (cdr l) (+ count (length (caar l))))))))
|
||||
(display "inside kee2") (newline)
|
||||
(pack-grammar no-of-rules no-of-items gram)
|
||||
(display "inside kee3") (newline)
|
||||
(set-derives)
|
||||
(display "inside kee4") (newline)
|
||||
(set-nullable)
|
||||
(display "inside kee5") (newline)
|
||||
(generate-states)
|
||||
(display "inside kee6") (newline)
|
||||
(lalr)
|
||||
(display "inside kee7") (newline)
|
||||
(build-tables)
|
||||
(display "inside kee8") (newline)
|
||||
(compact-action-table terms)
|
||||
(display "inside kee9") (newline)
|
||||
gram/actions))))
|
||||
|
||||
|
||||
|
|
@ -392,7 +381,6 @@
|
|||
(define dset (make-vector nvars -1))
|
||||
|
||||
(let loop ((i 1) (j 0)) ; i = 0
|
||||
(display "set-derives loop i=") (display i) (newline)
|
||||
(if (< i nrules)
|
||||
(let ((lhs (vector-ref rlhs i)))
|
||||
(if (>= lhs 0)
|
||||
|
|
@ -403,7 +391,7 @@
|
|||
(loop (+ i 1) j)))))
|
||||
|
||||
(set! derives (make-vector nvars 0))
|
||||
(display "set-derives derives=") (display derives) (newline)
|
||||
|
||||
(let loop ((i 0))
|
||||
(if (< i nvars)
|
||||
(let ((q (let loop2 ((j (vector-ref dset i)) (s '()))
|
||||
|
|
@ -477,28 +465,17 @@
|
|||
(define (set-firsts)
|
||||
(set! firsts (make-vector nvars '()))
|
||||
|
||||
(display "set-firsts firsts=") (display firsts) (newline)
|
||||
;; -- initialization
|
||||
(let loop ((i 0))
|
||||
(display "loop firsts i=") (display i)
|
||||
(display " firsts=") (display firsts) (newline)
|
||||
(if (< i nvars)
|
||||
(let loop2 ((sp (vector-ref derives i)))
|
||||
(if (null? sp)
|
||||
(loop (+ i 1))
|
||||
(let ((sym (vector-ref ritem (vector-ref rrhs (car sp)))))
|
||||
(display "sym=") (display sym)
|
||||
(display " nvars=") (display nvars)
|
||||
(display " < -1 sym nvars: ") (display (< -1 sym nvars)) (newline)
|
||||
(if (< -1 sym nvars)
|
||||
(begin
|
||||
(display "set i=") (display i)
|
||||
(display " :") (sinsert sym (vector-ref firsts i)) (newline)
|
||||
(vector-set! firsts i (sinsert sym (vector-ref firsts i))))
|
||||
(begin (display "no set i=") (display i) (newline)))
|
||||
(vector-set! firsts i (sinsert sym (vector-ref firsts i))))
|
||||
(loop2 (cdr sp)))))))
|
||||
|
||||
(display "set-firsts 2 firsts=") (display firsts) (newline)
|
||||
;; -- reflexive and transitive closure
|
||||
(let loop ((continue #t))
|
||||
(if continue
|
||||
|
|
@ -532,7 +509,6 @@
|
|||
(set-firsts)
|
||||
|
||||
(let loop ((i 0))
|
||||
(display "fderives i=") (display i) (newline)
|
||||
(if (< i nvars)
|
||||
(let ((x (let loop2 ((l (vector-ref firsts i)) (fd '()))
|
||||
(if (null? l)
|
||||
|
|
@ -601,13 +577,9 @@
|
|||
|
||||
|
||||
(define (generate-states)
|
||||
(display "inside generate-states") (newline)
|
||||
(allocate-storage)
|
||||
(display "inside generate-states2") (newline)
|
||||
(set-fderives)
|
||||
(display "inside generate-states3") (newline)
|
||||
(initialize-states)
|
||||
(display "inside generate-states4") (newline)
|
||||
(let loop ((this-state first-state))
|
||||
(if (pair? this-state)
|
||||
(let* ((x (car this-state))
|
||||
|
|
@ -743,25 +715,15 @@
|
|||
|
||||
(define (lalr)
|
||||
(set! token-set-size (+ 1 (quotient nterms (BITS-PER-WORD))))
|
||||
(display "lalr") (newline)
|
||||
(set-accessing-symbol)
|
||||
(display "lalr 1") (newline)
|
||||
(set-shift-table)
|
||||
(display "lalr 2") (newline)
|
||||
(set-reduction-table)
|
||||
(display "lalr 3") (newline)
|
||||
(set-max-rhs)
|
||||
(display "lalr 4") (newline)
|
||||
(initialize-LA)
|
||||
(display "lalr 5") (newline)
|
||||
(set-goto-map)
|
||||
(display "lalr 6") (newline)
|
||||
(initialize-F)
|
||||
(display "lalr 7") (newline)
|
||||
(build-relations)
|
||||
(display "lalr 8") (newline)
|
||||
(digraph includes)
|
||||
(display "lalr 8") (newline)
|
||||
(compute-lookaheads))
|
||||
|
||||
(define (set-accessing-symbol)
|
||||
|
|
@ -1313,7 +1275,6 @@
|
|||
(right: . right)
|
||||
(nonassoc: . nonassoc)))))
|
||||
|
||||
(display "rewrite-grammar!") (newline)
|
||||
(cond
|
||||
;; --- a few error conditions
|
||||
((not (list? tokens))
|
||||
|
|
@ -1327,7 +1288,6 @@
|
|||
(rev-terms '())
|
||||
(rev-terms/prec '())
|
||||
(prec-level 0))
|
||||
(display "rewrite-grammar! loop1") (newline)
|
||||
(if (pair? lst)
|
||||
(let ((term (car lst)))
|
||||
(cond
|
||||
|
|
@ -1359,7 +1319,6 @@
|
|||
|
||||
;; --- check the grammar rules
|
||||
(let loop2 ((lst grammar) (rev-nonterm-defs '()))
|
||||
(display "rewrite-grammar! loop2") (newline)
|
||||
(if (pair? lst)
|
||||
(let ((def (car lst)))
|
||||
(if (not (pair? def))
|
||||
|
|
@ -1373,24 +1332,16 @@
|
|||
(else
|
||||
(loop2 (cdr lst)
|
||||
(cons def rev-nonterm-defs)))))))
|
||||
(let* (;;(foobar (begin (display "foobar") (newline)))
|
||||
(terms (cons eoi (cons 'error (reverse rev-terms))))
|
||||
;;(foobar1 (begin (display "foobar2") (newline)))
|
||||
(let* ((terms (cons eoi (cons 'error (reverse rev-terms))))
|
||||
(terms/prec (cons '(eoi none 0) (cons '(error none 0) (reverse rev-terms/prec))))
|
||||
;;(foobar2 (begin (display "foobar3") (newline)))
|
||||
(nonterm-defs (reverse rev-nonterm-defs))
|
||||
;;(foobar3 (begin (display "foobar4") (newline)))
|
||||
(nonterms (cons '*start* (map car nonterm-defs)))
|
||||
;;(foobar4 (begin (display "foobar5") (newline)))
|
||||
)
|
||||
(display "terms") (newline)
|
||||
(nonterms (cons '*start* (map car nonterm-defs))))
|
||||
(if (= (length nonterms) 1)
|
||||
(lalr-error "Grammar must contain at least one nonterminal" '())
|
||||
(let loop-defs ((defs (cons `(*start* (,(cadr nonterms) ,eoi) : $1)
|
||||
nonterm-defs))
|
||||
(ruleno 0)
|
||||
(comp-defs '()))
|
||||
(display "loop-defs") (newline)
|
||||
(if (pair? defs)
|
||||
(let* ((nonterm-def (car defs))
|
||||
(compiled-def (rewrite-nonterm-def
|
||||
|
|
@ -1401,28 +1352,13 @@
|
|||
(+ ruleno (length compiled-def))
|
||||
(cons compiled-def comp-defs)))
|
||||
|
||||
(let* ((compiled-nonterm-defs (reverse comp-defs))
|
||||
(foobar6 (begin (display "foobar6") (newline)))
|
||||
(foobar7 (begin (display "compiled-nonterm-defs:") (display compiled-nonterm-defs) (newline)))
|
||||
(aa (apply append compiled-nonterm-defs))
|
||||
(foobar8 (begin (display "foobar8 aa=") (display aa) (newline)))
|
||||
(mep (map (lambda (x) (cons (caaar x) (map cdar x))) compiled-nonterm-defs))
|
||||
(foobar9 (begin (display "foobar9 mep=") (display mep) (newline)))
|
||||
)
|
||||
(display "K...") (newline)
|
||||
(display "k=") (display k) (newline)
|
||||
(let ((kee
|
||||
(k terms
|
||||
terms/prec
|
||||
nonterms
|
||||
;;;(map (lambda (x) (cons (caaar x) (map cdar x))) compiled-nonterm-defs)
|
||||
mep
|
||||
;;(apply append compiled-nonterm-defs)
|
||||
aa
|
||||
)))
|
||||
(display "K...dun") (newline)
|
||||
kee
|
||||
)))))))))))))
|
||||
(let ((compiled-nonterm-defs (reverse comp-defs)))
|
||||
(k terms
|
||||
terms/prec
|
||||
nonterms
|
||||
(map (lambda (x) (cons (caaar x) (map cdar x)))
|
||||
compiled-nonterm-defs)
|
||||
(apply append compiled-nonterm-defs))))))))))))))
|
||||
|
||||
|
||||
(define (rewrite-nonterm-def nonterm-def ruleno terms nonterms)
|
||||
|
|
@ -1688,18 +1624,7 @@
|
|||
'())))
|
||||
(vector->list shift-table)))))
|
||||
|
||||
(define (build-goto-table---)
|
||||
(display "build-goto-table...")
|
||||
(let ((r (build-goto-table-)))
|
||||
(newline)
|
||||
r))
|
||||
|
||||
(define (build-reduction-table--- gram/actions)
|
||||
(display "build-reduction-table...")
|
||||
(let ((r (build-reduction-table- gram/actions)))
|
||||
(newline)
|
||||
r))
|
||||
|
||||
(define build-reduction-table
|
||||
(lambda (gram/actions)
|
||||
`(vector
|
||||
|
|
@ -1771,10 +1696,8 @@
|
|||
|
||||
|
||||
(define (validate-options options)
|
||||
(display "validate-options options=") (display options) (newline)
|
||||
(for-each
|
||||
(lambda (option)
|
||||
(display "option=") (display option) (newline)
|
||||
(let ((p (assoc (car option) *valid-options*)))
|
||||
(if (or (not p)
|
||||
(not ((cdr p) option)))
|
||||
|
|
@ -1814,24 +1737,18 @@
|
|||
;; -- arguments
|
||||
|
||||
(define (extract-arguments lst proc)
|
||||
;; (display "extracting") (newline)
|
||||
(let loop ((options '())
|
||||
(tokens '())
|
||||
(rules '())
|
||||
(lst lst))
|
||||
(if (pair? lst)
|
||||
(let ((p (car lst)))
|
||||
;; (display "p:") (display p) (newline)
|
||||
;; (display "keyword?: ") (display (lalr-keyword? (car p))) (newline)
|
||||
(cond
|
||||
((and (pair? p)
|
||||
(lalr-keyword? (car p))
|
||||
(assq (car p) *valid-options*))
|
||||
(loop (cons p options) tokens rules (cdr lst)))
|
||||
(else
|
||||
;; (display "CALLING PROC") (newline)
|
||||
;; (display "LST:") (display (cdr lst)) (newline)
|
||||
;; (display "options:") (display options) (newline)
|
||||
(proc options p (cdr lst)))))
|
||||
(lalr-error "Malformed lalr-parser form" lst))))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue