summaryrefslogtreecommitdiffstats
path: root/chez.init
diff options
context:
space:
mode:
Diffstat (limited to 'chez.init')
-rw-r--r--chez.init266
1 files changed, 266 insertions, 0 deletions
diff --git a/chez.init b/chez.init
new file mode 100644
index 0000000..a91cce3
--- /dev/null
+++ b/chez.init
@@ -0,0 +1,266 @@
+;"chez.init" Initialization file for SLIB for Chez Scheme -*-scheme-*-
+; Copyright (C) 1993 dorai@cs.rice.edu (Dorai Sitaram)
+; Copyright (C) 1991, 1992, 1993 Aubrey Jaffer.
+;
+;Permission to copy this software, to redistribute it, and to use it
+;for any purpose is granted, subject to the following restrictions and
+;understandings.
+;
+;1. Any copy made of this software must include this copyright notice
+;in full.
+;
+;2. I have made no warrantee or representation that the operation of
+;this software will be error-free, and I am under no obligation to
+;provide any services, by way of maintenance, update, or otherwise.
+;
+;3. In conjunction with products arising from the use of this
+;material, there shall be no use of my name in any advertising,
+;promotional, or sales literature without prior written consent in
+;each case.
+
+;;; (software-type) should be set to the generic operating system type.
+;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported.
+
+(define (software-type) 'UNIX)
+
+(define (scheme-implementation-type) 'Chez)
+
+;;; (scheme-implementation-version) should return a string describing
+;;; the version the scheme implementation loading this file.
+
+(define (scheme-implementation-version) "?")
+
+(define implementation-vicinity
+ (lambda () "/usr/local/lib/scheme/"))
+
+;; library-vicinity is moved below the defination of getenv
+
+(define *features*
+ '(
+ source ;can load scheme source files
+ ;(slib:load-source "filename")
+ compiled ;can load compiled files
+ ;(slib:load-compiled "filename")
+ char-ready?
+ delay
+ dynamic-wind
+ fluid-let
+ format
+ full-continuation
+ getenv
+ ieee-p1178
+ macro
+ multiarg/and-
+ multiarg-apply
+ pretty-print
+ random
+ random-inexact
+ rationalize
+ rev3-procedures
+ rev3-report
+ rev4-optional-procedures
+ rev4-report
+ sort
+ system
+ transcript
+ with-file
+ string-port
+ ))
+
+;R4RS define-syntax in terms of Chez's extend-syntax.
+;Caveat: no let-syntax
+
+(extend-syntax (define-syntax syntax-rules)
+ ((define-syntax name (syntax-rules kwds . clauses))
+ (extend-syntax (name . kwds) . clauses)))
+
+;DEFINED?
+(define-syntax defined?
+ (syntax-rules ()
+ ((defined? x) (or (bound? 'x) (get 'x '*expander*)))))
+
+;Chez's sort routines have the opposite parameter order to Slib's
+(define chez:sort sort)
+(define chez:sort! sort!)
+(define chez:merge merge)
+(define chez:merge! merge!)
+
+(define sort
+ (lambda (s p)
+ (chez:sort p s)))
+(define sort!
+ (lambda (s p)
+ (chez:sort! p s)))
+(define merge
+ (lambda (s1 s2 p)
+ (chez:merge p s1 s2)))
+(define merge!
+ (lambda (s1 s2 p)
+ (chez:merge! p s1 s2)))
+
+;RENAME-FILE
+(define rename-file
+ (lambda (src dst)
+ (system (string-append "mv " src " " dst))))
+
+;OUTPUT-PORT-WIDTH
+(define output-port-width (lambda arg 79))
+
+;;; (OUTPUT-PORT-HEIGHT <port>)
+(define (output-port-height . arg) 24)
+
+;;; (CURRENT-ERROR-PORT)
+(define current-error-port
+ (let ((port (current-output-port)))
+ (lambda () port)))
+
+;;; (TMPNAM) makes a temporary file name.
+(define tmpnam
+ (let ((cntr 100))
+ (lambda () (set! cntr (+ 1 cntr))
+ (let ((tmp (string-append "slib_" (number->string cntr))))
+ (if (file-exists? tmp) (tmpnam) tmp)))))
+
+;GETENV
+(provide-foreign-entries '("getenv"))
+(define getenv
+ (foreign-procedure "getenv"
+ (string) string))
+
+(define library-vicinity
+ (let ((library-path (or (getenv "SCHEME_LIBRARY_PATH")
+ "/usr/local/lib/slib/")))
+ (lambda () library-path)))
+
+;FORCE-OUTPUT
+(define force-output flush-output)
+
+;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
+;;; port versions of CALL-WITH-*PUT-FILE.
+(define (call-with-output-string f)
+ (let ((outsp (open-output-string)))
+ (f outsp)
+ (let ((s (get-output-string outsp)))
+ (close-output-port outsp)
+ s)))
+
+(define (call-with-input-string s f)
+ (let* ((insp (open-input-string s))
+ (res (f insp)))
+ (close-input-port insp)
+ res))
+
+;CHAR-CODE-LIMIT
+(define char-code-limit 256)
+
+;Chez's MOST-POSITIVE-FIXNUM is a thunk rather than a number
+(if (procedure? most-positive-fixnum)
+ (set! most-positive-fixnum (most-positive-fixnum)))
+
+;;; Return argument
+(define (identity x) x)
+
+(define slib:eval eval)
+
+(define-macro! defmacro z `(define-macro! ,@z))
+
+(define (defmacro? m) (get m '*expander*))
+
+(define macroexpand-1 eps-expand-once)
+
+(define (macroexpand e)
+ (if (pair? e) (let ((a (car e)))
+ (if (and (symbol? a) (getprop a '*expander*))
+ (macroexpand (expand-once e))
+ e))
+ e))
+
+(define gentemp
+ (let ((*gensym-counter* -1))
+ (lambda ()
+ (set! *gensym-counter* (+ *gensym-counter* 1))
+ (string->symbol
+ (string-append "slib:G" (number->string *gensym-counter*))))))
+
+(define defmacro:eval slib:eval)
+(define macro:eval slib:eval)
+
+(define (slib:eval-load <pathname> evl)
+ (if (not (file-exists? <pathname>))
+ (set! <pathname> (string-append <pathname> (scheme-file-suffix))))
+ (call-with-input-file <pathname>
+ (lambda (port)
+ (let ((old-load-pathname *load-pathname*))
+ (set! *load-pathname* <pathname>)
+ (do ((o (read port) (read port)))
+ ((eof-object? o))
+ (evl o))
+ (set! *load-pathname* old-load-pathname)))))
+
+;Chez's (FORMAT f . a) corresponds to Slib's (FORMAT #f f . a)
+
+(define chez:format format)
+(define format
+ (lambda (where how . args)
+ (let ((str (apply chez:format how args)))
+ (cond ((not where) str)
+ ((eq? where #t) (display str))
+ (else (display str where))))))
+
+(define slib:error
+ (lambda args
+ (let ((port (current-error-port)))
+ (display "Error: " port)
+ (for-each (lambda (x) (display x port)) args)
+ (error #f ""))))
+
+(define slib:tab #\tab)
+(define slib:form-feed #\page)
+
+;Chez's nil variable is bound to '() rather than #f
+
+(define nil #f)
+
+(define in-vicinity string-append)
+
+;;; Define SLIB:EXIT to be the implementation procedure to exit or
+;;; return if exitting not supported.
+(define slib:chez:quit
+ (let ([arg (call-with-current-continuation (lambda (x) x))])
+ (cond [(procedure? arg) arg]
+ [arg (exit)]
+ [else (exit 1)])))
+
+(define slib:exit
+ (lambda args
+ (cond ((null? args) (slib:chez:quit #t))
+ ((eqv? #t (car args)) (slib:chez:quit #t))
+ ((eqv? #f (car args)) (slib:chez:quit #f))
+ ((zero? (car args)) (slib:chez:quit #t))
+ (else (slib:chez:quit #f)))))
+
+;;; Here for backward compatability
+;Note however that ".ss" is a common Chez file suffix
+(define (scheme-file-suffix) ".scm")
+
+;;; (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) (load (string-append f (scheme-file-suffix))))
+
+;;; defmacro:load and macro:load also need the default suffix
+(define defmacro:load slib:load-source)
+(define macro:load slib:load-source)
+
+;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
+;;; by compiling "foo.scm" if this implementation can compile files.
+;;; See feature 'COMPILED.
+
+(define slib:load-compiled load)
+
+;;; At this point SLIB:LOAD must be able to load SLIB files.
+
+(define slib:load slib:load-source)
+
+(slib:load (in-vicinity (library-vicinity) "require"))
+;end chez.init