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

* before attempting to use chaitin to compile the system.

This commit is contained in:
Abdulaziz Ghuloum 2007-02-11 21:42:01 -05:00
parent 353b4393b0
commit fa6e499b22
5 changed files with 76 additions and 48 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.

12
src/libaltcogen.ss
View File

@ -1570,14 +1570,20 @@
[else (error who "invalid tail ~s" x)])]
[else (error who "invalid tail ~s" x)]))
;;;
(define (properize args proper ac)
(cond
[proper ac]
[else
(error 'properize "not yet")
ac]))
;;;
(define (ClambdaCase x)
(record-case x
[(clambda-case info body)
(record-case info
[(case-info L args proper)
(unless proper (error who "improper lambda"))
(cons (label L)
(T body '()))])]))
(properize args proper
(cons (label L) (T body '())))])]))
;;;
(define (Clambda x)
(record-case x

14
src/libcompile.ss
View File

@ -5221,7 +5221,21 @@
(close-input-port ip)
(close-output-port op))))
(define alt-compile-file
(lambda (input-file output-file . rest)
(let ([ip (open-input-file input-file)]
[op (apply open-output-file output-file rest)])
(let f ()
(let ([x (read ip)])
(unless (eof-object? x)
(fasl-write (alt-compile-expr x) op)
(f))))
(close-input-port ip)
(close-output-port op))))
(primitive-set! 'compile-file compile-file)
(primitive-set! 'alt-compile-file alt-compile-file)
(primitive-set! 'assembler-output (make-parameter #f))
(primitive-set! 'compile
(lambda (x)

37
src/libcxr.ss
View File

@ -1,17 +1,18 @@
(primitive-set! 'car (lambda (x) (car x)))
(primitive-set! 'cdr (lambda (x) (cdr x)))
(primitive-set! 'cadr (lambda (x) (cadr x)))
;(primitive-set! 'car (lambda (x) (car x)))
;(primitive-set! 'cdr (lambda (x) (cdr x)))
;(primitive-set! 'cadr (lambda (x) (cadr x)))
(let ([err (lambda (who x)
(error who "invalid list structure ~s" x))])
;(primitive-set!
; 'car
; (lambda (orig)
; (if (pair? orig) ($car orig) (err 'car orig))))
;(primitive-set!
; 'cdr
; (lambda (orig)
; (if (pair? orig) ($cdr orig) (err 'cdr orig))))
(primitive-set!
'car
(lambda (orig)
(if (pair? orig) ($car orig) (err 'car orig))))
(primitive-set!
'cdr
(lambda (orig)
(if (pair? orig) ($cdr orig) (err 'cdr orig))))
(primitive-set!
'caar
(lambda (orig)
@ -19,13 +20,13 @@
(let ([x ($car orig)])
(if (pair? x) ($car x) (err 'caar orig)))
(err 'caar orig))))
;(primitive-set!
; 'cadr
; (lambda (orig)
; (if (pair? orig)
; (let ([x ($cdr orig)])
; (if (pair? x) ($car x) (err 'cadr orig)))
; (err 'cadr orig))))
(primitive-set!
'cadr
(lambda (orig)
(if (pair? orig)
(let ([x ($cdr orig)])
(if (pair? x) ($car x) (err 'cadr orig)))
(err 'cadr orig))))
(primitive-set!
'cdar
(lambda (orig)

61
src/makefile.ss
View File

@ -56,6 +56,7 @@
dynamic-wind display write print-graph fasl-write printf fprintf format
print-error read-token read comment-handler error warning exit call/cc
error-handler eval current-eval compile alt-compile compile-file
alt-compile-file
new-cafe load system expand sc-expand current-expand expand-mode
environment? interaction-environment identifier?
free-identifier=? bound-identifier=? literal-identifier=?
@ -225,29 +226,29 @@
(whack-system-env #t)
(define scheme-library-files
'(["libhandlers.ss" "libhandlers.fasl" p0]
["libcontrol.ss" "libcontrol.fasl" p0]
["libcollect.ss" "libcollect.fasl" p0]
["librecord.ss" "librecord.fasl" p0]
["libcxr.ss" "libcxr.fasl" p0]
["libnumerics.ss" "libnumerics.fasl" p0]
["libguardians.ss" "libguardians.fasl" p0]
["libcore.ss" "libcore.fasl" p0]
["libchezio.ss" "libchezio.fasl" p0]
["libhash.ss" "libhash.fasl" p0]
["libwriter.ss" "libwriter.fasl" p0]
["libtokenizer.ss" "libtokenizer.fasl" p0]
["libassembler.ss" "libassembler.fasl" p0]
["libintelasm.ss" "libintelasm.fasl" p0]
["libfasl.ss" "libfasl.fasl" p0]
["libtrace.ss" "libtrace.fasl" p0]
["libcompile.ss" "libcompile.fasl" p1]
["psyntax-7.1.ss" "psyntax.fasl" p0]
["libpp.ss" "libpp.fasl" p0]
["libcafe.ss" "libcafe.fasl" p0]
["libposix.ss" "libposix.fasl" p0]
["libtimers.ss" "libtimers.fasl" p0]
["libtoplevel.ss" "libtoplevel.fasl" p0]
'(["libhandlers.ss" "libhandlers.fasl" p0 onepass]
["libcontrol.ss" "libcontrol.fasl" p0 onepass]
["libcollect.ss" "libcollect.fasl" p0 onepass]
["librecord.ss" "librecord.fasl" p0 onepass]
["libcxr.ss" "libcxr.fasl" p0 onepass]
["libnumerics.ss" "libnumerics.fasl" p0 onepass]
["libguardians.ss" "libguardians.fasl" p0 onepass]
["libcore.ss" "libcore.fasl" p0 onepass]
["libchezio.ss" "libchezio.fasl" p0 onepass]
["libhash.ss" "libhash.fasl" p0 onepass]
["libwriter.ss" "libwriter.fasl" p0 onepass]
["libtokenizer.ss" "libtokenizer.fasl" p0 onepass]
["libassembler.ss" "libassembler.fasl" p0 onepass]
["libintelasm.ss" "libintelasm.fasl" p0 onepass]
["libfasl.ss" "libfasl.fasl" p0 onepass]
["libtrace.ss" "libtrace.fasl" p0 onepass]
["libcompile.ss" "libcompile.fasl" p1 onepass]
["psyntax-7.1.ss" "psyntax.fasl" p0 onepass]
["libpp.ss" "libpp.fasl" p0 onepass]
["libcafe.ss" "libcafe.fasl" p0 onepass]
["libposix.ss" "libposix.fasl" p0 onepass]
["libtimers.ss" "libtimers.fasl" p0 onepass]
["libtoplevel.ss" "libtoplevel.fasl" p0 onepass]
))
@ -263,12 +264,18 @@
(define (expand-file ifile)
(map sc-expand (read-file ifile)))
(define (compile-library ifile ofile)
(define (compile-library ifile ofile which-compile)
(parameterize ([assembler-output #f]
[expand-mode 'bootstrap]
[interaction-environment system-env])
(printf "compiling ~a ... \n" ifile)
(compile-file ifile ofile 'replace)))
(let ([proc
(case which-compile
[(onepass) compile-file]
[(chaitin) alt-compile-file]
[else (error 'compile-library "unknown compile ~s"
which-compile)])])
(printf "compiling ~a ... \n" ifile)
(proc ifile ofile 'replace))))
@ -277,7 +284,7 @@
(for-each
(lambda (x)
(when (eq? who (caddr x))
(compile-library (car x) (cadr x))))
(compile-library (car x) (cadr x) (cadddr x))))
scheme-library-files))
(define (time x) x)
(fork