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

actually use syncase's source information tracking. rock!

Browse source 
* module/ice-9/annotate.scm (deannotate/source-properties): Version of
  deannotate that sets source properties on the resulting expressions.

* module/ice-9/syncase.scm (sc-macro, syncase): Annotate expressions
  before they go into syncase, and deannotate/source-properties when they
  come out. The upshot is that syncase now understands source
  information, yay!
This commit is contained in:
Andy Wingo 2009-03-06 19:50:11 +01:00
parent 35289f24ee
commit 7118c8050c
2 changed files with 18 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

17
module/ice-9/annotate.scm
View file

@ -19,7 +19,8 @@
(define-module (ice-9 annotate) (define-module (ice-9 annotate)
:export (<annotation> annotation? annotate deannotate make-annotation :export (<annotation> annotation? annotate deannotate make-annotation
annotation-expression annotation-source annotation-stripped annotation-expression annotation-source annotation-stripped
set-annotation-stripped!)) set-annotation-stripped!
deannotate/source-properties))
(define <annotation> (define <annotation>
(make-vtable "prprpw" (make-vtable "prprpw"
@ -63,3 +64,17 @@
(cons (deannotate (car e)) (deannotate (cdr e)))) (cons (deannotate (car e)) (deannotate (cdr e))))
((annotation? e) (deannotate (annotation-expression e))) ((annotation? e) (deannotate (annotation-expression e)))
(else e))) (else e)))
(define (deannotate/source-properties e)
(cond ((list? e)
(map deannotate/source-properties e))
((pair? e)
(cons (deannotate/source-properties (car e))
(deannotate/source-properties (cdr e))))
((annotation? e)
(let ((e (deannotate/source-properties (annotation-expression e)))
(source (annotation-source e)))
(if (pair? e)
(set-source-properties! e source))
e))
(else e)))

4
module/ice-9/syncase.scm
View file

@ -47,7 +47,7 @@
(procedure->memoizing-macro (procedure->memoizing-macro
(lambda (exp env) (lambda (exp env)
(with-fluids ((expansion-eval-closure (env->eval-closure env))) (with-fluids ((expansion-eval-closure (env->eval-closure env)))
(sc-expand exp))))) (deannotate/source-properties (sc-expand (annotate exp)))))))
;;; Exported variables ;;; Exported variables
@ -235,7 +235,7 @@
(define (syncase exp) (define (syncase exp)
(with-fluids ((expansion-eval-closure (with-fluids ((expansion-eval-closure
(module-eval-closure (current-module)))) (module-eval-closure (current-module))))
(sc-expand exp))) (deannotate/source-properties (sc-expand (annotate exp)))))
(set-module-transformer! the-syncase-module syncase) (set-module-transformer! the-syncase-module syncase)