Hi there, Attached is a patch that fixes some inconsistencies between the definition of the procedures and types.db entries for the procedures defined in (chicken plist). The commit speaks for itself, really.
Cheers, Peter
>From 5540da318818c6a698280ca0cae7c8e774f66a84 Mon Sep 17 00:00:00 2001 From: Peter Bex <[email protected]> Date: Fri, 25 Jul 2025 11:58:49 +0200 Subject: [PATCH] Improve (chicken plist) function type handling and specializations It seems that there was an assumption that properties ("keys") are always symbols. However, this was not checked by either get or put!, and the docs don't indicate that this is the case, either. In fact, put! will allow any value type for the property, and get will correctly return its associated value. The only place where we checked for symbol-ness directly is in get-properties, and only to streamline the case where the "props" argument is not a list. Change this to check for pair?-ness. And while at it, we can also drop the ##sys#check-list, because props is now guaranteed to always be a pair. More importantly, the specializations for get and put! would only be applied when the "key" argument is known to be a symbol, which is both incorrect and inconvenient (sometimes a procedure will put a property handed to it and it might not know if it's a symbol). Change this to allow any type. Finally, the specialization for "get" only applied when the optional argument was given, which is also often not the case, which means many optimization opportunities would be missed. Add a specialization for the two-argument invocation. --- library.scm | 3 +-- types.db | 14 ++++++++------ 2 files changed, 9 insertions(+), 8 deletions(-) diff --git a/library.scm b/library.scm index 9c600d8b..a95817a2 100644 --- a/library.scm +++ b/library.scm @@ -7363,9 +7363,8 @@ EOF (define (get-properties sym props) (##sys#check-symbol sym 'get-properties) - (when (symbol? props) + (unless (pair? props) (set! props (list props)) ) - (##sys#check-list props 'get-properties) (let loop ((plist (##sys#slot sym 2))) (if (null? plist) (values #f #f #f) diff --git a/types.db b/types.db index 0ba17ce2..96d15f3f 100644 --- a/types.db +++ b/types.db @@ -1446,13 +1446,15 @@ ;; plist -(chicken.plist#get (#(procedure #:clean #:enforce) chicken.plist#get (symbol symbol #!optional *) *) - ((symbol symbol *) (##core#inline "C_i_getprop" #(1) #(2) #(3)))) -(chicken.plist#get-properties (#(procedure #:clean #:enforce) chicken.plist#get-properties (symbol list) symbol * list)) -(chicken.plist#put! (#(procedure #:clean #:enforce) chicken.plist#put! (symbol symbol *) undefined) - ((symbol symbol *) +(chicken.plist#get (#(procedure #:clean #:enforce) chicken.plist#get (symbol * #!optional *) *) + ((symbol * *) (##core#inline "C_i_getprop" #(1) #(2) #(3))) + ((symbol *) (##core#inline "C_i_getprop" #(1) #(2) '#f))) +(chicken.plist#get-properties (forall (a) + (#(procedure #:clean #:enforce) chicken.plist#get-properties (symbol (list-of a)) a * list))) +(chicken.plist#put! (#(procedure #:clean #:enforce) chicken.plist#put! (symbol * *) undefined) + ((symbol * *) (##core#inline_allocate ("C_a_i_putprop" 8) #(1) #(2) #(3)))) -(chicken.plist#remprop! (#(procedure #:clean #:enforce) chicken.plist#remprop! (symbol symbol) undefined)) +(chicken.plist#remprop! (#(procedure #:clean #:enforce) chicken.plist#remprop! (symbol *) undefined)) (chicken.plist#symbol-plist (#(procedure #:clean #:enforce) chicken.plist#symbol-plist (symbol) list) ((symbol) (##sys#slot #(1) '2))) -- 2.49.0
