From 90d4bfa13dbddffe88a7b8d032b80f75eaac9d96 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 19 Nov 2004 16:46:21 +0000 Subject: [PATCH] DEFAULT-OBJECT? is no longer a special form. --- v7/doc/ref-manual/overview.texi | 5 ++- v7/src/edwin/regexp.scm | 57 +++++++++++++-------------------- 2 files changed, 25 insertions(+), 37 deletions(-) diff --git a/v7/doc/ref-manual/overview.texi b/v7/doc/ref-manual/overview.texi index c85ac42ee..3982cb09c 100644 --- a/v7/doc/ref-manual/overview.texi +++ b/v7/doc/ref-manual/overview.texi @@ -1,9 +1,9 @@ @c This file is part of the MIT/GNU Scheme Reference Manual. -@c $Id: overview.texi,v 1.1 2003/04/15 03:30:04 cph Exp $ +@c $Id: overview.texi,v 1.2 2004/11/19 16:41:52 cph Exp $ @c Copyright 1991,1992,1993,1994,1995 Massachusetts Institute of Technology @c Copyright 1996,1997,1999,2000,2001 Massachusetts Institute of Technology -@c Copyright 2002,2003 Massachusetts Institute of Technology +@c Copyright 2002,2003,2004 Massachusetts Institute of Technology @c See file scheme.texinfo for copying conditions. @node Overview, Special Forms, Acknowledgements, Top @@ -1010,7 +1010,6 @@ defined when MIT/GNU Scheme is initialized: @tab cond @tab cons-stream @item declare -@tab default-object? @tab define @item define-integrable @tab define-structure diff --git a/v7/src/edwin/regexp.scm b/v7/src/edwin/regexp.scm index 2787acd97..1453c971e 100644 --- a/v7/src/edwin/regexp.scm +++ b/v7/src/edwin/regexp.scm @@ -1,9 +1,10 @@ #| -*-Scheme-*- -$Id: regexp.scm,v 1.81 2003/02/14 18:28:13 cph Exp $ +$Id: regexp.scm,v 1.82 2004/11/19 16:46:21 cph Exp $ Copyright 1986,1989,1991,1992,1993,1995 Massachusetts Institute of Technology Copyright 1996,1997,1999,2001,2002,2003 Massachusetts Institute of Technology +Copyright 2004 Massachusetts Institute of Technology This file is part of MIT/GNU Scheme. @@ -160,39 +161,6 @@ USA. (group-delete! group start (re-match-end-index 0)) (make-mark group start))) -(define-syntax default-end-mark - (sc-macro-transformer - (lambda (form environment) - (let ((start (close-syntax (cadr form) environment)) - (end (close-syntax (caddr form) environment))) - `(IF (DEFAULT-OBJECT? ,end) - (GROUP-END ,start) - (BEGIN - (IF (NOT (MARK<= ,start ,end)) - (ERROR "Marks incorrectly related:" ,start ,end)) - ,end)))))) - -(define-syntax default-start-mark - (sc-macro-transformer - (lambda (form environment) - (let ((start (close-syntax (cadr form) environment)) - (end (close-syntax (caddr form) environment))) - `(IF (DEFAULT-OBJECT? ,start) - (GROUP-START ,end) - (BEGIN - (IF (NOT (MARK<= ,start ,end)) - (ERROR "Marks incorrectly related:" ,start ,end)) - ,start)))))) - -(define-syntax default-case-fold-search - (sc-macro-transformer - (lambda (form environment) - (let ((case-fold-search (close-syntax (cadr form) environment)) - (mark (close-syntax (caddr form) environment))) - `(IF (DEFAULT-OBJECT? ,case-fold-search) - (GROUP-CASE-FOLD-SEARCH (MARK-GROUP ,mark)) - ,case-fold-search))))) - (define (search-forward string start #!optional end case-fold-search) (%re-search string start (default-end-mark start end) (default-case-fold-search case-fold-search start) @@ -229,6 +197,27 @@ USA. (mark-index end)))) (and index (make-mark group index))))) + +(define (default-end-mark start end) + (if (default-object? end) + (group-end start) + (begin + (if (not (mark<= start end)) + (error "Marks incorrectly related:" start end)) + end))) + +(define (default-start-mark start end) + (if (default-object? start) + (group-start end) + (begin + (if (not (mark<= start end)) + (error "Marks incorrectly related:" start end)) + start))) + +(define (default-case-fold-search case-fold-search mark) + (if (default-object? case-fold-search) + (group-case-fold-search (mark-group mark)) + case-fold-search)) (define (re-match-forward regexp start #!optional end case-fold-search) (let ((end (default-end-mark start end)) -- 2.25.1