scsh-0.6/scheme/more-packages.scm

967 lines
26 KiB
Scheme

; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; More and more packages. Some of these get loaded into the initial
; image to create scheme48.image; those that aren't can be loaded later
; using ,load-package.
; Things to load into initial.image to make scheme48.image.
(define-structure usual-features (export ) ;No exports
(open analysis ;auto-integration
disclosers
command-processor
debuginfo
;; Choose any combination of bignums, ratnums, recnums
bignums ratnums recnums
;; Choose either innums, floatnums, or neither
innums ;Silly inexact numbers
;; floatnums ;Still don't print correctly
;; pp
;; The following is listed because this structure is used to
;; generate a dependency list used by the Makefile...
usual-commands))
; Command processor
(define-structures ((command-processor command-processor-interface)
(command (export command-processor)))
(open scheme ;;-level-2 ; eval, interaction-environment
tables fluids
conditions handle
define-record-types
command-levels
reading ; gobble-line, with-sharp-sharp
i/o ; current-error-port
display-conditions ; display-condition
methods
;; environments ; interaction-environment
util ; unspecific
undefined ; $note-undefined
features ; force-output
interrupts ; set-enabled-interrupts!, all-interrupts
vm-exposure ; primitive-catch
fluids-internal ; get-dynamic-env, set-dynamic-env!
nodes ; for ## kludge
signals
structure-refs
root-scheduler) ; scheme-exit-now
(access threads ; thread?
threads-internal ; thread-continuation
continuations ; continuation?
ports)
(files (env version-info)
(env command)
(env read-command)))
(define-structure command-levels command-levels-interface
(open scheme
enumerated enum-case
tables
session-data
define-record-types
threads threads-internal
queues
scheduler
interrupts
weak
debug-messages ; for debugging
signals ; error
i/o ; current-error-port
util ; unspecific
channel-i/o ; steal-channel-port
fluids-internal ; get-dynamic-env, set-dynamic-env!
root-scheduler ; call-when-deadlocked!
conditions) ; define-condition-type
(files (env command-level)))
(define-structure basic-commands basic-commands-interface
(open scheme-level-2
command-processor
command-levels
undefined ; noting-undefined-variables
environments ; with-interaction-environment
evaluation ; eval, load-into
;; packages ; package?
root-scheduler ; scheme-exit-now
)
(files (env basic-command)))
; Usual command set
(define-structure usual-commands usual-commands-interface
(open basic-commands
build-commands
package-commands
debug-commands
inspect-commands
disassemble-commands
;profile-commands
))
; Image builder.
(define-structures ((build (export build-image stand-alone-resumer))
;JMG added structure for scsh
(build-internals (export simple-condition-handler))
(build-commands build-commands-interface))
(open scheme-level-2
command-processor
command-levels
conditions handle
low-level ; flush-the-symbol-tables!
usual-resumer
filenames ; translate
display-conditions ; display-condition
evaluation ; package-for-load, eval
environments ; with-interaction-environment
i/o ; current-error-port
write-images
signals)
(files (env build)))
; Package commands.
(define-structures ((package-commands package-commands-interface)
(package-commands-internal
package-commands-internal-interface))
(open scheme
command-processor
command-levels
methods
undefined ; noting-undefined-variables
packages ; for creating a user package
packages-internal ; set-package-integrate?!, etc.
package-mutation ; package-system-sentinel
environments ; *structure-ref, etc.
compiler-envs ; reflective-tower
ensures-loaded ; ensure-loaded
interfaces
ascii
i/o ; force-output, current-error-port
signals
util ; every
fluids)
(files (env pacman)))
; Debugging aids.
; Disclosers: this makes objects and conditions print nicely.
(define-structure disclosers disclosers-interface
(open scheme-level-1
methods more-types
tables
conditions
display-conditions
locations
code-vectors
closures
packages-internal ; location-info-tables
debug-data
segments ; get-debug-data
enumerated ; enumerand->name
weak ; weak-pointer?
i/o ; disclose-port
templates continuations low-channels
architecture)
(files (env disclosers)))
; For printing procedures with their names, etc.
(define-structure debuginfo debuginfo-interface
(open scheme-level-2
tables
debug-data
segments ; debug-data-table
;; packages
packages-internal ; package-name-table
names ; generated?
features
weak)
(files (env debuginfo)))
; Most of the debugging commands.
(define-structures ((debugging ;additional exports in future
(export breakpoint
continuation-parent))
(debug-commands debug-commands-interface))
(open scheme-level-2
command-processor ; define-command, etc.
command-levels
fluids
signals ; make-condition
util ; filter
evaluation ; eval-from-file, eval
environments ; environment-define! (for ,trace)
conditions ; define-condition-type
filenames ; set-translation!
disclosers ; template-name, debug-data-names
packages ; flush-location-names, package-integrate?
packages-internal ; [set-]package-integrate?[!], flush-location-names
undefined ; noting-undefined-variables
continuations ; continuation-template
architecture ; op/global, etc.
interrupts ; all-interrupts, set-enabled-interrupts!
vm-exposure ; fluid-let suppression kludge - fix later
exceptions ; continuation-preview
tables
nodes ; schemify for ,expand command
reading-forms ; $note-file-package
debug-data segments ; yucko
time ; real-time
primitives ; memory-status
structure-refs)
(access primitives ; want to both use and shadow collect
filenames ; and translate
syntactic) ; and expand
(files (env debug)))
; Inspector
(define-structures ((inspector (export inspect))
(inspector-internal (export prepare-menu))
(inspect-commands inspect-commands-interface))
(open scheme-level-2
command-processor ; define-command, etc.
command-levels
define-record-types
fluids
debugging ; command-loop-continuation
closures ; closure-template
disclosers ; template-debug-data, etc.
debug-data
evaluation ; eval
segments ; get-debug-data
templates
continuations
names ; desyntaxify
records
records-internal
low-level ; vector-unassigned?
locations
signals ; error
;; tables - not yet.
weak
util ; sublist
display-conditions) ; limited-write
(files (env inspect)))
(define-structure list-interfaces (export list-interface)
(open scheme-level-2 interfaces packages meta-types sort bindings)
(files (env list-interface)))
; Package and interface mutation.
(define-structure package-mutation package-mutation-interface
(open scheme-level-2
shadowing ; shadow-location!
packages
interfaces
bindings
packages-internal
defpackage ; set-verify-later!
locations
disclosers ; location-info
handle
tables fluids weak signals)
(files (env pedit)))
; The following hooks the compiler up with an exception handler for
; unbound variables.
(define-structure shadowing (export shadow-location!)
(open scheme-level-1
vm-exposure ;primitive-catch
continuations templates locations code-vectors
exceptions signals
architecture) ;(enum op global)
(files (env shadow))) ;Exception handler to support package system
; Disassembler
(define-structures ((disassembler
(export disassemble write-instruction))
(disassemble-commands disassemble-commands-interface))
(open scheme-level-2
command-processor ; define-command
disclosers ; template-name
enumerated ; enumerand->name
disclosers ; location-name
evaluation ; eval
templates
continuations
locations
code-vectors
closures
architecture
signals)
(files (env disasm)))
; Assembler.
(define-structure assembling (export) ; No exports, this defines a compilator.
(open scheme-level-2
compiler ;define-compilator
segments
architecture
nodes ;node-form node-ref
bindings ;binding? binding-place
meta-types ;value-type
templates ; for Richard's version
signals ;error
enumerated ;name->enumerand
code-vectors)
(files (env assem)))
; Foo
(define-structure assembler (export (lap :syntax))
(open scheme-level-2)
(for-syntax (open scheme-level-2 nodes meta-types assembling))
(begin
(define-syntax lap
(lambda (e r c)
(make-node (get-operator 'lap syntax-type) e)))))
; Execution profiler.
(define-structures ((profile (export run-with-profiling))
(profile-commands profile-commands-interface))
(open scheme
command-processor
continuations
architecture
interrupts
tables
primitives ; schedule-interrupt
wind
disclosers
time
sort
escapes) ; primitive-cwcc
(files (env profile)))
; Large integers and rational and complex numbers.
(define-structure extended-numbers extended-numbers-interface
(open scheme-level-2
methods meta-methods
define-record-types
exceptions ; make-opcode-generic!
primitives
architecture
signals
util
number-i/o)
(files (rts xnum)))
(define-structure bignums bignums-interface
(open scheme-level-2
extended-numbers
methods signals)
(files (rts bignum))
(optimize auto-integrate))
(define-structure innums (export ) ;inexact numbers
(open scheme-level-2
extended-numbers
methods signals
number-i/o) ;string->integer
(files (rts innum)))
(define-structure ratnums (export ) ;No exports
(open scheme-level-2
extended-numbers
methods signals
number-i/o) ;string->integer
(files (rts ratnum)))
(define-structure recnums (export ) ;No exports
(open scheme-level-2
extended-numbers
methods signals
number-i/o) ;really-number->string
(files (rts recnum)))
(define-structure floatnums
(export floatnum? exp log sin cos tan asin acos atan sqrt)
(open scheme-level-2
extended-numbers
code-vectors
methods signals
enumerated
loopholes
more-types ;:double
primitives) ;vm-extension double?
(files (rts floatnum))
(optimize auto-integrate))
(define-structure time time-interface
(open scheme-level-1 primitives architecture enumerated)
(files (rts time)))
(define-structure placeholders placeholder-interface
(open scheme-level-1 define-record-types
threads threads-internal queues
interrupts
signals)
(files (big placeholder))
(optimize auto-integrate))
;----------------
; Big Scheme
(define-structure random (export make-random)
(open scheme-level-2 bitwise
signals) ;call-error
(files (big random)))
(define-structure sort (export sort-list sort-list!)
(open scheme-level-2)
(files (big sort)))
(define-structure pp (export p pretty-print define-indentation)
(open scheme-level-2
tables
methods) ;disclose
(files (big pp)))
; Bitwise logical operators on bignums.
(define-structure bigbit (export ) ;No exports
(open scheme-level-2
bignums
methods
extended-numbers
;; exceptions
;; architecture
bitwise
signals)
(files (big bigbit)))
(define-structure formats (export format)
(open scheme-level-2 ascii signals
extended-ports)
(files (big format)))
(define-structure extended-ports extended-ports-interface
(open scheme-level-2 records define-record-types ports i/o i/o-internal
code-vectors ascii
structure-refs
signals)
(access primitives) ; copy-bytes!
(files (big more-port)))
(define-structure destructuring (export (destructure :syntax))
(open scheme-level-2)
(files (big destructure)))
(define-structure arrays arrays-interface
(open scheme-level-2 define-record-types signals)
(files (big array)))
(define-structure receiving (export (receive :syntax))
(open scheme-level-2)
(files (big receive)))
(define-structure defrecord defrecord-interface
(open scheme-level-1 records loopholes
primitives) ; unspecific
(files (big defrecord)))
(define-structures ((enum-sets enum-sets-interface)
(enum-sets-internal enum-sets-internal-interface))
(open scheme define-record-types
finite-types
bitwise
util
signals
external-calls)
(optimize auto-integrate)
(files (big enum-set)))
(define general-tables tables) ; backward compatibility
(define-structure thread-fluids thread-fluids-interface
(open scheme define-record-types weak
threads thread-cells fluids)
(files (big thread-fluid)))
(define-structure big-util big-util-interface
(open scheme-level-2
formats
features ; immutable? make-immutable!
structure-refs) ; structure-ref
(access signals ; error
debugging ; breakpoint
primitives) ; copy-bytes!
(files (big big-util)))
(define-structure big-scheme big-scheme-interface
(open scheme-level-2
formats
sort
extended-ports
pp
enumerated
bitwise
ascii
bigbit
big-util
tables
;defrecord
destructuring
receiving))
; Things needed for connecting with external code.
(define-structure external-calls (export call-imported-binding
lookup-imported-binding
define-exported-binding
shared-binding-ref
((import-definition
import-lambda-definition)
:syntax)
add-finalizer!
define-record-resumer
call-external-value)
(open scheme-level-2 define-record-types
primitives
architecture
exceptions interrupts signals
placeholders
shared-bindings
byte-vectors
bitwise bigbit ;for {enter|extract}_integer() helpers
records)
(files (big import-def)
(big callback)))
(define-structure dynamic-externals dynamic-externals-interface
(open scheme-level-2 define-record-types tables
signals ;warn
primitives ;find-all-records
i/o ;current-error-port
code-vectors
external-calls)
(files (big external)))
; Externals - this is obsolete; use external-calls and dynamic-externals
; instead.
(define-structure externals (compound-interface
dynamic-externals-interface
(export external-call
null-terminate))
(open scheme-level-2 structure-refs
dynamic-externals)
(access external-calls)
(begin
; We fake the old external-call primitive using the new one and a
; a C helper procedure from c/unix/dynamo.c.
(define (external-call proc . args)
(let ((args (apply vector args)))
(old-external-call (external-value proc) args)))
((structure-ref external-calls import-lambda-definition)
old-external-call (proc args)
"s48_old_external_call")
; All strings are now null terminated.
(define (null-terminate string) string)))
; Rudimentary object dump and restore
(define-structure dump/restore dump/restore-interface
(open scheme-level-1
number-i/o
tables
records
signals ;error
locations ;make-undefined-location
closures
code-vectors ;code vectors
fluids
ascii
bitwise
methods ;disclose
templates) ;template-info
(files (big dump)))
; Unix Sockets
(define-structure sockets
(export open-socket
close-socket
socket-accept
socket-port-number
socket-client
get-host-name
; From the old interface; I would like to get rid of these.
socket-listen
socket-listen-channels
socket-client-channels
)
(open scheme define-record-types
external-calls
low-channels ; channel? close-channel
signals ; error
interrupts ; enable-interrupts! disable-interrupts!
channel-i/o) ; wait-for-channel {in|out}put-channel->port
(files (big socket)))
; Heap traverser
(define-structure traverse
(export traverse-depth-first traverse-breadth-first trail
set-leaf-predicate! usual-leaf-predicate)
(open scheme-level-2
primitives ; ?
queues tables
bitwise locations closures code-vectors
disclosers ; foo
features ; string-hash
low-level) ; flush-the-symbol-table!, vector-unassigned?
(files (env traverse)))
; Space analyzer
(define-structure spatial (export space vector-space record-space)
(open scheme
architecture primitives assembler packages enumerated
features sort locations display-conditions)
(files (env space)))
; Structure & Interpretation compatibility
(define-structure sicp sicp-interface
(open scheme-level-2 signals tables)
(files (misc sicp)))
; red-black balanced binary search trees
(define-structure search-trees search-trees-interface
(open scheme-level-2 define-record-types)
(optimize auto-integrate)
(files (big search-tree)))
(define-structure finite-types (export ((define-finite-type
define-enumerated-type) :syntax))
(open scheme-level-2 code-quote define-record-types
enumerated
features) ; make-immutable
(files (big finite-type)))
; nondeterminism via call/cc
(define-structure nondeterminism (export with-nondeterminism
((either one-value all-values) :syntax)
fail)
(open scheme-level-2
fluids cells
(subset signals (error)))
(files (big either)))
;----------------
; SRFI packages
; SRFI-0 - Doesn't work with the module system.
; Olin's list library.
(define-structure srfi-1 srfi-1-interface
(open scheme-level-2
receiving
(subset signals (error)))
(files (srfi srfi-1)))
(define-structure srfi-2 (export (and-let* :syntax))
(open scheme-level-2
signals) ; error
(files (srfi srfi-2)))
; SRFI-3 - withdrawn
; SRFI-4 - needs hacks to the reader
(define-structure srfi-5 (export (let :syntax))
(open (modify scheme-level-2 (hide let)))
(files (srfi srfi-5)))
(define-structure srfi-6 (export open-input-string
open-output-string
get-output-string)
(open (modify extended-ports
(rename (make-string-input-port open-input-string)
(make-string-output-port open-output-string)
(string-output-port-output get-output-string)))))
; Configuration language
(define-structure srfi-7 (export) ; defines a command
(open scheme
; for parsing programs
receiving
nondeterminism
(subset signals (error))
(subset package-commands-internal (config-package))
ensures-loaded
(subset packages (note-structure-name!))
; for defining the command
(subset command-processor (define-user-command-syntax
user-command-environment))
(subset environments (environment-define!)))
(begin
(define available-srfis
'(srfi-1 srfi-2 srfi-5 srfi-6 srfi-7 srfi-8 srfi-9
srfi-11 srfi-13 srfi-14 srfi-16 srfi-17 srfi-19 srfi-23
srfi-25 srfi-26 srfi-27 srfi-28 srfi-30 srfi-31
srfi-37))
; Some SRFI's redefine Scheme variables.
(define shadowed
'((srfi-1 map for-each member assoc)
(srfi-5 let)
(srfi-13 string->list string-copy string-fill!)
(srfi-17 set!)))
)
(files (srfi srfi-7)))
; Taken directly from the SRFI document (or from `receiving', take your pick).
(define-structure srfi-8 (export (receive :syntax))
(open scheme-level-2)
(begin
(define-syntax receive
(syntax-rules ()
((receive formals expression body ...)
(call-with-values (lambda () expression)
(lambda formals body ...)))))))
; SRFI-9 is a slight modification of DEFINE-RECORD-TYPE.
(define-structure srfi-9 (export (define-record-type :syntax))
(open scheme-level-2
(with-prefix define-record-types sys:))
(begin
(define-syntax define-record-type
(syntax-rules ()
((define-record-type type-name . stuff)
(sys:define-record-type type-name type-name . stuff))))))
; SRFI-10 - no stand-alone interface.
(define-structure srfi-11 (export (let-values :syntax)
(let*-values :syntax))
(open scheme-level-2)
(files (srfi srfi-11)))
; SRFI-12 - withdrawn
; Two more encyclopedias from Olin.
(define-structure srfi-13 srfi-13-interface
(open scheme-level-2
bitwise
srfi-8 srfi-14
(subset signals (error)))
(files (srfi srfi-13)))
(define-structure srfi-14 srfi-14-interface
(open scheme-level-2
bitwise
srfi-9
(modify ascii (rename (char->ascii %char->latin1)
(ascii->char %latin1->char)))
(subset features (make-immutable!))
(subset signals (error)))
(files (srfi srfi-14)))
; SRFI-15 - withdrawn
(define-structure srfi-16 (export (case-lambda :syntax))
(open scheme-level-2
(subset signals (error)))
(files (srfi srfi-16)))
(define-structure srfi-17 (export (set! :syntax) setter)
(open (modify scheme-level-2 (rename (set! scheme-set!)))
(subset signals (error))
(subset util (unspecific)))
(files (srfi srfi-17)))
; SRFI-18 - no implementation given
(define (make-srfi-19 scheme-with-scsh)
(structure srfi-19-interface
(open scheme-with-scsh
(subset srfi-1 (reverse!))
srfi-6
srfi-8
signals
srfi-9)
(files (srfi srfi-19))))
; SRFI-20 - withdrawn
; SRFI-21 - no implementation given
; SRFI-22 - no implementation given
(define-structure srfi-23 (export error)
(open (subset signals (error))))
; SRFI-24 - withdrawn
(define-structure srfi-25 (export
array? make-array shape array
array-rank
array-start array-end
array-ref array-set! share-array)
(open scheme
srfi-23
srfi-9)
(files (srfi srfi-25)))
(define-structure srfi-26 (export ((cut cute) :syntax))
(open scheme)
(files (srfi srfi-26)))
(define-structure srfi-27 srfi-27-interface
(open
scheme-level-1
floatnums
external-calls
(subset srfi-9 (define-record-type))
(subset srfi-23 (error)))
;; scsh doesn't have S48's posix subsystem yet:
; (subset posix-time (current-time))
; (subset posix (time-seconds)))
(files (srfi srfi-27)))
(define-structure srfi-28 (export format)
(open scheme
srfi-23
srfi-6)
(files (srfi srfi-28)))
; SRFI-29 - requires access to the current locale
; SRFI-30 - scheme/rts/read.scm contains the reader for #|...|# comments
(define-structure srfi-31 srfi-31-interface
(open scheme)
(files (srfi srfi-31)))
(define-structure srfi-37 srfi-37-interface
(open scheme
srfi-9
srfi-11)
(files (srfi srfi-37)))
; ... end of package definitions.
; Temporary compatibility stuff
(define-syntax define-signature
(syntax-rules () ((define-signature . ?rest) (define-interface . ?rest))))
(define-syntax define-package
(syntax-rules () ((define-package . ?rest) (define-structures . ?rest))))
(define table tables)
(define record records)
; Must list all the packages defined in this file that are to be
; visible in the command processor's config package.
(define-interface more-structures-interface
(export ((more-structures
usual-features
arrays
assembler
assembling
general-tables
bigbit
bignums ratnums recnums floatnums
build
callback
cells
command-levels
command-processor
debugging
define-record-types
defrecord
destructuring
disassembler
disclosers
dump/restore
dynamic-externals
enum-case
enum-sets
extended-numbers
extended-ports
externals
external-calls
finite-types
formats
innums
inspector
inspector-internal
;linked-queues
list-interfaces
;more-threads
package-commands-internal
package-mutation
placeholders
pp
;profile
queues
time
random
receiving
search-trees
sicp
sockets
sort
strong
thread-fluids
traverse
spatial
big-scheme
big-util
;; From link-packages.scm:
analysis
debuginfo
expander
flatloading
linker
link-config
reification ;?
shadowing
;; Compatibility
record table
build-internals ;added by JMG
; SRFI packages
srfi-1 srfi-2 srfi-5 srfi-6 srfi-7 srfi-8 srfi-9
srfi-11 srfi-13 srfi-14 srfi-16 srfi-17
srfi-23 srfi-25 srfi-26 srfi-27 srfi-28
srfi-31 srfi-37
)
:structure)
make-srfi-19
((define-signature define-package) :syntax)))