conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* deleted ikarus.syntax.ss which is no longer needed 

* removed (ikarus system $all) library which is replaced by
  (psyntax system $all)
This commit is contained in:
Abdulaziz Ghuloum 2007-10-09 09:05:22 -04:00
parent 687c45dd6f
commit 75692f0306
3 changed files with 29 additions and 2665 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

2638
src/ikarus.syntax.ss
View File

File diff suppressed because it is too large Load Diff

56
src/makefile.ss
View File

@ -65,7 +65,6 @@
"ikarus.compiler.ss" "ikarus.compiler.ss"
"psyntax.compat.ss" "psyntax.compat.ss"
"psyntax.library-manager.ss" "psyntax.library-manager.ss"
;"ikarus.syntax.ss"
"psyntax.internal.ss" "psyntax.internal.ss"
"psyntax.config.ss" "psyntax.config.ss"
"psyntax.builders.ss" "psyntax.builders.ss"
@ -133,12 +132,6 @@
[trace-define (macro . trace-define)] [trace-define (macro . trace-define)]
)) ))
(define (macro-identifier? x)
(and (assq x ikarus-system-macros) #t))
(define (procedure-identifier? x)
(not (macro-identifier? x)))
(define library-legend (define library-legend
;; abbr. name visible? required? ;; abbr. name visible? required?
'([i (ikarus) #t #t] '([i (ikarus) #t #t]
@ -193,29 +186,10 @@
[$arg-list (ikarus system $arg-list) #f #t] [$arg-list (ikarus system $arg-list) #f #t]
[$stack (ikarus system $stack) #f #t] [$stack (ikarus system $stack) #f #t]
[$interrupts (ikarus system $interrupts) #f #t] [$interrupts (ikarus system $interrupts) #f #t]
[$all (ikarus system $all) #f #t] [$all (psyntax system $all) #f #t]
[$all2 (psyntax system $all) #f #t]
[$boot (ikarus system $bootstrap) #f #t] [$boot (ikarus system $bootstrap) #f #t]
)) ))
(define bootstrap-collection
(let ([ls
(let f ([ls library-legend])
(define required? cadddr)
(define library-name cadr)
(cond
[(null? ls) '()]
[(required? (car ls))
(cons (find-library-by-name (library-name (car ls)))
(f (cdr ls)))]
[else (f (cdr ls))]))])
(case-lambda
[() ls]
[(x) (unless (memq x ls)
(set! ls (cons x ls)))])))
(define identifier->library-map (define identifier->library-map
'( '(
[import i] [import i]
@ -1223,6 +1197,27 @@
[syntax-error i sc] [syntax-error i sc]
)) ))
(define (macro-identifier? x)
(and (assq x ikarus-system-macros) #t))
(define (procedure-identifier? x)
(not (macro-identifier? x)))
(define bootstrap-collection
(let ([ls
(let f ([ls library-legend])
(define required? cadddr)
(define library-name cadr)
(cond
[(null? ls) '()]
[(required? (car ls))
(cons (find-library-by-name (library-name (car ls)))
(f (cdr ls)))]
[else (f (cdr ls))]))])
(case-lambda
[() ls]
[(x) (unless (memq x ls)
(set! ls (cons x ls)))])))
(define (verify-map) (define (verify-map)
(define (f x) (define (f x)
@ -1340,6 +1335,11 @@
(boot-library-expand code)]) (boot-library-expand code)])
code))) code)))
;;; the first code to run on the system is one that initializes
;;; the value and proc fields of the location of $init-symbol-value!
;;; Otherwise, all subsequent inits to any global variable will
;;; segfault.
(define (make-init-code) (define (make-init-code)
(define proc (gensym)) (define proc (gensym))
(define loc (gensym)) (define loc (gensym))
@ -1368,6 +1368,8 @@
`([,label . (global . ,loc)]))) `([,label . (global . ,loc)])))
(define (expand-all files) (define (expand-all files)
;;; remove all re-exported identifiers (those with labels in
;;; subst but not binding in env).
(define (prune-subst subst env) (define (prune-subst subst env)
(cond (cond
((null? subst) '()) ((null? subst) '())