[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 03/05: Allow unchecked functions to have unboxed argumen
From: |
Andy Wingo |
Subject: |
[Guile-commits] 03/05: Allow unchecked functions to have unboxed arguments |
Date: |
Fri, 1 Oct 2021 05:37:32 -0400 (EDT) |
wingo pushed a commit to branch main
in repository guile.
commit c8c35c6987a1f072aacb5d8d2a41b245d255dac2
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Thu Jun 3 21:35:20 2021 +0200
Allow unchecked functions to have unboxed arguments
* module/language/cps/utils.scm (compute-var-representations): Use
'arg-representations from metadata for arg representations.
* module/language/tree-il/compile-cps.scm (sanitize-meta):
(convert): Make sure incoming terms have no arg representations.
---
module/language/cps/utils.scm | 13 ++++++++-----
module/language/tree-il/compile-cps.scm | 11 ++++++++++-
2 files changed, 18 insertions(+), 6 deletions(-)
diff --git a/module/language/cps/utils.scm b/module/language/cps/utils.scm
index 8f36e4d..2b0c91c 100644
--- a/module/language/cps/utils.scm
+++ b/module/language/cps/utils.scm
@@ -429,12 +429,15 @@ by a label, respectively."
(($ $kargs _ _ (or ($ $branch) ($ $switch) ($ $prompt) ($ $throw)))
representations)
(($ $kfun src meta self tail entry)
- (let ((representations (if self
+ (let* ((representations (if self
(intmap-add representations self 'scm)
- representations)))
- (fold1 (lambda (var representations)
- (intmap-add representations var 'scm))
- (get-defs entry) representations)))
+ representations))
+ (defs (get-defs entry))
+ (reprs (or (assq-ref meta 'arg-representations)
+ (map (lambda (_) 'scm) defs))))
+ (fold (lambda (var repr representations)
+ (intmap-add representations var repr))
+ representations defs reprs)))
(($ $kclause arity body alt)
(fold1 (lambda (var representations)
(intmap-add representations var 'scm))
diff --git a/module/language/tree-il/compile-cps.scm
b/module/language/tree-il/compile-cps.scm
index ffc8308..918e904 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -1581,6 +1581,15 @@ use as the proc slot."
(letk ktail ($kargs ('tail) (tail) ,head))
($ (build-list ktail src vals))))))
+(define (sanitize-meta meta)
+ (match meta
+ (() '())
+ (((k . v) . meta)
+ (let ((meta (sanitize-meta meta)))
+ (case k
+ ((arg-representations) meta)
+ (else (acons k v meta)))))))
+
;;; The conversion from Tree-IL to CPS essentially wraps every
;;; expression in a $kreceive, which models the Tree-IL semantics that
;;; extra values are simply truncated. In CPS, this means that the
@@ -1865,7 +1874,7 @@ use as the proc slot."
(letv self)
(letk ktail ($ktail))
(let$ kclause (convert-clauses body ktail))
- (letk kfun ($kfun fun-src meta self ktail kclause))
+ (letk kfun ($kfun fun-src (sanitize-meta meta) self ktail
kclause))
(let$ k (adapt-arity k fun-src 1))
(build-term ($continue k fun-src ($fun kfun))))
(let ((scope-id (fresh-scope-id)))
- [Guile-commits] branch main updated (d4d4336 -> c803566), Andy Wingo, 2021/10/01
- [Guile-commits] 02/05: Move live variable computation routines to utils and graphs., Andy Wingo, 2021/10/01
- [Guile-commits] 01/05: Add frame-local-ref / frame-local-set! support for type 'ptr, Andy Wingo, 2021/10/01
- [Guile-commits] 04/05: Add CPS pretty-printer, Andy Wingo, 2021/10/01
- [Guile-commits] 05/05: Add ,optimize-cps REPL meta-command, Andy Wingo, 2021/10/01
- [Guile-commits] 03/05: Allow unchecked functions to have unboxed arguments,
Andy Wingo <=