summaryrefslogtreecommitdiff
path: root/module/system/base/language.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-01-30 11:41:02 +0100
committerAndy Wingo <wingo@pobox.com>2009-01-30 11:41:02 +0100
commit5d6fb8bbeb5a6ab423062da3744ca215b0310dc2 (patch)
tree128189158c6fab48f2e2595129b0c4fc67484496 /module/system/base/language.scm
parent4b3184828416acfa5c099a54954ca00ce3cc0d0d (diff)
downloadguile-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.scm47
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))))