From 584ff1ccfba467042a2a37edce2b02c13aed9102 Mon Sep 17 00:00:00 2001 From: Scott Owens Date: Wed, 17 Oct 2001 05:51:18 +0000 Subject: [PATCH] *** empty log message *** original commit: 8d5d988ce3fa041013d10351e44003908781c5f6 --- collects/parser-tools/private-yacc/grammar.ss | 13 ++-- .../private-yacc/input-file-parser.ss | 67 +++++++++++++------ .../private-yacc/parser-builder.ss | 6 +- 3 files changed, 55 insertions(+), 31 deletions(-) diff --git a/collects/parser-tools/private-yacc/grammar.ss b/collects/parser-tools/private-yacc/grammar.ss index d45b4a3..b250afd 100644 --- a/collects/parser-tools/private-yacc/grammar.ss +++ b/collects/parser-tools/private-yacc/grammar.ss @@ -1,12 +1,9 @@ #cs (module grammar mzscheme - + ;; Constructs to create and access grammars, the internal ;; representation of the input to the parser generator. - - (require (lib "list.ss") - "yacc-helper.ss") - + (provide (rename export-make-item make-item) @@ -35,7 +32,7 @@ (rename gram-prods grammar-prods) ;; Things that work on productions - prod-index prod-prec prod-rhs prod-lhs) + prod-index prod-prec prod-rhs prod-lhs prod-action) ;;---------------------- LR items -------------------------- @@ -188,6 +185,6 @@ ;; ------------------------ Productions --------------------------- - ;; production = (make-prod non-term (gram-sym vector) int prec) - (define-struct prod (lhs rhs index prec)) + ;; production = (make-prod non-term (gram-sym vector) int prec syntax-object) + (define-struct prod (lhs rhs index prec action)) ) diff --git a/collects/parser-tools/private-yacc/input-file-parser.ss b/collects/parser-tools/private-yacc/input-file-parser.ss index f212ec1..a586a5c 100644 --- a/collects/parser-tools/private-yacc/input-file-parser.ss +++ b/collects/parser-tools/private-yacc/input-file-parser.ss @@ -8,6 +8,14 @@ (provide parse-input) + ;; get-args: num * syntax-object -> syntax-object list + (define (get-args x act) + (let loop ((i 1)) + (cond + ((> i x) null) + (else (cons (datum->syntax-object act (string->symbol (format "$~a" i))) + (loop (add1 i))))))) + ;; nullable: production list * int -> non-term set ;; determines which non-terminals can derive epsilon (define (nullable prods num-nts) @@ -104,7 +112,7 @@ term-syn))))) ;; parse-input: syntax-object^4 * string -> grammar - (define (parse-input start term-defs prec-decls prods) + (define (parse-input start term-defs prec-decls prods runtime) (let* ((counter 0) (start-sym (syntax-object->datum start)) @@ -261,9 +269,18 @@ "production right-hand-side must have form (symbol ...)" prod-so))))) + ;; parse-action: gram-sym vector * syntax-object -> syntax-object + (parse-action + (lambda (prod act) + (datum->syntax-object + runtime + `(lambda ,(get-args (vector-length prod) act) + ,act) + act))) + ;; parse-prod+action: non-term * syntax-object -> production (parse-prod+action - (lambda (nt prod-so) + (lambda (nt prod-so) (syntax-case prod-so (prec) ((prod-rhs action) (let ((p (parse-prod (syntax prod-rhs)))) @@ -278,27 +295,30 @@ (if (term? gs) (term-prec gs) (loop (sub1 i)))) - #f))) + #f)) + (parse-action p (syntax action))) (set! counter (add1 counter))))) ((prod-rhs (prec term) action) (identifier? (syntax term)) - (begin0 - (make-prod - nt - (parse-prod (syntax prod-rhs)) - counter - (term-prec - (hash-table-get - term-table - (syntax-object->datum (syntax term)) - (lambda () - (raise-syntax-error - 'parser-production-rhs - (format - "unrecognized terminal ~a in precedence declaration" - (syntax-object->datum (syntax term))) - (syntax term))))) - (set! counter (add1 counter))))) + (let ((p (parse-prod (syntax prod-rhs)))) + (begin0 + (make-prod + nt + p + counter + (term-prec + (hash-table-get + term-table + (syntax-object->datum (syntax term)) + (lambda () + (raise-syntax-error + 'parser-production-rhs + (format + "unrecognized terminal ~a in precedence declaration" + (syntax-object->datum (syntax term))) + (syntax term))))) + (parse-action p (syntax action))) + (set! counter (add1 counter))))) (_ (raise-syntax-error 'parser-production-rhs @@ -329,7 +349,10 @@ (vector (hash-table-get non-term-table start-sym)) 0 - #f)) + #f + (datum->syntax-object + runtime + `(lambda (x) x)))) (map parse-prods-for-nt (syntax->list prods)))) (nulls (nullable (apply append prods) (add1 (length non-terms))))) @@ -353,4 +376,4 @@ nulls (cons start non-terms) terms - counter)))))) + counter)))))) diff --git a/collects/parser-tools/private-yacc/parser-builder.ss b/collects/parser-tools/private-yacc/parser-builder.ss index 2e35599..cf27547 100644 --- a/collects/parser-tools/private-yacc/parser-builder.ss +++ b/collects/parser-tools/private-yacc/parser-builder.ss @@ -9,7 +9,7 @@ (provide build-parser) (define (build-parser start input-terms assocs prods filename runtime src) - (let* ((grammar (parse-input start input-terms assocs prods)) + (let* ((grammar (parse-input start input-terms assocs prods runtime)) (table (build-table grammar filename)) (table-code (cons 'vector @@ -38,9 +38,13 @@ (grammar-terms grammar)) ht))) + (actions-code + `(vector ,@(map prod-action (grammar-prods grammar)))) + (parser-code `(letrec ((term-sym->index ,token-code) (table ,table-code) + (actions ,actions-code) (pop-x (lambda (s n) (if (> n 0)