diff options
author | Andy Wingo <wingo@pobox.com> | 2023-11-17 08:48:33 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2023-11-17 08:48:33 +0100 |
commit | 49aa0940bcd1f77819326e73aaee44f5f359d830 (patch) | |
tree | ddbdbfb4a1f33b7f3ff8fef8108046dc162afe0f /module | |
parent | c2a9380a42ed2b2fdcfe641dc912b389f65f8db5 (diff) | |
download | guile-49aa0940bcd1f77819326e73aaee44f5f359d830.tar.gz |
Add CPS primcall for symbol-hash
* module/language/cps/effects-analysis.scm: symbol-hash is effect-free.
* module/language/cps/guile-vm/lower-primcalls.scm (symbol-hash): Lower
to word-ref/immediate.
* module/language/cps/switch.scm (optimize-branch-chain): Emit
symbol-hash instead of word-ref/immediate.
* module/language/cps/types.scm (symbol-hash): Infer result.
Diffstat (limited to 'module')
-rw-r--r-- | module/language/cps/effects-analysis.scm | 2 | ||||
-rw-r--r-- | module/language/cps/guile-vm/lower-primcalls.scm | 7 | ||||
-rw-r--r-- | module/language/cps/switch.scm | 4 | ||||
-rw-r--r-- | module/language/cps/types.scm | 3 |
4 files changed, 14 insertions, 2 deletions
diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm index 7b1e1d0ea..845394de0 100644 --- a/module/language/cps/effects-analysis.scm +++ b/module/language/cps/effects-analysis.scm @@ -497,6 +497,8 @@ the LABELS that are clobbered by the effects of LABEL." ((string-ref str idx) (&read-object &string)) ((string-set! str idx cp) (&write-object &string)) + ((symbol-hash)) + ((make-closure code) (&allocate &closure)) ((closure-ref code) (match param ((idx . nfree) diff --git a/module/language/cps/guile-vm/lower-primcalls.scm b/module/language/cps/guile-vm/lower-primcalls.scm index ae14f34e0..481721062 100644 --- a/module/language/cps/guile-vm/lower-primcalls.scm +++ b/module/language/cps/guile-vm/lower-primcalls.scm @@ -476,6 +476,13 @@ ($continue kadd src ($primcall 'word-ref/immediate '(string . 2) (s)))))) +;; precondition: sym is a symbol. +(define-primcall-lowerer (symbol-hash cps k src #f (sym)) + (with-cps cps + (build-term + ($continue k src + ($primcall 'word-ref/immediate '(symbol . 2) (sym)))))) + ;; precondition: none. (define-primcall-lowerer (make-atomic-box cps k src #f (val)) (with-cps cps diff --git a/module/language/cps/switch.scm b/module/language/cps/switch.scm index c600d11ab..f4ae40567 100644 --- a/module/language/cps/switch.scm +++ b/module/language/cps/switch.scm @@ -1,6 +1,6 @@ ;;; Continuation-passing style (CPS) intermediate language (IL) -;; Copyright (C) 2020 Free Software Foundation, Inc. +;; Copyright (C) 2020, 2023 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 @@ -371,7 +371,7 @@ object." (letk khash ($kargs () () ($continue kidx #f - ($primcall 'word-ref/immediate '(symbol . 2) (var))))) + ($primcall 'symbol-hash #f (var))))) (letk ksym ($kargs () () ($branch next khash #f 'symbol? #f (var)))) diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm index 9816078d4..597654ab8 100644 --- a/module/language/cps/types.scm +++ b/module/language/cps/types.scm @@ -807,6 +807,9 @@ minimum, and maximum." (define-type-inferrer (string-ref str idx result) (define! result &u64 0 *max-codepoint*)) +(define-type-inferrer (symbol-hash sym result) + (define! result &u64 0 &u64-max)) + (define-type-inferrer/param (make-closure param code result) (define nfree param) (define! result &procedure nfree nfree)) |