mike@ists.ists.ca (Mike Clarkson) (04/06/89)
I am embarrassed. The shar that I used to package the previous postings of macros for TI functionality junked the last line if it didn't end with a line-feed. So some of the files were truncated. Enclosed are patches to fix the problem, plus a new feature (PP), and some hooks for future development of the FLUIDS package. My apologies to those who were frustrated by my error. Snip here and feed to patch. Mike. ------------------------------------------------------------------------------- diff -c dist1.0/README dist1.1/README *** dist1.0/README Thu Apr 6 03:03:42 1989 --- dist1.1/README Thu Apr 6 02:52:22 1989 *************** *** 2,9 **** TI PC COMPATIBILITY PACKAGE ! Version 1.0 ! March 1989 For MIT C-Scheme 6.2.2 --- 2,9 ---- TI PC COMPATIBILITY PACKAGE ! Version 1.1 ! April 1989 For MIT C-Scheme 6.2.2 *************** *** 82,90 **** ASSERT GET-FILE-POSITION (Needs support in C for opening files with append) (SET! (VECTOR-REF vector n) value) (not implemented yet) - (SET! (FLUID var) value) (not implemented yet) SYNTAX (Conflicts with the MIT syntax) The windows code will have to wait until the next release of C-Scheme, which should have some windowing code to support Edwin: --- 82,98 ---- ASSERT GET-FILE-POSITION (Needs support in C for opening files with append) (SET! (VECTOR-REF vector n) value) (not implemented yet) SYNTAX (Conflicts with the MIT syntax) + The fluids code is being worked on (with many thanks to jinx); + at the moment there are just "Not implemented yet" macros in place. + + FLUID + FLUID-BOUND + FLUID-LAMBDA + TI-FLUID-LET + (SET! (FLUID var) value) + The windows code will have to wait until the next release of C-Scheme, which should have some windowing code to support Edwin: *************** *** 107,114 **** WINDOW-SET-SIZE! WINDOW? ! Engines have not been implemented, though I may look at making kwh's ! tasks act like engines: MAKE-ENGINE ENGINE-RETURN --- 115,122 ---- WINDOW-SET-SIZE! WINDOW? ! Engines have not been implemented. Jinx has supplied me with a set of ! engines that I am testing out, at least for Bsd systems. MAKE-ENGINE ENGINE-RETURN *************** *** 130,136 **** POSITION-PEN The line editor hasn't been ported, but in these days od Gnu, does anyone ! reall care? EDIT --- 138,144 ---- POSITION-PEN The line editor hasn't been ported, but in these days od Gnu, does anyone ! really care? EDIT diff -c dist1.0/compile-the-files.scm dist1.1/compile-the-files.scm *** dist1.0/compile-the-files.scm Thu Apr 6 03:03:43 1989 --- dist1.1/compile-the-files.scm Wed Apr 5 10:12:49 1989 *************** *** 16,18 **** --- 16,19 ---- (sf "window.scm") ;; The main file that loads or auto-loads the rest + (sf "ti.scm") diff -c dist1.0/parser-escape.scm dist1.1/parser-escape.scm *** dist1.0/parser-escape.scm Thu Apr 6 03:03:46 1989 --- dist1.1/parser-escape.scm Wed Apr 5 10:18:50 1989 *************** *** 24,26 **** --- 24,27 ---- (intern-string-no-coerce! (loop (read-string delimiters)))))) ;; end in-package parser-package + ) diff -c dist1.0/scoops.scm dist1.1/scoops.scm *** dist1.0/scoops.scm Thu Apr 6 03:03:39 1989 --- dist1.1/scoops.scm Wed Apr 5 10:19:00 1989 *************** *** 1161,1163 **** --- 1161,1165 ---- ((access ,(%sc-concat "SET-" var) (%sc-method-env ,class)) ,val))))) ;; end scoops-package environment + )) + diff -c dist1.0/sort.scm dist1.1/sort.scm *** dist1.0/sort.scm Thu Apr 6 03:03:32 1989 --- dist1.1/sort.scm Wed Apr 5 10:19:08 1989 *************** *** 107,109 **** --- 107,111 ---- (vector-copy v) 0 (-1+ (vector-length v))) + v) + diff -c dist1.0/ti.scm dist1.1/ti.scm *** dist1.0/ti.scm Thu Apr 6 03:03:34 1989 --- dist1.1/ti.scm Thu Apr 6 02:52:35 1989 *************** *** 165,174 **** ((string? pathname) (string->pathname pathname)) (else (error "DOS-CHDIR: Not a pathname, symbol or string"))))) - - - ;;; DOS-COPY-FILE (define dos-file-copy copy-file) --- 165,171 ---- *************** *** 221,226 **** --- 218,240 ---- ;;; EXPLODE (autoload-from-file "$SCHEME/xplode" '(explode)) + ;;; FLUID + (add-syntax! 'fluid (macro (var) + `(writeln "Not implemented yet"))) + + ;;; FLUID-BOUND? + (add-syntax! 'fluid-bound? (macro (var) + `(writeln "Not implemented yet"))) + + ;;; FLUID-LAMBDA + (add-syntax! 'fluid-lambda (macro (bindings . code) + `(writeln "Not implemented yet"))) + + ;;; FLUID-LET + ;; Renamed to TI-FLUID-LET as it Conflicts with MIT's fluid-let + (add-syntax! 'ti-fluid-let (macro (bindings . code) + `(writeln "Not implemented yet"))) + ;;; FLUSH-INPUT (define (flush-input #!optional port) (let ((newline-delimiters (char-set #\Newline))) *************** *** 370,378 **** --- 384,435 ---- ;; Not implemented yet - needs C support (autoload-from-file "$TISCHEME/file-extend" '(open-extend-file)) + ;;; PCS-DEBUG-MODE + ;; Just a stub - always true + (define pcs-debug-mode #T) + ;;; PI (define pi (* 4.0 (atan 1.0 1.0))) + ;;; PP + (define pp + (let () + (define (prepare scode) + (let ((s-expression (unsyntax scode))) + (if (and (pair? s-expression) + (eq? (car s-expression) 'NAMED-LAMBDA)) + `(DEFINE ,@(cdr s-expression)) + s-expression))) + + (lambda (scode #!optional port width) + + (define (kernel as-code?) + (if (scode-constant? scode) + ((access ti-pp scheme-pretty-printer) scode as-code? width) + ((access ti-pp scheme-pretty-printer) (prepare scode) true width))) + + (cond ((unassigned? port) + (set! port *current-output-port*)) + ((not (port? port)) (error 'PP "Bad port" port))) + (cond ((unassigned? width) + (set! width + (let ((x-size ((access :x-size port)))) + (if x-size (min 72 x-size) 72)))) + ((not (integer? width)) (error 'PP "Bad width" width))) + (with-output-to-port port + (lambda () (kernel false))) + *the-non-printing-object*))) + + (in-package scheme-pretty-printer + (define (ti-pp expression as-code? width) + (fluid-let ((x-size width)) + (let ((node (numerical-walk expression))) + (*unparse-newline) + ((if as-code? print-node print-non-code-node) node 0 0) + ((access :write-char *current-output-port*) char:newline) + ((access :flush-output *current-output-port*))))) + ) + ;;; POINT-COLOR (autoload-from-file "$TISCHEME/graphics" '(point-color)) *************** *** 434,440 **** eof-object))) ;;; REC ! ;; You may want to change REC of lambdas to named lambdas (syntax-table-define system-global-syntax-table 'REC (macro (var exp) `(letrec ((,var ,exp)) ,var))) --- 491,497 ---- eof-object))) ;;; REC ! ;; You may want to change REC of lambdas to NAMED-LAMBDAs (syntax-table-define system-global-syntax-table 'REC (macro (var exp) `(letrec ((,var ,exp)) ,var))) *************** *** 527,532 **** (newline) (define (ti-compatibility-package-version) ! "1.0") (writeln "TI Functions loaded.") --- 584,590 ---- (newline) (define (ti-compatibility-package-version) ! "1.1") (writeln "TI Functions loaded.") + -- Mike Clarkson mike@ists.UUCP Institute for Space and Terrestrial Science mike@ists.ists.ca York University, North York, Ontario, uunet!mnetor!yunexus!ists!mike CANADA M3J 1P3 +1 (416) 736-5611