r1/kernel.scm
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
Wed, 16 Jan 2019 17:15:58 +0000
changeset 438 1fe179d53161
parent 223 646d45b098aa
permissions -rw-r--r--
Add missing primitive implementation for the plain interpreter.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
223
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     1
(require 'srfi-1)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     2
(require 'oo)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     3
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     4
;---------------------------------------------------------------------------
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     5
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     6
(define (describe-object! o description)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     7
    (for-each (lambda (entry)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     8
		(let* ((delegating? (vector? entry))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     9
		       (entry (if delegating? (vector->list entry) entry))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    10
		       (name (car entry))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    11
		       (value (cadr entry))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    12
		       (kind (if (null? (cddr entry)) 'immutable (caddr entry))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    13
		  (add-slot! o name value delegating? kind)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    14
	      description)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    15
    o)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    16
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    17
(define (make-basic-object description)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    18
  (let ((o (make-object* (make-layout*) (vector))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    19
    (describe-object! o description)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    20
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    21
(define (make-named-object name description)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    22
  (let ((o (make-basic-object description)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    23
    (add-slot! o 'name name #f 'immutable)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    24
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    25
(define (make-method* selector formal-names body-exp)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    26
  (let ((m (clone-object *method*)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    27
    (set-slot! m 'selector selector)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    28
    (set-slot! m 'arguments formal-names)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    29
    (set-slot! m 'code body-exp)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    30
    m))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    31
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    32
(define (build-getter-body name)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    33
  (lambda (method self)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    34
    (get-slot self name)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    35
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    36
(define (build-setter-body name)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    37
  (lambda (method self value)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    38
    (set-slot! self name value)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    39
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    40
(define (make-getter-method-for name)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    41
  (let ((m (make-method* name '#(self) (build-getter-body name))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    42
    (set-slot! m 'accessor name)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    43
    m))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    44
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    45
(define (make-setter-method-for name mutator-name)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    46
  (let ((m (make-method* mutator-name '#(self value) (build-setter-body name))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    47
    (set-slot! m 'accessor name)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    48
    m))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    49
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    50
(define (make-traits name description)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    51
  (let ((t (make-named-object name `(#(traits ,*traits-traits*)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    52
    (describe-object! t description)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    53
    t))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    54
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    55
(define primitive-traits-hook
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    56
  (make-parameter
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    57
   (lambda (o)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    58
     (error "Cannot compute primitive traits" o))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    59
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    60
(define (traits-for-primitive o)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    61
  (cond
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    62
   ((number? o) *traits-number*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    63
   ((char? o) *traits-character*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    64
   ((symbol? o) *traits-symbol*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    65
   ((vector? o) *traits-tuple*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    66
   ((pair? o) *traits-pair*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    67
   ((string? o) *traits-string*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    68
   ((boolean? o) *traits-boolean*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    69
   ((null? o) *nil*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    70
   (else ((primitive-traits-hook) o))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    71
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    72
;---------------------------------------------------------------------------
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    73
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    74
(define *image-root* 'uninitialised-image-root)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    75
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    76
(let-syntax ((def (syntax-rules () ((_ (v n) ...) (begin (define v '(uninitialised v)) ...)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    77
  (include "root-hooks.scm"))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    78
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    79
(define (compute-roots-globals)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    80
  (let-syntax ((def (syntax-rules ()
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    81
			 ((_ (v n) ...)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    82
			  (filter car (list (list 'n v) ...))))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    83
    (include "root-hooks.scm")))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    84
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    85
(define *primitive-table* 'uninitialised-primitive-table)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    86
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    87
(define (store-primitive! key body-procedure)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    88
  (cond
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    89
   ((assoc key *primitive-table*) =>
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    90
    (lambda (cell)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    91
      (debug 0 "Warning: replacing primitive: "key)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    92
      (set-cdr! cell body-procedure)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    93
   (else
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    94
    (set! *primitive-table* (cons (cons key body-procedure) *primitive-table*)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    95
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    96
(define (lookup-primitive key)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    97
  (cond
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    98
   ((assoc key *primitive-table*) => cdr)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    99
   (else (error "Missing primitive" key))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   100
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   101
(define (reset-primitive-table!)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   102
  (set! *primitive-table* '())
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   103
  (let-syntax ((define-method
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   104
		 (lambda (x)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   105
		   (syntax-case x ()
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   106
		     ((_ (selector arg ...) primitive-name body ...)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   107
		      (with-syntax ((((name role) ...)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   108
				     (map (syntax-rules ()
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   109
					    ((_ (name role)) (name role))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   110
					    ((_ name) (name *no-role*)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   111
					  (syntax ((x arg) ...))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   112
				    (resend (datum->syntax-object (syntax selector) 'resend)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   113
			(syntax
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   114
			 (begin
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   115
			   (debug 1 "Define-method (primitive-side) "'primitive-name
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   116
				  " "'selector" "'(role ...))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   117
			   (store-primitive! 'primitive-name
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   118
					     (lambda (current-method name ...)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   119
					       (let ((resend (lambda ()
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   120
							       (debug 2 "Resending "'selector)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   121
							       (send/previous-method current-method
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   122
										     'selector
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   123
										     (vector
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   124
										      name ...)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   125
						 body ...)))))))))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   126
    (include "kernel-methods.scm")))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   127
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   128
(define global-store-hooks '())
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   129
(define global-load-hooks '())
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   130
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   131
(define (store-globals-to-image!)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   132
  (set! *image-root* (make-hash-table eq?))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   133
  (let-syntax ((def (syntax-rules ()
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   134
		      ((_ (v n) ...)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   135
		       (begin (hash-table-set! *image-root* 'v v) ...)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   136
    (include "root-hooks.scm"))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   137
  (run-hooks! global-store-hooks))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   138
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   139
(define (load-globals-from-image!)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   140
  (let-syntax ((def (syntax-rules ()
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   141
		      ((_ (v n) ...)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   142
		       (begin (set! v (hash-table-ref *image-root* 'v)) ...)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   143
    (include "root-hooks.scm"))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   144
  (run-hooks! global-load-hooks))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   145
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   146
;---------------------------------------------------------------------------
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   147
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   148
(define *root-literals* 'uninitialised-root-literals)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   149
(let-syntax ((def-root-literals (syntax-rules ()
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   150
				  ((_ (lit ob) ...)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   151
				   (set! *root-literals*
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   152
				     `((,lit ,(lambda () ob)) ...))))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   153
  (def-root-literals
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   154
    (() *nil*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   155
    (#t *true*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   156
    (#f *false*)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   157
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   158
(define bootstrap-hooks '())
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   159
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   160
(define (bootstrap-image!)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   161
  (set! *nil* (make-basic-object `()))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   162
  (set! *no-role* (make-basic-object `()))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   163
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   164
  (set! *traits-method* (make-basic-object `()))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   165
  (set! *method* (make-basic-object `()))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   166
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   167
  (let ((m *method*))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   168
    (add-slot! m 'traits *traits-method* #t 'immutable #f)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   169
    (add-slot! m 'code *nil* #f 'immutable #f)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   170
    (add-slot! m 'arguments *nil* #f 'immutable #f)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   171
    (add-slot! m 'accessor *nil* #f 'immutable #f)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   172
    (add-slot! m 'primitive *nil* #f 'immutable #f)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   173
    (add-slot! m 'selector *nil* #f 'immutable #f)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   174
    (add-slot! m 'literals *nil* #f 'immutable #f)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   175
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   176
    (add-accessors! m 'traits #t)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   177
    (add-accessors! m 'code #t)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   178
    (add-accessors! m 'arguments #t)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   179
    (add-accessors! m 'accessor #t)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   180
    (add-accessors! m 'primitive #t)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   181
    (add-accessors! m 'selector #t)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   182
    (add-accessors! m 'literals #t)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   183
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   184
    (add-slot! *nil* 'name "Nil" #f 'immutable)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   185
    (add-slot! *no-role* 'name "NoRole" #f 'immutable)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   186
    (add-slot! *traits-method* 'name "Method" #f 'immutable))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   187
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   188
  (set! *traits-traits* (make-named-object "Traits" `()))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   189
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   190
  (set! *traits-root* (make-traits "Root" `()))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   191
  (set! *root* (make-basic-object `(#(traits ,*traits-root*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   192
  (describe-object! *traits-traits* `(#(root ,*traits-root*)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   193
  (describe-object! *traits-method* `(#(traits ,*traits-traits*)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   194
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   195
  (set! *traits-oddball* (make-traits "Oddball" `(#(root ,*traits-root*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   196
  (set! *traits-derivable* (make-traits "Derivable" `(#(root ,*traits-root*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   197
  (set! *traits-cloneable* (make-traits "Cloneable" `(#(derivable ,*traits-derivable*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   198
  (describe-object! *traits-method* `(#(cloneable ,*traits-cloneable*)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   199
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   200
  (set! *oddball* (make-basic-object `(#(traits ,*traits-oddball*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   201
  (describe-object! *nil* `(#(traits ,*traits-oddball*)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   202
  (describe-object! *no-role* `(#(traits ,*traits-oddball*)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   203
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   204
  (set! *derivable* (make-basic-object `(#(traits ,*traits-derivable*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   205
  (set! *cloneable* (make-basic-object `(#(traits ,*traits-cloneable*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   206
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   207
  (set! *traits-number* (make-traits "Number" `(#(derivable ,*traits-derivable*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   208
  (set! *traits-character* (make-traits "Character" `(#(oddball ,*traits-oddball*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   209
  (set! *traits-boolean* (make-traits "Boolean" `(#(oddball ,*traits-oddball*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   210
  (set! *traits-symbol* (make-traits "Symbol" `(#(oddball ,*traits-oddball*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   211
  (set! *traits-tuple* (make-traits "Tuple" `(#(cloneable ,*traits-cloneable*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   212
  (set! *traits-pair* (make-traits "Pair" `(#(cloneable ,*traits-cloneable*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   213
  (set! *traits-string* (make-traits "String" `(#(cloneable ,*traits-cloneable*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   214
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   215
  (set! *traits-socket* (make-traits "Socket" `(#(derivable ,*traits-derivable*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   216
  (set! *traits-sdl-surface* (make-traits "SDL_Surface" `(#(oddball ,*traits-oddball*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   217
  (set! *traits-sdl-event* (make-traits "SDL_Event" `(#(oddball ,*traits-oddball*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   218
  (set! *traits-ttf-font* (make-traits "TTF_Font" `(#(oddball ,*traits-oddball*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   219
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   220
  (set! *true* (make-basic-object `(#(traits ,*traits-boolean*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   221
  (set! *false* (make-basic-object `(#(traits ,*traits-boolean*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   222
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   223
  (set! *tuple* '#())
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   224
  (set! *string* "")
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   225
  (set! *symbol* 'Symbol)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   226
  (set! *number* 0)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   227
  (set! *pair* (cons *nil* *nil*))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   228
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   229
  (set! *traits-block* (make-traits "Block" `(#(cloneable ,*traits-cloneable*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   230
  (set! *block* (make-basic-object `(#(traits ,*traits-block*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   231
				     (environment ,*nil*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   232
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   233
  ;; Language-specific -----------
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   234
  (set! *traits-cell* (make-traits "Cell" `(#(cloneable ,*traits-cloneable*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   235
  (set! *cell* (make-basic-object `(#(traits ,*traits-cell*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   236
				    (_pvt_value ,*no-role* mutable)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   237
				    (queue () mutable))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   238
  (set! *traits-location* (make-traits "Location" `(#(cloneable ,*traits-cloneable*))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   239
  (set! *location* (make-basic-object `(#(traits ,*traits-location*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   240
					(continuation ,*nil*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   241
					(parent ,*nil*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   242
					;;
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   243
					;; Need to delegate to parent,
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   244
					;; to get exn handler, globals
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   245
					;; etc.
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   246
					;;
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   247
					(children () mutable)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   248
					(dead ,*false* mutable))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   249
  (set! *boot-block* (metalevel-eval `(block () ((send "fileIn" ((string "boot.thing")))))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   250
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   251
  (set! *globals* (clone-object *cell*))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   252
  (metalevel-inject-cell-value
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   253
   *globals*
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   254
   (make-basic-object (compute-roots-globals)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   255
  ;; -----------------------------
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   256
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   257
  (run-hooks! bootstrap-hooks)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   258
  (flush-literal-objects-table!)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   259
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   260
  (for-each (lambda (entry)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   261
	      (install-object-for-literal! (car entry)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   262
					   ((cadr entry))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   263
	    *root-literals*)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   264
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   265
  (let-syntax ((define-method
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   266
		 (lambda (x)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   267
		   (syntax-case x ()
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   268
		     ((_ (selector arg ...) primitive-name body ...)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   269
		      (with-syntax ((((name role) ...)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   270
				     (map (syntax-rules ()
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   271
					    ((_ (name role)) (name role))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   272
					    ((_ name) (name *no-role*)))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   273
					  (syntax ((x arg) ...)))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   274
			(syntax
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   275
			 (begin
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   276
			   (debug 1 "Define-method (image-side) "'primitive-name
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   277
				  " "'selector" "'(role ...))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   278
			   (let ((method (define-method! 'selector '(name ...) `(,role ...)
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   279
					   (lookup-primitive 'primitive-name))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   280
			     (set-slot! method 'primitive 'primitive-name))))))))))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   281
    (include "kernel-methods.scm"))
646d45b098aa During the darcs->hg conversion, some "darcs mv" were turned into "hg rm"!
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
   282
)