(error "defmacro can only be used at the top level")))))))
(defmacro:transformer defmacro-transformer)))
-(define defmacro:syntax-transformer
- (lambda (f)
- (procedure->syntax
- (lambda (exp env)
- (copy-tree (apply f (cdr exp)))))))
-
;; XXX - should the definition of the car really be looked up in the
;; current module?
;;; {R4RS compliance}
;;;
-(primitive-load-path "ice-9/r4rs.scm")
+(primitive-load-path "ice-9/r4rs")
\f
\f
(if (provided? 'posix)
- (primitive-load-path "ice-9/posix.scm"))
+ (primitive-load-path "ice-9/posix"))
(if (provided? 'socket)
- (primitive-load-path "ice-9/networking.scm"))
+ (primitive-load-path "ice-9/networking"))
;; For reference, Emacs file-exists-p uses stat in this same way.
;; ENHANCE-ME: Catching an exception from stat is a bit wasteful, do this in
\f
+;;; {The interpreter stack}
+;;;
+
+(defmacro start-stack (tag exp)
+ `(%start-stack ,tag (lambda () ,exp)))
+
+\f
+
;;; {Loading by paths}
;;;
(define module-export! #f)
(define default-duplicate-binding-procedures #f)
-;; This boots the module system. All bindings needed by modules.c
-;; must have been defined by now.
-;;
-(set-current-module the-root-module)
-
(define %app (make-module 31))
(define app %app) ;; for backwards compatability
+
(local-define '(%app modules) (make-module 31))
(local-define '(%app modules guile) the-root-module)
+;; This boots the module system. All bindings needed by modules.c
+;; must have been defined by now.
+;;
+(set-current-module the-root-module)
+
;; (define-special-value '(%app modules new-ws) (lambda () (make-scm-module)))
(define (try-load-module name)
(error "unrecognized define-module argument" arg))))
(beautify-user-module! module)
(let loop ((kws kws)
- (reversed-interfaces '())
- (exports '())
- (re-exports '())
- (replacements '())
+ (reversed-interfaces '())
+ (exports '())
+ (re-exports '())
+ (replacements '())
(autoloads '()))
(if (null? kws)
- (call-with-deferred-observers
- (lambda ()
- (module-use-interfaces! module (reverse reversed-interfaces))
- (module-export! module exports)
- (module-replace! module replacements)
- (module-re-export! module re-exports)
+ (call-with-deferred-observers
+ (lambda ()
+ (module-use-interfaces! module (reverse reversed-interfaces))
+ (module-export! module exports)
+ (module-replace! module replacements)
+ (module-re-export! module re-exports)
(if (not (null? autoloads))
(apply module-autoload! module autoloads))))
- (case (car kws)
- ((#:use-module #:use-syntax)
- (or (pair? (cdr kws))
- (unrecognized kws))
- (let* ((interface-args (cadr kws))
- (interface (apply resolve-interface interface-args)))
- (and (eq? (car kws) #:use-syntax)
- (or (symbol? (caar interface-args))
- (error "invalid module name for use-syntax"
- (car interface-args)))
- (set-module-transformer!
- module
- (module-ref interface
- (car (last-pair (car interface-args)))
- #f)))
- (loop (cddr kws)
- (cons interface reversed-interfaces)
- exports
- re-exports
- replacements
+ (case (car kws)
+ ((#:use-module #:use-syntax)
+ (or (pair? (cdr kws))
+ (unrecognized kws))
+ (let* ((interface-args (cadr kws))
+ (interface (apply resolve-interface interface-args)))
+ (and (eq? (car kws) #:use-syntax)
+ (or (symbol? (caar interface-args))
+ (error "invalid module name for use-syntax"
+ (car interface-args)))
+ (set-module-transformer!
+ module
+ (module-ref interface
+ (car (last-pair (car interface-args)))
+ #f)))
+ (loop (cddr kws)
+ (cons interface reversed-interfaces)
+ exports
+ re-exports
+ replacements
autoloads)))
- ((#:autoload)
- (or (and (pair? (cdr kws)) (pair? (cddr kws)))
- (unrecognized kws))
- (loop (cdddr kws)
+ ((#:autoload)
+ (or (and (pair? (cdr kws)) (pair? (cddr kws)))
+ (unrecognized kws))
+ (loop (cdddr kws)
reversed-interfaces
- exports
- re-exports
- replacements
+ exports
+ re-exports
+ replacements
(let ((name (cadr kws))
(bindings (caddr kws)))
(cons* name bindings autoloads))))
- ((#:no-backtrace)
- (set-system-module! module #t)
- (loop (cdr kws) reversed-interfaces exports re-exports
+ ((#:no-backtrace)
+ (set-system-module! module #t)
+ (loop (cdr kws) reversed-interfaces exports re-exports
replacements autoloads))
- ((#:pure)
- (purify-module! module)
- (loop (cdr kws) reversed-interfaces exports re-exports
+ ((#:pure)
+ (purify-module! module)
+ (loop (cdr kws) reversed-interfaces exports re-exports
replacements autoloads))
- ((#:duplicates)
- (if (not (pair? (cdr kws)))
- (unrecognized kws))
- (set-module-duplicates-handlers!
- module
- (lookup-duplicates-handlers (cadr kws)))
- (loop (cddr kws) reversed-interfaces exports re-exports
+ ((#:duplicates)
+ (if (not (pair? (cdr kws)))
+ (unrecognized kws))
+ (set-module-duplicates-handlers!
+ module
+ (lookup-duplicates-handlers (cadr kws)))
+ (loop (cddr kws) reversed-interfaces exports re-exports
replacements autoloads))
- ((#:export #:export-syntax)
- (or (pair? (cdr kws))
- (unrecognized kws))
- (loop (cddr kws)
- reversed-interfaces
- (append (cadr kws) exports)
- re-exports
- replacements
+ ((#:export #:export-syntax)
+ (or (pair? (cdr kws))
+ (unrecognized kws))
+ (loop (cddr kws)
+ reversed-interfaces
+ (append (cadr kws) exports)
+ re-exports
+ replacements
autoloads))
- ((#:re-export #:re-export-syntax)
- (or (pair? (cdr kws))
- (unrecognized kws))
- (loop (cddr kws)
- reversed-interfaces
- exports
- (append (cadr kws) re-exports)
- replacements
+ ((#:re-export #:re-export-syntax)
+ (or (pair? (cdr kws))
+ (unrecognized kws))
+ (loop (cddr kws)
+ reversed-interfaces
+ exports
+ (append (cadr kws) re-exports)
+ replacements
autoloads))
- ((#:replace #:replace-syntax)
- (or (pair? (cdr kws))
- (unrecognized kws))
- (loop (cddr kws)
- reversed-interfaces
- exports
- re-exports
- (append (cadr kws) replacements)
+ ((#:replace #:replace-syntax)
+ (or (pair? (cdr kws))
+ (unrecognized kws))
+ (loop (cddr kws)
+ reversed-interfaces
+ exports
+ re-exports
+ (append (cadr kws) replacements)
autoloads))
- (else
- (unrecognized kws)))))
+ (else
+ (unrecognized kws)))))
(run-hook module-defined-hook module)
module))
(error "define-macro can only be used at the top level")))))
-(defmacro define-syntax-macro (first . rest)
- (let ((name (if (symbol? first) first (car first)))
- (transformer
- (if (symbol? first)
- (car rest)
- `(lambda ,(cdr first) ,@rest))))
- `(eval-case
- ((load-toplevel compile-toplevel)
- (define ,name (defmacro:syntax-transformer ,transformer)))
- (else
- (error "define-syntax-macro can only be used at the top level")))))
-
\f
;;; {While}
;; This is probably a bug in syncase.
;;
(define-macro (while cond . body)
- (define (while-helper proc)
- (do ((key (make-symbol "while-key")))
- ((catch key
- (lambda ()
- (proc (lambda () (throw key #t))
- (lambda () (throw key #f))))
- (lambda (key arg) arg)))))
- `(,while-helper (,lambda (break continue)
- (do ()
- ((,not ,cond))
- ,@body)
- #t)))
+ (let ((key (make-symbol "while-key")))
+ `(do ()
+ ((catch ',key
+ (lambda ()
+ (let ((break (lambda () (throw ',key #t)))
+ (continue (lambda () (throw ',key #f))))
+ (do ()
+ ((not ,cond))
+ ,@body)
+ #t))
+ (lambda (key arg)
+ arg))))))
\f
;; Return a list of expressions that evaluate to the appropriate
;; arguments for resolve-interface according to SPEC.
+(eval-case
+ ((compile-toplevel)
+ (if (memq 'prefix (read-options))
+ (error "boot-9 must be compiled with #:kw, not :kw"))))
+
(define (compile-interface-spec spec)
(define (make-keyarg sym key quote?)
(cond ((or (memq sym spec)
;; Indeed, all references to global variables are memoized into such
;; variable objects.
+;; FIXME: these don't work with the compiler
(define-macro (@ mod-name var-name)
(let ((var (module-variable (resolve-interface mod-name) var-name)))
(if (not var)
;; scmsigs.c scm_sigaction_for_thread), so the handlers setup here have
;; no effect.
(let ((old-handlers #f)
+ (start-repl (module-ref (resolve-interface '(system repl repl))
+ 'start-repl))
(signals (if (provided? 'posix)
`((,SIGINT . "User interrupt")
(,SIGFPE . "Arithmetic error")
;; the protected thunk.
(lambda ()
- (let ((status (scm-style-repl)))
+ (let ((status (start-repl 'scheme)))
(run-hook exit-hook)
status))
(provided? sym)))
(begin-deprecated
- (primitive-load-path "ice-9/deprecated.scm"))
+ (primitive-load-path "ice-9/deprecated"))
\f
HCoop / bpt / guile.git / blobdiff