~ chicken-core (chicken-5) c83fca9999efe372debe7d59b6ba966293f44104

commit c83fca9999efe372debe7d59b6ba966293f44104
Author:     Peter Bex via Chicken-hackers <chicken-hackers@nongnu.org>
AuthorDate: Fri Jul 25 13:46:15 2025 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sun Jul 27 21:17:58 2025 +0200

    Improve (chicken plist) types
    
    On Fri, Jul 25, 2025 at 12:11:36PM +0200, Peter Bex via Chicken-hackers wrote:
    > 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.
    
    Here's an improved version of the patch where I allow for the non-list
    version of the "properties" argument to get-properties, and also
    improved the third result value from "list" to "(list-of pair)".
    
    Cheers,
    Peter
    
    From 8047fa2922e0c8b3a8f574ee50e8158a5178b700 Mon Sep 17 00:00:00 2001
    From: Peter Bex <peter@more-magic.net>
    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.
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

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..fba0eaa6 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 (or a (list-of a))) a * (list-of pair))))
+(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)))