diff options
author | Andy Wingo <wingo@pobox.com> | 2023-09-15 10:07:40 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2023-09-15 10:18:50 +0200 |
commit | 6756aeff9514bff792e9804217161a7d8ca61fe5 (patch) | |
tree | bd377742cbe2a23123ab77d523ef67712571424c /module/language | |
parent | c0715e09033de4697013e5ddc62ab06296d1ae82 (diff) | |
download | guile-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.scm | 6 | ||||
-rw-r--r-- | module/language/cps/guile-vm/reify-primitives.scm | 1 | ||||
-rw-r--r-- | module/language/cps/types.scm | 12 | ||||
-rw-r--r-- | module/language/tree-il/compile-bytecode.scm | 1 | ||||
-rw-r--r-- | module/language/tree-il/compile-cps.scm | 22 | ||||
-rw-r--r-- | module/language/tree-il/cps-primitives.scm | 1 |
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) |