1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00

Wire up the baseline compiler to -O0

* module/language/tree-il/spec.scm (join): Use match rather than
  pmatch.
  (tree-il): Declare compiler to bytecode.
  (choose-compiler): New implementation.  Note, the baseline compiler
  probably doesn't even work!!!
This commit is contained in:
Andy Wingo 2020-05-08 23:07:30 +02:00
parent f711ab85b2
commit b5a52b4961

View file

@ -20,9 +20,10 @@
(define-module (language tree-il spec) (define-module (language tree-il spec)
#:use-module (system base language) #:use-module (system base language)
#:use-module (system base pmatch) #:use-module (ice-9 match)
#:use-module (language tree-il) #:use-module (language tree-il)
#:use-module (language tree-il compile-cps) #:use-module (language tree-il compile-cps)
#:use-module (language tree-il compile-bytecode)
#:use-module ((language tree-il analyze) #:select (make-analyzer)) #:use-module ((language tree-il analyze) #:select (make-analyzer))
#:use-module ((language tree-il optimize) #:select (make-lowerer)) #:use-module ((language tree-il optimize) #:select (make-lowerer))
#:export (tree-il)) #:export (tree-il))
@ -31,12 +32,19 @@
(apply write (unparse-tree-il exp) port)) (apply write (unparse-tree-il exp) port))
(define (join exps env) (define (join exps env)
(pmatch exps (match exps
(() (make-void #f)) (() (make-void #f))
((,x) x) ((x) x)
((,x . ,rest) ((x . rest)
(make-seq #f x (join rest env))) (make-seq #f x (join rest env)))
(else (error "what!" exps env)))) (_ (error "what!" exps env))))
(define (choose-compiler target optimization-level opts)
(if (match (memq #:cps? opts)
((_ cps? . _) cps?)
(#f (<= 1 optimization-level)))
(cons 'cps compile-cps)
(cons 'bytecode compile-bytecode)))
(define-language tree-il (define-language tree-il
#:title "Tree Intermediate Language" #:title "Tree Intermediate Language"
@ -44,7 +52,9 @@
#:printer write-tree-il #:printer write-tree-il
#:parser parse-tree-il #:parser parse-tree-il
#:joiner join #:joiner join
#:compilers `((cps . ,compile-cps)) #:compilers `((cps . ,compile-cps)
(bytecode . ,compile-bytecode))
#:compiler-chooser choose-compiler
#:analyzer make-analyzer #:analyzer make-analyzer
#:lowerer make-lowerer #:lowerer make-lowerer
#:for-humans? #f) #:for-humans? #f)