mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-18 17:50:29 +02:00
Rearrange PEG Modules
* module/ice-9/peg.scm: move code out of here * module/ice-9/peg/match-records.scm: remove this file * module/ice-9/peg/using-parsers.scm: make a new module with utilities for using parsers. It contains the code from both peg.scm and match-records.scm * module/ice-9/peg/string-peg.scm: update to use new module
This commit is contained in:
Noah Lavine
Andy Wingo
parent
22d4c9d99a
commit
0977b03ef1
4 changed files with 123 additions and 119 deletions
|
|
@ -18,16 +18,15 @@
|
|||
;;;;
|
||||
|
||||
(define-module (ice-9 peg)
|
||||
#:export (peg-parse
|
||||
define-nonterm
|
||||
; define-nonterm-f
|
||||
peg-match)
|
||||
#:use-module (ice-9 peg codegen)
|
||||
#:use-module (ice-9 peg string-peg)
|
||||
#:use-module (ice-9 peg simplify-tree)
|
||||
#:use-module (ice-9 peg match-record)
|
||||
#:use-module (ice-9 peg using-parsers)
|
||||
#:use-module (ice-9 peg cache)
|
||||
#:re-export (peg-sexp-compile
|
||||
#:re-export (peg-parse
|
||||
define-nonterm
|
||||
peg-match
|
||||
peg-sexp-compile
|
||||
define-grammar
|
||||
define-grammar-f
|
||||
keyword-flatten
|
||||
|
|
@ -39,71 +38,3 @@
|
|||
peg:substring
|
||||
peg-record?))
|
||||
|
||||
;;;
|
||||
;;; Helper Macros
|
||||
;;;
|
||||
|
||||
(define-syntax until
|
||||
(syntax-rules ()
|
||||
"Evaluate TEST. If it is true, return its value. Otherwise,
|
||||
execute the STMTs and try again."
|
||||
((_ test stmt stmt* ...)
|
||||
(let lp ()
|
||||
(or test
|
||||
(begin stmt stmt* ... (lp)))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;; FOR DEFINING AND USING NONTERMINALS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; Parses STRING using NONTERM
|
||||
(define (peg-parse nonterm string)
|
||||
;; We copy the string before using it because it might have been modified
|
||||
;; in-place since the last time it was parsed, which would invalidate the
|
||||
;; cache. Guile uses copy-on-write for strings, so this is fast.
|
||||
(let ((res (nonterm (string-copy string) (string-length string) 0)))
|
||||
(if (not res)
|
||||
#f
|
||||
(make-prec 0 (car res) string (string-collapse (cadr res))))))
|
||||
|
||||
;; Defines a new nonterminal symbol accumulating with ACCUM.
|
||||
(define-syntax define-nonterm
|
||||
(lambda (x)
|
||||
(syntax-case x ()
|
||||
((_ sym accum pat)
|
||||
(let ((matchf (peg-sexp-compile #'pat (syntax->datum #'accum)))
|
||||
(accumsym (syntax->datum #'accum)))
|
||||
;; CODE is the code to parse the string if the result isn't cached.
|
||||
(let ((syn (wrap-parser-for-users x matchf accumsym #'sym)))
|
||||
#`(define sym #,(cg-cached-parser syn))))))))
|
||||
|
||||
(define (peg-like->peg pat)
|
||||
(syntax-case pat ()
|
||||
(str (string? (syntax->datum #'str)) #'(peg str))
|
||||
(else pat)))
|
||||
|
||||
;; Searches through STRING for something that parses to PEG-MATCHER. Think
|
||||
;; regexp search.
|
||||
(define-syntax peg-match
|
||||
(lambda (x)
|
||||
(syntax-case x ()
|
||||
((_ pattern string-uncopied)
|
||||
(let ((pmsym (syntax->datum #'pattern)))
|
||||
(let ((matcher (peg-sexp-compile (peg-like->peg #'pattern) 'body)))
|
||||
;; We copy the string before using it because it might have been
|
||||
;; modified in-place since the last time it was parsed, which would
|
||||
;; invalidate the cache. Guile uses copy-on-write for strings, so
|
||||
;; this is fast.
|
||||
#`(let ((string (string-copy string-uncopied))
|
||||
(strlen (string-length string-uncopied))
|
||||
(at 0))
|
||||
(let ((ret (until (or (>= at strlen)
|
||||
(#,matcher string strlen at))
|
||||
(set! at (+ at 1)))))
|
||||
(if (eq? ret #t) ;; (>= at strlen) succeeded
|
||||
#f
|
||||
(let ((end (car ret))
|
||||
(match (cadr ret)))
|
||||
(make-prec
|
||||
at end string
|
||||
(string-collapse match))))))))))))
|
||||
|
|
|
|||
|
|
@ -1,43 +0,0 @@
|
|||
;;;; match-record.scm --- records to hold PEG parser results
|
||||
;;;;
|
||||
;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
;;;; License as published by the Free Software Foundation; either
|
||||
;;;; version 3 of the License, or (at your option) any later version.
|
||||
;;;;
|
||||
;;;; This library is distributed in the hope that it will be useful,
|
||||
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;;; 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
|
||||
;;;;
|
||||
|
||||
(define-module (ice-9 peg match-record)
|
||||
#:export (prec make-prec peg:start peg:end peg:string
|
||||
peg:tree peg:substring peg-record?))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;; PMATCH STRUCTURE MUNGING
|
||||
;; Pretty self-explanatory.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define prec
|
||||
(make-record-type "peg" '(start end string tree)))
|
||||
(define make-prec
|
||||
(record-constructor prec '(start end string tree)))
|
||||
(define (peg:start pm)
|
||||
(if pm ((record-accessor prec 'start) pm) #f))
|
||||
(define (peg:end pm)
|
||||
(if pm ((record-accessor prec 'end) pm) #f))
|
||||
(define (peg:string pm)
|
||||
(if pm ((record-accessor prec 'string) pm) #f))
|
||||
(define (peg:tree pm)
|
||||
(if pm ((record-accessor prec 'tree) pm) #f))
|
||||
(define (peg:substring pm)
|
||||
(if pm (substring (peg:string pm) (peg:start pm) (peg:end pm)) #f))
|
||||
(define peg-record? (record-predicate prec))
|
||||
|
|
@ -22,9 +22,8 @@
|
|||
define-grammar
|
||||
define-grammar-f
|
||||
peg-grammar)
|
||||
#:use-module (ice-9 peg)
|
||||
#:use-module (ice-9 peg using-parsers)
|
||||
#:use-module (ice-9 peg codegen)
|
||||
#:use-module (ice-9 peg match-record)
|
||||
#:use-module (ice-9 peg simplify-tree))
|
||||
|
||||
;; Gets the left-hand depth of a list.
|
||||
|
|
|
|||
117
module/ice-9/peg/using-parsers.scm
Normal file
117
module/ice-9/peg/using-parsers.scm
Normal file
|
|
@ -0,0 +1,117 @@
|
|||
;;;; using-parsers.scm --- utilities to make using parsers easier
|
||||
;;;;
|
||||
;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
;;;; License as published by the Free Software Foundation; either
|
||||
;;;; version 3 of the License, or (at your option) any later version.
|
||||
;;;;
|
||||
;;;; This library is distributed in the hope that it will be useful,
|
||||
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;;; 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
|
||||
;;;;
|
||||
|
||||
(define-module (ice-9 peg using-parsers)
|
||||
#:use-module (ice-9 peg simplify-tree)
|
||||
#:use-module (ice-9 peg codegen)
|
||||
#:use-module (ice-9 peg cache)
|
||||
#:use-module (ice-9 peg string-peg)
|
||||
#:export (peg-parse define-nonterm peg-match
|
||||
prec make-prec peg:start peg:end peg:string
|
||||
peg:tree peg:substring peg-record?))
|
||||
|
||||
;;;
|
||||
;;; Helper Macros
|
||||
;;;
|
||||
|
||||
(define-syntax until
|
||||
(syntax-rules ()
|
||||
"Evaluate TEST. If it is true, return its value. Otherwise,
|
||||
execute the STMTs and try again."
|
||||
((_ test stmt stmt* ...)
|
||||
(let lp ()
|
||||
(or test
|
||||
(begin stmt stmt* ... (lp)))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;; FOR DEFINING AND USING NONTERMINALS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; Parses STRING using NONTERM
|
||||
(define (peg-parse nonterm string)
|
||||
;; We copy the string before using it because it might have been modified
|
||||
;; in-place since the last time it was parsed, which would invalidate the
|
||||
;; cache. Guile uses copy-on-write for strings, so this is fast.
|
||||
(let ((res (nonterm (string-copy string) (string-length string) 0)))
|
||||
(if (not res)
|
||||
#f
|
||||
(make-prec 0 (car res) string (string-collapse (cadr res))))))
|
||||
|
||||
;; Defines a new nonterminal symbol accumulating with ACCUM.
|
||||
(define-syntax define-nonterm
|
||||
(lambda (x)
|
||||
(syntax-case x ()
|
||||
((_ sym accum pat)
|
||||
(let ((matchf (peg-sexp-compile #'pat (syntax->datum #'accum)))
|
||||
(accumsym (syntax->datum #'accum)))
|
||||
;; CODE is the code to parse the string if the result isn't cached.
|
||||
(let ((syn (wrap-parser-for-users x matchf accumsym #'sym)))
|
||||
#`(define sym #,(cg-cached-parser syn))))))))
|
||||
|
||||
(define (peg-like->peg pat)
|
||||
(syntax-case pat ()
|
||||
(str (string? (syntax->datum #'str)) #'(peg str))
|
||||
(else pat)))
|
||||
|
||||
;; Searches through STRING for something that parses to PEG-MATCHER. Think
|
||||
;; regexp search.
|
||||
(define-syntax peg-match
|
||||
(lambda (x)
|
||||
(syntax-case x ()
|
||||
((_ pattern string-uncopied)
|
||||
(let ((pmsym (syntax->datum #'pattern)))
|
||||
(let ((matcher (peg-sexp-compile (peg-like->peg #'pattern) 'body)))
|
||||
;; We copy the string before using it because it might have been
|
||||
;; modified in-place since the last time it was parsed, which would
|
||||
;; invalidate the cache. Guile uses copy-on-write for strings, so
|
||||
;; this is fast.
|
||||
#`(let ((string (string-copy string-uncopied))
|
||||
(strlen (string-length string-uncopied))
|
||||
(at 0))
|
||||
(let ((ret (until (or (>= at strlen)
|
||||
(#,matcher string strlen at))
|
||||
(set! at (+ at 1)))))
|
||||
(if (eq? ret #t) ;; (>= at strlen) succeeded
|
||||
#f
|
||||
(let ((end (car ret))
|
||||
(match (cadr ret)))
|
||||
(make-prec
|
||||
at end string
|
||||
(string-collapse match))))))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;; PMATCH STRUCTURE MUNGING
|
||||
;; Pretty self-explanatory.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define prec
|
||||
(make-record-type "peg" '(start end string tree)))
|
||||
(define make-prec
|
||||
(record-constructor prec '(start end string tree)))
|
||||
(define (peg:start pm)
|
||||
(if pm ((record-accessor prec 'start) pm) #f))
|
||||
(define (peg:end pm)
|
||||
(if pm ((record-accessor prec 'end) pm) #f))
|
||||
(define (peg:string pm)
|
||||
(if pm ((record-accessor prec 'string) pm) #f))
|
||||
(define (peg:tree pm)
|
||||
(if pm ((record-accessor prec 'tree) pm) #f))
|
||||
(define (peg:substring pm)
|
||||
(if pm (substring (peg:string pm) (peg:start pm) (peg:end pm)) #f))
|
||||
(define peg-record? (record-predicate prec))
|
||||
Loading…
Add table
Add a link
Reference in a new issue