320 lines
		
	
	
		
			8.2 KiB
		
	
	
	
		
			Scheme
		
	
	
	
			
		
		
	
	
			320 lines
		
	
	
		
			8.2 KiB
		
	
	
	
		
			Scheme
		
	
	
	
;;; The packages that scsh uses/defines.
 | 
						|
;;; Copyright (c) 1994 by Olin Shivers.
 | 
						|
 | 
						|
;;; Note: field-reader package (fr.scm) and here docs use READ-LINE.
 | 
						|
;;; It is defined in rdelim.scm.
 | 
						|
 | 
						|
;;; You link up a scsh package by defining a package named OS-DEPENDENT
 | 
						|
;;; that satisfies the interfaces for packages
 | 
						|
;;;     buffered-io-flags
 | 
						|
;;;     posix-fdflags 
 | 
						|
;;;     posix-errno
 | 
						|
;;;     posix-signals
 | 
						|
;;; Anything else it provides should be specified in an interface called
 | 
						|
;;; os-extras-interface. See the scsh structure below.
 | 
						|
;;; Then the scsh structure can be instantiated.
 | 
						|
;;;
 | 
						|
;;; The architecture directories, like next/ and irix/ and so forth,
 | 
						|
;;; provide packages that can serve as the os-dependent package. E.g.,
 | 
						|
;;; the next-defs package, defined in next/packages.
 | 
						|
;;;
 | 
						|
;;; This whole mechanism would be better solved with a functor.
 | 
						|
;;;     -Olin
 | 
						|
 | 
						|
 | 
						|
;;; The LET-OPT package for optional argument parsing & defaulting
 | 
						|
;;; is found in the let-opt.scm file.
 | 
						|
 | 
						|
 | 
						|
(define-structure error-package (export error warn)
 | 
						|
  (open signals))
 | 
						|
 | 
						|
 | 
						|
(define-structure scsh-utilities scsh-utilities-interface
 | 
						|
  (open bitwise error-package let-opt scheme)
 | 
						|
  (files utilities))
 | 
						|
 | 
						|
 | 
						|
;;; This guy goes into the FOR-SYNTAX part of scsh's syntax exports.
 | 
						|
(define-structure scsh-syntax-helpers
 | 
						|
  (export transcribe-extended-process-form)
 | 
						|
  (open receiving	; receive
 | 
						|
	error-package
 | 
						|
	syntactic	; generated?
 | 
						|
	scsh-utilities	; check-arg
 | 
						|
	scheme
 | 
						|
	)
 | 
						|
  (files syntax-helpers))
 | 
						|
 | 
						|
 | 
						|
;;; The bufpol/{block, line, none} values
 | 
						|
(define-structure buffered-io-flags buffered-io-flags-interface
 | 
						|
  (open defenum-package scheme)
 | 
						|
  (files (machine bufpol)))
 | 
						|
 | 
						|
 | 
						|
(define-structure char-set-package char-set-interface  
 | 
						|
  (open error-package ascii scheme)
 | 
						|
  (files char-set))
 | 
						|
 | 
						|
 | 
						|
(define-structures ((tty-flags tty-flags-interface)
 | 
						|
		    (scsh-internal-tty-flags scsh-internal-tty-flags-interface))
 | 
						|
  (open scheme ascii bitwise)
 | 
						|
  (files (machine tty-consts)))
 | 
						|
 | 
						|
 | 
						|
(define-structure scsh-version scsh-version-interface
 | 
						|
  (open scheme)
 | 
						|
  (files scsh-version))
 | 
						|
 | 
						|
(define-structure partial-s48-ports
 | 
						|
  (export current-input-port current-output-port
 | 
						|
	  newline
 | 
						|
	  error-output-port
 | 
						|
 | 
						|
	  $current-input-port
 | 
						|
	  $current-output-port
 | 
						|
	  $error-output-port)
 | 
						|
  (open ports))
 | 
						|
 | 
						|
;;; The scsh-level-0 package is for implementation convenience.
 | 
						|
;;; The scsh startup and top-level modules need access to scsh
 | 
						|
;;; procedures, but they export procedures that are themselves
 | 
						|
;;; part of scsh. So scsh-level-0 is the core scsh stuff, which is
 | 
						|
;;; imported by these two modules. These modules all collectively
 | 
						|
;;; export the whole scsh enchilada.
 | 
						|
 | 
						|
(define-structures
 | 
						|
  ((scsh-level-0
 | 
						|
    (compound-interface posix-fdflags-interface
 | 
						|
			posix-errno-interface
 | 
						|
			posix-signals-interface
 | 
						|
			sockets-network-interface ; Standard Network Interface
 | 
						|
			os-extras-interface ; Extra stuff from OS.
 | 
						|
			scsh-delimited-readers-interface
 | 
						|
			scsh-errors-interface
 | 
						|
			scsh-io-interface
 | 
						|
			scsh-file-interface
 | 
						|
			scsh-process-interface
 | 
						|
			scsh-process-state-interface
 | 
						|
			scsh-user/group-db-interface
 | 
						|
			scsh-command-line-interface
 | 
						|
			scsh-signals-interface
 | 
						|
			scsh-environment-interface
 | 
						|
			scsh-home-interface
 | 
						|
			scsh-string-interface
 | 
						|
			scsh-file-names-interface
 | 
						|
			scsh-misc-interface
 | 
						|
			scsh-high-level-process-interface
 | 
						|
			scsh-time-interface ; new in 0.2
 | 
						|
			scsh-sockets-interface ; new in 0.3
 | 
						|
			tty-interface ; new in 0.4
 | 
						|
			scsh-version-interface
 | 
						|
			char-set-interface
 | 
						|
			signal-handler-interface
 | 
						|
			;; This stuff would probably be better off kept
 | 
						|
			;; in separate modules, but we'll toss it in for now.
 | 
						|
			(interface-of ascii) ; char<->ascii
 | 
						|
			string-ports-interface
 | 
						|
			))
 | 
						|
   (scsh-level-0-internals (export set-command-line-args!
 | 
						|
				   init-scsh-hindbrain
 | 
						|
				   init-scsh-vars))
 | 
						|
   (scsh-regexp-package scsh-regexp-interface))
 | 
						|
  (for-syntax (open scsh-syntax-helpers scheme))
 | 
						|
  (open externals
 | 
						|
	structure-refs
 | 
						|
	cig-aux
 | 
						|
	receiving
 | 
						|
	defrec-package
 | 
						|
	define-foreign-syntax
 | 
						|
	formats
 | 
						|
	os-dependent		; OS dependent stuff
 | 
						|
	buffered-io-flags	; stdio dependent
 | 
						|
	ascii
 | 
						|
	records
 | 
						|
	extended-ports
 | 
						|
	partial-s48-ports
 | 
						|
;	ports
 | 
						|
	build
 | 
						|
	bigbit
 | 
						|
	bitwise
 | 
						|
	signals
 | 
						|
	conditions
 | 
						|
	scsh-utilities
 | 
						|
	handle
 | 
						|
	fluids
 | 
						|
	weak
 | 
						|
 | 
						|
;	scsh-regexp-package
 | 
						|
;	scsh-regexp-internals
 | 
						|
	char-set-package
 | 
						|
	scsh-version
 | 
						|
	tty-flags
 | 
						|
	scsh-internal-tty-flags	; Not exported
 | 
						|
	let-opt			; optional-arg parsing & defaulting
 | 
						|
	
 | 
						|
	interrupts	; signal handler code
 | 
						|
 | 
						|
	scheme
 | 
						|
	)
 | 
						|
 | 
						|
  (access command-processor
 | 
						|
	  escapes
 | 
						|
	  ports		; S48's force-output
 | 
						|
	  formats
 | 
						|
	  records	; I don't think this is necessary. !!!
 | 
						|
	  scheme)	; For accessing the normal I/O operators.
 | 
						|
 | 
						|
  (begin (define set-batch-mode?!
 | 
						|
	   (structure-ref command-processor set-batch-mode?!))
 | 
						|
	 (define with-continuation (structure-ref escapes with-continuation)))
 | 
						|
 | 
						|
  (files syntax
 | 
						|
	 syscalls
 | 
						|
	 select
 | 
						|
	 fname
 | 
						|
	 stringcoll
 | 
						|
	 scsh-condition
 | 
						|
	 rw
 | 
						|
	 newports
 | 
						|
	 fdports
 | 
						|
	 procobj		; New in release 0.4.
 | 
						|
	 (machine waitcodes)	; OS dependent code.
 | 
						|
	 filesys
 | 
						|
	 fileinfo
 | 
						|
	 glob
 | 
						|
	 filemtch
 | 
						|
	 time			; New in release 0.2.
 | 
						|
	 (machine time_dep)
 | 
						|
	 network		; New in release 0.3.
 | 
						|
	 endian			; New in release 0.4.
 | 
						|
	 flock			; New in release 0.4.
 | 
						|
	 tty			; New in release 0.4.
 | 
						|
	 pty			; New in release 0.4.
 | 
						|
	 sighandlers		; New in release 0.5.
 | 
						|
	 scsh
 | 
						|
	 re
 | 
						|
	 rdelim
 | 
						|
	 ))
 | 
						|
 | 
						|
(define-structure defrec-package (export (define-record :syntax))
 | 
						|
  (open records scheme)
 | 
						|
  (for-syntax (open scheme error-package receiving))
 | 
						|
  (files defrec))
 | 
						|
 | 
						|
(define-structure defenum-package (export (define-enum-constant  :syntax)
 | 
						|
					  (define-enum-constants :syntax))
 | 
						|
  (open scheme)
 | 
						|
  (files enumconst))
 | 
						|
 | 
						|
;;; This code opens so many modules of gruesome, low-level S48 internals 
 | 
						|
;;; that these two modules are segregated into separate packages, each
 | 
						|
;;; exporting just two definitions.
 | 
						|
 | 
						|
(define-structure scsh-startup-package (export dump-scsh-program dump-scsh)
 | 
						|
  (open scsh-level-0-internals	; init-scsh-* set-command-line-args!
 | 
						|
	scsh-level-0		; error-output-port command-line-arguments
 | 
						|
	scsh-top-package	; parse-switches-and-execute
 | 
						|
	handle			; with-handler
 | 
						|
	command-processor	; user-context
 | 
						|
	write-images		; write-image
 | 
						|
	build-internals		; simple-condition-handler
 | 
						|
	low-level		; flush-the-symbol-table!
 | 
						|
	command-processor	; command-output
 | 
						|
	filenames		; translate
 | 
						|
	scheme-level-2-internal	; usual-resumer
 | 
						|
	scheme)
 | 
						|
  (files startup))
 | 
						|
 | 
						|
(define-structure scsh-top-package (export parse-switches-and-execute repl)
 | 
						|
  (open command-processor
 | 
						|
	ensures-loaded
 | 
						|
	environments
 | 
						|
	error-package
 | 
						|
	evaluation
 | 
						|
	extended-ports
 | 
						|
	interfaces
 | 
						|
	interrupts
 | 
						|
	package-commands-internal
 | 
						|
	package-mutation
 | 
						|
	packages
 | 
						|
	receiving
 | 
						|
	scsh-version
 | 
						|
	scsh-level-0		; with-current-input-port error-output-port
 | 
						|
				; with-current-output-port exit
 | 
						|
	scsh-level-0-internals	; set-command-line-args! init-scsh-vars
 | 
						|
	scheme)
 | 
						|
  (files top meta-arg))
 | 
						|
 | 
						|
 | 
						|
(define-structure field-reader-package scsh-field-reader-interface
 | 
						|
  (open receiving		; receive
 | 
						|
	char-set-package
 | 
						|
	scsh-utilities
 | 
						|
	error-package		; error
 | 
						|
	scsh-level-0		; delimited readers
 | 
						|
	scsh-regexp-package
 | 
						|
	let-opt			; optional-arg parsing & defaulting
 | 
						|
	scheme
 | 
						|
	)
 | 
						|
  (files fr))
 | 
						|
 | 
						|
 | 
						|
(define-structures
 | 
						|
  ((awk-expander-package (export expand-awk))
 | 
						|
   (awk-support-package (export next-range next-:range
 | 
						|
				next-range: next-:range:)))
 | 
						|
  (open receiving		; receive
 | 
						|
	scsh-utilities	
 | 
						|
	error-package		; error
 | 
						|
	scsh-regexp-package
 | 
						|
	scheme
 | 
						|
	)
 | 
						|
  (files awk))
 | 
						|
	 
 | 
						|
 | 
						|
(define-structure awk-package awk-interface
 | 
						|
  (open awk-support-package scsh-regexp-package receiving scheme)
 | 
						|
  (for-syntax (open awk-expander-package scheme))
 | 
						|
  (begin (define-syntax awk expand-awk)))
 | 
						|
 | 
						|
 | 
						|
(define-structure scsh
 | 
						|
  (compound-interface (interface-of scsh-level-0)
 | 
						|
		      (interface-of scsh-startup-package)
 | 
						|
		      scsh-regexp-interface
 | 
						|
		      scsh-field-reader-interface 	; new in 0.3
 | 
						|
;		      scsh-dbm-interface
 | 
						|
		      (export repl)
 | 
						|
		      awk-interface)
 | 
						|
 | 
						|
  (open structure-refs
 | 
						|
	scsh-level-0
 | 
						|
	scsh-level-0-internals
 | 
						|
	scsh-regexp-package
 | 
						|
	scsh-startup-package
 | 
						|
;	dbm
 | 
						|
	awk-package
 | 
						|
	field-reader-package
 | 
						|
	scheme)
 | 
						|
 | 
						|
  (access scsh-top-package)
 | 
						|
  (begin (define repl (structure-ref scsh-top-package repl))))
 | 
						|
 | 
						|
(define-structure scsh-here-string-hax (export)
 | 
						|
  (open reading
 | 
						|
	receiving
 | 
						|
	scsh		; Just need the delimited readers.
 | 
						|
	features	; make-immutable!
 | 
						|
	scheme)
 | 
						|
  (files here))
 | 
						|
 | 
						|
(define-structure test-package (export test-proc)
 | 
						|
  (open scsh-regexp-package scheme)
 | 
						|
  (begin (define (test-proc p)
 | 
						|
	   (regexp-substitute p
 | 
						|
			      (string-match "(foo)(.*)(bar)" "Hello foo Olin bar quux")
 | 
						|
			      'post 3 1 2 'pre))))
 |