[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 01/05: Factor with-cps out to separate module
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 01/05: Factor with-cps out to separate module |
|
Date: |
Tue, 02 Jun 2015 10:23:02 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit bac96c10f51b17e06862fc85980242723cac6419
Author: Andy Wingo <address@hidden>
Date: Tue Jun 2 11:06:37 2015 +0200
Factor with-cps out to separate module
* module/language/cps2/with-cps.scm: New file.
* module/language/tree-il/compile-cps2.scm: Use (language cps2 with-cps).
* module/Makefile.am: Add language/cps2/with-cps.scm.
* .dir-locals.el: Add indentation rules for with-cps.
---
.dir-locals.el | 2 +
module/Makefile.am | 3 +-
module/language/cps2/with-cps.scm | 134 ++++++++++++++++++++++++++++++
module/language/tree-il/compile-cps2.scm | 107 +-----------------------
4 files changed, 139 insertions(+), 107 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index 895c112..5e213c5 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -15,6 +15,8 @@
(eval . (put 'let-fresh 'scheme-indent-function 2))
(eval . (put 'with-fresh-name-state 'scheme-indent-function 1))
(eval . (put 'with-fresh-name-state-from-dfg 'scheme-indent-function 1))
+ (eval . (put 'with-cps 'scheme-indent-function 1))
+ (eval . (put 'with-cps-constants 'scheme-indent-function 1))
(eval . (put 'build-cps-term 'scheme-indent-function 0))
(eval . (put 'build-cps-exp 'scheme-indent-function 0))
(eval . (put 'build-cps-cont 'scheme-indent-function 0))
diff --git a/module/Makefile.am b/module/Makefile.am
index 10f634c..b02a8f6 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -158,7 +158,8 @@ CPS2_LANG_SOURCES =
\
language/cps2/simplify.scm \
language/cps2/spec.scm \
language/cps2/types.scm \
- language/cps2/utils.scm
+ language/cps2/utils.scm \
+ language/cps2/with-cps.scm
BYTECODE_LANG_SOURCES = \
language/bytecode.scm \
diff --git a/module/language/cps2/with-cps.scm
b/module/language/cps2/with-cps.scm
new file mode 100644
index 0000000..354007e
--- /dev/null
+++ b/module/language/cps2/with-cps.scm
@@ -0,0 +1,134 @@
+;;; Continuation-passing style (CPS) intermediate language (IL)
+
+;; Copyright (C) 2013, 2014, 2015 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library 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
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+
+;;; Commentary:
+;;;
+;;; Guile's CPS language is a label->cont mapping, which seems simple
+;;; enough. However it's often cumbersome to thread around the output
+;;; CPS program when doing non-trivial transformations, or when building
+;;; a CPS program from scratch. For example, when visiting an
+;;; expression during CPS conversion, we usually already know the label
+;;; and the $kargs wrapper for the cont, and just need to know the body
+;;; of that cont. However when building the body of that possibly
+;;; nested Tree-IL expression we will also need to add conts to the
+;;; result, so really it's a process that takes an incoming program,
+;;; adds conts to that program, and returns the result program and the
+;;; result term.
+;;;
+;;; It's a bit treacherous to do in a functional style as once you start
+;;; adding to a program, you shouldn't add to previous versions of that
+;;; program. Getting that right in the context of this program seed
+;;; that is threaded through the conversion requires the use of a
+;;; pattern, with-cps.
+;;;
+;;; with-cps goes like this:
+;;;
+;;; (with-cps cps clause ... tail-clause)
+;;;
+;;; Valid clause kinds are:
+;;;
+;;; (letk LABEL CONT)
+;;; (letv VAR ...)
+;;; (let$ X (PROC ARG ...))
+;;;
+;;; letk and letv create fresh CPS labels and variable names,
+;;; respectively. Labels and vars bound by letk and letv are in scope
+;;; from their point of definition onward. letv just creates fresh
+;;; variable names for use in other parts of with-cps, while letk binds
+;;; fresh labels to values and adds them to the resulting program. The
+;;; right-hand-side of letk, CONT, is passed to build-cont, so it should
+;;; be a valid production of that language.
+;;;
+;;; let$ delegates processing to a sub-computation. The form (PROC ARG
+;;; ...) is syntactically altered to be (PROC CPS ARG ...), where CPS is
+;;; the value of the program being built, at that point in the
+;;; left-to-right with-cps execution. That form is is expected to
+;;; evaluate to two values: the new CPS term, and the value to bind to
+;;; X. X is in scope for the following with-cps clauses. The name was
+;;; chosen because the $ is reminiscent of the $ in CPS data types.
+;;;
+;;; The result of the with-cps form is determined by the tail clause,
+;;; which may be of these two kinds:
+;;;
+;;; ($ (PROC ARG ...))
+;;; EXP
+;;;
+;;; $ is like let$, but in tail position. Otherwise EXP is any kind of
+;;; expression, which should not add to the resulting program. Ending
+;;; the with-cps with EXP is equivalant to returning (values CPS EXP).
+;;;
+;;; It's a bit of a monad, innit? Don't tell anyone though!
+;;;
+;;; Sometimes you need to just bind some constants to CPS values.
+;;; with-cps-constants is there for you. For example:
+;;;
+;;; (with-cps-constants cps ((foo 34))
+;;; (build-term ($values (foo))))
+;;;
+;;; The body of with-cps-constants is a with-cps clause, or a sequence
+;;; of such clauses. But usually you will want with-cps-constants
+;;; inside a with-cps, so it usually looks like this:
+;;;
+;;; (with-cps cps
+;;; ...
+;;; ($ (with-cps-constants ((foo 34))
+;;; (build-term ($values (foo))))))
+;;;
+;;; which is to say that the $ or the let$ adds the CPS argument for us.
+;;;
+;;; Code:
+
+(define-module (language cps2 with-cps)
+ #:use-module (language cps2)
+ #:use-module (language cps2 utils)
+ #:use-module (language cps intmap)
+ #:export (with-cps with-cps-constants))
+
+(define-syntax with-cps
+ (syntax-rules (letk letv let$ $)
+ ((_ (exp ...) clause ...)
+ (let ((cps (exp ...)))
+ (with-cps cps clause ...)))
+ ((_ cps (letk label cont) clause ...)
+ (let-fresh (label) ()
+ (with-cps (intmap-add! cps label (build-cont cont))
+ clause ...)))
+ ((_ cps (letv v ...) clause ...)
+ (let-fresh () (v ...)
+ (with-cps cps clause ...)))
+ ((_ cps (let$ var (proc arg ...)) clause ...)
+ (call-with-values (lambda () (proc cps arg ...))
+ (lambda (cps var)
+ (with-cps cps clause ...))))
+ ((_ cps ($ (proc arg ...)))
+ (proc cps arg ...))
+ ((_ cps exp)
+ (values cps exp))))
+
+(define-syntax with-cps-constants
+ (syntax-rules ()
+ ((_ cps () clause ...)
+ (with-cps cps clause ...))
+ ((_ cps ((var val) (var* val*) ...) clause ...)
+ (let ((x val))
+ (with-cps cps
+ (letv var)
+ (let$ body (with-cps-constants ((var* val*) ...)
+ clause ...))
+ (letk label ($kargs ('var) (var) ,body))
+ (build-term ($continue label #f ($const x))))))))
diff --git a/module/language/tree-il/compile-cps2.scm
b/module/language/tree-il/compile-cps2.scm
index 14cd5f5..932a49d 100644
--- a/module/language/tree-il/compile-cps2.scm
+++ b/module/language/tree-il/compile-cps2.scm
@@ -56,6 +56,7 @@
#:use-module ((system foreign) #:select (make-pointer pointer->scm))
#:use-module (language cps2)
#:use-module (language cps2 utils)
+ #:use-module (language cps2 with-cps)
#:use-module (language cps primitives)
#:use-module (language tree-il analyze)
#:use-module (language tree-il optimize)
@@ -84,110 +85,6 @@
(scope-counter (1+ scope-id))
scope-id))
-;;; We will traverse the nested Tree-IL expression to build the
-;;; label->cont mapping for the result. When visiting any particular
-;;; expression, we usually already know the label and the $kargs wrapper
-;;; for the cont, and just need to know the body of that cont. However
-;;; when building the body of that possibly nested Tree-IL expression we
-;;; will also need to add conts to the result, so really it's a process
-;;; that takes an incoming program, adds conts to that program, and
-;;; returns the result program and the result term.
-;;;
-;;; It's a bit treacherous to do in a functional style as once you start
-;;; adding to a program, you shouldn't add to previous versions of that
-;;; program. Getting that right in the context of this program seed
-;;; that is threaded through the conversion requires the use of a
-;;; pattern, with-cps.
-;;;
-;;; with-cps goes like this:
-;;;
-;;; (with-cps cps clause ... tail-clause)
-;;;
-;;; Valid clause kinds are:
-;;;
-;;; (letk LABEL CONT)
-;;; (letv VAR ...)
-;;; (let$ X (PROC ARG ...))
-;;;
-;;; letk and letv create fresh CPS labels and variable names,
-;;; respectively. Labels and vars bound by letk and letv are in scope
-;;; from their point of definition onward. letv just creates fresh
-;;; variable names for use in other parts of with-cps, while letk binds
-;;; fresh labels to values and adds them to the resulting program. The
-;;; right-hand-side of letk, CONT, is passed to build-cont, so it should
-;;; be a valid production of that language.
-;;;
-;;; let$ delegates processing to a sub-computation. The form (PROC ARG
-;;; ...) is syntactically altered to be (PROC CPS ARG ...), where CPS is
-;;; the value of the program being built, at that point in the
-;;; left-to-right with-cps execution. That form is is expected to
-;;; evaluate to two values: the new CPS term, and the value to bind to
-;;; X. X is in scope for the following with-cps clauses. The name was
-;;; chosen because the $ is reminiscent of the $ in CPS data types.
-;;;
-;;; The result of the with-cps form is determined by the tail clause,
-;;; which may be of these two kinds:
-;;;
-;;; ($ (PROC ARG ...))
-;;; EXP
-;;;
-;;; $ is like let$, but in tail position. Otherwise EXP is any kind of
-;;; expression, which should not add to the resulting program. Ending
-;;; the with-cps with EXP is equivalant to returning (values CPS EXP).
-;;;
-;;; It's a bit of a monad, innit? Don't tell anyone though!
-;;;
-(define-syntax with-cps
- (syntax-rules (letk letv let$ $)
- ((_ (exp ...) clause ...)
- (let ((cps (exp ...)))
- (with-cps cps clause ...)))
- ((_ cps (letk label cont) clause ...)
- (let-fresh (label) ()
- (with-cps (intmap-add! cps label (build-cont cont))
- clause ...)))
- ((_ cps (letv v ...) clause ...)
- (let-fresh () (v ...)
- (with-cps cps clause ...)))
- ((_ cps (let$ var (proc arg ...)) clause ...)
- (call-with-values (lambda () (proc cps arg ...))
- (lambda (cps var)
- (with-cps cps clause ...))))
- ((_ cps ($ (proc arg ...)))
- (proc cps arg ...))
- ((_ cps exp)
- (values cps exp))))
-
-;;; Sometimes you need to just bind some constants to CPS values.
-;;; with-cps-constants is there for you. For example:
-;;;
-;;; (with-cps-constants cps ((foo 34))
-;;; (build-term ($values (foo))))
-;;;
-;;; The body of with-cps-constants is a with-cps clause, or a sequence
-;;; of such clauses. But usually you will want with-cps-constants
-;;; inside a with-cps, so it usually looks like this:
-;;;
-;;; (with-cps cps
-;;; ...
-;;; ($ (with-cps-constants ((foo 34))
-;;; (build-term ($values (foo))))))
-;;;
-;;; which is to say that the $ or the let$ adds the CPS argument for us.
-;;;
-(define-syntax with-cps-constants
- (syntax-rules ()
- ((_ cps () clause ...)
- (with-cps cps clause ...))
- ((_ cps ((var val) (var* val*) ...) clause ...)
- (let ((x val))
- (with-cps cps
- (letv var)
- (let$ body (with-cps-constants ((var* val*) ...)
- clause ...))
- (letk label ($kargs ('var) (var) ,body))
- (build-term ($continue label #f ($const x))))))))
-
(define (toplevel-box cps src name bound? val-proc)
(define (lookup cps name bound? k)
(match (current-topbox-scope)
@@ -1041,8 +938,6 @@ integer."
env))
;;; Local Variables:
-;;; eval: (put 'with-cps 'scheme-indent-function 1)
-;;; eval: (put 'with-cps-constants 'scheme-indent-function 1)
;;; eval: (put 'convert-arg 'scheme-indent-function 2)
;;; eval: (put 'convert-args 'scheme-indent-function 2)
;;; End: