* module/language/scheme/amatch.scm: Remove, this approach won't be used.
* module/Makefile.am: Adjust for additions and removals.
* module/language/scheme/compile-ghil.scm: Remove an vestigial debugging
statement.
* module/language/scheme/spec.scm:
* module/language/scheme/compile-tree-il.scm:
* module/language/scheme/decompile-tree-il.scm: Add tree-il compiler and
decompiler.
* module/language/tree-il/compile-glil.scm: Add some notes.
* module/language/tree-il/spec.scm: No need to wrap expressions in
lambdas -- GHIL needs somewhere to put its variables, we don't.
$(srcdir)/ice-9/psyntax.scm $(srcdir)/ice-9/psyntax-pp.scm
SCHEME_LANG_SOURCES = \
- language/scheme/amatch.scm \
- language/scheme/compile-ghil.scm language/scheme/spec.scm \
+ language/scheme/compile-ghil.scm \
+ language/scheme/spec.scm \
+ language/scheme/compile-tree-il.scm \
+ language/scheme/decompile-tree-il.scm \
language/scheme/inline.scm
TREE_IL_LANG_SOURCES = \
+++ /dev/null
-(define-module (language scheme amatch)
- #:export (amatch))
-
-;; This is exactly the same as pmatch except that it unpacks annotations
-;; as needed.
-
-(define-syntax amatch
- (syntax-rules (else guard)
- ((_ (op arg ...) cs ...)
- (let ((v (op arg ...)))
- (amatch v cs ...)))
- ((_ v) (if #f #f))
- ((_ v (else e0 e ...)) (begin e0 e ...))
- ((_ v (pat (guard g ...) e0 e ...) cs ...)
- (let ((fk (lambda () (amatch v cs ...))))
- (apat v pat
- (if (and g ...) (begin e0 e ...) (fk))
- (fk))))
- ((_ v (pat e0 e ...) cs ...)
- (let ((fk (lambda () (amatch v cs ...))))
- (apat v pat (begin e0 e ...) (fk))))))
-
-(define-syntax apat
- (syntax-rules (_ quote unquote)
- ((_ v _ kt kf) kt)
- ((_ v () kt kf) (if (null? v) kt kf))
- ((_ v (quote lit) kt kf)
- (if (equal? v (quote lit)) kt kf))
- ((_ v (unquote var) kt kf) (let ((var v)) kt))
- ((_ v (x . y) kt kf)
- (if (apair? v)
- (let ((vx (acar v)) (vy (acdr v)))
- (apat vx x (apat vy y kt kf) kf))
- kf))
- ((_ v lit kt kf) (if (eq? v (quote lit)) kt kf))))
#:export (compile-ghil translate-1
*translate-table* define-scheme-translator))
-(module-ref (current-module) 'receive)
-
;;; environment := #f
;;; | MODULE
;;; | COMPILE-ENV
--- /dev/null
+;;; Guile Scheme specification
+
+;; Copyright (C) 2001 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (language scheme compile-tree-il)
+ #:use-module (language tree-il)
+ #:export (compile-tree-il))
+
+;;; environment := #f
+;;; | MODULE
+;;; | COMPILE-ENV
+;;; compile-env := (MODULE LEXICALS . EXTERNALS)
+(define (cenv-module env)
+ (cond ((not env) #f)
+ ((module? env) env)
+ ((and (pair? env) (module? (car env))) (car env))
+ (else (error "bad environment" env))))
+
+(define (cenv-lexicals env)
+ (cond ((not env) '())
+ ((module? env) '())
+ ((pair? env) (cadr env))
+ (else (error "bad environment" env))))
+
+(define (cenv-externals env)
+ (cond ((not env) '())
+ ((module? env) '())
+ ((pair? env) (cddr env))
+ (else (error "bad environment" env))))
+
+(define (make-cenv module lexicals externals)
+ (cons module (cons lexicals externals)))
+
+(define (location x)
+ (and (pair? x)
+ (let ((props (source-properties x)))
+ (and (not (null? props))
+ props))))
+
+(define (compile-tree-il x e opts)
+ (save-module-excursion
+ (lambda ()
+ (and=> (cenv-module e) set-current-module)
+ (let ((x (sc-expand x 'c '(compile load eval)))
+ (cenv (make-cenv (current-module)
+ (cenv-lexicals e) (cenv-externals e))))
+ (values x cenv cenv)))))
--- /dev/null
+;;; Guile VM code converters
+
+;; Copyright (C) 2001,2009 Free Software Foundation, Inc.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; see the file COPYING. If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(define-module (language scheme decompile-tree-il)
+ #:use-module (language tree-il)
+ #:export (decompile-tree-il))
+
+(define (decompile-tree-il x env opts)
+ (values (tree-il->scheme x) env))
(define-module (language scheme spec)
#:use-module (system base language)
#:use-module (language scheme compile-ghil)
+ #:use-module (language scheme compile-tree-il)
+ #:use-module (language scheme decompile-tree-il)
#:export (scheme))
;;;
#:version "0.5"
#:reader read
#:read-file read-file
- #:compilers `((ghil . ,compile-ghil))
+ #:compilers `((ghil . ,compile-ghil)
+ (tree-il . ,compile-tree-il))
+ #:decompilers `((tree-il . ,decompile-tree-il))
#:evaluator (lambda (x module) (primitive-eval x))
#:printer write
)
;;; TREE-IL -> GLIL compiler
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2001,2008,2009 Free Software Foundation, Inc.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
(ghil-env-add! parent-env v))
(ghil-env-variables env))))
+;; Possible optimizations:
+;; * compile primitives specially
+;; * turn global-refs into primitive-refs
+;; * constant folding, propagation
+;; * procedure inlining
+;; * always when single call site
+;; * always for "trivial" procs
+;; * otherwise who knows
+;; * dead code elimination
+;; * degenerate case optimizations
+
+
;; The premise of this, unused, approach to optimization is that you can
;; determine the environment of a variable lexically, because they have
;; been alpha-renamed. It makes the transformations *much* easier.
(define (write-tree-il exp . port)
(apply write (unparse-tree-il exp) port))
-(define (parse x)
- (make-lambda #f '() '() (parse-tree-il x)))
-
(define (join exps env)
- (if (or-map (lambda (x)
- (or (not (lambda? x))
- (not (null? (lambda-vars x)))))
- exps)
- (error "tree-il expressions to join must be thunks"))
-
- (make-lambda #f '() '() (make-sequence #f (map lambda-body exps))))
+ (make-sequence #f exps))
(define-language tree-il
#:title "Tree Intermediate Language"
#:version "1.0"
#:reader read
#:printer write-tree-il
- #:parser parse
+ #:parser parse-tree-il
#:joiner join
#:compilers `((glil . ,compile-glil))
)
HCoop / bpt / guile.git / commitdiff