diff options
author | Andy Wingo <wingo@pobox.com> | 2009-01-30 11:41:02 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-01-30 11:41:02 +0100 |
commit | 5d6fb8bbeb5a6ab423062da3744ca215b0310dc2 (patch) | |
tree | 128189158c6fab48f2e2595129b0c4fc67484496 /module/system/base/language.scm | |
parent | 4b3184828416acfa5c099a54954ca00ce3cc0d0d (diff) | |
download | guile-5d6fb8bbeb5a6ab423062da3744ca215b0310dc2.tar.gz |
allow specification of languages by name; add decompilers to languages
* module/system/base/language.scm (lookup-decompilation-order): New
function, like its compiling cousin, but backwards.
(compute-translation-order): Rework so that languages can be specified
either by name or by identity. Return a list of language - procedure
pairs, without the "to" language in the list, instead of a list of
languages.
(invalidate-compilation-cache!): Invalidate the decompilation cache
too.
(<language>): Add a decompiler field.
* module/system/base/compile.scm (compile-passes): Much simpler now that
lookup-compilation-order gives us the procedures directly.
* module/language/*/spec.scm: Specify compilers by name, so that we can
avoid unnecessary module loads, and so that when we specify
decompilers, we can avoid cycles.
Diffstat (limited to 'module/system/base/language.scm')
-rw-r--r-- | module/system/base/language.scm | 47 |
1 files changed, 34 insertions, 13 deletions
diff --git a/module/system/base/language.scm b/module/system/base/language.scm index 208e0e128..23ae88ea3 100644 --- a/module/system/base/language.scm +++ b/module/system/base/language.scm @@ -24,9 +24,10 @@ #:export (define-language lookup-language make-language language-name language-title language-version language-reader language-printer language-parser language-read-file - language-compilers language-evaluator + language-compilers language-decompilers language-evaluator - lookup-compilation-order invalidate-compilation-cache!)) + lookup-compilation-order lookup-decompilation-order + invalidate-compilation-cache!)) ;;; @@ -42,6 +43,7 @@ (parser #f) (read-file #f) (compilers '()) + (decompilers '()) (evaluator #f)) (define-macro (define-language name . spec) @@ -56,20 +58,39 @@ (error "no such language" name)))) (define *compilation-cache* '()) +(define *decompilation-cache* '()) (define (invalidate-compilation-cache!) + (set! *decompilation-cache* '()) (set! *compilation-cache* '())) -(define (compute-compilation-order from to) - (let lp ((from from) (seen '())) - (cond ((eq? from to) (reverse! (cons from seen))) - ((memq from seen) #f) - (else (or-map (lambda (lang) (lp lang (cons from seen))) - (map car (language-compilers from))))))) +(define (compute-translation-order from to language-translators) + (cond + ((not (language? to)) + (compute-translation-order from (lookup-language to) language-translators)) + (else + (let lp ((from from) (seen '())) + (cond + ((not (language? from)) + (lp (lookup-language from) seen)) + ((eq? from to) (reverse! seen)) + ((memq from seen) #f) + (else (or-map (lambda (pair) + (lp (car pair) (acons from (cdr pair) seen))) + (language-translators from)))))))) (define (lookup-compilation-order from to) - (or (assoc-ref *compilation-cache* (cons from to)) - (let ((order (compute-compilation-order from to))) - (set! *compilation-cache* - (acons (cons from to) order *compilation-cache*)) - order))) + (let ((key (cons from to))) + (or (assoc-ref *compilation-cache* key) + (let ((order (compute-translation-order from to language-compilers))) + (set! *compilation-cache* + (acons key order *compilation-cache*)) + order)))) + +(define (lookup-decompilation-order from to) + (let ((key (cons from to))) + (or (assoc-ref *decompilation-cache* key) + (let ((order (compute-translation-order from to language-decompilers))) + (set! *decompilation-cache* + (acons key order *decompilation-cache*)) + order)))) |