[[project @ 1997-01-04 03:11:22 by ghouston]
ghouston**19970104031124
 Ignore-this: ef8c936557ea342ddb4c87f34f64d038
 * init.scm (define-structure): simple substitute.
 * let-opt.scm: new copy from SCSH.  replace :optional with optional.
] hunk ./ChangeLog 1
+Sat Jan  4 02:48:02 1997  Gary Houston  <ghouston@actrix.gen.nz>
+
+	* init.scm (define-structure): simple substitute.
+
+Sun Dec 29 08:12:10 1996  Gary Houston  <ghouston@actrix.gen.nz>
+
+	* let-opt.scm: new copy from SCSH.  replace :optional with optional.
+
hunk ./init.scm 12
+(require 'values)
hunk ./init.scm 16
-(require 'values)
+;; just pick out the begin forms.
+(defmacro define-structure (name interface . body)
+  (let loop ((rest body)
+	     (result '(begin)))
+    (if (null? rest)
+	(reverse result)
+	(loop (cdr rest)
+	      (if (eq? (caar rest) 'begin)
+		  (cons (car rest) result)
+		  result)))))
hunk ./let-opt.scm 2
+;;; for Guile: replaced :optional with optional.
hunk ./let-opt.scm 5
-;;; 	(:OPTIONAL rest-arg default-exp)
+;;; 	(OPTIONAL rest-arg default-exp)
hunk ./let-opt.scm 11
-;;; The LET-OPTIONALS* and :OPTIONAL macros are defined with simple
+;;; The LET-OPTIONALS* and OPTIONAL macros are defined with simple
hunk ./let-opt.scm 29
-;;;		 (:optional       :syntax))
+;;;		 (optional       :syntax))
hunk ./let-opt.scm 92
-;(define-structure let-opt-expanders (export expand-let-optionals)
-;  (open scheme)
-;  (begin
+(define-structure let-opt-expanders (export expand-let-optionals)
+  (open scheme)
+  (begin
hunk ./let-opt.scm 99
-;(define (make-default-procs vars body-proc defaulter-names defs rename)
-;  (let ((%lambda (rename 'lambda)))
-;    (let recur ((vars (reverse vars))
-;		(defaulter-names (reverse defaulter-names))
-;		(defs (reverse defs))
-;		(next-guy body-proc))
-;      (if (null? vars) '()
-;	  (let ((vars (cdr vars)))
-;	    `((,(car defaulter-names)
-;	       (,%lambda ,(reverse vars)
-;			 (,next-guy ,@(reverse vars) ,(car defs))))
-;	      . ,(recur vars
-;			(cdr defaulter-names)
-;			(cdr defs)
-;			(car defaulter-names))))))))
+(define (make-default-procs vars body-proc defaulter-names defs rename)
+  (let ((%lambda (rename 'lambda)))
+    (let recur ((vars (reverse vars))
+		(defaulter-names (reverse defaulter-names))
+		(defs (reverse defs))
+		(next-guy body-proc))
+      (if (null? vars) '()
+	  (let ((vars (cdr vars)))
+	    `((,(car defaulter-names)
+	       (,%lambda ,(reverse vars)
+			 (,next-guy ,@(reverse vars) ,(car defs))))
+	      . ,(recur vars
+			(cdr defaulter-names)
+			(cdr defs)
+			(car defaulter-names))))))))
hunk ./let-opt.scm 118
-;(define (make-if-tree vars defaulters body-proc rest rename)
-;  (let ((%if (rename 'if))
-;	(%null? (rename 'null?))
-;	(%error (rename 'error))
-;	(%let (rename 'let))
-;	(%car (rename 'car))
-;	(%cdr (rename 'cdr)))
+(define (make-if-tree vars defaulters body-proc rest rename)
+  (let ((%if (rename 'if))
+	(%null? (rename 'null?))
+	(%error (rename 'error))
+	(%let (rename 'let))
+	(%car (rename 'car))
+	(%cdr (rename 'cdr)))
hunk ./let-opt.scm 126
-;    (let recur ((vars vars) (defaulters defaulters) (non-defaults '()))
-;      (if (null? vars)
-;	  `(,%if (,%null? ,rest) (,body-proc . ,(reverse non-defaults))
-;		 (,%error "Too many optional arguments." ,rest))
+    (let recur ((vars vars) (defaulters defaulters) (non-defaults '()))
+      (if (null? vars)
+	  `(,%if (,%null? ,rest) (,body-proc . ,(reverse non-defaults))
+		 (,%error "Too many optional arguments." ,rest))
hunk ./let-opt.scm 131
-;	  (let ((v (car vars)))
-;	    `(,%if (,%null? ,rest)
-;		   (,(car defaulters) . ,(reverse non-defaults))
-;		   (,%let ((,v (,%car ,rest))
-;			   (,rest (,%cdr ,rest)))
-;		     ,(recur (cdr vars)
-;			     (cdr defaulters)
-;			     (cons v non-defaults)))))))))
+	  (let ((v (car vars)))
+	    `(,%if (,%null? ,rest)
+		   (,(car defaulters) . ,(reverse non-defaults))
+		   (,%let ((,v (,%car ,rest))
+			   (,rest (,%cdr ,rest)))
+		     ,(recur (cdr vars)
+			     (cdr defaulters)
+			     (cons v non-defaults)))))))))
hunk ./let-opt.scm 141
-;(define (expand-let-optionals exp rename compare?)
-;  (let* ((arg-list (cadr exp))
-;	 (var/defs (caddr exp))
-;	 (body (cdddr exp))
-;	 (vars (map car var/defs))
+(define (expand-let-optionals exp rename compare?)
+  (let* ((arg-list (cadr exp))
+	 (var/defs (caddr exp))
+	 (body (cdddr exp))
+	 (vars (map car var/defs))
hunk ./let-opt.scm 147
-;	 (prefix-sym (lambda (prefix sym)
-;		       (string->symbol (string-append prefix (symbol->string sym)))))
+	 (prefix-sym (lambda (prefix sym)
+		       (string->symbol (string-append prefix (symbol->string sym)))))
hunk ./let-opt.scm 150
-;	 ;; Private vars, one for each user var.
-;	 ;; We prefix the % to help keep macro-expanded code from being
-;	 ;; too confusing.
-;	 (vars2 (map (lambda (v) (rename (prefix-sym "%" v)))
-;		     vars))
+	 ;; Private vars, one for each user var.
+	 ;; We prefix the % to help keep macro-expanded code from being
+	 ;; too confusing.
+	 (vars2 (map (lambda (v) (rename (prefix-sym "%" v)))
+		     vars))
hunk ./let-opt.scm 156
-;	 (defs (map cadr var/defs))
-;	 (body-proc (rename 'body))
+	 (defs (map cadr var/defs))
+	 (body-proc (rename 'body))
hunk ./let-opt.scm 159
-;	 ;; A private var, bound to the value of the ARG-LIST expression.
-;	 (rest-var (rename '%rest))
+	 ;; A private var, bound to the value of the ARG-LIST expression.
+	 (rest-var (rename '%rest))
hunk ./let-opt.scm 162
-;	 (%let* (rename 'let*))
-;	 (%lambda (rename 'lambda))
+	 (%let* (rename 'let*))
+	 (%lambda (rename 'lambda))
hunk ./let-opt.scm 165
-;	 (defaulter-names (map (lambda (var) (rename (prefix-sym "def-" var)))
-;			       vars))
+	 (defaulter-names (map (lambda (var) (rename (prefix-sym "def-" var)))
+			       vars))
hunk ./let-opt.scm 168
-;	 (defaulters (make-default-procs vars2 body-proc
-;					 defaulter-names defs rename))
-;	 (if-tree (make-if-tree vars2 defaulter-names body-proc
-;				rest-var rename)))
+	 (defaulters (make-default-procs vars2 body-proc
+					 defaulter-names defs rename))
+	 (if-tree (make-if-tree vars2 defaulter-names body-proc
+				rest-var rename)))
hunk ./let-opt.scm 173
-;    `(,%let* ((,rest-var ,arg-list)
-;	      (,body-proc (,%lambda ,vars . ,body))
-;	      . ,defaulters)
-;       ,if-tree)))
+    `(,%let* ((,rest-var ,arg-list)
+	      (,body-proc (,%lambda ,vars . ,body))
+	      . ,defaulters)
+       ,if-tree)))
hunk ./let-opt.scm 178
-;)) ; erutcurts-enifed
+)) ; erutcurts-enifed
hunk ./let-opt.scm 184
-;(define-structure let-opt (export (let-optionals  :syntax)
-;				  (let-optionals* :syntax)
-;				  (:optional      :syntax))
-;  (open scheme error-package)
-;  (for-syntax (open let-opt-expanders scheme))
-;  (begin
+(define-structure let-opt (export (let-optionals  :syntax)
+				  (let-optionals* :syntax)
+				  (optional      :syntax))
+  (open scheme error-package)
+  (for-syntax (open let-opt-expanders scheme))
+  (begin
hunk ./let-opt.scm 195
-;(define-syntax let-optionals expand-let-optionals)
+(define-syntax let-optionals expand-let-optionals)
hunk ./let-opt.scm 198
-;;; (:optional rest-arg default-exp)
+;;; (optional rest-arg default-exp)
hunk ./let-opt.scm 210
-;; for Guile, renamed from :optional 
hunk ./let-opt.scm 238
-;(define-syntax let-optionals*
-;  (syntax-rules ()
-;    ((let-optionals* args vars&defaults body1 ...)
-;     (let ((rest args))
-;       (really-let-optionals* rest vars&defaults body1 ...)))))
+(define-syntax let-optionals*
+  (syntax-rules ()
+    ((let-optionals* args vars&defaults body1 ...)
+     (let ((rest args))
+       (really-let-optionals* rest vars&defaults body1 ...)))))
hunk ./let-opt.scm 244
-;(define-syntax really-let-optionals*
-;  (syntax-rules ()
-;    ;; Standard case. Do the first var/default and recurse.
-;    ((really-let-optionals* args ((var1 default1) etc ...)
-;       body1 ...)
-;     (call-with-values (lambda () (if (null? args)
-;				      (values default1 '())
-;				      (values (car args) (cdr args))))
-;		       (lambda (var1 rest)
-;			 (really-let-optionals* rest (etc ...)
-;			   body1 ...))))
+(define-syntax really-let-optionals*
+  (syntax-rules ()
+    ;; Standard case. Do the first var/default and recurse.
+    ((really-let-optionals* args ((var1 default1) etc ...)
+       body1 ...)
+     (call-with-values (lambda () (if (null? args)
+				      (values default1 '())
+				      (values (car args) (cdr args))))
+		       (lambda (var1 rest)
+			 (really-let-optionals* rest (etc ...)
+			   body1 ...))))
hunk ./let-opt.scm 256
-;    ;; Single rest arg -- bind to the remaining rest values.
-;    ((really-let-optionals* args (rest) body1 ...)
-;     (let ((rest args)) body1 ...))
+    ;; Single rest arg -- bind to the remaining rest values.
+    ((really-let-optionals* args (rest) body1 ...)
+     (let ((rest args)) body1 ...))
hunk ./let-opt.scm 260
-;    ;; No more vars. Make sure there are no unaccounted-for values, and
-;    ;; do the body.
-;    ((really-let-optionals* args () body1 ...)
-;     (if (null? args) (begin body1 ...)
-;	 (error "Too many optional arguments." args)))))
+    ;; No more vars. Make sure there are no unaccounted-for values, and
+    ;; do the body.
+    ((really-let-optionals* args () body1 ...)
+     (if (null? args) (begin body1 ...)
+	 (error "Too many optional arguments." args)))))
hunk ./let-opt.scm 266
-;)) ; erutcurts-enifed
+)) ; erutcurts-enifed
hunk ./network.scm 6
-;;; numerous changes for interface with Guile primitives.
+;;; numerous changes to interface with Guile primitives.