mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 23:50:19 +02:00
Code Activity

*** empty log message ***

Browse source
This commit is contained in:
Keisuke Nishida 2001-04-16 03:43:48 +00:00
parent 78591ef5c3
commit 8f5cfc810f
41 changed files with 681 additions and 529 deletions
Download patch file Download diff file Expand all files Collapse all files

10
module/language/scheme/spec.scm
View file

@ -30,15 +30,11 @@
(read-enable 'positions)
;;;
;;; Compiler
;;;
(define (compile port env . opts)
(define (read-file port)
(do ((x (read port) (read port))
(l '() (cons x l)))
((eof-object? x)
(apply compile-in (cons 'begin (reverse! l)) env scheme opts))))
(cons 'begin (reverse! l)))))
;;;
;;; Language definition
@ -48,7 +44,7 @@
:title "Guile Scheme"
:version "0.5"
:reader read
:read-file read-file
:translator translate
:printer write
:compiler compile
)

13
module/language/scheme/translate.scm
View file

@ -36,6 +36,9 @@
;;; Translator
;;;
(define scheme-primitives
'(not null? eq? eqv? equal? pair? list? cons car cdr set-car! set-cdr!))
(define (trans e l x)
(cond ((pair? x)
(let ((y (macroexpand x)))
@ -216,15 +219,17 @@
(() (make:void))
((('else . body)) (trans:pair `(begin ,@body)))
(((((? symbol? key) ...) body ...) rest ...)
(if (memq 'compile key)
(primitive-eval `(begin ,@(copy-tree body))))
(if (memq 'load-toplevel key)
(trans:pair `(begin ,@body))
(begin
(primitive-eval `(begin ,@(copy-tree body)))
(trans:pair `(begin ,@body)))
(loop rest)))
(else (bad-syntax)))))
(else
(make-<ghil-call> e l (trans:x head) (map trans:x tail)))))
(if (memq head scheme-primitives)
(make-<ghil-inline> e l head (map trans:x tail))
(make-<ghil-call> e l (trans:x head) (map trans:x tail))))))
(define (trans-quasiquote e l x)
(cond ((not (pair? x)) x)