File: debug-packages.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 (134 lines) | stat: -rw-r--r-- 3,441 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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
; Copyright (c) 1993, 1994 Richard Kelsey and Jonathan Rees.  See file COPYING.


; Handy things for debugging the run-time system, byte code compiler,
; and linker.


; Alternative command processor.  Handy for debugging the bigger one.

(define (make-mini-command scheme)
  (define-structure mini-command (export command-processor)
    (open scheme
	  signals conditions handle
	  display-conditions)
    (files (debug mini-command)))
  mini-command)

; Miniature EVAL, for debugging runtime system sans package system.

(define-structures ((mini-eval evaluation-interface)
		    (mini-environments
		     (export interaction-environment
			     scheme-report-environment
			     set-interaction-environment!
			     set-scheme-report-environment!)))
  (open scheme-level-2
	signals)		;error
  (files (debug mini-eval)))

(define (make-scheme environments evaluation) ;cf. initial-packages.scm
  (define-structure scheme scheme-interface
    (open scheme-level-2
	  environments
	  evaluation))
  scheme)

; Stand-alone system that doesn't contain a byte-code compiler.
; This is useful for various testing purposes.

(define mini-scheme (make-scheme mini-environments mini-eval))

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

(define-structure little-system (export start)
  (open scheme-level-1
	mini-command
	scheme-level-2-internal)
  (begin (define start
	   (usual-resumer
	    (lambda (args) (command-processor #f args))))))

(define (link-little-system)
  (link-simple-system '(debug little)
		      'start
		      little-system))



; --------------------
; Hack: smallest possible reified system.

(define-structures ((mini-for-reification for-reification-interface)
		    (mini-packages (export make-simple-package)))
  (open scheme-level-2
	;; tables
	features		;contents
	locations
	signals)		;error
  (files (debug mini-package)))

(define-structure mini-system (export start)
  (open mini-scheme
	mini-command
	mini-for-reification
	mini-packages
	mini-environments		;set-interaction-environment!
	scheme-level-2-internal		;usual-resumer
	conditions handle		;error? with-handler
	signals)			;error
  (files (debug mini-start)))

(define (link-mini-system)
  (link-reified-system (list (cons 'scheme mini-scheme)
			     (cons 'write-images write-images)
			     (cons 'primitives primitives) ;just for fun
			     (cons 'scheme-level-2-internal
				   scheme-level-2-internal)
			     (cons 'command mini-command))
		       '(debug mini)
		       'start
		       mini-system mini-for-reification))



; --------------------
; S-expression interpreter

(define-structure run evaluation-interface
  (open scheme-level-2 syntactic packages scan meta-types
	environments
	signals
	locations
	features   ;force-output
	tables
	fluids)
  (files (debug run)))


; Hack: an interpreter-based system.

(define (link-medium-system)		;cf. initial.scm

  (def medium-scheme (make-scheme environments run))

  (let ()

    (def command (make-mini-command medium-scheme))

    (let ()

      (def medium-system
	;; Cf. initial-packages.scm
	(make-initial-system medium-scheme command))

      (let ((structs (list (cons 'scheme medium-scheme)
			   (cons 'primitives primitives) ;just for fun
			   (cons 'scheme-level-2-internal
				 scheme-level-2-internal)
			   (cons 'command command))))

	(link-reified-system structs
			     '(debug medium)
			     `(start ',(map car structs))
			     medium-system for-reification)))))