From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Jan Nieuwenhuizen Newsgroups: gmane.lisp.guile.devel Subject: Re: Bison-like source locations in LALR-parser -- upstream update Date: Sun, 05 Oct 2014 12:27:58 +0200 Organization: AvatarAcademy.nl Message-ID: <8761fyizf5.fsf_-_@drakenvlieg.flower> References: <1406966311-19014-1-git-send-email-janneke@gnu.org> <878umusx8s.fsf@gnu.org> <87d2c41803.fsf@drakenvlieg.flower> <87y4us2jes.fsf@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1412504921 24654 80.91.229.3 (5 Oct 2014 10:28:41 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 5 Oct 2014 10:28:41 +0000 (UTC) Cc: guile-devel@gnu.org To: ludo@gnu.org (Ludovic =?utf-8?Q?Court=C3=A8s?=) Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sun Oct 05 12:28:34 2014 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Xaj3D-0006l2-1s for guile-devel@m.gmane.org; Sun, 05 Oct 2014 12:28:27 +0200 Original-Received: from localhost ([::1]:46955 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Xaj3C-0005uS-J7 for guile-devel@m.gmane.org; Sun, 05 Oct 2014 06:28:26 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:34158) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Xaj33-0005u7-JB for guile-devel@gnu.org; Sun, 05 Oct 2014 06:28:22 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Xaj2y-0006Gm-OW for guile-devel@gnu.org; Sun, 05 Oct 2014 06:28:17 -0400 Original-Received: from smtp-vbr7.xs4all.nl ([194.109.24.27]:2698) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Xaj2t-00069o-2N; Sun, 05 Oct 2014 06:28:07 -0400 Original-Received: from drakenvlieg.flower.peder.onsbrabantnet.nl (static.kpn.net [92.70.116.82] (may be forged)) (authenticated bits=0) by smtp-vbr7.xs4all.nl (8.13.8/8.13.8) with ESMTP id s95ARxsJ010324 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES128-SHA bits=128 verify=NO); Sun, 5 Oct 2014 12:28:01 +0200 (CEST) (envelope-from janneke@gnu.org) X-Url: http://AvatarAcademy.nl In-Reply-To: <87y4us2jes.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Wed, 13 Aug 2014 23:01:47 +0200") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) X-Virus-Scanned: by XS4ALL Virus Scanner X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 194.109.24.27 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:17545 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Ludovic Court=C3=A8s writes: Hi, >>> I don=E2=80=99t think this is needed. Lexers are expected to use >>> =E2=80=98make-lexical-token=E2=80=99 and =E2=80=98make-source-location= =E2=80=99 from (system base lalr) >>> to preserve source location information. >> I hope you're right...and that's what I tried, but I didn't get it >> working. Possibly I need to cook-up a small example. > Here=E2=80=99s an example: > > http://git.savannah.gnu.org/cgit/guile-rpc.git/tree/modules/rpc/compiler/= lexer.l Thanks for the example! To me that is still a nice hack and that is why I think that more straightforward bison-like parser support would be nice. >> Yes...that's looks quit dead. Isn't it? I can try though... > > Well, that=E2=80=99s because it=E2=80=99s =E2=80=9Cfinished.=E2=80=9D :-) Heheh, yeah right ;-) > But yeah, it=E2=80=99s worth trying. Dominique has been responsive and h= elpful > in the past. Dominique was indeed very responsive and helpful. He expressed that he found my patches very interesting, found two problems, suggested how to fix those and merged them. Find attached the three patches pulled verbatim from upstream that Guile is behind on now, the first one is by Dominique. Greetings, Jan --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-LALR-parser-No-more-unexpected-shift-reduce-conflict.patch >From a6aac9d20d9d64f475780b59011c1e7e0cb1670a Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 5 Oct 2014 12:07:03 +0200 Subject: [PATCH 1/3] LALR-parser: No more unexpected shift-reduce conflicts with LR driver. --- module/system/base/lalr.upstream.scm | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/module/system/base/lalr.upstream.scm b/module/system/base/lalr.upstream.scm index 217c439..ecc0fb3 100755 --- a/module/system/base/lalr.upstream.scm +++ b/module/system/base/lalr.upstream.scm @@ -235,6 +235,11 @@ (define driver-name 'lr-driver) + (define (glr-driver?) + (eq? driver-name 'glr-driver)) + (define (lr-driver?) + (eq? driver-name 'lr-driver)) + (define (gen-tables! tokens gram ) (initialize-all) (rewrite-grammar @@ -1097,14 +1102,14 @@ (add-conflict-message "%% Reduce/Reduce conflict (reduce " (- new-action) ", reduce " (- current-action) ") on '" (get-symbol (+ symbol nvars)) "' in state " state) - (if (eq? driver-name 'glr-driver) + (if (glr-driver?) (set-cdr! (cdr actions) (cons new-action (cddr actions))) (set-car! (cdr actions) (max current-action new-action)))) ;; --- shift/reduce conflict ;; can we resolve the conflict using precedences? (case (resolve-conflict symbol (- current-action)) ;; -- shift - ((shift) (if (eq? driver-name 'glr-driver) + ((shift) (if (glr-driver?) (set-cdr! (cdr actions) (cons new-action (cddr actions))) (set-car! (cdr actions) new-action))) ;; -- reduce @@ -1113,11 +1118,12 @@ (else (add-conflict-message "%% Shift/Reduce conflict (shift " new-action ", reduce " (- current-action) ") on '" (get-symbol (+ symbol nvars)) "' in state " state) - (if (eq? driver-name 'glr-driver) + (if (glr-driver?) (set-cdr! (cdr actions) (cons new-action (cddr actions))) (set-car! (cdr actions) new-action)))))))) - (vector-set! action-table state (cons (list symbol new-action) state-actions))))) + (vector-set! action-table state (cons (list symbol new-action) state-actions))) + )) (define (add-action-for-all-terminals state action) (do ((i 1 (+ i 1))) @@ -1131,7 +1137,9 @@ (let ((red (vector-ref reduction-table i))) (if (and red (>= (red-nreds red) 1)) (if (and (= (red-nreds red) 1) (vector-ref consistent i)) - (add-action-for-all-terminals i (- (car (red-rules red)))) + (if (glr-driver?) + (add-action-for-all-terminals i (- (car (red-rules red)))) + (add-action i 'default (- (car (red-rules red))))) (let ((k (vector-ref lookaheads (+ i 1)))) (let loop ((j (vector-ref lookaheads i))) (if (< j k) -- /home/janneke/.signature --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0002-LALR-parser-provide-bison-like-location-constructs-1.patch >From ddbbc3874bfdcefa23622edc16175c9881342194 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 5 Oct 2014 12:08:24 +0200 Subject: [PATCH 2/3] LALR-parser: provide bison-like location constructs @1 ... @n. * module/system/base/lalr.upstream.scm (lalr-parser): Provide bison-like positional location constructs: @1 ... @n. (*lalr-scm-version*): Bump to 2.5.0. --- module/system/base/lalr.upstream.scm | 40 ++++++++++++++++-------------------- 1 file changed, 18 insertions(+), 22 deletions(-) diff --git a/module/system/base/lalr.upstream.scm b/module/system/base/lalr.upstream.scm index ecc0fb3..8e915f9 100755 --- a/module/system/base/lalr.upstream.scm +++ b/module/system/base/lalr.upstream.scm @@ -1,6 +1,7 @@ ;;; ;;;; An Efficient and Portable LALR(1) Parser Generator for Scheme ;;; +;; Copyright 2014 Jan Nieuwenhuizen ;; Copyright 1993, 2010 Dominique Boucher ;; ;; This program is free software: you can redistribute it and/or @@ -17,7 +18,7 @@ ;; along with this program. If not, see . -(define *lalr-scm-version* "2.4.1") +(define *lalr-scm-version* "2.5.0") (cond-expand @@ -1599,17 +1600,19 @@ `(let* (,@(if act (let loop ((i 1) (l rhs)) (if (pair? l) - (let ((rest (cdr l))) - (cons - `(,(string->symbol - (string-append - "$" - (number->string - (+ (- n i) 1)))) - ,(if (eq? driver-name 'lr-driver) - `(vector-ref ___stack (- ___sp ,(- (* i 2) 1))) - `(list-ref ___sp ,(+ (* (- i 1) 2) 1)))) - (loop (+ i 1) rest))) + (let ((rest (cdr l)) + (ns (number->string (+ (- n i) 1)))) + (cons + `(tok ,(if (eq? driver-name 'lr-driver) + `(vector-ref ___stack (- ___sp ,(- (* i 2) 1))) + `(list-ref ___sp ,(+ (* (- i 1) 2) 1)))) + (cons + `(,(string->symbol (string-append "$" ns)) + (if (lexical-token? tok) (lexical-token-value tok) tok)) + (cons + `(,(string->symbol (string-append "@" ns)) + (if (lexical-token? tok) (lexical-token-source tok) tok)) + (loop (+ i 1) rest))))) '())) '())) ,(if (= nt 0) @@ -1887,17 +1890,11 @@ (lexical-token-category tok) tok)) - (define (___value tok) - (if (lexical-token? tok) - (lexical-token-value tok) - tok)) - (define (___run) (let loop () (if ___input (let* ((state (vector-ref ___stack ___sp)) (i (___category ___input)) - (attr (___value ___input)) (act (___action i (vector-ref ___atable state)))) (cond ((not (symbol? i)) @@ -1926,7 +1923,7 @@ ;; Shift current token on top of the stack ((>= act 0) - (___shift act attr) + (___shift act ___input) (set! ___input (if (eq? i '*eoi*) '*eoi* #f)) (loop)) @@ -2033,8 +2030,7 @@ (define (run) (let loop-tokens () (consume) - (let ((symbol (token-category *input*)) - (attr (token-attribute *input*))) + (let ((symbol (token-category *input*))) (for-all-processes (lambda (process) (let loop ((stacks (list process)) (active-stacks '())) @@ -2052,7 +2048,7 @@ (add-parse (car (take-right stack 2))) (actions-loop other-actions active-stacks)) ((>= action 0) - (let ((new-stack (shift action attr stack))) + (let ((new-stack (shift action *input* stack))) (add-process new-stack)) (actions-loop other-actions active-stacks)) (else -- /home/janneke/.signature --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0003-LALR-parser-transparent-source-locations-using-sourc.patch >From cce9b448ad15a7c70d710ec7a5779ed27c8a3e4c Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 5 Oct 2014 12:13:00 +0200 Subject: [PATCH 3/3] LALR-parser: transparent source locations using source-proprerties. * module/system/base/lalr.upstream.scm (note-source-location): New function. (lalr-parser): Add token argument to push. (lr-driver): (___push), (glr-driver): (push): Transparently set source location from token using source-properties. --- module/system/base/lalr.upstream.scm | 41 ++++++++++++++++++++++++------------ 1 file changed, 28 insertions(+), 13 deletions(-) diff --git a/module/system/base/lalr.upstream.scm b/module/system/base/lalr.upstream.scm index 8e915f9..d2c0872 100755 --- a/module/system/base/lalr.upstream.scm +++ b/module/system/base/lalr.upstream.scm @@ -34,7 +34,8 @@ (def-macro (lalr-error msg obj) `(error ,msg ,obj)) (define pprint pretty-print) - (define lalr-keyword? keyword?)) + (define lalr-keyword? keyword?) + (define (note-source-location lvalue tok) lvalue)) ;; -- (bigloo @@ -45,7 +46,8 @@ (define lalr-keyword? keyword?) (def-macro (BITS-PER-WORD) 29) (def-macro (logical-or x . y) `(bit-or ,x ,@y)) - (def-macro (lalr-error msg obj) `(error "lalr-parser" ,msg ,obj))) + (def-macro (lalr-error msg obj) `(error "lalr-parser" ,msg ,obj)) + (define (note-source-location lvalue tok) lvalue)) ;; -- Chicken (chicken @@ -57,7 +59,8 @@ (define lalr-keyword? symbol?) (def-macro (BITS-PER-WORD) 30) (def-macro (logical-or x . y) `(bitwise-ior ,x ,@y)) - (def-macro (lalr-error msg obj) `(error ,msg ,obj))) + (def-macro (lalr-error msg obj) `(error ,msg ,obj)) + (define (note-source-location lvalue tok) lvalue)) ;; -- STKlos (stklos @@ -68,7 +71,8 @@ (define lalr-keyword? keyword?) (define-macro (BITS-PER-WORD) 30) (define-macro (logical-or x . y) `(bit-or ,x ,@y)) - (define-macro (lalr-error msg obj) `(error 'lalr-parser ,msg ,obj))) + (define-macro (lalr-error msg obj) `(error 'lalr-parser ,msg ,obj)) + (define (note-source-location lvalue tok) lvalue)) ;; -- Guile (guile @@ -79,7 +83,14 @@ (define lalr-keyword? symbol?) (define-macro (BITS-PER-WORD) 30) (define-macro (logical-or x . y) `(logior ,x ,@y)) - (define-macro (lalr-error msg obj) `(error ,msg ,obj))) + (define-macro (lalr-error msg obj) `(error ,msg ,obj)) + (define (note-source-location lvalue tok) + (if (and (supports-source-properties? lvalue) + (not (source-property lvalue 'loc)) + (lexical-token? tok)) + (set-source-property! lvalue 'loc (lexical-token-source tok))) + lvalue)) + ;; -- Kawa (kawa @@ -88,7 +99,8 @@ (define logical-or logior) (define (lalr-keyword? obj) (keyword? obj)) (define (pprint obj) (pretty-print obj)) - (define (lalr-error msg obj) (error msg obj))) + (define (lalr-error msg obj) (error msg obj)) + (define (note-source-location lvalue tok) lvalue)) ;; -- SISC (sisc @@ -99,8 +111,8 @@ (define lalr-keyword? symbol?) (define-macro BITS-PER-WORD (lambda () 32)) (define-macro logical-or (lambda (x . y) `(logor ,x ,@y))) - (define-macro (lalr-error msg obj) `(error "~a ~S:" ,msg ,obj))) - + (define-macro (lalr-error msg obj) `(error "~a ~S:" ,msg ,obj)) + (define (note-source-location lvalue tok) lvalue)) (else (error "Unsupported Scheme system"))) @@ -1617,7 +1629,10 @@ '())) ,(if (= nt 0) '$1 - `(___push ,n ,nt ,(cdr p) ,@(if (eq? driver-name 'lr-driver) '() '(___sp))))))))) + `(___push ,n ,nt ,(cdr p) ,@(if (eq? driver-name 'lr-driver) '() '(___sp)) + ,(if (eq? driver-name 'lr-driver) + `(vector-ref ___stack (- ___sp ,(length rhs))) + `(list-ref ___sp ,(length rhs)))))))))) gram/actions)))) @@ -1833,14 +1848,14 @@ (if (>= ___sp (vector-length ___stack)) (___growstack))) - (define (___push delta new-category lvalue) + (define (___push delta new-category lvalue tok) (set! ___sp (- ___sp (* delta 2))) (let* ((state (vector-ref ___stack ___sp)) (new-state (cdr (assoc new-category (vector-ref ___gtable state))))) (set! ___sp (+ ___sp 2)) (___checkstack) (vector-set! ___stack ___sp new-state) - (vector-set! ___stack (- ___sp 1) lvalue))) + (vector-set! ___stack (- ___sp 1) (note-source-location lvalue tok)))) (define (___reduce st) ((vector-ref ___rtable st) ___stack ___sp ___gtable ___push ___pushback)) @@ -2008,11 +2023,11 @@ (set! *parses* (cons parse *parses*))) - (define (push delta new-category lvalue stack) + (define (push delta new-category lvalue stack tok) (let* ((stack (drop stack (* delta 2))) (state (car stack)) (new-state (cdr (assv new-category (vector-ref ___gtable state))))) - (cons new-state (cons lvalue stack)))) + (cons new-state (cons (note-source-location lvalue tok) stack)))) (define (reduce state stack) ((vector-ref ___rtable state) stack ___gtable push)) -- /home/janneke/.signature --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable --=20 Jan Nieuwenhuizen | GNU LilyPond http://lilypond.org Freelance IT http://JoyofSource.com | Avatar=C2=AE http://AvatarAcademy.nl= =20=20 --=-=-=--