[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 03/08: Variable renaming in type-fold.scm
From: |
Andy Wingo |
Subject: |
[Guile-commits] 03/08: Variable renaming in type-fold.scm |
Date: |
Wed, 3 Jan 2018 15:31:23 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit 29fee39c2aafc13245fb5fd48bcf6db195251282
Author: Andy Wingo <address@hidden>
Date: Wed Jan 3 15:30:33 2018 +0100
Variable renaming in type-fold.scm
* module/language/cps/type-fold.scm: Rename "name" variables that
indicate primcalls to "op".
---
module/language/cps/type-fold.scm | 102 +++++++++++++++++++-------------------
1 file changed, 51 insertions(+), 51 deletions(-)
diff --git a/module/language/cps/type-fold.scm
b/module/language/cps/type-fold.scm
index 3ac1eae..d9be02d 100644
--- a/module/language/cps/type-fold.scm
+++ b/module/language/cps/type-fold.scm
@@ -45,26 +45,26 @@
(define *branch-folders* (make-hash-table))
-(define-syntax-rule (define-branch-folder name f)
- (hashq-set! *branch-folders* 'name f))
+(define-syntax-rule (define-branch-folder op f)
+ (hashq-set! *branch-folders* 'op f))
(define-syntax-rule (define-branch-folder-alias to from)
(hashq-set! *branch-folders* 'to (hashq-ref *branch-folders* 'from)))
-(define-syntax-rule (define-unary-branch-folder* (name param arg min max)
+(define-syntax-rule (define-unary-branch-folder* (op param arg min max)
body ...)
- (define-branch-folder name (lambda (param arg min max) body ...)))
+ (define-branch-folder op (lambda (param arg min max) body ...)))
-(define-syntax-rule (define-unary-branch-folder (name arg min max) body ...)
- (define-unary-branch-folder* (name param arg min max) body ...))
+(define-syntax-rule (define-unary-branch-folder (op arg min max) body ...)
+ (define-unary-branch-folder* (op param arg min max) body ...))
-(define-syntax-rule (define-binary-branch-folder (name arg0 min0 max0
+(define-syntax-rule (define-binary-branch-folder (op arg0 min0 max0
arg1 min1 max1)
body ...)
- (define-branch-folder name (lambda (param arg0 min0 max0 arg1 min1 max1)
body ...)))
+ (define-branch-folder op (lambda (param arg0 min0 max0 arg1 min1 max1) body
...)))
-(define-syntax-rule (define-special-immediate-predicate-folder name imin imax)
- (define-unary-branch-folder (name type min max)
+(define-syntax-rule (define-special-immediate-predicate-folder op imin imax)
+ (define-unary-branch-folder (op type min max)
(let ((type* (logand type &special-immediate)))
(cond
((zero? (logand type &special-immediate)) (values #t #f))
@@ -86,8 +86,8 @@
(define-special-immediate-predicate-folder false? &nil &false)
(define-special-immediate-predicate-folder nil? &null &false) ;; &nil in middle
-(define-syntax-rule (define-unary-type-predicate-folder name &type)
- (define-unary-branch-folder (name type min max)
+(define-syntax-rule (define-unary-type-predicate-folder op &type)
+ (define-unary-branch-folder (op type min max)
(let ((type* (logand type &type)))
(cond
((zero? type*) (values #t #f))
@@ -216,22 +216,22 @@
(define *primcall-macro-reducers* (make-hash-table))
-(define-syntax-rule (define-primcall-macro-reducer name f)
- (hashq-set! *primcall-macro-reducers* 'name f))
+(define-syntax-rule (define-primcall-macro-reducer op f)
+ (hashq-set! *primcall-macro-reducers* 'op f))
-(define-syntax-rule (define-unary-primcall-macro-reducer (name cps k src
- arg type min
max)
+(define-syntax-rule (define-unary-primcall-macro-reducer (op cps k src
+ arg type min max)
body ...)
- (define-primcall-macro-reducer name
+ (define-primcall-macro-reducer op
(lambda (cps k src param arg type min max)
body ...)))
(define-syntax-rule (define-binary-primcall-macro-reducer
- (name cps k src
- arg0 type0 min0 max0
- arg1 type1 min1 max1)
+ (op cps k src
+ arg0 type0 min0 max0
+ arg1 type1 min1 max1)
body ...)
- (define-primcall-macro-reducer name
+ (define-primcall-macro-reducer op
(lambda (cps k src param arg0 type0 min0 max0 arg1 type1 min1 max1)
body ...)))
@@ -278,21 +278,21 @@
(define *primcall-reducers* (make-hash-table))
-(define-syntax-rule (define-primcall-reducer name f)
- (hashq-set! *primcall-reducers* 'name f))
+(define-syntax-rule (define-primcall-reducer op f)
+ (hashq-set! *primcall-reducers* 'op f))
-(define-syntax-rule (define-unary-primcall-reducer (name cps k src param
+(define-syntax-rule (define-unary-primcall-reducer (op cps k src param
arg type min max)
body ...)
- (define-primcall-reducer name
+ (define-primcall-reducer op
(lambda (cps k src param arg type min max)
body ...)))
-(define-syntax-rule (define-binary-primcall-reducer (name cps k src param
+(define-syntax-rule (define-binary-primcall-reducer (op cps k src param
arg0 type0 min0 max0
arg1 type1 min1 max1)
body ...)
- (define-primcall-reducer name
+ (define-primcall-reducer op
(lambda (cps k src param arg0 type0 min0 max0 arg1 type1 min1 max1)
body ...)))
@@ -438,7 +438,7 @@
(else (error "unhandled immediate" val))))
(else (error "unhandled type" type val))))
(let ((types (infer-types cps start)))
- (define (fold-primcall cps label names vars k src name param args def)
+ (define (fold-primcall cps label names vars k src op param args def)
(call-with-values (lambda () (lookup-post-type types label def 0))
(lambda (type min max)
(and (not (zero? type))
@@ -446,7 +446,7 @@
(zero? (logand type (lognot &scalar-types)))
(eqv? min max)
(let ((val (scalar-value type min)))
- ;; (pk 'folded src name args val)
+ ;; (pk 'folded src op args val)
(with-cps cps
(letv v*)
(letk k* ($kargs (#f) (v*)
@@ -455,8 +455,8 @@
;; possible.
(setk label
($kargs names vars
- ($continue k* src ($primcall name param
args))))))))))
- (define (transform-primcall f cps label names vars k src name param args)
+ ($continue k* src ($primcall op param args))))))))))
+ (define (transform-primcall f cps label names vars k src op param args)
(and f
(match args
((arg0)
@@ -481,36 +481,36 @@
(with-cps cps
(setk label ($kargs names vars
,term)))))))))))
(_ #f))))
- (define (reduce-primcall cps label names vars k src name param args)
+ (define (reduce-primcall cps label names vars k src op param args)
(cond
- ((transform-primcall (hashq-ref *primcall-macro-reducers* name)
- cps label names vars k src name param args)
+ ((transform-primcall (hashq-ref *primcall-macro-reducers* op)
+ cps label names vars k src op param args)
=> (lambda (cps)
(match (intmap-ref cps label)
(($ $kargs names vars
- ($ $continue k src ($ $primcall name param args)))
- (reduce-primcall cps label names vars k src name param
args)))))
- ((transform-primcall (hashq-ref *primcall-reducers* name)
- cps label names vars k src name param args))
+ ($ $continue k src ($ $primcall op param args)))
+ (reduce-primcall cps label names vars k src op param args)))))
+ ((transform-primcall (hashq-ref *primcall-reducers* op)
+ cps label names vars k src op param args))
(else cps)))
- (define (fold-unary-branch cps label names vars kf kt src name param arg)
+ (define (fold-unary-branch cps label names vars kf kt src op param arg)
(and=>
- (hashq-ref *branch-folders* name)
+ (hashq-ref *branch-folders* op)
(lambda (folder)
(call-with-values (lambda () (lookup-pre-type types label arg))
(lambda (type min max)
(call-with-values (lambda () (folder param type min max))
(lambda (f? v)
- ;; (when f? (pk 'folded-unary-branch label name arg v))
+ ;; (when f? (pk 'folded-unary-branch label op arg v))
(and f?
(with-cps cps
(setk label
($kargs names vars
($continue (if v kt kf) src
($values ())))))))))))))
- (define (fold-binary-branch cps label names vars kf kt src name param arg0
arg1)
+ (define (fold-binary-branch cps label names vars kf kt src op param arg0
arg1)
(and=>
- (hashq-ref *branch-folders* name)
+ (hashq-ref *branch-folders* op)
(lambda (folder)
(call-with-values (lambda () (lookup-pre-type types label arg0))
(lambda (type0 min0 max0)
@@ -519,29 +519,29 @@
(call-with-values (lambda ()
(folder param type0 min0 max0 type1 min1
max1))
(lambda (f? v)
- ;; (when f? (pk 'folded-binary-branch label name arg0
arg1 v))
+ ;; (when f? (pk 'folded-binary-branch label op arg0 arg1
v))
(and f?
(with-cps cps
(setk label
($kargs names vars
($continue (if v kt kf) src
($values ())))))))))))))))
- (define (visit-primcall cps label names vars k src name param args)
+ (define (visit-primcall cps label names vars k src op param args)
;; We might be able to fold primcalls that define a value.
(match (intmap-ref cps k)
(($ $kargs (_) (def))
- (or (fold-primcall cps label names vars k src name param args def)
- (reduce-primcall cps label names vars k src name param args)))
+ (or (fold-primcall cps label names vars k src op param args def)
+ (reduce-primcall cps label names vars k src op param args)))
(_
- (reduce-primcall cps label names vars k src name param args))))
- (define (visit-branch cps label names vars kf kt src name param args)
+ (reduce-primcall cps label names vars k src op param args))))
+ (define (visit-branch cps label names vars kf kt src op param args)
;; We might be able to fold primcalls that branch.
(match args
((x)
- (or (fold-unary-branch cps label names vars kf kt src name param x)
+ (or (fold-unary-branch cps label names vars kf kt src op param x)
cps))
((x y)
- (or (fold-binary-branch cps label names vars kf kt src name param x y)
+ (or (fold-binary-branch cps label names vars kf kt src op param x y)
cps))))
(let lp ((label start) (cps cps))
(if (<= label end)
- [Guile-commits] branch master updated (108ade6 -> 118f516), Andy Wingo, 2018/01/03
- [Guile-commits] 05/08: Fix add-prompt-control-flow-edges for terms with no continuation, Andy Wingo, 2018/01/03
- [Guile-commits] 02/08: Fix sandbox, Andy Wingo, 2018/01/03
- [Guile-commits] 07/08: Simplify prompt slot allocation now that bailouts can't continue, Andy Wingo, 2018/01/03
- [Guile-commits] 03/08: Variable renaming in type-fold.scm,
Andy Wingo <=
- [Guile-commits] 08/08: $primcall always continues to $kargs, Andy Wingo, 2018/01/03
- [Guile-commits] 06/08: $throw is a new kind of CPS term, Andy Wingo, 2018/01/03
- [Guile-commits] 04/08: $prompt is now its own kind of CPS term., Andy Wingo, 2018/01/03
- [Guile-commits] 01/08: $branch is now a distinct CPS term type, Andy Wingo, 2018/01/03