1; Part of Scheme 48 1.9. See file COPYING for notices and license. 2 3; Authors: Richard Kelsey, Jonathan Rees, Mike Sperber, Michael Zabka, 4; Robert Ransom, Marcel Turino, Manuel Dietrich, Marcus Crestani, 5; Harald Glab-Phlak 6 7 8; More and more packages. Some of these get loaded into the initial 9; image to create scheme48.image; those that aren't can be loaded later 10; using ,load-package. 11 12; Things to load into initial.image to make scheme48.image. 13 14(define-structure usual-features (export ) ;No exports 15 (open analysis ;auto-integration 16 command-processor 17 debuginfo 18 disclosers 19 floatnums 20 more-vm-exceptions 21 ;; pp 22 ;; Choose either innums, floatnums, or neither 23 ;; innums ;Silly inexact numbers 24 ;; bignums ; now in the VM 25 ;; Choose any combination of bignums, ratnums, recnums 26 ratnums recnums 27 ;; The following is listed because this structure is used to 28 ;; generate a dependency list used by the Makefile... 29 usual-commands 30 unicode-char-maps 31 )) 32 33; Large integers and rational and complex numbers. 34 35(define-structure extended-numbers extended-numbers-interface 36 (open scheme-level-2 37 methods meta-methods 38 define-record-types 39 primitives 40 architecture 41 exceptions 42 (subset vm-exceptions (extend-opcode!)) 43 util 44 number-i/o) 45 (files (rts xnum))) 46 47(define-structure innums (export ) ;inexact numbers 48 (open scheme-level-2 49 extended-numbers 50 methods exceptions 51 number-i/o) ;string->integer 52 (files (rts innum))) 53 54(define-structure ratnums (export ) ;No exports 55 (open scheme-level-2 56 extended-numbers 57 methods exceptions 58 number-i/o) ;string->integer 59 (files (rts ratnum))) 60 61(define-structure recnums (export ) ;No exports 62 (open scheme-level-2 63 extended-numbers 64 methods exceptions 65 number-i/o) ;really-number->string 66 (files (rts recnum))) 67 68(define-structure floatnums 69 (export floatnum? exp log sin cos tan asin acos atan sqrt) 70 (open scheme-level-2 71 extended-numbers 72 code-vectors 73 methods exceptions 74 enumerated 75 loopholes 76 more-types ;<double> 77 primitives) ;vm-extension double? 78 (files (rts floatnum)) 79 (optimize auto-integrate)) 80 81(define-structure unicode-char-maps unicode-char-maps-interface 82 (open (modify scheme (hide string-ci=? string-ci<?)) 83 set-text-procedures 84 unicode 85 finite-types 86 define-record-types 87 tables 88 bitwise) 89 (files (env unicode-category) 90 (env unicode-info) 91 (env unicode-charmap))) 92 93(define-structure time time-interface 94 (open scheme-level-1 primitives architecture enumerated) 95 (begin 96 (define (real-time) 97 (time (enum time-option real-time) #f)) 98 99 (define (run-time) 100 (time (enum time-option run-time) #f)))) 101 102(define-structure placeholders placeholder-interface 103 (open scheme-level-1 proposals queues 104 (subset util (unspecific)) 105 threads threads-internal 106 interrupts 107 exceptions) 108 (files (big placeholder)) 109 (optimize auto-integrate)) 110 111(define-structure locks locks-interface 112 (open scheme-level-2 queues 113 threads threads-internal 114 interrupts 115 proposals) 116 (optimize auto-integrate) 117 (files (big lock))) 118 119;-------- 120; Unicode 121 122(define-structure text-codec-utils text-codec-utils-interface 123 (open scheme-level-2 124 ports 125 i/o 126 text-codecs) 127 (files (big text-codec-util))) 128 129(define-structure unicode-normalizations unicode-normalizations-interface 130 (open scheme 131 unicode 132 bitwise) 133 (files (big unicode-normalization-info) 134 (big unicode-normalization))) 135 136; -------------------- 137; Transport Link Cell Tables 138 139(define-structure tconc-queues tconc-queues-interface 140 (open scheme-level-1 exceptions) 141 (files (big tconc-queue)) 142 (optimize auto-integrate)) 143 144(define-structure tlc-tables tlc-tables-interface 145 (open scheme-level-1 146 exceptions 147 features ; string-hash, make-immutable! 148 define-record-types 149 tconc-queues 150 unicode-char-maps 151 tables 152 variable-argument-lists 153 (subset primitives (make-transport-link-cell 154 transport-link-cell? 155 transport-link-cell-key 156 transport-link-cell-value 157 set-transport-link-cell-value! 158 transport-link-cell-next 159 set-transport-link-cell-next! 160 transport-link-cell-tconc 161 set-transport-link-cell-tconc! 162 memory-status)) 163 (subset architecture (memory-status-option)) 164 enumerated) 165 (files (big tlc-table)) 166 (optimize auto-integrate)) 167 168; -------------------- 169; Standards 170 171(define-structure r5rs r5rs-interface 172 (open scheme)) 173 174;---------------- 175; Big Scheme 176 177(define-structure random (export make-random) 178 (open scheme-level-2 bitwise 179 exceptions) 180 (files (big random))) 181 182(define-structure sort (export sort-list sort-list!) 183 (open scheme-level-2 184 vector-heap-sort list-merge-sort) 185 (begin 186 (define (sort-list l obj-<) 187 (let ((v (list->vector l))) 188 (vector-heap-sort! obj-< v) 189 (vector->list v))) 190 (define (sort-list! l obj-<) 191 (list-merge-sort! obj-< l)))) 192 193(define-structure pp (export p pretty-print define-indentation) 194 (open scheme-level-2 195 tables 196 (subset methods (disclose))) 197 (files (big pp))) 198 199(define-structure formats (export format) 200 (open scheme-level-2 ascii exceptions 201 extended-ports) 202 (files (big format))) 203 204(define-structure extended-ports extended-ports-interface 205 (open scheme-level-2 define-record-types ascii byte-vectors 206 ports 207 i/o i/o-internal 208 proposals 209 util ; unspecific 210 exceptions 211 (subset primitives (copy-bytes! write-byte char->utf utf->char)) 212 (subset architecture (text-encoding-option)) 213 enumerated 214 encodings 215 (subset text-codecs 216 (set-port-text-codec! utf-8-codec define-text-codec))) 217 (files (big more-port))) 218 219(define-structure destructuring (export (destructure :syntax)) 220 (open scheme-level-2) 221 (files (big destructure))) 222 223(define-structure mvlet (export ((mvlet mvlet*) :syntax)) 224 (open scheme-level-2) 225 (files (big mvlet))) 226 227(define-structure reduce (export ((reduce iterate) 228 :syntax) 229 ((list* list% 230 list-spine* list-spine% 231 list-spine-cycle-safe* 232 list-spine-cycle-safe% 233 vector* vector% 234 string* string% 235 count* count% 236 bits* bits% 237 input* input% 238 stream* stream%) 239 :syntax)) 240 (open scheme-level-2 241 bitwise 242 exceptions) 243 (files (big iterate))) 244 245(define-structure arrays arrays-interface 246 (open scheme-level-2 define-record-types exceptions) 247 (files (big array))) 248 249(define-structure lu-decompositions lu-decompositions-interface 250 (open scheme receiving arrays floatnums exceptions) 251 (files (big lu-decomp))) 252 253(define-structure compact-tables compact-tables-interface 254 (open scheme) 255 (files (big compact-table))) 256 257(define-structure inversion-lists inversion-lists-interface 258 (open scheme 259 bitwise 260 define-record-types 261 exceptions) 262 (files (big inversion-list))) 263 264(define-structure constant-tables constant-tables-interface 265 (open scheme 266 bitwise 267 define-record-types) 268 (files (big constant-table))) 269 270(define-structure receiving (export (receive :syntax)) 271 (open scheme-level-2 272 util)) 273 274(define-structure defrecord defrecord-interface 275 (open scheme-level-1 records record-types loopholes 276 primitives) ; unspecific, low-level record ops 277 (files (big defrecord))) 278 279(define-structures ((masks masks-interface) 280 (mask-types mask-types-interface)) 281 (open scheme-level-1 define-record-types 282 bitwise 283 util ; every 284 number-i/o ; number->string 285 exceptions) ; assertion-violation 286 (files (big mask))) 287 288(define-structures ((enum-sets enum-sets-interface) 289 (enum-sets-internal enum-sets-internal-interface)) 290 (open scheme define-record-types 291 finite-types 292 bitwise 293 util 294 exceptions 295 external-calls) 296 (optimize auto-integrate) 297 (files (big enum-set))) 298 299(define general-tables tables) ; backward compatibility 300 301(define-structure big-util big-util-interface 302 (open scheme-level-2 303 formats 304 features ; immutable? make-immutable! 305 (modify exceptions 306 (rename (error rts-error)) 307 (expose error assertion-violation)) 308 (modify debugging (rename (breakpoint rts-breakpoint)) 309 (expose breakpoint)) 310 (subset primitives (copy-bytes!)) 311 (subset util (filter))) 312 (files (big big-util))) 313 314(define-structure big-scheme big-scheme-interface 315 (open scheme-level-2 316 formats 317 sort 318 extended-ports 319 pp 320 enumerated 321 bitwise 322 ascii 323 big-util 324 tables 325 destructuring 326 receiving)) 327 328; Things needed for connecting with external code. 329 330(define-structure external-calls (export call-imported-binding 331 call-imported-binding-2 332 lookup-imported-binding 333 define-exported-binding 334 shared-binding-ref 335 ((import-definition 336 import-lambda-definition 337 import-lambda-definition-2) 338 :syntax) 339 add-finalizer! 340 define-record-resumer 341 call-external-value 342 call-external-value-2) 343 (open scheme-level-2 define-record-types 344 primitives 345 os-strings 346 architecture ; includes ENUM 347 enum-case 348 vm-exceptions interrupts exceptions conditions 349 placeholders 350 shared-bindings 351 byte-vectors 352 ;bitwise ;for {enter|extract}_integer() helpers 353 (subset record-types (define-record-resumer)) 354 (subset records-internal (:record-type))) 355 (files (big import-def) 356 (big callback))) 357 358(define-structure shared-objects shared-objects-interface 359 (open scheme-level-2 360 define-record-types 361 exceptions 362 external-calls 363 os-strings text-codecs) 364 (files (big shared-object))) 365 366(define-structure load-dynamic-externals load-dynamic-externals-interface 367 (open scheme-level-2 368 define-record-types 369 shared-objects 370 (subset usual-resumer (add-initialization-thunk!)) 371 (subset big-util (delq delete any)) 372 filenames 373 (subset exceptions (assertion-violation))) 374 (files (big dynamic-external))) 375 376(define-structure c-system-function (export have-system? system) 377 (open scheme-level-2 byte-vectors os-strings external-calls exceptions) 378 (begin 379 (import-lambda-definition-2 s48-system (string) "s48_system_2") 380 381 (define (have-system?) 382 (not (= 0 (s48-system #f)))) 383 384 ;; Kludge 385 (define (system cmd-line) 386 (s48-system (x->os-byte-vector cmd-line))))) 387 388; Rudimentary object dump and restore 389 390(define-structure dump/restore dump/restore-interface 391 (open scheme-level-1 392 number-i/o 393 tables 394 records record-types 395 exceptions ;error 396 locations ;make-undefined-location 397 closures 398 code-vectors ;code vectors 399 fluids 400 ascii 401 bitwise 402 (subset methods (disclose)) 403 templates) ;template-info 404 (files (big dump))) 405 406; Pipes containing values. 407 408(define-structure value-pipes value-pipes-interface 409 (open scheme queues 410 proposals 411 threads-internal 412 exceptions) ;assertion-violation 413 (optimize auto-integrate) 414 (files (big value-pipe))) 415 416; Heap traverser 417 418(define-structure traverse 419 (export traverse-depth-first traverse-breadth-first trail 420 set-leaf-predicate! usual-leaf-predicate) 421 (open scheme-level-2 422 primitives 423 queues tables 424 bitwise locations closures code-vectors 425 features ; string-hash 426 low-level ; vector-unassigned? 427 more-types loopholes) 428 (files (env traverse))) 429 430; Reinitializing upon image resumption 431 432(define-structure reinitializers reinitializers-interface 433 (open scheme-level-2 434 define-record-types 435 (subset record-types (define-record-resumer))) 436 (files (big reinitializer))) 437 438; Profiler. 439 440(define-structure profiler profiler-interface 441 (open scheme 442 architecture 443 cells 444 closures 445 continuations 446 debug-data 447 debugging 448 define-record-types 449 disclosers 450 environments 451 escapes 452 interrupts 453 locks 454 exceptions 455 (modify primitives (prefix primitives:) 456 (expose collect time memory-status 457 continuation-length continuation-ref 458 unspecific)) 459 session-data 460 sort 461 tables 462 templates 463 command-processor 464 ) 465 (files (env profile))) 466 467(define-structure profile-commands (export) 468 (open scheme 469 command-processor 470 profiler 471 profiler-instrumentation ; make sure it gets loaded 472 (subset environments (environment-define!))) 473 (files (env profile-command))) 474 475(define-structure profiler-instrumentation (export instrument-form) 476 (open scheme 477 bindings 478 compiler-envs 479 environments 480 features 481 exceptions 482 nodes 483 optimizer 484 package-commands-internal 485 packages 486 packages-internal 487 primops 488 profiler 489 util) 490 (files (env profile-instr))) 491 492; Space analyzer 493 494(define-structure spatial (export space vector-space record-space) 495 (open scheme 496 architecture primitives assembler packages enumerated 497 features sort locations display-conditions) 498 (files (env space))) 499 500; Listing what is in an interface. Here because it needs sort. 501 502(define-structure list-interfaces (export list-interface) 503 (open scheme-level-2 interfaces packages meta-types sort bindings) 504 (files (env list-interface))) 505 506; red-black balanced binary search trees 507 508(define-structure search-trees search-trees-interface 509 (open scheme-level-2 define-record-types) 510 (optimize auto-integrate) 511 (files (big search-tree))) 512 513; vectors that grow as large as they need to 514 515(define-structure sparse-vectors sparse-vectors-interface 516 (open scheme 517 bitwise 518 define-record-types) 519 (files (big hilbert))) 520 521; utilities for dealing with variable argument lists 522 523(define-structure variable-argument-lists variable-argument-lists-interface 524 (open scheme-level-2) 525 (files (big vararg))) 526 527; record types with a fixed number of instances 528 529(define-structure finite-types (export ((define-finite-type 530 define-enumerated-type) :syntax)) 531 (open scheme-level-2 code-quotation define-record-types 532 enumerated 533 features) ; make-immutable 534 (files (big finite-type))) 535 536; nondeterminism via call/cc 537 538(define-structure nondeterminism (export with-nondeterminism 539 ((either one-value all-values) :syntax) 540 fail) 541 (open scheme-level-2 542 fluids cells 543 exceptions 544 (subset exceptions (error))) 545 (files (big either))) 546 547; test suites 548 549(define-structure matchers matchers-interface 550 (open scheme 551 define-record-types 552 big-util) 553 (files (big matcher))) 554 555(define-structure test-suites test-suites-interface 556 (open scheme 557 cells 558 (subset big-util (any delete)) 559 matchers 560 exceptions 561 define-record-types 562 exceptions conditions 563 display-conditions 564 escapes continuations previews 565 (subset i/o (current-error-port)) 566 (subset i/o-internal (output-port-forcers)) 567 fluids) 568 (files (big test-suite))) 569 570(define-structure libscheme48 (export dump-libscheme48-image) 571 (open scheme 572 (subset escapes (with-continuation)) 573 build) 574 (files (big libscheme48))) 575 576;---------------- 577; Obsolete packages 578 579; Bignums and bitwise logical operators on bignums. These are now handled 580; by the VM. These packages are here to keep from breaking scripts that 581; load them. They will be removed in a later release. 582 583(define-structure bignums (export) 584 (open scheme-level-2)) 585 586(define-structure bigbit (export) 587 (open scheme-level-2)) 588 589; The old signals 590 591(define-structure signals signals-interface 592 (open scheme-level-2 593 signal-conditions 594 conditions) 595 (files (big signal))) 596 597; ... end of package definitions. 598 599; Temporary compatibility stuff 600(define-syntax define-signature 601 (syntax-rules () ((define-signature . ?rest) (define-interface . ?rest)))) 602(define-syntax define-package 603 (syntax-rules () ((define-package . ?rest) (define-structures . ?rest)))) 604(define table tables) 605(define record records) 606; It used to be called `code-quote', so this is the name the linker imports. 607(define code-quote code-quotation) 608 609; Time 610(define-interface os-time-interface 611 (export current-utc-time 612 timezone-offset 613 time-seconds 614 time-microseconds 615 time?)) 616 617(define-structure os-time os-time-interface 618 (open scheme 619 define-record-types 620 os-strings 621 external-calls 622 shared-bindings) 623 (files (big os-time))) 624