shithub: femtolisp

Info  •  Files  •  Log  •  Branches

move {put,get,rem}prop to system.lsp

Change from [sym -> key -> val] to [key -> sym -> val] mapping to
most likely reduce the number of tables created.

--- a/aliases.scm

+++ b/aliases.scm

@@ -226,26 +226,6 @@

   (unwind-protect (thunk)

                   (after)))

-(let ((*properties* (table)))

-  (set! putprop

-        (λ (sym key val)

-          (let ((sp (get *properties* sym #f)))

-            (if (not sp)

-                (let ((t (table)))

-                  (put! *properties* sym t)

-                  (set! sp t)))

-            (put! sp key val))))

-

-  (set! getprop

-        (λ (sym key)

-          (let ((sp (get *properties* sym #f)))

-            (and sp (get sp key #f)))))

-

-  (set! remprop

-        (λ (sym key)

-          (let ((sp (get *properties* sym #f)))

-            (and sp (has? sp key) (del! sp key))))))

-

 ; --- gambit

 (define arithmetic-shift ash)

--- a/flisp.boot

+++ b/flisp.boot

@@ -92,8 +92,8 @@

 	    #fn("5000n10T<:" #() caadr) caar #fn("5000n10<<:" #() caar) cadaar

 	    #fn("5000n10<<T:" #() cadaar) cadadr #fn("5000n10TT:" #() cadadr) cadar

 	    #fn("5000n10<T:" #() cadar) caddar #fn("5000n10<=T:" #() caddar) cadddr

-	    #fn("5000n10==T:" #() cadddr) caddr #2=#fn("5000n10=T:" #() caddr) call-with-values

-	    #fn("7000n205086B3@0A86<C90186=}2:18661:" #() #(#1=(*values*))) capture-var! #fn("<000n27005171186E5387;IG042286510r323861e152p4:" #(bcode:cenv

+	    #fn("5000n10==T:" #() cadddr) caddr #3=#fn("5000n10=T:" #() caddr) call-with-values

+	    #fn("7000n205086B3@0A86<C90186=}2:18661:" #() #(#2=(*values*))) capture-var! #fn("<000n27005171186E5387;IG042286510r323861e152p4:" #(bcode:cenv

   index-of #fn(length) #fn(nconc)) capture-var!)

 	    cdaaar #fn("5000n10<<<=:" #() cdaaar) cdaadr

 	    #fn("5000n10T<=:" #() cdaadr) cdaar #fn("5000n10<<=:" #() cdaar) cdadar

@@ -234,6 +234,7 @@

 	    #fn("9000n382J401:700082<15282=63:" #(foldl) foldl) foldr #fn(":000n382J401:082<700182=5362:" #(foldr) foldr)

 	    get-defined-vars #fn("7000n170A<05161:" #(delete-duplicates) #(#0=(#fn("8000n10H340q:0<20Cj00=B3d00TR;37040Te1;IS040TB;3E0471051R;3:0471051e1;I404q:0<22C?07324A<0=52}2:q:" #(define

   caadr begin nconc #fn(map)) #(#0#)))))

+	    getprop #fn(":000\x8720003000\x882000I60O?2420A1825387;3<04208708263:" #(#fn(get)) #(#1=#table()))

 	    hex5 #fn("8000n170210r@52r52263:" #(string-lpad #fn(number->string) #\0) hex5) identity

 	    #fn("5000n10:" #() identity) in-env? #fn("7000n21B;3F042001<52;I:047101=62:" #(#fn(assq)

   in-env?) in-env?)

@@ -333,10 +334,13 @@

 							      #fn(iostream->string)) print-to-string)

 	    printable? #fn("6000n120051;I80421051S:" #(#fn(iostream?)

 						       #fn(eof-object?)) printable?)

-	    procedure? #.function? quote-value

-	    #fn("6000n1700513400:210e2:" #(self-evaluating? quote) quote-value) quoted? #fn("6000n10<20Q:" #(quote) quoted?)

-	    random #fn("7000n1200513<0712250062:23500i2:" #(#fn(integer?) mod #fn(rand)

-							    #fn(rand-double)) random)

+	    procedure? #.function? putprop

+	    #fn(";000n320A1O5387360O@E0215022A18853488?7^14228708253482:" #(#fn(get)

+									    #fn(table)

+									    #fn(put!)) #(#1#))

+	    quote-value #fn("6000n1700513400:210e2:" #(self-evaluating? quote) quote-value) quoted?

+	    #fn("6000n10<20Q:" #(quote) quoted?) random #fn("7000n1200513<0712250062:23500i2:" #(#fn(integer?)

+  mod #fn(rand) #fn(rand-double)) random)

 	    read-all #fn("7000n17071062:" #(read-all-of read) read-all) read-all-of

 	    #fn(":000n2D\x8a686201860>3_486<^1q015162:" #(#fn("8000n220A5138071061:F<10P92A5162:" #(#fn(io-eof?)

   reverse!))) read-all-of)

@@ -344,6 +348,9 @@

 								   #fn(ash)) ref-int16-LE)

 	    ref-int32-LE #fn("<000n2202101EMGE522101KMGr8522101r2MGr@522101r3MGrH52g461:" #(#fn(int32)

   #fn(ash)) ref-int32-LE)

+	    remprop #fn("8000n220A1O5386;3F042186052;3:042286062:" #(#fn(get)

+								     #fn(has?)

+								     #fn(del!)) #(#1#))

 	    repl #fn(":000n0DD\x8a4\x8a58420_485218485>2_485<5047260:" #(#fn("8000n0702151422735142425{267751S;3F04788451798551485w:4D:" #(princ

   "> " #fn(io-flush) *output-stream* #fn("5000n02060:" #(#fn(read)))

   #fn("6000n1207151422061:" #(#fn(io-discardbuffer) *input-stream* #fn(raise)))

@@ -404,7 +411,7 @@

   x newline #.apply)))))

 	    untrace #fn("9000n1200517185513A0220238551r2G62:D:" #(#fn(top-level-value) traced? #fn(set-top-level-value!)

 								  #fn(function:vals)) untrace)

-	    values #fn("8000z00B3:00=J500<:A0P:" #() #(#1#)) vars-to-env

+	    values #fn("8000z00B3:00=J500<:A0P:" #() #(#2#)) vars-to-env

 	    #fn(":000n32021182>2072230515163:" #(#fn(map)

 						 #fn("9000n2700210A52SS1FM63:" #(vinfo #fn(memq)))

 						 iota #fn(length)) vars-to-env)

@@ -414,5 +421,5 @@

 								   #fn(vector-alloc)

 								   #fn("9000n1A0F920G51p:" #())) vector-map)

 	    vinfo #fn("7000n30182e3:" #() vinfo) vinfo:heap? #.cadr vinfo:index

-	    #2# vinfo:sym #.car void

+	    #3# vinfo:sym #.car void

 	    #fn("5000n0D:" #() void) zero? #fn("6000n10El:" #() zero?))

--- a/system.lsp

+++ b/system.lsp

@@ -694,6 +694,33 @@

                   (cdr strlist))

         (iostream->string b))))

+; props -----------------------------------------------------------------------

+

+;; This is implemented in a slightly different fashion as expected:

+;;

+;;     *properties* : key → { symbol → value }

+;;

+;; The assumption here is that keys will most likely be the same across multiple symbols

+;; so it makes more sense to reduce the number of subtables for the *properties* table.

+(let ((*properties* (table)))

+  (set! putprop

+        (λ (sym key val)

+          (let ((kt (get *properties* key #f)))

+            (unless kt

+                (let ((t (table)))

+                  (put! *properties* key t)

+                  (set! kt t)))

+            (put! kt sym val)

+            val)))

+  (set! getprop

+        (λ (sym key (def #f))

+          (let ((kt (get *properties* key def)))

+            (and kt (get kt sym def)))))

+  (set! remprop

+        (λ (sym key)

+          (let ((kt (get *properties* key #f)))

+            (and kt (has? kt sym) (del! kt sym))))))

+

 ; toplevel --------------------------------------------------------------------

 (define (macrocall? e) (and (symbol? (car e))