1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +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:
Andy Wingo 2013-10-31 14:17:30 +01:00
parent 30b7cf9df0
commit b73a2ee017
6 changed files with 24 additions and 10 deletions

View file

@ -22,6 +22,7 @@
#:use-module (system base compile)
#:use-module (system base language)
#:use-module (system vm program)
#:use-module (system vm objcode)
#:replace (eval-string))
(define (ensure-language x)
@ -84,5 +85,6 @@
(set-port-column! port line))
(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))))))))

View file

@ -20,12 +20,23 @@
(define-module (language rtl spec)
#:use-module (system base language)
#:use-module (system vm objcode)
#:use-module (ice-9 binary-ports)
#: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
#:title "Register Transfer Language"
#:compilers '()
#:compilers `((value . ,rtl->value))
#:printer (lambda (rtl port) (put-bytevector port rtl))
#:reader get-bytevector-all
#:for-humans? #f)

View file

@ -44,7 +44,7 @@
#:printer write-tree-il
#:parser parse-tree-il
#:joiner join
#:compilers `((glil . ,compile-glil)
(cps . ,compile-cps))
#:compilers `((cps . ,compile-cps)
(glil . ,compile-glil))
#:for-humans? #f
)

View file

@ -1,6 +1,6 @@
;;; 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
;; 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)
o)))
(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))
(input-files (assoc-ref options 'input-files))
(output-file (assoc-ref options 'output-file))

View file

@ -133,7 +133,7 @@
(define* (compile-file file #:key
(output-file #f)
(from (current-language))
(to 'objcode)
(to 'rtl)
(env (default-environment from))
(opts '())
(canonicalization 'relative))
@ -207,7 +207,7 @@
(define* (read-and-compile port #:key
(from (current-language))
(to 'objcode)
(to 'rtl)
(env (default-environment from))
(opts '()))
(let ((from (ensure-language from))

View file

@ -25,6 +25,7 @@
#:use-module (system base language)
#:use-module (system base message)
#:use-module (system vm program)
#:use-module (system vm objcode)
#:autoload (language tree-il optimize) (optimize)
#:use-module (ice-9 control)
#: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)
(let ((from (repl-language 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))))
(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)))
(repl-option-ref repl 'interp)))
(lambda () (eval form (current-module)))
(make-program (repl-compile repl form)))))
(load-thunk-from-memory (repl-compile repl form)))))
(define (repl-eval repl form)
(let ((thunk (repl-prepare-eval-thunk repl form)))