diff options
Diffstat (limited to 'Template.scm')
| -rw-r--r-- | Template.scm | 116 |
1 files changed, 70 insertions, 46 deletions
diff --git a/Template.scm b/Template.scm index 9d30d40..6421d92 100644 --- a/Template.scm +++ b/Template.scm @@ -13,8 +13,8 @@ (define (scheme-implementation-type) 'Template) -;;; (scheme-implementation-home-page) should return a (string) URL -;;; (Uniform Resource Locator) for this scheme implementation's home +;;; (scheme-implementation-home-page) should return a (string) URI +;;; (Uniform Resource Identifier) for this scheme implementation's home ;;; page; or false if there isn't one. (define (scheme-implementation-home-page) #f) @@ -30,7 +30,7 @@ (define (implementation-vicinity) (case (software-type) - ((UNIX) "/usr/local/src/scheme/") + ((UNIX) "/usr/local/src/scheme/") ((VMS) "scheme$src:") ((MS-DOS) "C:\\scheme\\"))) @@ -68,57 +68,69 @@ ;(slib:load-source "filename") ; compiled ;can load compiled files ;(slib:load-compiled "filename") -; rev4-report ;conforms to -; rev3-report ;conforms to -; ieee-p1178 ;conforms to -; sicp ;runs code from Structure and - ;Interpretation of Computer - ;Programs by Abelson and Sussman. -; rev4-optional-procedures ;LIST-TAIL, STRING->LIST, + + ;; Scheme report features + + rev5-report ;conforms to + eval ;R5RS two-argument eval + values ;R5RS multiple values + dynamic-wind ;R5RS dynamic-wind + macro ;R5RS high level macros + delay ;has DELAY and FORCE + multiarg-apply ;APPLY can take more than 2 args. + char-ready? + rationalize + rev4-optional-procedures ;LIST-TAIL, STRING->LIST, ;LIST->STRING, STRING-COPY, ;STRING-FILL!, LIST->VECTOR, ;VECTOR->LIST, and VECTOR-FILL! + + rev4-report ;conforms to + + ieee-p1178 ;conforms to + +; rev3-report ;conforms to + ; rev2-procedures ;SUBSTRING-MOVE-LEFT!, ;SUBSTRING-MOVE-RIGHT!, ;SUBSTRING-FILL!, ;STRING-NULL?, APPEND!, 1+, ;-1+, <?, <=?, =?, >?, >=? +; object-hash ;has OBJECT-HASH + ; multiarg/and- ;/ and - can take more than 2 args. -; multiarg-apply ;APPLY can take more than 2 args. -; rationalize -; delay ;has DELAY and FORCE ; with-file ;has WITH-INPUT-FROM-FILE and ;WITH-OUTPUT-FROM-FILE -; string-port ;has CALL-WITH-INPUT-STRING and - ;CALL-WITH-OUTPUT-STRING ; transcript ;TRANSCRIPT-ON and TRANSCRIPT-OFF -; char-ready? -; macro ;has R4RS high level macros -; defmacro ;has Common Lisp DEFMACRO -; eval ;R5RS two-argument eval -; record ;has user defined data structures -; values ;proposed multiple values -; dynamic-wind ;proposed dynamic-wind -; ieee-floating-point ;conforms to + ieee-floating-point ;conforms to IEEE Standard 754-1985 + ;IEEE Standard for Binary + ;Floating-Point Arithmetic. full-continuation ;can return multiple times -; object-hash ;has OBJECT-HASH + ;; Other common features + + srfi ;srfi-0, COND-EXPAND finds all srfi-* +; sicp ;runs code from Structure and + ;Interpretation of Computer + ;Programs by Abelson and Sussman. +; defmacro ;has Common Lisp DEFMACRO +; record ;has user defined data structures +; string-port ;has CALL-WITH-INPUT-STRING and + ;CALL-WITH-OUTPUT-STRING ; sort -; queue ;queues ; pretty-print ; object->string -; format +; format ;Common-lisp output formatting ; trace ;has macros: TRACE and UNTRACE ; compiler ;has (COMPILER) ; ed ;(ED) is editor ; system ;posix (system <string>) getenv ;posix (getenv <string>) ; program-arguments ;returns list of strings (argv) -; Xwindows ;X support -; curses ;screen management package -; termcap ;terminal description package -; terminfo ;sysV terminal description ; current-time ;returns time in seconds since 1/1/1970 + + ;; Implementation Specific features + )) ;;; (OUTPUT-PORT-WIDTH <port>) @@ -150,6 +162,13 @@ ;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string ;;; port versions of CALL-WITH-*PUT-FILE. +;;; "rationalize" adjunct procedures. +;;(define (find-ratio x e) +;; (let ((rat (rationalize x e))) +;; (list (numerator rat) (denominator rat)))) +;;(define (find-ratio-between x y) +;; (find-ratio (/ (+ x y) 2) (/ (- x y) 2))) + ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can ;;; be returned by CHAR->INTEGER. (define char-code-limit 256) @@ -175,18 +194,20 @@ (define (defmacro? m) (and (assq m *defmacros*) #t)) (define (macroexpand-1 e) - (if (pair? e) (let ((a (car e))) - (cond ((symbol? a) (set! a (assq a *defmacros*)) - (if a (apply (cdr a) (cdr e)) e)) - (else e))) + (if (pair? e) + (let ((a (car e))) + (cond ((symbol? a) (set! a (assq a *defmacros*)) + (if a (apply (cdr a) (cdr e)) e)) + (else e))) e)) (define (macroexpand e) - (if (pair? e) (let ((a (car e))) - (cond ((symbol? a) - (set! a (assq a *defmacros*)) - (if a (macroexpand (apply (cdr a) (cdr e))) e)) - (else e))) + (if (pair? e) + (let ((a (car e))) + (cond ((symbol? a) + (set! a (assq a *defmacros*)) + (if a (macroexpand (apply (cdr a) (cdr e))) e)) + (else e))) e)) (define gentemp @@ -201,6 +222,9 @@ (define (defmacro:expand* x) (require 'defmacroexpand) (apply defmacro:expand* x '())) +(define (defmacro:load <pathname>) + (slib:eval-load <pathname> defmacro:eval)) + (define (slib:eval-load <pathname> evl) (if (not (file-exists? <pathname>)) (set! <pathname> (string-append <pathname> (scheme-file-suffix)))) @@ -213,17 +237,17 @@ (evl o)) (set! *load-pathname* old-load-pathname))))) -(define (defmacro:load <pathname>) - (slib:eval-load <pathname> defmacro:eval)) - (define slib:warn (lambda args - (let ((port (current-error-port))) - (display "Warn: " port) - (for-each (lambda (x) (display x port)) args)))) + (let ((cep (current-error-port))) + (if (provided? 'trace) (print-call-stack cep)) + (display "Warn: " cep) + (for-each (lambda (x) (display x cep)) args)))) ;;; define an error procedure for the library -;(define slib:error error) +(define (slib:error . args) + (if (provided? 'trace) (print-call-stack (current-error-port))) + (apply error args)) ;;; define these as appropriate for your system. (define slib:tab (integer->char 9)) |