summaryrefslogtreecommitdiff
path: root/module/language
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2023-09-15 10:07:40 +0200
committerAndy Wingo <wingo@pobox.com>2023-09-15 10:18:50 +0200
commit6756aeff9514bff792e9804217161a7d8ca61fe5 (patch)
treebd377742cbe2a23123ab77d523ef67712571424c /module/language
parentc0715e09033de4697013e5ddc62ab06296d1ae82 (diff)
downloadguile-6756aeff9514bff792e9804217161a7d8ca61fe5.tar.gz
Better compilation for symbol->string
* libguile/intrinsics.c (scm_bootstrap_intrinsics): * libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS): Add symbol->string intrinsic. * module/language/cps/guile-vm/reify-primitives.scm (compute-known-primitives): * module/language/tree-il/compile-bytecode.scm (+): * module/language/tree-il/compile-cps.scm (symbol->string): * module/language/tree-il/cps-primitives.scm (symbol->string): * module/language/cps/effects-analysis.scm (symbol->string): * module/language/cps/types.scm (symbol->keyword): * module/system/vm/assembler.scm (symbol->string): Add the necessary code to compile symbol->string.
Diffstat (limited to 'module/language')
-rw-r--r--module/language/cps/effects-analysis.scm6
-rw-r--r--module/language/cps/guile-vm/reify-primitives.scm1
-rw-r--r--module/language/cps/types.scm12
-rw-r--r--module/language/tree-il/compile-bytecode.scm1
-rw-r--r--module/language/tree-il/compile-cps.scm22
-rw-r--r--module/language/tree-il/cps-primitives.scm1
6 files changed, 43 insertions, 0 deletions
diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm
index bd7c03239..66f95a6bb 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -408,6 +408,12 @@ the LABELS that are clobbered by the effects of LABEL."
((push-dynamic-state state) (&write-object &fluid) &type-check)
((pop-dynamic-state) (&write-object &fluid)))
+(define-primitive-effects
+ ((symbol->string x)) ;; CPS lowering includes symbol? type check.
+ ((symbol->keyword) &type-check)
+ ((string->symbol) &type-check)
+ ((keyword->symbol) &type-check))
+
;; Threads. Calls cause &all-effects, which reflects the fact that any
;; call can capture a partial continuation and reinstate it on another
;; thread.
diff --git a/module/language/cps/guile-vm/reify-primitives.scm b/module/language/cps/guile-vm/reify-primitives.scm
index ea5ee92a6..871d12524 100644
--- a/module/language/cps/guile-vm/reify-primitives.scm
+++ b/module/language/cps/guile-vm/reify-primitives.scm
@@ -337,6 +337,7 @@
string->number
string->symbol
symbol->keyword
+ symbol->string
class-of
scm->f64
s64->u64 s64->scm scm->s64
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index f33d07492..422e31ec0 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -926,6 +926,18 @@ minimum, and maximum."
;;;
+;;; Symbols and keywords
+;;;
+(define-simple-types
+ ((symbol->keyword &symbol) &keyword)
+ ((keyword->symbol &keyword) &symbol)
+ ((symbol->string &symbol) &string)
+ ((string->symbol &string) &symbol))
+
+
+
+
+;;;
;;; Threads. We don't currently track threads as an object type.
;;;
diff --git a/module/language/tree-il/compile-bytecode.scm b/module/language/tree-il/compile-bytecode.scm
index c4c9bf614..2be2b1397 100644
--- a/module/language/tree-il/compile-bytecode.scm
+++ b/module/language/tree-il/compile-bytecode.scm
@@ -267,6 +267,7 @@
(string->number #:nargs 1 #:has-result? #t #:emit emit-string->number)
(string->symbol #:nargs 1 #:has-result? #t #:emit emit-string->symbol)
(symbol->keyword #:nargs 1 #:has-result? #t #:emit emit-symbol->keyword)
+ (symbol->string #:nargs 1 #:has-result? #t #:emit emit-symbol->string)
(class-of #:nargs 1 #:has-result? #t #:emit emit-class-of)
diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm
index 9ebdb72a3..42a1c90da 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -350,6 +350,28 @@
($continue kinit src
($primcall 'allocate-vector/immediate size ()))))))
+(define-primcall-converter symbol->string
+ (lambda (cps k src op param sym)
+ (define not-symbol
+ #(wrong-type-arg
+ "symbol->string"
+ "Wrong type argument in position 1 (expecting symbol): ~S"))
+ (with-cps cps
+ (letk knot-symbol
+ ($kargs () () ($throw src 'throw/value+data not-symbol (sym))))
+ ;; This is the right lowering but the Guile-VM backend gets it a
+ ;; bit wrong: the symbol->string intrinsic instruction includes a
+ ;; type-check and actually allocates. We should change symbols in
+ ;; Guile-VM so that symbol->string is cheaper.
+ (letk ksym
+ ($kargs () ()
+ ($continue k src ($primcall 'symbol->string #f (sym)))))
+ (letk kheap-object
+ ($kargs () ()
+ ($branch knot-symbol ksym src 'symbol? #f (sym))))
+ (build-term
+ ($branch knot-symbol kheap-object src 'heap-object? #f (sym))))))
+
(define (ensure-pair cps src op pred x is-pair)
(define msg
(match pred
diff --git a/module/language/tree-il/cps-primitives.scm b/module/language/tree-il/cps-primitives.scm
index 380ebb48f..c6ab96471 100644
--- a/module/language/tree-il/cps-primitives.scm
+++ b/module/language/tree-il/cps-primitives.scm
@@ -70,6 +70,7 @@
(define-cps-primitive string->number 1 1)
(define-cps-primitive string->symbol 1 1)
(define-cps-primitive symbol->keyword 1 1)
+(define-cps-primitive symbol->string 1 1)
(define-cps-primitive integer->char 1 1)
(define-cps-primitive char->integer 1 1)