1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

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.
This commit is contained in:
Andy Wingo 2023-11-17 08:48:33 +01:00
parent c2a9380a42
commit 49aa0940bc
4 changed files with 14 additions and 2 deletions

View file

@ -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)

View file

@ -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

View file

@ -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))))

View file

@ -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))