mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 21:40:33 +02:00
Code Activity

Beginnings of psyntax switch to new syntax objects

Browse source 
* module/ice-9/psyntax.scm: Baby steps towards support of a new
  representation of syntax objects.
* module/ice-9/psyntax-pp.scm: Regenerate.
This commit is contained in:
Andy Wingo 2017-03-27 20:38:55 +02:00
parent 64c5cc58fc
commit eb84c2f2da
2 changed files with 2659 additions and 2630 deletions
Download patch file Download diff file Expand all files Collapse all files

5262
module/ice-9/psyntax-pp.scm
View file

File diff suppressed because it is too large Load diff

27
module/ice-9/psyntax.scm
View file

@ -165,7 +165,12 @@
(eval-when (compile)
(set-current-module (resolve-module '(guile))))
(let ()
(let ((syntax? (module-ref (current-module) 'syntax?))
(make-syntax (module-ref (current-module) 'make-syntax))
(syntax-expression (module-ref (current-module) 'syntax-expression))
(syntax-wrap (module-ref (current-module) 'syntax-wrap))
(syntax-module (module-ref (current-module) 'syntax-module)))
(define-syntax define-expansion-constructors
(lambda (x)
(syntax-case x ()
@ -466,7 +471,25 @@
;; 'gensym' so that the generated identifier is reproducible.
(module-gensym (symbol->string id)))
(define-structure (syntax-object expression wrap module))
(define (syntax-object? x)
(or (syntax? x)
(and (vector? x)
(= (vector-length x) 4)
(eqv? (vector-ref x 0) 'syntax-object))))
(define (make-syntax-object expression wrap module)
(vector 'syntax-object expression wrap module))
(define (syntax-object-expression obj)
(if (syntax? obj)
(syntax-expression obj)
(vector-ref obj 1)))
(define (syntax-object-wrap obj)
(if (syntax? obj)
(syntax-wrap obj)
(vector-ref obj 2)))
(define (syntax-object-module obj)
(if (syntax? obj)
(syntax-module obj)
(vector-ref obj 3)))
(define-syntax no-source (identifier-syntax #f))