>From 446a0d7bbcdb25fbe7e527d29fcb625a8d54e845 Mon Sep 17 00:00:00 2001 From: Evan Hanson 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