mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-01 12:20:26 +02:00
Default to compiling to RTL
* module/ice-9/eval-string.scm (eval-string) * module/language/tree-il/spec.scm (tree-il) * module/scripts/compile.scm (compile) * module/system/base/compile.scm (compile-file, read-and-compile) * module/system/repl/common.scm (repl-compile, repl-prepare-eval-thunk): Default to compiling to RTL. * module/language/rtl/spec.scm (rtl->value): Add value compiler.
This commit is contained in:
parent
30b7cf9df0
commit
b73a2ee017
6 changed files with 24 additions and 10 deletions
|
@ -22,6 +22,7 @@
|
||||||
#:use-module (system base compile)
|
#:use-module (system base compile)
|
||||||
#:use-module (system base language)
|
#:use-module (system base language)
|
||||||
#:use-module (system vm program)
|
#:use-module (system vm program)
|
||||||
|
#:use-module (system vm objcode)
|
||||||
#:replace (eval-string))
|
#:replace (eval-string))
|
||||||
|
|
||||||
(define (ensure-language x)
|
(define (ensure-language x)
|
||||||
|
@ -84,5 +85,6 @@
|
||||||
(set-port-column! port line))
|
(set-port-column! port line))
|
||||||
|
|
||||||
(if (or compile? (not (language-evaluator lang)))
|
(if (or compile? (not (language-evaluator lang)))
|
||||||
((make-program (read-and-compile port #:from lang #:to 'objcode)))
|
((load-thunk-from-memory
|
||||||
|
(read-and-compile port #:from lang #:to 'rtl)))
|
||||||
(read-and-eval port #:lang lang))))))))
|
(read-and-eval port #:lang lang))))))))
|
||||||
|
|
|
@ -20,12 +20,23 @@
|
||||||
|
|
||||||
(define-module (language rtl spec)
|
(define-module (language rtl spec)
|
||||||
#:use-module (system base language)
|
#:use-module (system base language)
|
||||||
|
#:use-module (system vm objcode)
|
||||||
#:use-module (ice-9 binary-ports)
|
#:use-module (ice-9 binary-ports)
|
||||||
#:export (rtl))
|
#:export (rtl))
|
||||||
|
|
||||||
|
(define (rtl->value x e opts)
|
||||||
|
(let ((thunk (load-thunk-from-memory x)))
|
||||||
|
(if (eq? e (current-module))
|
||||||
|
;; save a cons in this case
|
||||||
|
(values (thunk) e e)
|
||||||
|
(save-module-excursion
|
||||||
|
(lambda ()
|
||||||
|
(set-current-module e)
|
||||||
|
(values (thunk) e e))))))
|
||||||
|
|
||||||
(define-language rtl
|
(define-language rtl
|
||||||
#:title "Register Transfer Language"
|
#:title "Register Transfer Language"
|
||||||
#:compilers '()
|
#:compilers `((value . ,rtl->value))
|
||||||
#:printer (lambda (rtl port) (put-bytevector port rtl))
|
#:printer (lambda (rtl port) (put-bytevector port rtl))
|
||||||
#:reader get-bytevector-all
|
#:reader get-bytevector-all
|
||||||
#:for-humans? #f)
|
#:for-humans? #f)
|
||||||
|
|
|
@ -44,7 +44,7 @@
|
||||||
#:printer write-tree-il
|
#:printer write-tree-il
|
||||||
#:parser parse-tree-il
|
#:parser parse-tree-il
|
||||||
#:joiner join
|
#:joiner join
|
||||||
#:compilers `((glil . ,compile-glil)
|
#:compilers `((cps . ,compile-cps)
|
||||||
(cps . ,compile-cps))
|
(glil . ,compile-glil))
|
||||||
#:for-humans? #f
|
#:for-humans? #f
|
||||||
)
|
)
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; Compile --- Command-line Guile Scheme compiler -*- coding: iso-8859-1 -*-
|
;;; Compile --- Command-line Guile Scheme compiler -*- coding: iso-8859-1 -*-
|
||||||
|
|
||||||
;; Copyright 2005,2008,2009,2010,2011 Free Software Foundation, Inc.
|
;; Copyright 2005,2008,2009,2010,2011,2013 Free Software Foundation, Inc.
|
||||||
;;
|
;;
|
||||||
;; This program is free software; you can redistribute it and/or
|
;; This program is free software; you can redistribute it and/or
|
||||||
;; modify it under the terms of the GNU Lesser General Public License
|
;; modify it under the terms of the GNU Lesser General Public License
|
||||||
|
@ -139,7 +139,7 @@ There is NO WARRANTY, to the extent permitted by law.~%"))
|
||||||
(cons #:O o)
|
(cons #:O o)
|
||||||
o)))
|
o)))
|
||||||
(from (or (assoc-ref options 'from) 'scheme))
|
(from (or (assoc-ref options 'from) 'scheme))
|
||||||
(to (or (assoc-ref options 'to) 'objcode))
|
(to (or (assoc-ref options 'to) 'rtl))
|
||||||
(target (or (assoc-ref options 'target) %host-type))
|
(target (or (assoc-ref options 'target) %host-type))
|
||||||
(input-files (assoc-ref options 'input-files))
|
(input-files (assoc-ref options 'input-files))
|
||||||
(output-file (assoc-ref options 'output-file))
|
(output-file (assoc-ref options 'output-file))
|
||||||
|
|
|
@ -133,7 +133,7 @@
|
||||||
(define* (compile-file file #:key
|
(define* (compile-file file #:key
|
||||||
(output-file #f)
|
(output-file #f)
|
||||||
(from (current-language))
|
(from (current-language))
|
||||||
(to 'objcode)
|
(to 'rtl)
|
||||||
(env (default-environment from))
|
(env (default-environment from))
|
||||||
(opts '())
|
(opts '())
|
||||||
(canonicalization 'relative))
|
(canonicalization 'relative))
|
||||||
|
@ -207,7 +207,7 @@
|
||||||
|
|
||||||
(define* (read-and-compile port #:key
|
(define* (read-and-compile port #:key
|
||||||
(from (current-language))
|
(from (current-language))
|
||||||
(to 'objcode)
|
(to 'rtl)
|
||||||
(env (default-environment from))
|
(env (default-environment from))
|
||||||
(opts '()))
|
(opts '()))
|
||||||
(let ((from (ensure-language from))
|
(let ((from (ensure-language from))
|
||||||
|
|
|
@ -25,6 +25,7 @@
|
||||||
#:use-module (system base language)
|
#:use-module (system base language)
|
||||||
#:use-module (system base message)
|
#:use-module (system base message)
|
||||||
#:use-module (system vm program)
|
#:use-module (system vm program)
|
||||||
|
#:use-module (system vm objcode)
|
||||||
#:autoload (language tree-il optimize) (optimize)
|
#:autoload (language tree-il optimize) (optimize)
|
||||||
#:use-module (ice-9 control)
|
#:use-module (ice-9 control)
|
||||||
#:use-module (ice-9 history)
|
#:use-module (ice-9 history)
|
||||||
|
@ -176,7 +177,7 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
|
||||||
(define (repl-compile repl form)
|
(define (repl-compile repl form)
|
||||||
(let ((from (repl-language repl))
|
(let ((from (repl-language repl))
|
||||||
(opts (repl-compile-options repl)))
|
(opts (repl-compile-options repl)))
|
||||||
(compile form #:from from #:to 'objcode #:opts opts
|
(compile form #:from from #:to 'rtl #:opts opts
|
||||||
#:env (current-module))))
|
#:env (current-module))))
|
||||||
|
|
||||||
(define (repl-expand repl form)
|
(define (repl-expand repl form)
|
||||||
|
@ -205,7 +206,7 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
|
||||||
(or (null? (language-compilers (repl-language repl)))
|
(or (null? (language-compilers (repl-language repl)))
|
||||||
(repl-option-ref repl 'interp)))
|
(repl-option-ref repl 'interp)))
|
||||||
(lambda () (eval form (current-module)))
|
(lambda () (eval form (current-module)))
|
||||||
(make-program (repl-compile repl form)))))
|
(load-thunk-from-memory (repl-compile repl form)))))
|
||||||
|
|
||||||
(define (repl-eval repl form)
|
(define (repl-eval repl form)
|
||||||
(let ((thunk (repl-prepare-eval-thunk repl form)))
|
(let ((thunk (repl-prepare-eval-thunk repl form)))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue