File: initial.scm

package info (click to toggle)
scsh 0.5.1-2
  • links: PTS
  • area: non-free
  • in suites: potato, slink
  • size: 6,540 kB
  • ctags: 8,656
  • sloc: lisp: 39,346; ansic: 13,466; sh: 1,669; makefile: 624
file content (59 lines) | stat: -rw-r--r-- 1,736 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.


; Link script.

(define (link-initial-system)
  (let ((structures-to-open		;Structures to open for the initial
	 (struct-list scheme		;system's read-eval-print loop.
		      environments
		      module-system
		      ensures-loaded
		      packages
		      packages-internal)))  ; package-for-syntax
    (link-reified-system (append (desirable-structures)
				 structures-to-open)
			 'initial
			 ;; The expression that evaluates to the
			 ;; procedure that maps the reified-structure alist
			 ;; to the startup procedure:
			 `(start ',(map car structures-to-open))
			 ;; Structures to open for evaluating that
			 ;; expression and the expression that
			 ;; evaluates to the reified-structure alist:
			 initial-system
			 for-reification
			 ;; scheme-level-1
			 )))

(define (desirable-structures)
  (let ((env (interaction-environment))
	(l '()))
    (for-each (lambda (int)
		(for-each-declaration
		     (lambda (name type)
		       (if (not (assq name l))
			   (let ((s (eval name env)))
			     (if (structure? s)
				 (set! l (cons (cons name s) l))))))
		     int))
	      (list low-structures-interface
		    run-time-structures-interface
		    features-structures-interface
		    run-time-internals-structures-interface
		    compiler-structures-interface
		    initial-structures-interface))
    (reverse l)))


; Your choice of evaluators:

(define scheme (make-scheme environments evaluation))
; (define scheme (make-scheme mini-environments mini-eval))
; (define scheme (make-scheme environments run))
; etc.

; Your choice of command processors.

(define initial-system
  (make-initial-system scheme (make-mini-command scheme)))