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

first stabs as s-expression-driven transformation of GHIL

Browse source 
* module/language/ghil/compile-glil.scm (optimize*): Rewritten optimizer
  -- not yet in use, but it's closer to the code that I'd like to write.

* module/system/base/syntax.scm (transform-record): New crazy macro,
  makes GHIL a little less painful to work with.
This commit is contained in:
Andy Wingo 2009-02-27 12:36:58 +01:00
parent 246be37e48
commit b106a3eddc
2 changed files with 167 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

95
module/language/ghil/compile-glil.scm
View file

@ -45,6 +45,101 @@
(ghil-env-add! parent-env v))
(ghil-env-variables env))))
(define-macro (->ghil x)
`(,(symbol-append 'make-ghil- (car x))
env loc
,@(map (lambda (y)
(if (and (pair? y) (eq? (car y) 'unquote))
(cadr y)
y))
(cdr x))))
(define (optimize* x)
(transform-record (<ghil> env loc) x
((quasiquote exp)
(define (optimize-qq x)
(cond ((list? x) (map optimize-qq x))
((pair? x) (cons (optimize-qq (car x)) (optimize-qq (cdr x))))
((record? x) (optimize x))
(else x)))
(->ghil
(quasiquote (optimize-qq x))))
((unquote exp)
(->ghil
(unquote (optimize exp))))
((unquote-splicing exp)
(->ghil
(unquote-splicing (optimize exp))))
((set var val)
(->ghil
(set var (optimize val))))
((define var val)
(->ghil
(define var (optimize val))))
((if test then else)
(->ghil
(if (optimize test) (optimize then) (optimize else))))
((and exps)
(->ghil
(and (map optimize exps))))
((or exps)
(->ghil
(or (map optimize exps))))
((begin exps)
(->ghil
(begin (map optimize exps))))
((bind vars vals body)
(->ghil
(bind vars (map optimize vals) (optimize body))))
((mv-bind producer vars rest body)
(->ghil
(mv-bind (optimize producer) vars rest (optimize body))))
((inline inst args)
(->ghil
(inline inst (map optimize args))))
((call (proc (lambda vars (rest #f) meta body)) args)
(->ghil
(bind vars (optimize args) (optimize body))))
((call proc args)
(->ghil
(call (optimize proc) (map optimize args))))
((lambda vars rest meta body)
(->ghil
(lambda vars rest meta (optimize body))))
((mv-call producer (consumer (lambda vars rest meta body)))
(->ghil
(mv-bind (optimize producer) vars rest (optimize body))))
((mv-call producer consumer)
(->ghil
(mv-call (optimize producer) (optimize consumer))))
((values values)
(->ghil
(values (map optimize values))))
((values* values)
(->ghil
(values* (map optimize values))))
(else
(error "unrecognized GHIL" x))))
(define (optimize x)
(record-case x
((<ghil-set> env loc var val)