Again per Felix and Peter's proposal. Note that this patch is based on
the one that moves 'quit' to chicken.repl (to avoid conflicts), so that
one will need to be applied first.
Cheers,
Evan
>From 446a0d7bbcdb25fbe7e527d29fcb625a8d54e845 Mon Sep 17 00:00:00 2001
From: Evan Hanson <ev...@foldling.org>
Date: Thu, 27 Jul 2017 07:46:23 +1200
Subject: [PATCH] Add chicken.plist module
---
README | 1 +
chicken.import.scm | 5 -----
defaults.make | 2 +-
distribution/manifest | 2 ++
library.scm | 7 +++++++
rules.make | 3 +++
support.scm | 1 +
types.db | 23 +++++++++++------------
8 files changed, 26 insertions(+), 18 deletions(-)
diff --git a/README b/README
index e8df7e3a..b525d977 100644
--- a/README
+++ b/README
@@ -309,6 +309,7 @@ _/ _/ _/ _/ _/ _/ _/ _/ _/ _/_/
| | |-- chicken.memory.import.so
| | |-- chicken.pathname.import.so
| | |-- chicken.platform.import.so
+ | | |-- chicken.plist.import.so
| | |-- chicken.port.import.so
| | |-- chicken.posix.import.so
| | |-- chicken.pretty-print.import.so
diff --git a/chicken.import.scm b/chicken.import.scm
index 4b1da7ae..11af6228 100644
--- a/chicken.import.scm
+++ b/chicken.import.scm
@@ -113,13 +113,11 @@
(fxxor . chicken.fixnum#fxxor)
(fxlen . chicken.fixnum#fxlen)
gensym
- get
(get-call-chain . chicken.condition#get-call-chain)
(get-condition-property . chicken.condition#get-condition-property)
get-environment-variable
(get-line-number . chicken.syntax#get-line-number)
get-output-string
- get-properties
getter-with-setter
implicit-exit-handler
infinite?
@@ -160,12 +158,10 @@
procedure-information
program-name
promise?
- put!
quotient&modulo
quotient&remainder
ratnum?
(register-feature! . chicken.platform#register-feature!)
- remprop!
rename-file
(repository-path . chicken.platform#repository-path)
(require . chicken.load#require)
@@ -188,7 +184,6 @@
subvector
symbol-append
symbol-escape
- symbol-plist
(syntax-error . chicken.syntax#syntax-error)
system
(unregister-feature! . chicken.platform#unregister-feature!)
diff --git a/defaults.make b/defaults.make
index 69ca7330..6dfb342c 100644
--- a/defaults.make
+++ b/defaults.make
@@ -267,7 +267,7 @@ PRIMITIVE_IMPORT_LIBRARIES = chicken chicken.condition chicken.csi chicken.forei
DYNAMIC_IMPORT_LIBRARIES = srfi-4
DYNAMIC_CHICKEN_IMPORT_LIBRARIES = bitwise errno file.posix \
fixnum flonum format gc io keyword load locative memory \
- platform posix pretty-print process process.signal \
+ platform plist posix pretty-print process process.signal \
process-context random syntax time time.posix
DYNAMIC_CHICKEN_COMPILER_IMPORT_LIBRARIES = user-pass
DYNAMIC_CHICKEN_UNIT_IMPORT_LIBRARIES = continuation data-structures \
diff --git a/distribution/manifest b/distribution/manifest
index 02bde929..0d79bf59 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -314,6 +314,8 @@ chicken.pathname.import.scm
chicken.pathname.import.c
chicken.platform.import.scm
chicken.platform.import.c
+chicken.plist.import.scm
+chicken.plist.import.c
chicken.port.import.scm
chicken.port.import.c
chicken.posix.import.scm
diff --git a/library.scm b/library.scm
index 6a00479e..17e096b3 100644
--- a/library.scm
+++ b/library.scm
@@ -5601,6 +5601,11 @@ EOF
;;; Property lists
+(module chicken.plist
+ (get get-properties put! remprop! symbol-plist)
+
+(import scheme chicken)
+
(define (put! sym prop val)
(##sys#check-symbol sym 'put!)
(##core#inline_allocate ("C_a_i_putprop" 8) sym prop val) )
@@ -5663,6 +5668,8 @@ EOF
(values prop (##sys#slot tl 0) nxt)
(loop nxt) ) ) ) ) )
+) ; chicken.plist
+
;;; Print timing information (support for "time" macro):
diff --git a/rules.make b/rules.make
index 14212cbc..20dc5ff0 100644
--- a/rules.make
+++ b/rules.make
@@ -511,6 +511,7 @@ $(eval $(call declare-emitted-import-lib-dependency,chicken.flonum,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.gc,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.keyword,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.platform,library))
+$(eval $(call declare-emitted-import-lib-dependency,chicken.plist,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.time,library))
$(eval $(call declare-emitted-import-lib-dependency,chicken.load,eval))
$(eval $(call declare-emitted-import-lib-dependency,chicken.format,extras))
@@ -613,6 +614,7 @@ support.c: support.scm mini-srfi-1.scm \
chicken.keyword.import.scm \
chicken.pathname.import.scm \
chicken.platform.import.scm \
+ chicken.plist.import.scm \
chicken.port.import.scm \
chicken.pretty-print.import.scm \
chicken.random.import.scm \
@@ -775,6 +777,7 @@ library.c: $(SRCDIR)library.scm $(SRCDIR)banner.scm $(SRCDIR)common-declarations
-emit-import-library chicken.gc \
-emit-import-library chicken.keyword \
-emit-import-library chicken.platform \
+ -emit-import-library chicken.plist \
-emit-import-library chicken.time
internal.c: $(SRCDIR)internal.scm $(SRCDIR)mini-srfi-1.scm
$(bootstrap-lib) -emit-import-library chicken.internal
diff --git a/support.scm b/support.scm
index 0f8f4029..1ccff2d4 100644
--- a/support.scm
+++ b/support.scm
@@ -87,6 +87,7 @@
chicken.keyword
chicken.pathname
chicken.platform
+ chicken.plist
chicken.port
chicken.pretty-print
chicken.random
diff --git a/types.db b/types.db
index 6e403d25..e03c3ff3 100644
--- a/types.db
+++ b/types.db
@@ -1194,12 +1194,8 @@
(gensym (#(procedure #:clean) gensym (#!optional (or string symbol)) symbol))
-(get (#(procedure #:clean #:enforce) get (symbol symbol #!optional *) *)
- ((symbol symbol *) (##core#inline "C_i_getprop" #(1) #(2) #(3))))
-
(get-environment-variable (#(procedure #:clean #:enforce) get-environment-variable (string) *))
(get-output-string (#(procedure #:clean #:enforce) get-output-string (output-port) string))
-(get-properties (#(procedure #:clean #:enforce) get-properties (symbol list) symbol * list))
;; keyword
@@ -1238,6 +1234,17 @@
(chicken.platform#repository-path (#(procedure #:clean) chicken.platform#repository-path (#!optional *) *))
(chicken.platform#installation-repository (#(procedure #:clean) chicken.platform#installation-repository (#!optional *) *))
+;; 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 *)
+ (##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#symbol-plist (#(procedure #:clean #:enforce) chicken.plist#symbol-plist (symbol) list)
+ ((symbol) (##sys#slot #(1) '2)))
(getter-with-setter
(#(procedure #:clean #:enforce)
@@ -1284,11 +1291,6 @@
(make-promise (#(procedure #:enforce) make-promise (*) (struct promise))
(((struct promise)) #(1)))
-(put! (#(procedure #:clean #:enforce) put! (symbol symbol *) undefined)
- ((symbol symbol *)
- (##core#inline_allocate ("C_a_i_putprop" 8) #(1) #(2) #(3))))
-
-(remprop! (#(procedure #:clean #:enforce) remprop! (symbol symbol) undefined))
(rename-file (#(procedure #:clean #:enforce) rename-file (string string) string))
(reset (procedure reset () noreturn))
(reset-handler (#(procedure #:clean #:enforce) reset-handler (#!optional (procedure () . *)) procedure))
@@ -1339,9 +1341,6 @@
(subvector (forall (a) (#(procedure #:clean #:enforce) subvector ((vector-of a) fixnum #!optional fixnum) (vector-of a))))
(symbol-escape (#(procedure #:clean) symbol-escape (#!optional *) *))
-(symbol-plist (#(procedure #:clean #:enforce) symbol-plist (symbol) list)
- ((symbol) (##sys#slot #(1) '2)))
-
(system (#(procedure #:clean #:enforce) system (string) fixnum))
(vector-resize
(forall (a b) (#(procedure #:clean #:enforce) vector-resize ((vector-of a) fixnum #!optional b)
--
2.11.0
_______________________________________________
Chicken-hackers mailing list
Chicken-hackers@nongnu.org
https://lists.nongnu.org/mailman/listinfo/chicken-hackers
