/
usr
/
share
/
guile
/
3.0
/
sxml
/
ssax
/
/usr/share/guile/3.0/sxml/ssax
mkdir
upload
Name
Size
Mode
Actions
input-parse.scm
7932
0644
edit
dl
rm
Edit:
/usr/share/guile/3.0/sxml/ssax/input-parse.scm
(7932B)
;;;; (sxml ssax input-parse) -- a simple lexer ;;;; ;;;; Copyright (C) 2009 Free Software Foundation, Inc. ;;;; Modified 2004 by Andy Wingo <wingo at pobox dot com>. ;;;; Written 2003 by Oleg Kiselyov <oleg at pobox dot com> as input-parse.scm. ;;;; ;;;; 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 ;;;; ;;; Commentary: ;; ;; A simple lexer. ;; ;; The procedures in this module surprisingly often suffice to parse an ;; input stream. They either skip, or build and return tokens, according ;; to inclusion or delimiting semantics. The list of characters to ;; expect, include, or to break at may vary from one invocation of a ;; function to another. This allows the functions to easily parse even ;; context-sensitive languages. ;; ;; EOF is generally frowned on, and thrown up upon if encountered. ;; Exceptions are mentioned specifically. The list of expected ;; characters (characters to skip until, or break-characters) may ;; include an EOF "character", which is to be coded as the symbol, ;; @code{*eof*}. ;; ;; The input stream to parse is specified as a @dfn{port}, which is ;; usually the last (and optional) argument. It defaults to the current ;; input port if omitted. ;; ;; If the parser encounters an error, it will throw an exception to the ;; key @code{parser-error}. The arguments will be of the form ;; @code{(@var{port} @var{message} @var{specialising-msg}*)}. ;; ;; The first argument is a port, which typically points to the offending ;; character or its neighborhood. You can then use @code{port-column} ;; and @code{port-line} to query the current position. @var{message} is ;; the description of the error. Other arguments supply more details ;; about the problem. ;; ;;; Code: (define-module (sxml ssax input-parse) #:use-module (ice-9 rdelim) #:export (peek-next-char assert-curr-char skip-until skip-while next-token next-token-of read-text-line read-string find-string-from-port?)) (define ascii->char integer->char) (define char->ascii char->integer) (define char-newline #\newline) (define char-return #\return) (define inc 1+) (define dec 1-) ;; rewrite oleg's define-opt into define* style (define-macro (define-opt bindings body . body-rest) (let* ((rev-bindings (reverse bindings)) (opt-bindings (and (pair? rev-bindings) (pair? (car rev-bindings)) (eq? 'optional (caar rev-bindings)) (cdar rev-bindings)))) (if opt-bindings `(define* ,(append (reverse (cons #:optional (cdr rev-bindings))) opt-bindings) ,body ,@body-rest) `(define* ,bindings ,body ,@body-rest)))) (define (parser-error port message . rest) (apply throw 'parser-error port message rest)) (include-from-path "sxml/upstream/input-parse.scm") ;; This version for guile is quite speedy, due to read-delimited (which ;; is implemented in C). (define-opt (next-token prefix-skipped-chars break-chars (optional (comment "") (port (current-input-port))) ) (let ((delims (list->string (delete '*eof* break-chars)))) (if (eof-object? (if (null? prefix-skipped-chars) (peek-char port) (skip-while prefix-skipped-chars port))) (if (memq '*eof* break-chars) "" (parser-error port "EOF while reading a token " comment)) (let ((token (read-delimited delims port 'peek))) (if (and (eof-object? (peek-char port)) (not (memq '*eof* break-chars))) (parser-error port "EOF while reading a token " comment) token))))) (define-opt (read-text-line (optional (port (current-input-port))) ) (read-line port)) ;; Written 1995, 1996 by Oleg Kiselyov (oleg@acm.org) ;; Modified 1996, 1997, 1998, 2001 by A. Jaffer (agj@alum.mit.edu) ;; Modified 2003 by Steve VanDevender (stevev@hexadecimal.uoregon.edu) ;; Modified 2004 Andy Wingo <wingo at pobox dot com> ;; This function is from SLIB's strsrch.scm, and is in the public domain. (define (find-string-from-port? str <input-port> . max-no-char) "Looks for @var{str} in @var{<input-port>}, optionally within the first @var{max-no-char} characters." (set! max-no-char (if (null? max-no-char) #f (car max-no-char))) (letrec ((no-chars-read 0) (peeked? #f) (my-peek-char ; Return a peeked char or #f (lambda () (and (or (not (number? max-no-char)) (< no-chars-read max-no-char)) (let ((c (peek-char <input-port>))) (cond (peeked? c) ((eof-object? c) #f) ((procedure? max-no-char) (set! peeked? #t) (if (max-no-char c) #f c)) ((eqv? max-no-char c) #f) (else c)))))) (next-char (lambda () (set! peeked? #f) (read-char <input-port>) (set! no-chars-read (+ 1 no-chars-read)))) (match-1st-char ; of the string str (lambda () (let ((c (my-peek-char))) (and c (begin (next-char) (if (char=? c (string-ref str 0)) (match-other-chars 1) (match-1st-char))))))) ;; There has been a partial match, up to the point pos-to-match ;; (for example, str[0] has been found in the stream) ;; Now look to see if str[pos-to-match] for would be found, too (match-other-chars (lambda (pos-to-match) (if (>= pos-to-match (string-length str)) no-chars-read ; the entire string has matched (let ((c (my-peek-char))) (and c (if (not (char=? c (string-ref str pos-to-match))) (backtrack 1 pos-to-match) (begin (next-char) (match-other-chars (+ 1 pos-to-match))))))))) ;; There had been a partial match, but then a wrong char showed up. ;; Before discarding previously read (and matched) characters, we check ;; to see if there was some smaller partial match. Note, characters read ;; so far (which matter) are those of str[0..matched-substr-len - 1] ;; In other words, we will check to see if there is such i>0 that ;; substr(str,0,j) = substr(str,i,matched-substr-len) ;; where j=matched-substr-len - i (backtrack (lambda (i matched-substr-len) (let ((j (- matched-substr-len i))) (if (<= j 0) ;; backed off completely to the begining of str (match-1st-char) (let loop ((k 0)) (if (>= k j) (match-other-chars j) ; there was indeed a shorter match (if (char=? (string-ref str k) (string-ref str (+ i k))) (loop (+ 1 k)) (backtrack (+ 1 i) matched-substr-len)))))))) ) (match-1st-char)))
Save
cmd:
run