diff --git a/module/nyacc/ChangeLog b/module/nyacc/ChangeLog index e09aaefe..a347f507 100644 --- a/module/nyacc/ChangeLog +++ b/module/nyacc/ChangeLog @@ -1,3 +1,8 @@ +2017-03-03 Matt Wette + + * lalr.scm: added "keepers" keyword argument to compact-machine + and also added $end as default + 2017-02-28 Matt Wette * lang/c99/pprint.scm: (binary 'd-del .. => (binary 'd-sel diff --git a/module/nyacc/README.nyacc b/module/nyacc/README.nyacc index 6093c7ef..77c3063d 100644 --- a/module/nyacc/README.nyacc +++ b/module/nyacc/README.nyacc @@ -1,4 +1,4 @@ -This is a version 0.76.5+c99dev of NYACC (Not Yet Another Compiler Compiler!). +This is a version 0.76.5+jsdev of NYACC (Not Yet Another Compiler Compiler!). Copyright (C) 2015-2017 Matthew R. Wette diff --git a/module/nyacc/lalr.scm b/module/nyacc/lalr.scm index 378899fd..fcdeb4e5 100644 --- a/module/nyacc/lalr.scm +++ b/module/nyacc/lalr.scm @@ -1,6 +1,6 @@ ;;; nyacc/lalr.scm ;;; -;;; Copyright (C) 2014-2016 Matthew R. Wette +;;; Copyright (C) 2014-2017 Matthew R. Wette ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -12,9 +12,8 @@ ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Lesser General Public License for more details. ;;; -;;; You should have received a copy of the GNU Lesser General Public -;;; License along with this library; if not, write to the Free Software -;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +;;; You should have received a copy of the GNU Lesser General Public License +;;; along with this library; if not, see (cond-expand (guile-2) @@ -50,7 +49,7 @@ #:use-module (nyacc util) ) -(define *nyacc-version* "0.76.5+c99dev") +(define *nyacc-version* "0.76.5+jsdev") ;; @deffn proxy-? sym rhs @@ -110,7 +109,7 @@ ;; If the first character `$' then it's reserved. (eqv? #\$ (string-ref (symbol->string (syntax->datum grammar-symbol)) 0))) -;; @deffn lalr-spec grammar => spec +;; @deffn {Syntax} lalr-spec grammar => spec ;; This routine reads a grammar in a scheme-like syntax and returns an a-list. ;; This spec' can be an input for @item{make-parser-generator} or ;; @item{pp-spec}. @@ -126,6 +125,7 @@ ;; @end itemize ;; Currently, the number of arguments for items is computed in the routine ;; @code{process-grammar}. +;; @end deffn (define-syntax lalr-spec (syntax-rules +++ () ((_ +++) @@ -505,12 +505,16 @@ (if (pair? (filter (lambda (s) (char=? #\* (string-ref s 0))) err-l)) #f (list - ;; most referenced + ;; Put most referenced items first, but keep start and rhs-v at + ;; top so that if we want to restart (see restart-spec) we can + ;; reuse the tail here. + (cons 'start start-symbol) + (cons 'rhs-v (map-attr->vector al 'rhs)) + ;; + (cons 'restart-tail #t) ; see @code{restart-spec} below (cons 'non-terms nl) (cons 'lhs-v (list->vector (reverse ll))) - (cons 'rhs-v (map-attr->vector al 'rhs)) (cons 'terminals tl) - (cons 'start start-symbol) (cons 'attr (list (cons 'expect (or (assq-ref tree 'expect) 0)) (cons 'notice (assq-ref tree 'notice)))) @@ -519,7 +523,8 @@ (cons 'prp-v (map-attr->vector al 'prec)) ; per-rule precedence (cons 'act-v (map-attr->vector al 'act)) (cons 'ref-v (map-attr->vector al 'ref)) - (cons 'err-l err-l))))))))) + (cons 'err-l err-l) + )))))))) ;;; === Code for processing the specification. ================================ @@ -1525,14 +1530,14 @@ ;; pat-v - parse action table ;; ref-v - references ;; len-v - rule lengths -;; rto-v - hashed lhs symbols +;; rto-v - hashed lhs symbols (rto = reduce to) ;; to print itemsets need: ;; kis-v - itemsets ;; lhs-v - left hand sides ;; rhs-v - right hand sides ;; pat-v - action table -;; @deffn restart-spec spec start => spec +;; @deffn restart-spec [spec|mach] start => spec ;; This generates a new spec with a different start. ;; @example ;; (restart-spec clang-spec 'expression) => cexpr-spec @@ -1542,7 +1547,7 @@ (vector-set! rhs-v 0 (vector start)) (cons* (cons 'start start) (cons 'rhs-v rhs-v) - spec))) + (member '(restart-tail . #t) spec)))) ;; @deffn make-lalr-machine spec => pgen ;; Generate a-list of items used for building/debugging parsers. @@ -1561,7 +1566,7 @@ (cons* (cons 'len-v (vector-map (lambda (i v) (vector-length v)) (assq-ref sm5 'rhs-v))) - (cons 'rto-v (vector-copy (assq-ref sm5 'lhs-v))) + (cons 'rto-v (vector-copy (assq-ref sm5 'lhs-v))) ; "reduce to" sm5))) (lambda () (fluid-set! *lalr-core* prev-core))))) @@ -1608,14 +1613,20 @@ ;; otherwise, return #t. (lambda () #t))) -;; @deffn compact-machine mach [#:keep 3] => mach +;; The list of tokens that do not get absorbed into default reductions. +;; See @code{compact-machine} below. +(define default-keepers '($error $lone-comm $code-comm $end)) + +;; @deffn compact-machine mach [#:keep 3] [#:keepers '()] => mach ;; A "filter" to compact the parse table. For each state this will replace ;; the most populus set of reductions of the same production rule with a -;; default production. However, reductions triggered by keepers like -;; @code{'$error}, @code{'$lone-comm} or @code{'$lone-comm} are not counted. -;; The parser will want to treat errors and comments separately so that they -;; can be trapped (e.g., unaccounted comments are skipped). -(define* (compact-machine mach #:key (keep 3)) +;; default production. However, reductions triggered by user-specified keepers +;; and the default keepers -- @code{'$error}, @code{'$end}, @code{'$lone-comm} +;; and @code{'$lone-comm} are not counted. The parser will want to treat +;; errors and comments separately so that they can be trapped (e.g., +;; unaccounted comments are skipped). +;; @end deffn +(define* (compact-machine mach #:key (keep 3) (keepers '())) (let* ((pat-v (assq-ref mach 'pat-v)) (nst (vector-length pat-v)) (hashed (number? (caar (vector-ref pat-v 0)))) ; been hashified? @@ -1631,9 +1642,8 @@ (lambda (r) (cons -1 (- r))) (lambda (r) `($default reduce . ,r)))) (mtab (assq-ref mach 'mtab)) - (keepers (list (assq-ref mtab '$lone-comm) - (assq-ref mtab '$code-comm) - (assq-ref mtab '$error)))) + (keepers (map (lambda (k) (assq-ref mtab k)) + (append keepers default-keepers)))) ;; Keep an a-list mapping reduction prod-rule => count. (let iter ((sx nst) (trn-l #f) (cnt-al '()) (p-max '(0 . 0))) @@ -1948,12 +1958,13 @@ (regexp-substitute #f m 'pre repl 'post) str))) -;; @deffn write-lalr-tables mach filename [#:lang output-lang] +;; @deffn {Procedure} write-lalr-tables mach filename [#:lang output-lang] ;; For example, ;; @example ;; write-lalr-tables mach "tables.scm" ;; write-lalr-tables mach "tables.tcl" #:lang 'tcl ;; @end example +;; @end deffn (define* (write-lalr-tables mach filename #:key (lang 'scheme)) (define (write-table mach name port) @@ -1973,12 +1984,13 @@ (newline port)))) -;; @deffn write-lalr-actions mach filename [#:lang output-lang] +;; @deffn {Procedure} write-lalr-actions mach filename [#:lang output-lang] ;; For example, ;; @example ;; write-lalr-actions mach "actions.scm" ;; write-lalr-actions mach "actions.tcl" #:lang 'tcl ;; @end example +;; @end deffn (define* (write-lalr-actions mach filename #:key (lang 'scheme)) (define (pp-rule/ts gx) diff --git a/module/nyacc/parse.scm b/module/nyacc/parse.scm index fcf5944d..6a92a182 100644 --- a/module/nyacc/parse.scm +++ b/module/nyacc/parse.scm @@ -1,6 +1,6 @@ ;;; nyacc/parse.scm ;;; -;;; Copyright (C) 2014-2016 Matthew R. Wette +;;; Copyright (C) 2014-2017 Matthew R. Wette ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -12,9 +12,8 @@ ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;; Lesser General Public License for more details. ;;; -;;; You should have received a copy of the GNU Lesser General Public -;;; License along with this library; if not, write to the Free Software -;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA +;;; You should have received a copy of the GNU Lesser General Public License +;;; along with this library; if not, see ;; make parser that provide list of la-toks to lexer: ;; e.g., if comment not in latok, just throw away @@ -43,10 +42,10 @@ ;; @end example ;; The generated parser is reentrant. (define* (make-lalr-parser mach) - (let* ((len-v (assq-ref mach 'len-v)) - (rto-v (assq-ref mach 'rto-v)) ; reduce to - (pat-v (assq-ref mach 'pat-v)) - (actn-v (assq-ref mach 'act-v)) ; unknown action vector + (let* ((len-v (assq-ref mach 'len-v)) ; production RHS length + (rto-v (assq-ref mach 'rto-v)) ; reduce to + (pat-v (assq-ref mach 'pat-v)) ; parse action (shift, reduce) table + (actn-v (assq-ref mach 'act-v)) ; symbolic actions (mtab (assq-ref mach 'mtab)) (xact-v (if (procedure? (vector-ref actn-v 0)) actn-v (vector-map @@ -125,6 +124,7 @@ ;; redunctions if that is the only choice, and does not wait for '$end to ;; return. This needs algorithm verification. Makes some assumptions that ;; need to be verified. +(use-modules (ice-9 pretty-print)) (define* (make-lalr-ia-parser mach) (let* ((len-v (assq-ref mach 'len-v)) (rto-v (assq-ref mach 'rto-v)) ; reduce to @@ -194,7 +194,7 @@ (stx (or (assq-ref stxl tval) (assq-ref stxl def) parse-error))) - #;(if debug (fmtout " lval=~S laval=~S\n" lval laval)) + ;;(if debug (fmtout " lval=~S laval=~S\n" lval laval)) (if debug (dmsg (car state) (if nval tval sval) stx)) (cond ((error? stx)