Re: JACAL, scm

[Aubrey Jaffer]

 | From: Rob Browning <address@hidden>
 | Date: Sat, 22 Sep 2001 22:16:34 -0500
 | 
 | Aubrey Jaffer <address@hidden> writes:
 | 
 | > Is a Guile release planned for the next month, or should I release an
 | > SLIB with guile.init workarounds for Guile 1.4?
 | 
 | We're hoping to have a release in the next month, but that will of
 | course depend on how well the rest of the beta releases go.  Right
 | now, I'd say we're still on track.
 | 
 | However, judging from the amazingly slow transition rate from 1.3.X to
 | 1.4.X, it might be worthwile to include the 1.4 fix anyway.
 | 
 | Even now there are people still using 1.3.4, to a large extent because
 | up until recently, some of the major distributions still only provided
 | 1.3.X.

I wrote a new SLIB/guile.init (replacing ice-9/slib.scm) which works
with both Guile-1.3.4 and Guile-1.4.  The main hurdle was realizing that
SLIB calls to READ also had to be made case-insensitive.

I made SLIB:LOAD and READ case-insensitive by essentially fluid binding
the global read property.  It is cumbersome with READ-OPTIONS-INTERFACE
and READ-ENABLE/READ-DISABLE.  READ-OPTIONS-INTERFACE seems to return
the same alist no matter what argument it is given; and I could find no
arguments to READ-SET! which resulted in any action other than ERROR.
Are there save and restore options primitives?

Does Guile already have case-insensitive LOAD and READ primitives?

Binding global properties to alter function behavior (essentially
argument passing) is asking for trouble in a multi-threaded environment.
For READ it isn't even necessary; if these properties were attached to
the port, then multi-thread safety would follow.  Parameters like
stack-depth, which are truly global, are best set from the command line.

I could not find how to use-modules from the command line, so I changed
JACAL to create a guile.scm with the contents:

  (use-modules (ice-9 slib))
  (slib:load "/usr/local/lib/jacal/math")
  (math)

invoked with:

  guile -l ${SCHEME_LIBRARY_PATH}guile.init -l ${JACALDIR}guile.scm

Why can Guile load multiple files from the command line, but not execute
more than one expression?  Why can't Guile execute a command-line
expression before entering interactive session?

SCM's command line is capable of nearly anything which /bin/sh's is.  I
script extensively with it and recommend it for Schemes aspiring to
scripting languages.

http://swissnet.ai.mit.edu/ftpdir/users/jaffer/slib.zip and
http://swissnet.ai.mit.edu/ftpdir/users/jaffer/jacal.zip are my new
versions.

                               -=-=-=-=-

;"guile.init" Configuration file for SLIB for GUILE     -*-scheme-*-
;;; Author: Aubrey Jaffer
;;;
;;; This code is in the public domain.

(define-module (ice-9 slib))            ; :no-backtrace
(define slib-module (current-module))
(define (defined? symbol) (module-defined? slib-module symbol))

(define base:define define)
(define define
  (procedure->memoizing-macro
   (lambda (exp env)
     (cons (if (= 1 (length env)) 'define-public 'base:define) (cdr exp)))))

;;; Hack to make syncase macros work in the slib module
(if (nested-ref the-root-module '(app modules ice-9 syncase))
    (set-object-property! (module-local-variable (current-module) 'define)
                          '*sc-expander*
                          '(define)))

;;; (software-type) should be set to the generic operating system type.
;;; UNIX, VMS, MACOS, AMIGA and MS-DOS are supported.
(define (software-type) 'unix)

;;; (scheme-implementation-type) should return the name of the scheme
;;; implementation loading this file.
(define (scheme-implementation-type) 'guile)

;;; (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)
  "http://www.gnu.org/software/guile/guile.html";)

;;; (scheme-implementation-version) should return a string describing
;;; the version the scheme implementation loading this file.
(define scheme-implementation-version version)

(define in-vicinity string-append)

;;; (implementation-vicinity) should be defined to be the pathname of
;;; the directory where any auxillary files to your Scheme
;;; implementation reside.
(define implementation-vicinity
  (let* ((path (or (%search-load-path "slib/require.scm")
                   (error "Could not find slib/require.scm in " %load-path)))
         (vic (substring path 0 (- (string-length path) 16))))
    (lambda () vic)))

;;; (library-vicinity) should be defined to be the pathname of the
;;; directory where files of Scheme library functions reside.
(define library-vicinity
  (let ((library-path
         (or
          ;; Use this getenv if your implementation supports it.
          (and (defined? 'getenv) (getenv "SCHEME_LIBRARY_PATH"))
          ;; Use this path if your scheme does not support GETENV
          ;; or if SCHEME_LIBRARY_PATH is not set.
          (in-vicinity (implementation-vicinity) "slib/"))))
    (lambda () library-path)))

;;; (home-vicinity) should return the vicinity of the user's HOME
;;; directory, the directory which typically contains files which
;;; customize a computer environment for a user.
(define home-vicinity
  (let ((home-path (getenv "HOME")))
    (lambda () home-path)))

;;; *FEATURES* should be set to a list of symbols describing features
;;; of this implementation.  Suggestions for features are:
(define *features*
  (append
      '(
        source                          ;can load scheme source files
                                        ;(slib:load-source "filename")
;       compiled                        ;can load compiled files
                                        ;(slib:load-compiled "filename")

                       ;; 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.
;       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.
        with-file                       ;has WITH-INPUT-FROM-FILE and
                                        ;WITH-OUTPUT-FROM-FILE
;       transcript                      ;TRANSCRIPT-ON and TRANSCRIPT-OFF
;       ieee-floating-point             ;conforms to IEEE Standard 754-1985
                                        ;IEEE Standard for Binary
                                        ;Floating-Point Arithmetic.
        full-continuation               ;can return multiple times

                        ;; 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
;       pretty-print
;       object->string
;       format                          ;Common-lisp output formatting
;       trace                           ;has macros: TRACE and UNTRACE
;       compiler                        ;has (COMPILER)
;       ed                              ;(ED) is editor
        random
        )

        (if (defined? 'getenv)
            '(getenv)
            '())

        (if (defined? 'current-time)
            '(current-time)
            '())

        (if (defined? 'system)
            '(system)
            '())

        (if (defined? 'array?)
            '(array)
            '())

        (if (defined? 'char-ready?)
            '(char-ready?)
            '())

        (if (defined? 'array-for-each)
            '(array-for-each)
            '())

        *features*))

;;; (OUTPUT-PORT-WIDTH <port>)
(define (output-port-width . arg) 79)

;;; (OUTPUT-PORT-HEIGHT <port>)
(define (output-port-height . arg) 24)

;;; Return argument
(define (identity x) x)

;;; SLIB:EVAL is single argument eval using the top-level (user) environment.
(define slib:eval eval)

;;; Define SLIB:EXIT to be the implementation procedure to exit or
;;; return if exitting not supported.
(define slib:exit quit)

(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)))))

(define (guile:wrap-case-insensitive proc)
  (lambda args
    (let* ((options (read-options-interface 'case-insensitive))
           (case-insensitivity (assv 'case-insensitive options)))
      (save-module-excursion
       (lambda ()
         (set-current-module slib-module)
         (dynamic-wind
             (lambda () (read-enable 'case-insensitive))
             (lambda () (apply proc args))
             (lambda () (if (and case-insensitivity
                                 (eqv? 'no (cadr case-insensitivity)))
                            (read-disable 'case-insensitive)))))))))

(define read (guile:wrap-case-insensitive read))

;;; (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
  (let ((load-file (guile:wrap-case-insensitive load)))
    (lambda (<pathname>)
      (load-file (string-append <pathname> (scheme-file-suffix))))))

(define slib:load-source slib:load)

;;; (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 slib:load)

(define defmacro:eval slib:eval)
(define defmacro:load slib:load)

(define (defmacro:expand* x)
  (require 'defmacroexpand) (apply defmacro:expand* x '()))

;;; If your implementation provides R4RS macros:
(define macro:eval slib:eval)
(define macro:load slib:load)

(define slib:warn warn)
(define slib:error error)

;;; define these as appropriate for your system.
(define slib:tab #\tab)
(define slib:form-feed #\page)

;;; {Time}
(define difftime -)
(define offset-time +)

;;; Early version of 'logical is built-in
(define logical:logand                  logand)
(define logical:logior                  logior)
(define logical:logxor                  logxor)
(define logical:lognot                  lognot)
(define logical:logtest                 logtest)
(define logical:logbit?                 logbit?)
(define (logical:copy-bit index to bool)
  (if bool
      (logical:logior to (logical:ash 1 index))
      (logical:logand to (logical:lognot (logical:ash 1 index)))))
(define copy-bit                        logical:copy-bit)
(define logical:ash                     ash)
(define logical:logcount                logcount)
(define logical:integer-length          integer-length)
(define (logical:bit-field n start end)
  (logical:logand (- (logical:integer-expt 2 (- end start)) 1)
                  (logical:ash n (- start))))
(define bit-field                       logical:bit-field)
(define (logical:bitwise-if mask n0 n1)
  (logical:logior (logical:logand mask n0)
                  (logical:logand (logical:lognot mask) n1)))
(define bitwise-if                      logical:bitwise-if)
(define logical:bit-extract             bit-extract)
(define (logical:copy-bit-field to start end from)
  (logical:bitwise-if
   (logical:ash (- (logical:integer-expt 2 (- end start)) 1) start)
   (logical:ash from start)
   to))
(define copy-bit-field                  logical:copy-bit-field)
(define logical:integer-expt            integer-expt)
(define logical:ipow-by-squaring        ipow-by-squaring)

;;; array-for-each
(define (array-indexes ra)
  (let ((ra0 (apply make-array '() (array-shape ra))))
    (array-index-map! ra0 list)
    ra0))
(define (array-copy! source dest)
  (array-map! dest identity source))

;;; {Random numbers}
(define (make-random-state . args)
  (let ((seed (if (null? args) *random-state* (car args))))
    (cond ((string? seed))
          ((number? seed) (set! seed (number->string seed)))
          (else (let ()
                  (require 'object->string)
                  (set! seed (object->limited-string seed 50)))))
    (seed->random-state seed)))

(slib:load (in-vicinity (library-vicinity) "require"))