artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

nyacc: working javascript interpreter in guile

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

5
module/nyacc/ChangeLog
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> 2017-02-28 Matt Wette <mwette@alumni.caltech.edu>
* lang/c99/pprint.scm: (binary 'd-del .. => (binary 'd-sel * lang/c99/pprint.scm: (binary 'd-del .. => (binary 'd-sel

2
module/nyacc/README.nyacc
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 Copyright (C) 2015-2017 Matthew R. Wette

62
module/nyacc/lalr.scm
View file

@ -1,6 +1,6 @@
;;; nyacc/lalr.scm ;;; 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 ;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public ;;; 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 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Lesser General Public License for more details. ;;; Lesser General Public License for more details.
;;; ;;;
;;; You should have received a copy of the GNU Lesser General Public ;;; You should have received a copy of the GNU Lesser General Public License
;;; License along with this library; if not, write to the Free Software ;;; along with this library; if not, see <http://www.gnu.org/licenses/>
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(cond-expand (cond-expand
(guile-2) (guile-2)
@ -50,7 +49,7 @@
#:use-module (nyacc util) #:use-module (nyacc util)
) )
(define *nyacc-version* "0.76.5+c99dev") (define *nyacc-version* "0.76.5+jsdev")
;; @deffn proxy-? sym rhs ;; @deffn proxy-? sym rhs
@ -110,7 +109,7 @@
;; If the first character `$' then it's reserved. ;; If the first character `$' then it's reserved.
(eqv? #\$ (string-ref (symbol->string (syntax->datum grammar-symbol)) 0))) (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 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 ;; This spec' can be an input for @item{make-parser-generator} or
;; @item{pp-spec}. ;; @item{pp-spec}.
@ -126,6 +125,7 @@
;; @end itemize ;; @end itemize
;; Currently, the number of arguments for items is computed in the routine ;; Currently, the number of arguments for items is computed in the routine
;; @code{process-grammar}. ;; @code{process-grammar}.
;; @end deffn
(define-syntax lalr-spec (define-syntax lalr-spec
(syntax-rules +++ () (syntax-rules +++ ()
((_ <expr> +++) ((_ <expr> +++)
@ -505,12 +505,16 @@
(if (pair? (filter (lambda (s) (char=? #\* (string-ref s 0))) err-l)) (if (pair? (filter (lambda (s) (char=? #\* (string-ref s 0))) err-l))
#f #f
(list (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 'non-terms nl)
(cons 'lhs-v (list->vector (reverse ll))) (cons 'lhs-v (list->vector (reverse ll)))
(cons 'rhs-v (map-attr->vector al 'rhs))
(cons 'terminals tl) (cons 'terminals tl)
(cons 'start start-symbol)
(cons 'attr (list (cons 'attr (list
(cons 'expect (or (assq-ref tree 'expect) 0)) (cons 'expect (or (assq-ref tree 'expect) 0))
(cons 'notice (assq-ref tree 'notice)))) (cons 'notice (assq-ref tree 'notice))))
@ -519,7 +523,8 @@
(cons 'prp-v (map-attr->vector al 'prec)) ; per-rule precedence (cons 'prp-v (map-attr->vector al 'prec)) ; per-rule precedence
(cons 'act-v (map-attr->vector al 'act)) (cons 'act-v (map-attr->vector al 'act))
(cons 'ref-v (map-attr->vector al 'ref)) (cons 'ref-v (map-attr->vector al 'ref))
(cons 'err-l err-l))))))))) (cons 'err-l err-l)
))))))))
;;; === Code for processing the specification. ================================ ;;; === Code for processing the specification. ================================
@ -1525,14 +1530,14 @@
;; pat-v - parse action table ;; pat-v - parse action table
;; ref-v - references ;; ref-v - references
;; len-v - rule lengths ;; len-v - rule lengths
;; rto-v - hashed lhs symbols ;; rto-v - hashed lhs symbols (rto = reduce to)
;; to print itemsets need: ;; to print itemsets need:
;; kis-v - itemsets ;; kis-v - itemsets
;; lhs-v - left hand sides ;; lhs-v - left hand sides
;; rhs-v - right hand sides ;; rhs-v - right hand sides
;; pat-v - action table ;; 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. ;; This generates a new spec with a different start.
;; @example ;; @example
;; (restart-spec clang-spec 'expression) => cexpr-spec ;; (restart-spec clang-spec 'expression) => cexpr-spec
@ -1542,7 +1547,7 @@
(vector-set! rhs-v 0 (vector start)) (vector-set! rhs-v 0 (vector start))
(cons* (cons 'start start) (cons* (cons 'start start)
(cons 'rhs-v rhs-v) (cons 'rhs-v rhs-v)
spec))) (member '(restart-tail . #t) spec))))
;; @deffn make-lalr-machine spec => pgen ;; @deffn make-lalr-machine spec => pgen
;; Generate a-list of items used for building/debugging parsers. ;; Generate a-list of items used for building/debugging parsers.
@ -1561,7 +1566,7 @@
(cons* (cons*
(cons 'len-v (vector-map (lambda (i v) (vector-length v)) (cons 'len-v (vector-map (lambda (i v) (vector-length v))
(assq-ref sm5 'rhs-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))) sm5)))
(lambda () (fluid-set! *lalr-core* prev-core))))) (lambda () (fluid-set! *lalr-core* prev-core)))))
@ -1608,14 +1613,20 @@
;; otherwise, return #t. ;; otherwise, return #t.
(lambda () #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 ;; 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 ;; the most populus set of reductions of the same production rule with a
;; default production. However, reductions triggered by keepers like ;; default production. However, reductions triggered by user-specified keepers
;; @code{'$error}, @code{'$lone-comm} or @code{'$lone-comm} are not counted. ;; and the default keepers -- @code{'$error}, @code{'$end}, @code{'$lone-comm}
;; The parser will want to treat errors and comments separately so that they ;; and @code{'$lone-comm} are not counted. The parser will want to treat
;; can be trapped (e.g., unaccounted comments are skipped). ;; errors and comments separately so that they can be trapped (e.g.,
(define* (compact-machine mach #:key (keep 3)) ;; unaccounted comments are skipped).
;; @end deffn
(define* (compact-machine mach #:key (keep 3) (keepers '()))
(let* ((pat-v (assq-ref mach 'pat-v)) (let* ((pat-v (assq-ref mach 'pat-v))
(nst (vector-length pat-v)) (nst (vector-length pat-v))
(hashed (number? (caar (vector-ref pat-v 0)))) ; been hashified? (hashed (number? (caar (vector-ref pat-v 0)))) ; been hashified?
@ -1631,9 +1642,8 @@
(lambda (r) (cons -1 (- r))) (lambda (r) (cons -1 (- r)))
(lambda (r) `($default reduce . ,r)))) (lambda (r) `($default reduce . ,r))))
(mtab (assq-ref mach 'mtab)) (mtab (assq-ref mach 'mtab))
(keepers (list (assq-ref mtab '$lone-comm) (keepers (map (lambda (k) (assq-ref mtab k))
(assq-ref mtab '$code-comm) (append keepers default-keepers))))
(assq-ref mtab '$error))))
;; Keep an a-list mapping reduction prod-rule => count. ;; Keep an a-list mapping reduction prod-rule => count.
(let iter ((sx nst) (trn-l #f) (cnt-al '()) (p-max '(0 . 0))) (let iter ((sx nst) (trn-l #f) (cnt-al '()) (p-max '(0 . 0)))
@ -1948,12 +1958,13 @@
(regexp-substitute #f m 'pre repl 'post) (regexp-substitute #f m 'pre repl 'post)
str))) str)))
;; @deffn write-lalr-tables mach filename [#:lang output-lang] ;; @deffn {Procedure} write-lalr-tables mach filename [#:lang output-lang]
;; For example, ;; For example,
;; @example ;; @example
;; write-lalr-tables mach "tables.scm" ;; write-lalr-tables mach "tables.scm"
;; write-lalr-tables mach "tables.tcl" #:lang 'tcl ;; write-lalr-tables mach "tables.tcl" #:lang 'tcl
;; @end example ;; @end example
;; @end deffn
(define* (write-lalr-tables mach filename #:key (lang 'scheme)) (define* (write-lalr-tables mach filename #:key (lang 'scheme))
(define (write-table mach name port) (define (write-table mach name port)
@ -1973,12 +1984,13 @@
(newline port)))) (newline port))))
;; @deffn write-lalr-actions mach filename [#:lang output-lang] ;; @deffn {Procedure} write-lalr-actions mach filename [#:lang output-lang]
;; For example, ;; For example,
;; @example ;; @example
;; write-lalr-actions mach "actions.scm" ;; write-lalr-actions mach "actions.scm"
;; write-lalr-actions mach "actions.tcl" #:lang 'tcl ;; write-lalr-actions mach "actions.tcl" #:lang 'tcl
;; @end example ;; @end example
;; @end deffn
(define* (write-lalr-actions mach filename #:key (lang 'scheme)) (define* (write-lalr-actions mach filename #:key (lang 'scheme))
(define (pp-rule/ts gx) (define (pp-rule/ts gx)

18
module/nyacc/parse.scm
View file

@ -1,6 +1,6 @@
;;; nyacc/parse.scm ;;; 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 ;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public ;;; 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 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Lesser General Public License for more details. ;;; Lesser General Public License for more details.
;;; ;;;
;;; You should have received a copy of the GNU Lesser General Public ;;; You should have received a copy of the GNU Lesser General Public License
;;; License along with this library; if not, write to the Free Software ;;; along with this library; if not, see <http://www.gnu.org/licenses/>
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;; make parser that provide list of la-toks to lexer: ;; make parser that provide list of la-toks to lexer:
;; e.g., if comment not in latok, just throw away ;; e.g., if comment not in latok, just throw away
@ -43,10 +42,10 @@
;; @end example ;; @end example
;; The generated parser is reentrant. ;; The generated parser is reentrant.
(define* (make-lalr-parser mach) (define* (make-lalr-parser mach)
(let* ((len-v (assq-ref mach 'len-v)) (let* ((len-v (assq-ref mach 'len-v)) ; production RHS length
(rto-v (assq-ref mach 'rto-v)) ; reduce to (rto-v (assq-ref mach 'rto-v)) ; reduce to
(pat-v (assq-ref mach 'pat-v)) (pat-v (assq-ref mach 'pat-v)) ; parse action (shift, reduce) table
(actn-v (assq-ref mach 'act-v)) ; unknown action vector (actn-v (assq-ref mach 'act-v)) ; symbolic actions
(mtab (assq-ref mach 'mtab)) (mtab (assq-ref mach 'mtab))
(xact-v (if (procedure? (vector-ref actn-v 0)) actn-v (xact-v (if (procedure? (vector-ref actn-v 0)) actn-v
(vector-map (vector-map
@ -125,6 +124,7 @@
;; redunctions if that is the only choice, and does not wait for '$end to ;; redunctions if that is the only choice, and does not wait for '$end to
;; return. This needs algorithm verification. Makes some assumptions that ;; return. This needs algorithm verification. Makes some assumptions that
;; need to be verified. ;; need to be verified.
(use-modules (ice-9 pretty-print))
(define* (make-lalr-ia-parser mach) (define* (make-lalr-ia-parser mach)
(let* ((len-v (assq-ref mach 'len-v)) (let* ((len-v (assq-ref mach 'len-v))
(rto-v (assq-ref mach 'rto-v)) ; reduce to (rto-v (assq-ref mach 'rto-v)) ; reduce to
@ -194,7 +194,7 @@
(stx (or (assq-ref stxl tval) (stx (or (assq-ref stxl tval)
(assq-ref stxl def) (assq-ref stxl def)
parse-error))) 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)) (if debug (dmsg (car state) (if nval tval sval) stx))
(cond (cond
((error? stx) ((error? stx)