From 4684239efa63dc1b2c1cbe37ef7d3062029f5532 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:40 -0800
Subject: Import Upstream version 3b1

---
 pscheme.init | 75 +++++++++++++++++++++++++++---------------------------------
 1 file changed, 34 insertions(+), 41 deletions(-)

(limited to 'pscheme.init')

diff --git a/pscheme.init b/pscheme.init
index 11c0125..49c98a3 100644
--- a/pscheme.init
+++ b/pscheme.init
@@ -13,9 +13,9 @@
 (define (scheme-implementation-version)
   (let ((v (version)))
     (string-append
-      (number->string (car v)) "."
-      (number->string (cadr v)) "."
-      (number->string (caddr v)))))
+     (number->string (car v)) "."
+     (number->string (cadr v)) "."
+     (number->string (caddr v)))))
 (define (scheme-implementation-home-page) "http://www.mazama.net/scheme/pscheme.htm")
 
 (define (implementation-vicinity) "\\Program Files\\Pocket Scheme\\")
@@ -58,8 +58,7 @@
 ;@
 (define sub-vicinity
   (case (software-type)
-    ((vms) (lambda
-	       (vic name)
+    ((vms) (lambda (vic name)
 	     (let ((l (string-length vic)))
 	       (if (or (zero? (string-length vic))
 		       (not (char=? #\] (string-ref vic (- l 1)))))
@@ -99,6 +98,7 @@
     rev4-optional-procedures
     vicinity
     srfi-59
+    srfi-96
     multiarg/and-
     multiarg-apply
     with-file
@@ -106,16 +106,16 @@
     defmacro
     rationalize
     delay
-; pscheme needs the R5RS arity-2 eval in order to define the following
-;    eval
+;;; pscheme needs the R5RS arity-2 eval in order to define the following
+;;;    eval
     dynamic-wind
     full-continuation
-    srfi
-; pscheme needs print-call-stack in order to define the following
-;	trace
+    srfi-0
+;;; pscheme needs print-call-stack in order to define the following
+;;;	trace
     system
     string-port
-	))
+    ))
 
 ;;@ (FILE-POSITION <port> . <k>)
 (define (file-position . args) #f)
@@ -165,10 +165,10 @@
 ;@
 (define (browse-url url)
   (with-handlers
-    ;; the pscheme SYSTEM procedure raises an exn when it can't find the image to run.
-    ;; SYSTEM uses ShellExecuteEx where available, so we give it the document name to open
-    (((lambda (x) #t) (lambda (x) #f)))
-    (system url)))
+   ;; the pscheme SYSTEM procedure raises an exn when it can't find the image to run.
+   ;; SYSTEM uses ShellExecuteEx where available, so we give it the document name to open
+   (((lambda (x) #t) (lambda (x) #f)))
+   (system url)))
 
 
 ;;@ CHAR-CODE-LIMIT is one greater than the largest integer which can
@@ -197,13 +197,9 @@
 ;;@ SLIB:EVAL is single argument eval using the top-level (user) environment.
 (define slib:eval eval)
 
-;;; If your implementation provides R4RS macros:
-;(define macro:eval slib:eval)
-;(define macro:load load)
-
 ;;@ Define defmacro in terms of our define-macro
 (define-macro (defmacro name args . body)
- `(define-macro (,name ,@args) ,@body))
+  `(define-macro (,name ,@args) ,@body))
 
 ; following defns removed in 0.6.3 while I rethink macro support
 ;(define defmacro? macro?)
@@ -213,14 +209,6 @@
 ;@
 (define gentemp gensym)
 
-(define base:eval slib:eval)
-;@
-(define defmacro:eval slib:eval)
-
-;; slib:eval-load definition moved to  "require.scm"
-;@
-(define (defmacro:load <pathname>)
-  (slib:eval-load <pathname> defmacro:eval))
 ;@
 (define slib:warn
   (lambda args
@@ -233,16 +221,16 @@
 
 ;;@ As announced by feature string-port
 (define (call-with-output-string t)
- (let* ((p (open-output-string))
-        (r (t p))
-        (s (get-output-string p)))
-  (close-output-port p)
-  s))
+  (let* ((p (open-output-string))
+	 (r (t p))
+	 (s (get-output-string p)))
+    (close-output-port p)
+    s))
 (define (call-with-input-string s t)
- (let* ((p (open-input-string s))
-        (r (t p)))
-  (close-input-port p)
-  r))
+  (let* ((p (open-input-string s))
+	 (r (t p)))
+    (close-input-port p)
+    r))
 
 ;;@ define these as appropriate for your system.
 (define slib:tab (integer->char 9))
@@ -273,9 +261,9 @@
 ;;@ (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
 ;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
 (define (slib:load-source f)
- (if (not (file-exists? f))
-  (set! f (string-append f (scheme-file-suffix))))
- (load f))
+  (if (not (file-exists? f))
+      (set! f (string-append f (scheme-file-suffix))))
+  (load f))
 
 ;;@ (SLIB:LOAD-COMPILED "foo") should load the file that was produced
 ;;; by compiling "foo.scm" if this implementation can compile files.
@@ -285,9 +273,14 @@
 ;;@ At this point SLIB:LOAD must be able to load SLIB files.
 (define slib:load slib:load-source)
 
+;@
+(define defmacro:eval slib:eval)
+;@
+(define defmacro:load slib:load-source)
+
 ;;; Pscheme and SLIB both define REQUIRE, so dispatch on argument type.
 (define pscheme:require require)
 (slib:load (in-vicinity (library-vicinity) "require"))
 (define slib:require require)
 (define (require x)
- (if (string? x) (pscheme:require x) (slib:require x)))
+  (if (string? x) (pscheme:require x) (slib:require x)))
-- 
cgit v1.2.3