1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 22:10:21 +02:00

more cleanups to boot-9/psyntax

* module/ice-9/boot-9.scm: Comment some more things.

* module/ice-9/psyntax.scm: Remove error-hook -- callers should just use
  syntax-violation. Change all callers.

* module/ice-9/psyntax-pp.scm: Regenerated.
This commit is contained in:
Andy Wingo 2009-04-29 23:39:09 +02:00
parent 4d24854111
commit 6a952e0ee9
3 changed files with 39 additions and 45 deletions

View file

@ -186,6 +186,9 @@
(define (resolve-module . args)
#f)
;; Output hook for syncase. It's here because we want to be able to
;; replace its definition, for compiling; but that isn't implemented
;; yet.
(define (make-module-ref mod var kind)
(case kind
((public) (if mod `(@ ,mod ,var) var))
@ -200,7 +203,12 @@
var))
(else (error "foo" mod var kind))))
;;; API provided by psyntax
;; Input hook to syncase -- so that we might be able to pass annotated
;; expressions in. Currently disabled. Maybe we should just use
;; source-properties directly.
(define (annotation? x) #f)
;; API provided by psyntax
(define syntax-violation #f)
(define datum->syntax #f)
(define syntax->datum #f)
@ -211,24 +219,21 @@
(define sc-expand #f)
(define sc-expand3 #f)
;;; Implementation detail of psyntax -- the thing that does expand-time
;;; dispatch for syntax-case macros
;; $sc-expand is an implementation detail of psyntax. It is used by
;; expanded macros, to dispatch an input against a set of patterns.
(define $sc-dispatch #f)
;;; Useless crap I'd like to get rid of
(define (annotation? x) #f)
;; Load it up!
(primitive-load-path "ice-9/psyntax-pp")
;; Until the module system is booted, this will be the current expander.
;; %pre-modules-transformer is the Scheme expander from now until the
;; module system has booted up.
(define %pre-modules-transformer sc-expand)
;;; {Defmacros}
;;;
;;; Depends on: features, eval-case
;;;
(define-syntax define-macro
(lambda (x)

File diff suppressed because one or more lines are too long

View file

@ -109,13 +109,6 @@
;;; by eval, and eval accepts one argument, nothing special must be done
;;; to support the "noexpand" flag, since it is handled by sc-expand.
;;;
;;; (error who format-string why what)
;;; where who is either a symbol or #f, format-string is always "~a ~s",
;;; why is always a string, and what may be any object. error should
;;; signal an error with a message something like
;;;
;;; "error in <who>: <why> <what>"
;;;
;;; (gensym)
;;; returns a unique symbol each time it's called
;;;
@ -325,10 +318,6 @@
(lambda (x mod)
(primitive-eval `(,noexpand ,x))))
(define error-hook
(lambda (who why what)
(error who "~a ~s" why what)))
(define-syntax gensym-hook
(syntax-rules ()
((_) (gensym))))
@ -488,7 +477,7 @@
(syntax-rules ()
((_ pred? e who)
(let ((x e))
(if (not (pred? x)) (error-hook who "invalid argument" x))))))
(if (not (pred? x)) (syntax-violation who "invalid argument" x))))))
;;; compile-time environments
@ -808,7 +797,7 @@
((annotation? id)
(let ((id (unannotate id)))
(or (first (search id (wrap-subst w) (wrap-marks w))) id)))
(else (error-hook 'id-var-name "invalid id" id)))))
(else (syntax-violation 'id-var-name "invalid id" id)))))
;;; free-id=? must be passed fully wrapped ids since (free-id=? x y)
;;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not.
@ -2315,20 +2304,20 @@
(syntax (begin exp ...))))))))
(define-syntax unquote
(lambda (x)
(syntax-case x ()
((_ e)
(error 'unquote
"expression ,~s not valid outside of quasiquote"
(syntax->datum (syntax e)))))))
(lambda (x)
(syntax-case x ()
((_ e)
(syntax-violation 'unquote
"expression not valid outside of quasiquote"
x)))))
(define-syntax unquote-splicing
(lambda (x)
(syntax-case x ()
((_ e)
(error 'unquote-splicing
"expression ,@~s not valid outside of quasiquote"
(syntax->datum (syntax e)))))))
(lambda (x)
(syntax-case x ()
((_ e)
(syntax-violation 'unquote-splicing
"expression not valid outside of quasiquote"
x)))))
(define-syntax case
(lambda (x)