[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 15/24: Remove dead code in CPS converter
From: |
Andy Wingo |
Subject: |
[Guile-commits] 15/24: Remove dead code in CPS converter |
Date: |
Tue, 10 Apr 2018 13:24:14 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 3047bcaefb52d771a9522c918d8d32dcd0e2bd06
Author: Andy Wingo <address@hidden>
Date: Tue Apr 10 14:10:03 2018 +0200
Remove dead code in CPS converter
* module/language/tree-il/compile-cps.scm: Remove dead primcall
expanders.
---
module/language/tree-il/compile-cps.scm | 104 +++++---------------------------
1 file changed, 15 insertions(+), 89 deletions(-)
diff --git a/module/language/tree-il/compile-cps.scm
b/module/language/tree-il/compile-cps.scm
index 4724375..ab3f6e2 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -71,89 +71,16 @@
(build-term
($continue k src ($primcall op param args)))))
-(define (convert-indexed-getter cps k src op param obj idx)
- (with-cps cps
- (letv idx')
- (letk k' ($kargs ('idx) (idx')
- ($continue k src ($primcall op param (obj idx')))))
- (build-term ($continue k' src ($primcall 'scm->u64 #f (idx))))))
-
-(define (convert-indexed-setter cps k src op param obj idx val)
- (with-cps cps
- (letv idx')
- (letk k' ($kargs ('idx) (idx')
- ($continue k src ($primcall op param (obj idx' val)))))
- (build-term ($continue k' src ($primcall 'scm->u64 #f (idx))))))
-
-(define (convert-indexed-getter/tag cps k src op param obj idx tag-result)
- (with-cps cps
- (letv res')
- (letk k' ($kargs ('res) (res')
- ($continue k src ($primcall tag-result #f (res')))))
- ($ (convert-indexed-getter k' src op param obj idx))))
-
-(define (convert-indexed-setter/untag cps k src op param obj idx val untag-val)
- (with-cps cps
- (letv val')
- (let$ body (convert-indexed-setter k src op param obj idx val'))
- (letk k' ($kargs ('val) (val') ,body))
- (build-term ($continue k' src ($primcall untag-val #f (val))))))
-
-(define convert-scm-u64->scm-primcall convert-indexed-getter)
-(define convert-scm-u64-scm-primcall convert-indexed-setter)
-
-(define (convert-u64-scm->scm-primcall cps k src op param len init)
- (with-cps cps
- (letv len')
- (letk k' ($kargs ('len) (len')
- ($continue k src ($primcall op param (len' init)))))
- (build-term ($continue k' src ($primcall 'scm->u64 #f (len))))))
-
-(define (convert-scm-u64->f64-primcall cps k src op param obj idx)
- (convert-indexed-getter/tag cps k src op param obj idx 'f64->scm))
-(define (convert-scm-u64-f64-primcall cps k src op param obj idx val)
- (convert-indexed-setter/untag cps k src op param obj idx val 'scm->f64))
-
-(define (convert-scm-u64->u64-primcall cps k src op param obj idx)
- (convert-indexed-getter/tag cps k src op param obj idx 'u64->scm))
-(define (convert-scm-u64-u64-primcall cps k src op param obj idx val)
- (convert-indexed-setter/untag cps k src op param obj idx val 'scm->u64))
-
-(define (convert-scm-u64->s64-primcall cps k src op param obj idx)
- (convert-indexed-getter/tag cps k src op param obj idx 's64->scm))
-(define (convert-scm-u64-s64-primcall cps k src op param obj idx val)
- (convert-indexed-setter/untag cps k src op param obj idx val 'scm->s64))
-
-(define (convert-*->u64-primcall cps k src op param . args)
- (with-cps cps
- (letv res')
- (letk k' ($kargs ('res) (res')
- ($continue k src ($primcall 'u64->scm #f (res')))))
- (build-term ($continue k' src ($primcall op param args)))))
-(define convert-scm->u64-primcall convert-*->u64-primcall)
-(define (convert-u64->scm-primcall cps k src op param arg)
- (with-cps cps
- (letv arg')
- (letk k' ($kargs ('arg) (arg')
- ($continue k src ($primcall op param (arg')))))
- (build-term ($continue k' src ($primcall 'scm->u64 #f (arg))))))
-
(define *primcall-converters* (make-hash-table))
(define-syntax-rule (define-primcall-converter name proc)
(hashq-set! *primcall-converters* 'name proc))
-(define-syntax define-primcall-converters
- (lambda (x)
- (define (spec->convert spec)
- (string->symbol
- (string-join
- (append '("convert") (map symbol->string spec) '("primcall"))
- "-")))
- (define (compute-converter spec)
- (datum->syntax #'here (spec->convert (syntax->datum spec))))
- (syntax-case x ()
- ((_ (op . spec) ...)
- (with-syntax (((cvt ...) (map compute-converter #'(spec ...))))
- #'(begin (define-primcall-converter op cvt) ...))))))
+
+(define (convert-primcall* cps k src op param args)
+ (let ((proc (hashq-ref *primcall-converters* op convert-primcall/default)))
+ (apply proc cps k src op param args)))
+
+(define (convert-primcall cps k src op param . args)
+ (convert-primcall* cps k src op param args))
(define (ensure-vector cps src op pred v have-length)
(define msg
@@ -1357,16 +1284,15 @@
(build-term
($branch knot-char kuntag src 'char? #f (ch))))))
-(define-primcall-converters
- (rsh scm u64 >scm)
- (lsh scm u64 >scm))
-
-(define (convert-primcall* cps k src op param args)
- (let ((proc (hashq-ref *primcall-converters* op convert-primcall/default)))
- (apply proc cps k src op param args)))
+(define (convert-shift cps k src op param obj idx)
+ (with-cps cps
+ (letv idx')
+ (letk k' ($kargs ('idx) (idx')
+ ($continue k src ($primcall op param (obj idx')))))
+ (build-term ($continue k' src ($primcall 'scm->u64 #f (idx))))))
-(define (convert-primcall cps k src op param . args)
- (convert-primcall* cps k src op param args))
+(define-primcall-converter rsh convert-shift)
+(define-primcall-converter lsh convert-shift)
;;; Guile's semantics are that a toplevel lambda captures a reference on
;;; the current module, and that all contained lambdas use that module
- [Guile-commits] 05/24: Add VM ops needed for string-ref, (continued)
- [Guile-commits] 05/24: Add VM ops needed for string-ref, Andy Wingo, 2018/04/10
- [Guile-commits] 01/24: Add instrinsics to runtime, Andy Wingo, 2018/04/10
- [Guile-commits] 02/24: Compile some generic arithmetic to intrinsic calls, Andy Wingo, 2018/04/10
- [Guile-commits] 23/24: Remove class-of opcode, Andy Wingo, 2018/04/10
- [Guile-commits] 19/24: string->number, etc intrinsics, Andy Wingo, 2018/04/10
- [Guile-commits] 24/24: Remove load-typed-array, make-array opcodes, Andy Wingo, 2018/04/10
- [Guile-commits] 20/24: Remove string->number, etc opcodes, Andy Wingo, 2018/04/10
- [Guile-commits] 09/24: Explode "string-set!", Andy Wingo, 2018/04/10
- [Guile-commits] 14/24: Remove char->integer from VM, Andy Wingo, 2018/04/10
- [Guile-commits] 17/24: Add $code CPS expression type, Andy Wingo, 2018/04/10
- [Guile-commits] 15/24: Remove dead code in CPS converter,
Andy Wingo <=
- [Guile-commits] 22/24: Class-of is intrinsic, Andy Wingo, 2018/04/10
- [Guile-commits] 18/24: Remove unused make-closure opcode., Andy Wingo, 2018/04/10
- [Guile-commits] 08/24: Add string-set! intrinsic, Andy Wingo, 2018/04/10