nyacc: working javascript interpreter in guile
This commit is contained in:
parent
07310be6d0
commit
2f1e0e6360
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue