nyacc: working javascript interpreter in guile
authorMatt Wette <matt.wette@gmail.com>
Sat, 4 Mar 2017 01:07:29 +0000 (17:07 -0800)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 4 Mar 2017 01:07:29 +0000 (17:07 -0800)
module/nyacc/ChangeLog
module/nyacc/README.nyacc
module/nyacc/lalr.scm
module/nyacc/parse.scm

index e09aaefed82711750275a54168fbf9e5bcad8930..a347f50711a41d851908b1507684140f08676123 100644 (file)
@@ -1,3 +1,8 @@
+2017-03-03  Matt Wette  <mwette@alumni.caltech.edu>
+
+       * lalr.scm: added "keepers" keyword argument to compact-machine
+       and also added $end as default
+
 2017-02-28  Matt Wette  <mwette@alumni.caltech.edu>
 
        * lang/c99/pprint.scm: (binary 'd-del .. => (binary 'd-sel
index 6093c7efb6654d8648b27475e8a801c5edd5bb34..77c3063dc3dc2293b493d2fcc6814053a1996d96 100644 (file)
@@ -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
 
index 378899fd84fb3152a135fa9712bf309d40edaf34..fcdeb4e5ff30f93ee723926388aecd5ccda131a8 100644 (file)
@@ -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 <http://www.gnu.org/licenses/>
 
 (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
   ;; 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}.
 ;; @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 +++ () 
     ((_ <expr> +++)
          (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))))
               (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. ================================
 
 ;;   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
     (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.
            (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)))))
 
     ;; 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?
                         (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)))
        (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)
       (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)
index fcf5944d57488d9eb0ba92d1558f5884f75c4660..6a92a18245dc1bf67ecddeeb8f3f6626c89237be 100644 (file)
@@ -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 <http://www.gnu.org/licenses/>
 
 ;; make parser that provide list of la-toks to lexer:
 ;; e.g., if comment not in latok, just throw away
 ;; @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
 ;; 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
                   (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)