Author: yamakenz
Date: Thu Jun 14 14:40:16 2007
New Revision: 4594
Added:
sigscheme-trunk/lib/srfi-1.scm
- copied, changed from r4593, /vendor/misc/srfi-1-reference.scm
Log:
* lib/srfi-1.scm
- New file copied from vendor/misc/srfi-1-reference.scm
- (check-arg, :optional): New procedure
- (iota): Adapt to SigScheme
Copied: sigscheme-trunk/lib/srfi-1.scm (from r4593,
/vendor/misc/srfi-1-reference.scm)
==============================================================================
--- /vendor/misc/srfi-1-reference.scm (original)
+++ sigscheme-trunk/lib/srfi-1.scm Thu Jun 14 14:40:16 2007
@@ -6,6 +6,15 @@
;;; hold me liable for its use. Please send bug reports to [EMAIL PROTECTED]
;;; -Olin
+;;; Copyright (c) 2007 SigScheme Project <uim-en AT googlegroups.com>
+
+;; ChangeLog
+;;
+;; 2007-06-15 yamaken Imported from
+;; http://srfi.schemers.org/srfi-1/srfi-1-reference.scm
+;; and adapted to SigScheme
+
+
;;; This is a library of list- and pair-processing functions. I wrote it after
;;; carefully considering the functions provided by the libraries found in
;;; R4RS/R5RS Scheme, MIT Scheme, Gambit, RScheme, MzScheme, slib, Common
@@ -208,6 +217,24 @@
;;;
;;; The SRFI discussion record contains more discussion on this topic.
+;;; SigScheme adaptation
+;;;;;;;;;;;;;;;;;;;;;;;;
+
+(use srfi-8)
+(use srfi-23)
+
+;;(define (check-arg pred val caller)
+;; (let lp ((val val))
+;; (if (pred val) val (lp (error "Bad argument" val pred caller)))))
+(define (check-arg pred val caller) #f)
+
+(define :optional
+ (lambda (opt default)
+ (case (length opt)
+ ((0) default)
+ ((1) (car opt))
+ (else (error "superfluous arguments")))))
+
;;; Constructors
;;;;;;;;;;;;;;;;
@@ -271,9 +298,10 @@
(define (iota count . maybe-start+step)
(check-arg integer? count iota)
(if (< count 0) (error "Negative step count" iota count))
- (let-optionals maybe-start+step ((start 0) (step 1))
+ (let-optionals* maybe-start+step ((start 0) (step 1) . must-be-null)
(check-arg number? start iota)
(check-arg number? step iota)
+ (if (not (null? must-be-null)) (error "superfluous arguments"))
(let ((last-val (+ start (* (- count 1) step))))
(do ((count count (- count 1))
(val last-val (- val step))
