nyacc: working javascript interpreter in guile

This commit is contained in:
Matt Wette 2017-03-03 17:07:29 -08:00 committed by Jan Nieuwenhuizen
parent 07310be6d0
commit 2f1e0e6360
4 changed files with 52 additions and 35 deletions

View 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

View 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

View 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
@ -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 +++ ()
((_ <expr> +++)
@ -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)

View 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
@ -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)