[Guile-commits] branch main updated: Add CPS primcall for symbol-hash

[Andy Wingo]

This is an automated email from the git hooks/post-receive script.

wingo pushed a commit to branch main
in repository guile.

The following commit(s) were added to refs/heads/main by this push:
     new 49aa0940b Add CPS primcall for symbol-hash
49aa0940b is described below

commit 49aa0940bcd1f77819326e73aaee44f5f359d830
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Fri Nov 17 08:48:33 2023 +0100

    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.
---
 module/language/cps/effects-analysis.scm         | 2 ++
 module/language/cps/guile-vm/lower-primcalls.scm | 7 +++++++
 module/language/cps/switch.scm                   | 4 ++--
 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))