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

syntax-object->datum => syntax->datum, likewise datum->syntax

* module/ice-9/boot-9.scm (datum->syntax, syntax->datum): Rename from
  datum->syntax-object and syntax-object->datum, following r6rs. Change
  all callers. Reorder some of the other exports from psyntax.

* module/ice-9/psyntax.scm: Change datum->syntax and syntax->datum
  definitions and callers.

* module/ice-9/psyntax-pp.scm: Regenerated.

* module/oop/goops.scm (define-class-pre-definition): Update for changes.
This commit is contained in:
Andy Wingo 2009-04-26 20:56:24 +02:00
parent e4721dde31
commit 22225fc113
4 changed files with 42 additions and 41 deletions

View file

@ -187,12 +187,13 @@
(define syntax-violation #f)
(define (annotation? x) #f)
(define bound-identifier=? #f)
(define datum->syntax-object #f)
(define free-identifier=? #f)
(define generate-temporaries #f)
(define datum->syntax #f)
(define syntax->datum #f)
(define identifier? #f)
(define syntax-object->datum #f)
(define generate-temporaries #f)
(define bound-identifier=? #f)
(define free-identifier=? #f)
(define andmap
(lambda (f first . rest)
@ -234,28 +235,28 @@
"Define a defmacro."
(syntax-case x ()
((_ (macro . args) doc body1 body ...)
(string? (syntax-object->datum (syntax doc)))
(string? (syntax->datum (syntax doc)))
(syntax (define-macro macro doc (lambda args body1 body ...))))
((_ (macro . args) body ...)
(syntax (define-macro macro #f (lambda args body ...))))
((_ macro doc transformer)
(or (string? (syntax-object->datum (syntax doc)))
(not (syntax-object->datum (syntax doc))))
(or (string? (syntax->datum (syntax doc)))
(not (syntax->datum (syntax doc))))
(syntax
(define-syntax macro
(lambda (y)
doc
(syntax-case y ()
((_ . args)
(let ((v (syntax-object->datum (syntax args))))
(datum->syntax-object y (apply transformer v))))))))))))
(let ((v (syntax->datum (syntax args))))
(datum->syntax y (apply transformer v))))))))))))
(define-syntax defmacro
(lambda (x)
"Define a defmacro, with the old lispy defun syntax."
(syntax-case x ()
((_ macro args doc body1 body ...)
(string? (syntax-object->datum (syntax doc)))
(string? (syntax->datum (syntax doc)))
(syntax (define-macro macro doc (lambda args body1 body ...))))
((_ macro args body ...)
(syntax (define-macro macro #f (lambda args body ...)))))))

File diff suppressed because one or more lines are too long

View file

@ -49,7 +49,7 @@
;;; also documented in the R4RS and draft R5RS.
;;;
;;; bound-identifier=?
;;; datum->syntax-object
;;; datum->syntax
;;; define-syntax
;;; fluid-let-syntax
;;; free-identifier=?
@ -60,7 +60,7 @@
;;; letrec-syntax
;;; syntax
;;; syntax-case
;;; syntax-object->datum
;;; syntax->datum
;;; syntax-rules
;;; with-syntax
;;;
@ -209,7 +209,7 @@
;;; Objects with no standard print syntax, including objects containing
;;; cycles and syntax object, are allowed in quoted data as long as they
;;; are contained within a syntax form or produced by datum->syntax-object.
;;; are contained within a syntax form or produced by datum->syntax.
;;; Such objects are never copied.
;;; All identifiers that don't have macro definitions and are not bound
@ -264,14 +264,14 @@
(lambda (x)
(define construct-name
(lambda (template-identifier . args)
(datum->syntax-object
(datum->syntax
template-identifier
(string->symbol
(apply string-append
(map (lambda (x)
(if (string? x)
x
(symbol->string (syntax-object->datum x))))
(symbol->string (syntax->datum x))))
args))))))
(syntax-case x ()
((_ (name id1 ...))
@ -1351,7 +1351,7 @@
(lambda (e docstring c r w mod k)
(syntax-case c ()
((args doc e1 e2 ...)
(and (string? (syntax-object->datum (syntax doc))) (not docstring))
(and (string? (syntax->datum (syntax doc))) (not docstring))
(chi-lambda-clause e (syntax doc) (syntax (args e1 e2 ...)) r w mod k))
(((id ...) e1 e2 ...)
(let ((ids (syntax (id ...))))
@ -1814,8 +1814,8 @@
(syntax-case e ()
((_ (mod ...) id)
(and (andmap id? (syntax (mod ...))) (id? (syntax id)))
(values (syntax-object->datum (syntax id))
(syntax-object->datum
(values (syntax->datum (syntax id))
(syntax->datum
(syntax (public mod ...))))))))
(global-extend 'module-ref '@@
@ -1823,8 +1823,8 @@
(syntax-case e ()
((_ (mod ...) id)
(and (andmap id? (syntax (mod ...))) (id? (syntax id)))
(values (syntax-object->datum (syntax id))
(syntax-object->datum
(values (syntax->datum (syntax id))
(syntax->datum
(syntax (private mod ...))))))))
(global-extend 'begin 'begin '())
@ -2004,11 +2004,11 @@
(lambda (x)
(nonsymbol-id? x)))
(set! datum->syntax-object
(set! datum->syntax
(lambda (id datum)
(make-syntax-object datum (syntax-object-wrap id) #f)))
(set! syntax-object->datum
(set! syntax->datum
; accepts any object, since syntax objects may consist partially
; or entirely of unwrapped, nonsymbolic data
(lambda (x)
@ -2292,11 +2292,11 @@
(let f ((x (read p)))
(if (eof-object? x)
(begin (close-input-port p) '())
(cons (datum->syntax-object k x)
(cons (datum->syntax k x)
(f (read p))))))))
(syntax-case x ()
((k filename)
(let ((fn (syntax-object->datum (syntax filename))))
(let ((fn (syntax->datum (syntax filename))))
(with-syntax (((exp ...) (read-file fn (syntax k))))
(syntax (begin exp ...))))))))
@ -2306,7 +2306,7 @@
((_ e)
(error 'unquote
"expression ,~s not valid outside of quasiquote"
(syntax-object->datum (syntax e)))))))
(syntax->datum (syntax e)))))))
(define-syntax unquote-splicing
(lambda (x)
@ -2314,7 +2314,7 @@
((_ e)
(error 'unquote-splicing
"expression ,@~s not valid outside of quasiquote"
(syntax-object->datum (syntax e)))))))
(syntax->datum (syntax e)))))))
(define-syntax case
(lambda (x)

View file

@ -241,8 +241,8 @@
(lambda (x)
(syntax-case x ()
((_ (k arg rest ...) out ...)
(keyword? (syntax-object->datum (syntax k)))
(case (syntax-object->datum (syntax k))
(keyword? (syntax->datum (syntax k)))
(case (syntax->datum (syntax k))
((#:getter #:setter)
(syntax
(define-class-pre-definition (rest ...)
@ -277,7 +277,7 @@
((_ () out ...)
(syntax (begin out ...)))
((_ (slot rest ...) out ...)
(keyword? (syntax-object->datum (syntax slot)))
(keyword? (syntax->datum (syntax slot)))
(syntax (begin out ...)))
((_ (slot rest ...) out ...)
(identifier? (syntax slot))