renaming word-parameter to word-def; renaming word-property to word-prop

TODO.FACTOR.txt

@@ -6,6 +6,13 @@
 
 + ui:
 
+- resizing a gadget should probably relayout children
+- when halo is shown, rollovers don't disappear
+- halo outline should be the clipped rect
+- sometimes releasing moving gadget doesn't work
+- after moving halo, halo is underneath the gadget
+- resizing: drag relative to initial click pos
+- thumb gadgetry breaks with halo sometimes
 - mouse enter onto overlapping with interior, but not child, gadget
 - menu dragging
 - scrollable inspector
@@ -17,7 +24,6 @@
 - console: scroll to bottom
 - split preferred size and layouting
 - remove shelf/pile duplication
-- resizing gadgets
 - faster layout
 - faster repaint
 - closing inspectors

library/bootstrap/boot.factor

@@ -68,7 +68,7 @@ vocabularies get [
 
     "syntax" get [
         cdr dup word? [
-            "syntax" "vocabulary" set-word-property
+            "syntax" "vocabulary" set-word-prop
         ] [
             drop
         ] ifte

library/bootstrap/image.factor

@@ -191,7 +191,7 @@ M: f ' ( obj -- ptr )
         dup hashcode fixnum-tag immediate ,
         0 ,
         dup word-primitive ,
-        dup word-parameter ' ,
+        dup word-def ' ,
         dup word-props ' ,
         0 ,
         0 ,

library/bootstrap/primitives.factor

@@ -198,8 +198,8 @@ vocabularies get [
 ] [                                           
     3unlist >r create >r 1 + r> 2dup swap f define r>
     dup string? [
-        "stack-effect" set-word-property
+        "stack-effect" set-word-prop
     ] [
-        "infer-effect" set-word-property
+        "infer-effect" set-word-prop
     ] ifte
 ] each drop

library/compiler/alien.factor

@@ -126,7 +126,7 @@ SYMBOL: alien-parameters
     r> swap [ drop ] [ #cleanup swons , ] ifte
     linearize-returns ;
 
-#alien-invoke [ linearize-alien ] "linearizer" set-word-property
+#alien-invoke [ linearize-alien ] "linearizer" set-word-prop
 
 : alien-invoke ( ... returns library function parameters -- ... )
     #! Call a C library function.
@@ -140,9 +140,9 @@ SYMBOL: alien-parameters
     ] make-string throw ;
 
 \ alien-invoke [ [ object object object object ] [ ] ]
-"infer-effect" set-word-property
+"infer-effect" set-word-prop
 
-\ alien-invoke [ infer-alien ] "infer" set-word-property
+\ alien-invoke [ infer-alien ] "infer" set-word-prop
 
 global [
     "libraries" get [ <namespace> "libraries" set ] unless

library/compiler/compiler.factor

@@ -56,7 +56,7 @@ USE: test
     "verbose-compile" get [
         "Compiling " write dup . flush
     ] when
-    dup word-parameter ;
+    dup word-def ;
 
 GENERIC: (compile) ( word -- )
 
@@ -69,7 +69,7 @@ M: compound (compile) ( word -- )
 : precompile ( word -- )
     #! Print linear IR of word.
     [
-        word-parameter dataflow optimize linearize simplify [.]
+        word-def dataflow optimize linearize simplify [.]
     ] with-scope ;
 
 : compile-postponed ( -- )

library/compiler/generator.factor

@@ -34,7 +34,7 @@ SYMBOL: relocation-table
 
 : generate-node ( [[ op params ]] -- )
     #! Generate machine code for a node.
-    unswons dup "generator" word-property [
+    unswons dup "generator" word-prop [
         call
     ] [
         "No generator" throw
@@ -76,9 +76,9 @@ SYMBOL: previous-offset
         ] when*
     ] catch ;
 
-#label [ save-xt ] "generator" set-word-property
+#label [ save-xt ] "generator" set-word-prop
 
-#end-dispatch [ drop ] "generator" set-word-property
+#end-dispatch [ drop ] "generator" set-word-prop
 
 : type-tag ( type -- tag )
     #! Given a type number, return the tag number.

library/compiler/linearizer.factor

@@ -62,13 +62,13 @@ SYMBOL: #end-dispatch
     [ node-param get ] bind
     dup immediate? #push-immediate #push-indirect ?
     swons ,
-] "linearizer" set-word-property
+] "linearizer" set-word-prop
 
 : <label> ( -- label )
-    gensym  dup t "label" set-word-property ;
+    gensym  dup t "label" set-word-prop ;
 
 : label? ( obj -- ? )
-    dup word? [ "label" word-property ] [ drop f ] ifte ;
+    dup word? [ "label" word-prop ] [ drop f ] ifte ;
 
 : label, ( label -- )
     #label swons , ;
@@ -81,7 +81,7 @@ SYMBOL: #end-dispatch
 
 #simple-label [
     linearize-simple-label
-] "linearizer" set-word-property
+] "linearizer" set-word-prop
 
 : linearize-label ( node -- )
     #! Labels are tricky, because they might contain non-tail
@@ -97,7 +97,7 @@ SYMBOL: #end-dispatch
 
 #label [
     linearize-label
-] "linearizer" set-word-property
+] "linearizer" set-word-prop
 
 : linearize-ifte ( param -- )
     #! The parameter is a list of two lists, each one a dataflow
@@ -112,7 +112,7 @@ SYMBOL: #end-dispatch
 
 \ ifte [
     [ node-param get ] bind linearize-ifte
-] "linearizer" set-word-property
+] "linearizer" set-word-prop
 
 : dispatch-head ( vtable -- end label/code )
     #! Output the jump table insn and return a list of
@@ -133,6 +133,6 @@ SYMBOL: #end-dispatch
 
 \ dispatch [
     [ node-param get ] bind linearize-dispatch
-] "linearizer" set-word-property
+] "linearizer" set-word-prop
 
-#values [ drop ] "linearizer" set-word-property
+#values [ drop ] "linearizer" set-word-prop

library/compiler/optimizer.factor

@@ -131,43 +131,43 @@ SYMBOL: branch-returns
         node-param [ [ dupd kill-nodes ] map nip ] change
     ] extend , ;
 
-#push [ [ node-param get ] bind , ] "scan-literal" set-word-property
+#push [ [ node-param get ] bind , ] "scan-literal" set-word-prop
-#push [ consumes-literal? not ] "can-kill" set-word-property
+#push [ consumes-literal? not ] "can-kill" set-word-prop
-#push [ kill-node ] "kill-node" set-word-property
+#push [ kill-node ] "kill-node" set-word-prop
 
 #label [
     [ node-param get ] bind (scan-literals)
-] "scan-literal" set-word-property
+] "scan-literal" set-word-prop
 
 #label [
     [ node-param get ] bind can-kill?
-] "can-kill" set-word-property
+] "can-kill" set-word-prop
 
 #call-label [
     [ node-param get ] bind =
-] "calls-label" set-word-property
+] "calls-label" set-word-prop
 
 : calls-label? ( label list -- ? )
     [ "calls-label" [ 2drop f ] apply-dataflow ] some-with? ;
 
 #label [
     [ node-param get ] bind calls-label?
-] "calls-label" set-word-property
+] "calls-label" set-word-prop
 
 #simple-label [
     [ node-param get ] bind calls-label?
-] "calls-label" set-word-property
+] "calls-label" set-word-prop
 
 : branches-call-label? ( label list -- ? )
     [ calls-label? ] some-with? ;
 
 \ ifte [
     [ node-param get ] bind branches-call-label?
-] "calls-label" set-word-property
+] "calls-label" set-word-prop
 
 \ dispatch [
     [ node-param get ] bind branches-call-label?
-] "calls-label" set-word-property
+] "calls-label" set-word-prop
 
 : optimize-label ( -- op )
     #! Does the label node contain calls to itself?
@@ -179,7 +179,7 @@ SYMBOL: branch-returns
         optimize-label node-op set
         node-param [ kill-nodes ] change
     ] extend ,
-] "kill-node" set-word-property
+] "kill-node" set-word-prop
 
 #values [
     dupd consumes-literal? [
@@ -187,25 +187,25 @@ SYMBOL: branch-returns
     ] [
         drop t
     ] ifte
-] "can-kill" set-word-property
+] "can-kill" set-word-prop
 
-\ ifte [ scan-branches ] "scan-literal" set-word-property
+\ ifte [ scan-branches ] "scan-literal" set-word-prop
-\ ifte [ can-kill-branches? ] "can-kill" set-word-property
+\ ifte [ can-kill-branches? ] "can-kill" set-word-prop
-\ ifte [ kill-branches ] "kill-node" set-word-property
+\ ifte [ kill-branches ] "kill-node" set-word-prop
 
-\ dispatch [ scan-branches ] "scan-literal" set-word-property
+\ dispatch [ scan-branches ] "scan-literal" set-word-prop
-\ dispatch [ can-kill-branches? ] "can-kill" set-word-property
+\ dispatch [ can-kill-branches? ] "can-kill" set-word-prop
-\ dispatch [ kill-branches ] "kill-node" set-word-property
+\ dispatch [ kill-branches ] "kill-node" set-word-prop
 
 ! Don't care about inputs to recursive combinator calls
-#call-label [ 2drop t ] "can-kill" set-word-property
+#call-label [ 2drop t ] "can-kill" set-word-prop
 
-\ drop [ 2drop t ] "can-kill" set-word-property
+\ drop [ 2drop t ] "can-kill" set-word-prop
-\ drop [ kill-node ] "kill-node" set-word-property
+\ drop [ kill-node ] "kill-node" set-word-prop
-\ dup [ 2drop t ] "can-kill" set-word-property
+\ dup [ 2drop t ] "can-kill" set-word-prop
-\ dup [ kill-node ] "kill-node" set-word-property
+\ dup [ kill-node ] "kill-node" set-word-prop
-\ swap [ 2drop t ] "can-kill" set-word-property
+\ swap [ 2drop t ] "can-kill" set-word-prop
-\ swap [ kill-node ] "kill-node" set-word-property
+\ swap [ kill-node ] "kill-node" set-word-prop
 
 : kill-mask ( killing inputs -- mask )
     [ over [ over value= ] some? >boolean nip ] map nip ;
@@ -219,15 +219,15 @@ SYMBOL: branch-returns
     ] keep
     over [ [ node-op set ] extend , ] [ 2drop ] ifte ;
 
-\ over [ 2drop t ] "can-kill" set-word-property
+\ over [ 2drop t ] "can-kill" set-word-prop
 \ over [
     [
         [[ [ f f ] over ]]
         [[ [ f t ] dup  ]]
     ] reduce-stack-op
-] "kill-node" set-word-property
+] "kill-node" set-word-prop
 
-\ pick [ 2drop t ] "can-kill" set-word-property
+\ pick [ 2drop t ] "can-kill" set-word-prop
 \ pick [
     [
         [[ [ f f f ] pick ]]
@@ -235,9 +235,9 @@ SYMBOL: branch-returns
         [[ [ f t f ] over ]]
         [[ [ f t t ] dup  ]]
     ] reduce-stack-op
-] "kill-node" set-word-property
+] "kill-node" set-word-prop
 
-\ >r [ 2drop t ] "can-kill" set-word-property
+\ >r [ 2drop t ] "can-kill" set-word-prop
-\ >r [ kill-node ] "kill-node" set-word-property
+\ >r [ kill-node ] "kill-node" set-word-prop
-\ r> [ 2drop t ] "can-kill" set-word-property
+\ r> [ 2drop t ] "can-kill" set-word-prop
-\ r> [ kill-node ] "kill-node" set-word-property
+\ r> [ kill-node ] "kill-node" set-word-prop

library/compiler/simplifier.factor

@@ -11,7 +11,7 @@ SYMBOL: simplifying
     #! A list of quotations with stack effect
     #! ( linear -- linear ? ) that can simplify the first node
     #! in the linear IR.
-    car car "simplifiers" word-property ;
+    car car "simplifiers" word-prop ;
 
 : simplify-node ( linear list -- linear ? )
     dup [
@@ -45,7 +45,7 @@ SYMBOL: simplifying
         dup car cdr simplifying get label-called?
         [ f ] [ cdr t ] ifte
     ]
-] "simplifiers" set-word-property
+] "simplifiers" set-word-prop
 
 : next-physical? ( op linear -- ? )
     cdr dup [ car car = ] [ 2drop f ] ifte ;
@@ -55,10 +55,10 @@ SYMBOL: simplifying
     #! its param.
     over next-physical? [ cdr unswons cdr t ] [ f f ] ifte ;
 
-\ >r [ [ \ r> cancel nip ] ] "simplifiers" set-word-property
+\ >r [ [ \ r> cancel nip ] ] "simplifiers" set-word-prop
-\ r> [ [ \ >r cancel nip ] ] "simplifiers" set-word-property
+\ r> [ [ \ >r cancel nip ] ] "simplifiers" set-word-prop
-\ dup [ [ \ drop cancel nip ] ] "simplifiers" set-word-property
+\ dup [ [ \ drop cancel nip ] ] "simplifiers" set-word-prop
-\ swap [ [ \ swap cancel nip ] ] "simplifiers" set-word-property
+\ swap [ [ \ swap cancel nip ] ] "simplifiers" set-word-prop
 
 \ drop [
     [
@@ -70,7 +70,7 @@ SYMBOL: simplifying
             #replace-indirect swons swons t
         ] when
     ]
-] "simplifiers" set-word-property
+] "simplifiers" set-word-prop
 
 : find-label ( label -- rest )
     simplifying get [
@@ -78,19 +78,19 @@ SYMBOL: simplifying
     ] some? nip ;
 
 : next-logical ( linear -- linear )
-    dup car car "next-logical" word-property call ;
+    dup car car "next-logical" word-prop call ;
 
 #label [
     cdr next-logical
-] "next-logical" set-word-property
+] "next-logical" set-word-prop
 
 #jump-label [
     car cdr find-label cdr
-] "next-logical" set-word-property
+] "next-logical" set-word-prop
 
 #target-label [
     car cdr find-label cdr
-] "next-logical" set-word-property
+] "next-logical" set-word-prop
 
 : next-logical? ( op linear -- ? )
     next-logical dup [ car car = ] [ 2drop f ] ifte ;
@@ -104,11 +104,11 @@ SYMBOL: simplifying
 
 #call [
     [ #return #jump reduce ]
-] "simplifiers" set-word-property
+] "simplifiers" set-word-prop
 
 #call-label [
     [ #return #jump-label reduce ]
-] "simplifiers" set-word-property
+] "simplifiers" set-word-prop
 
 : double-jump ( linear op1 op2 -- linear ? )
     #! A jump to a jump is just a jump. If the next logical node
@@ -145,13 +145,13 @@ SYMBOL: simplifying
     [ #jump #jump double-jump ]
     [ useless-jump ]
     [ dead-code ]
-] "simplifiers" set-word-property
+] "simplifiers" set-word-prop
 
 #target-label [
     [ #jump-label #target-label double-jump ]
     [ #jump #target double-jump ]
-] "simplifiers" set-word-property
+] "simplifiers" set-word-prop
 
-#jump [ [ dead-code ] ] "simplifiers" set-word-property
+#jump [ [ dead-code ] ] "simplifiers" set-word-prop
-#return [ [ dead-code ] ] "simplifiers" set-word-property
+#return [ [ dead-code ] ] "simplifiers" set-word-prop
-#end-dispatch [ [ dead-code ] ] "simplifiers" set-word-property
+#end-dispatch [ [ dead-code ] ] "simplifiers" set-word-prop

library/compiler/x86/assembler.factor

@@ -87,7 +87,7 @@ GENERIC: displacement ( op -- )
 ( Register operands -- eg, ECX                                 )
 : REGISTER:
     CREATE dup define-symbol
-    scan-word "register" set-word-property ; parsing
+    scan-word "register" set-word-prop ; parsing
 
 REGISTER: EAX 0
 REGISTER: ECX 1
@@ -98,10 +98,10 @@ REGISTER: EBP 5
 REGISTER: ESI 6
 REGISTER: EDI 7
 
-PREDICATE: word register "register" word-property ;
+PREDICATE: word register "register" word-prop ;
 
 M: register modifier drop BIN: 11 ;
-M: register register "register" word-property ;
+M: register register "register" word-prop ;
 M: register displacement drop ;
 
 ( Indirect register operands -- eg, [ ECX ]                    )

library/compiler/x86/fixnum.factor

@@ -43,7 +43,7 @@ USE: math-internals
 ! prototype to test the assembler.
 
 : self ( word -- )
-    f swap dup "infer-effect" word-property (consume/produce) ;
+    f swap dup "infer-effect" word-prop (consume/produce) ;
 
 : fixnum-insn ( overflow opcode -- )
     #! This needs to be factored.
@@ -59,15 +59,15 @@ USE: math-internals
 
 \ fixnum+ [
     drop \ fixnum+ \ ADD fixnum-insn
-] "generator" set-word-property
+] "generator" set-word-prop
 
-\ fixnum+ [ \ fixnum+ self ] "infer" set-word-property
+\ fixnum+ [ \ fixnum+ self ] "infer" set-word-prop
 
 \ fixnum- [
     drop \ fixnum- \ SUB fixnum-insn
-] "generator" set-word-property
+] "generator" set-word-prop
 
-\ fixnum- [ \ fixnum- self ] "infer" set-word-property
+\ fixnum- [ \ fixnum- self ] "infer" set-word-prop
 
 \ fixnum* [
     drop
@@ -81,9 +81,9 @@ USE: math-internals
     ESI 4 SUB
     [ ESI ] EAX MOV
     r> compiled-offset swap patch
-] "generator" set-word-property
+] "generator" set-word-prop
 
-\ fixnum* [ \ fixnum* self ] "infer" set-word-property
+\ fixnum* [ \ fixnum* self ] "infer" set-word-prop
 
 \ fixnum/i [
     drop
@@ -98,9 +98,9 @@ USE: math-internals
     ESI 4 SUB
     [ ESI ] EAX MOV
     r> compiled-offset swap patch
-] "generator" set-word-property
+] "generator" set-word-prop
 
-\ fixnum/i [ \ fixnum/i self ] "infer" set-word-property
+\ fixnum/i [ \ fixnum/i self ] "infer" set-word-prop
 
 \ fixnum-mod [
     drop
@@ -115,9 +115,9 @@ USE: math-internals
     ESI 4 SUB
     [ ESI ] EDX MOV
     r> compiled-offset swap patch
-] "generator" set-word-property
+] "generator" set-word-prop
 
-\ fixnum-mod [ \ fixnum-mod self ] "infer" set-word-property
+\ fixnum-mod [ \ fixnum-mod self ] "infer" set-word-prop
 
 \ fixnum/mod [
     drop
@@ -132,9 +132,9 @@ USE: math-internals
     [ ESI -4 ] EAX MOV
     [ ESI ] EDX MOV
     r> compiled-offset swap patch
-] "generator" set-word-property
+] "generator" set-word-prop
 
-\ fixnum/mod [ \ fixnum/mod self ] "infer" set-word-property
+\ fixnum/mod [ \ fixnum/mod self ] "infer" set-word-prop
 
 \ arithmetic-type [
     drop
@@ -150,6 +150,6 @@ USE: math-internals
     EAX 3 SHL
     PUSH-DS
     compiled-offset swap patch
-] "generator" set-word-property
+] "generator" set-word-prop
 
-\ arithmetic-type [ \ arithmetic-type self ] "infer" set-word-property
+\ arithmetic-type [ \ arithmetic-type self ] "infer" set-word-prop

library/compiler/x86/generator.factor

@@ -8,7 +8,7 @@ math memory namespaces words ;
     PEEK-DS
     2unlist type-tag >r cell * r> - EAX swap 2list EAX swap MOV
     [ ESI ] EAX MOV
-] "generator" set-word-property
+] "generator" set-word-prop
 
 : compile-call-label ( label -- )
     0 CALL fixup compiled-offset defer-xt ;
@@ -24,21 +24,21 @@ math memory namespaces words ;
 
 #call [
     compile-call
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #jump [
     dup dup postpone-word
     compile-jump-label
     t rel-word
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #call-label [
     compile-call-label
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #jump-label [
     compile-jump-label
-] "generator" set-word-property
+] "generator" set-word-prop
 
 : compile-jump-t ( word -- )
     POP-DS
@@ -49,11 +49,11 @@ math memory namespaces words ;
 
 #jump-t-label [
     compile-jump-t
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #jump-t [
     dup compile-jump-t t rel-word
-] "generator" set-word-property
+] "generator" set-word-prop
 
 : compile-jump-f ( word -- )
     POP-DS
@@ -64,17 +64,17 @@ math memory namespaces words ;
 
 #jump-f-label [
     compile-jump-f
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #jump-f [
     dup compile-jump-f t rel-word
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #return-to [
     0 PUSH fixup 0 defer-xt rel-address
-] "generator" set-word-property
+] "generator" set-word-prop
 
-#return [ drop RET ] "generator" set-word-property
+#return [ drop RET ] "generator" set-word-prop
 
 \ dispatch [
     #! Compile a piece of code that jumps to an offset in a
@@ -87,33 +87,33 @@ math memory namespaces words ;
     [ EAX ] JMP
     compile-aligned
     compiled-offset swap set-compiled-cell ( fixup -- )
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #target-label [
     #! Jump table entries are absolute addresses.
     compile-target rel-address
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #target [
     #! Jump table entries are absolute addresses.
     dup dup postpone-word compile-target f rel-word
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #c-call [
     uncons load-dll 2dup dlsym CALL t rel-dlsym
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #unbox [
     dup f dlsym CALL f t rel-dlsym
     EAX PUSH
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #box [
     EAX PUSH
     dup f dlsym CALL f t rel-dlsym
     ESP 4 ADD
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #cleanup [
     dup 0 = [ drop ] [ ESP swap ADD ] ifte
-] "generator" set-word-property
+] "generator" set-word-prop

library/compiler/x86/stack.factor

@@ -52,32 +52,32 @@ USING: inference kernel assembler words lists alien memory ;
 #push-immediate [
     ESI 4 ADD
     immediate-literal
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #push-indirect [
     indirect-literal
     PUSH-DS
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #replace-immediate [
     immediate-literal
-] "generator" set-word-property
+] "generator" set-word-prop
 
 #replace-indirect [
     indirect-literal
     [ ESI ] EAX MOV
-] "generator" set-word-property
+] "generator" set-word-prop
 
 \ drop [
     drop
     ESI 4 SUB
-] "generator" set-word-property
+] "generator" set-word-prop
 
 \ dup [
     drop
     PEEK-DS
     PUSH-DS
-] "generator" set-word-property
+] "generator" set-word-prop
 
 \ swap [
     drop
@@ -85,29 +85,29 @@ USING: inference kernel assembler words lists alien memory ;
     EDX [ ESI -4 ] MOV
     [ ESI ] EDX MOV
     [ ESI -4 ] EAX MOV
-] "generator" set-word-property
+] "generator" set-word-prop
 
 \ over [
     drop
     EAX [ ESI -4 ] MOV
     PUSH-DS
-] "generator" set-word-property
+] "generator" set-word-prop
 
 \ pick [
     drop
     EAX [ ESI -8 ] MOV
     PUSH-DS
-] "generator" set-word-property
+] "generator" set-word-prop
 
 \ >r [
     drop
     POP-DS
     ECX CS>
     PUSH-CS
-] "generator" set-word-property
+] "generator" set-word-prop
 
 \ r> [
     drop
     POP-CS
     PUSH-DS
-] "generator" set-word-property
+] "generator" set-word-prop

library/compiler/xt.factor

@@ -57,7 +57,7 @@ SYMBOL: compiled-xts
     compiled-offset swap compiled-xts [ acons ] change ;
 
 : commit-xt ( xt word -- )
-    dup t "compiled" set-word-property  set-word-xt ;
+    dup t "compiled" set-word-prop  set-word-xt ;
 
 : commit-xts ( -- )
     compiled-xts get [ unswons commit-xt ] each

library/generic/builtin.factor

@@ -8,32 +8,32 @@ words vectors ;
 SYMBOL: builtin
 
 builtin [
-    "builtin-type" word-property unit
+    "builtin-type" word-prop unit
-] "builtin-supertypes" set-word-property
+] "builtin-supertypes" set-word-prop
 
 builtin [
     ( generic vtable definition class -- )
     rot set-vtable drop
-] "add-method" set-word-property
+] "add-method" set-word-prop
 
-builtin 50 "priority" set-word-property
+builtin 50 "priority" set-word-prop
 
 ! All builtin types are equivalent in ordering
-builtin [ 2drop t ] "class<" set-word-property
+builtin [ 2drop t ] "class<" set-word-prop
 
 : builtin-predicate ( type# symbol -- )
     #! We call search here because we have to know if the symbol
     #! is t or f, and cannot compare type numbers or symbol
     #! identity during bootstrapping.
     dup "f" [ "syntax" ] search = [
-        nip [ not ] "predicate" set-word-property
+        nip [ not ] "predicate" set-word-prop
     ] [
         dup "t" [ "syntax" ] search = [
-            nip [ ] "predicate" set-word-property
+            nip [ ] "predicate" set-word-prop
         ] [
             dup predicate-word
             [ rot [ swap type eq? ] cons define-compound ] keep
-            unit "predicate" set-word-property
+            unit "predicate" set-word-prop
         ] ifte
     ] ifte ;
 
@@ -41,7 +41,7 @@ builtin [ 2drop t ] "class<" set-word-property
     >r swap
     dup intern-symbol
     2dup builtin-predicate
-    [ swap "builtin-type" set-word-property ] keep
+    [ swap "builtin-type" set-word-prop ] keep
     dup builtin define-class r> define-slots ;
 
 : builtin-type ( n -- symbol )

library/generic/complement.factor

@@ -9,10 +9,10 @@ vectors words ;
 SYMBOL: complement
 
 complement [
-    "complement" word-property builtin-supertypes
+    "complement" word-prop builtin-supertypes
     num-types count
     difference
-] "builtin-supertypes" set-word-property
+] "builtin-supertypes" set-word-prop
 
 complement [
     ( generic vtable definition class -- )
@@ -22,20 +22,20 @@ complement [
             dup [ add-method ] [ 2drop 2drop ] ifte
         ] keep
     ] repeat 3drop
-] "add-method" set-word-property
+] "add-method" set-word-prop
 
-complement 90 "priority" set-word-property
+complement 90 "priority" set-word-prop
 
 complement [
-    swap "complement" word-property
+    swap "complement" word-prop
-    swap "complement" word-property
+    swap "complement" word-prop
     class< not
-] "class<" set-word-property
+] "class<" set-word-prop
 
 : complement-predicate ( complement -- list )
-    "predicate" word-property [ not ] append ;
+    "predicate" word-prop [ not ] append ;
 
 : define-complement ( class complement -- )
-    2dup "complement" set-word-property
+    2dup "complement" set-word-prop
-    dupd complement-predicate "predicate" set-word-property
+    dupd complement-predicate "predicate" set-word-prop
     complement define-class ;

library/generic/generic.factor

@@ -23,33 +23,33 @@ namespaces parser strings words vectors math math-internals ;
 ! methods are added to the vtable.
 
 : metaclass ( class -- metaclass )
-    "metaclass" word-property ;
+    "metaclass" word-prop ;
 
 : builtin-supertypes ( class -- list )
     #! A list of builtin supertypes of the class.
-    dup metaclass "builtin-supertypes" word-property call ;
+    dup metaclass "builtin-supertypes" word-prop call ;
 
 : set-vtable ( definition class vtable -- )
-    >r "builtin-type" word-property r> set-vector-nth ;
+    >r "builtin-type" word-prop r> set-vector-nth ;
 
-: class-ord ( class -- n ) metaclass "priority" word-property ;
+: class-ord ( class -- n ) metaclass "priority" word-prop ;
 
 : class< ( cls1 cls2 -- ? )
     #! Test if class1 is a subclass of class2.
     over metaclass over metaclass = [
-        dup metaclass "class<" word-property call
+        dup metaclass "class<" word-prop call
     ] [
         swap class-ord swap class-ord <
     ] ifte ;
 
 : methods ( generic -- alist )
-    "methods" word-property hash>alist [ 2car class< ] sort ;
+    "methods" word-prop hash>alist [ 2car class< ] sort ;
 
 : add-method ( generic vtable definition class -- )
     #! Add the method entry to the vtable. Unlike define-method,
     #! this is called at vtable build time, and in the sorted
     #! order.
-    dup metaclass "add-method" word-property [
+    dup metaclass "add-method" word-prop [
         [ "Metaclass is missing add-method" throw ]
     ] unless* call ;
 
@@ -65,18 +65,20 @@ namespaces parser strings words vectors math math-internals ;
     ] each nip ;
 
 : make-generic ( word vtable -- )
-    over "combination" word-property cons define-compound ;
+    #! (define-compound) is used to avoid resetting generic
+    #! word properties.
+    over "combination" word-prop cons (define-compound) ;
 
 : define-method ( class generic definition -- )
     -rot
-    [ "methods" word-property set-hash ] keep dup <vtable>
+    [ "methods" word-prop set-hash ] keep dup <vtable>
     make-generic ;
 
 : init-methods ( word -- )
-     dup "methods" word-property [
+     dup "methods" word-prop [
          drop
      ] [
-        <namespace> "methods" set-word-property
+        <namespace> "methods" set-word-prop
      ] ifte ;
 
 ! Defining generic words
@@ -84,8 +86,8 @@ namespaces parser strings words vectors math math-internals ;
     #! Takes a combination parameter. A combination is a
     #! quotation that takes some objects and a vtable from the
     #! stack, and calls the appropriate row of the vtable.
-    [ swap "definer" set-word-property ] keep
+    [ swap "definer" set-word-prop ] keep
-    [ swap "combination" set-word-property ] keep
+    [ swap "combination" set-word-prop ] keep
     dup init-methods
     dup <vtable> make-generic ;
 
@@ -93,7 +95,7 @@ namespaces parser strings words vectors math math-internals ;
     >r dup type r> dispatch ; inline
 
 PREDICATE: compound generic ( word -- ? )
-    "combination" word-property [ single-combination ] = ;
+    "combination" word-prop [ single-combination ] = ;
 
 : arithmetic-combination ( n n vtable -- )
     #! Note that the numbers remain on the stack, possibly after
@@ -101,7 +103,7 @@ PREDICATE: compound generic ( word -- ? )
     >r arithmetic-type r> dispatch ; inline
 
 PREDICATE: compound 2generic ( word -- ? )
-    "combination" word-property [ arithmetic-combination ] = ;
+    "combination" word-prop [ arithmetic-combination ] = ;
 
 ! Maps lists of builtin type numbers to class objects.
 SYMBOL: classes
@@ -134,7 +136,7 @@ SYMBOL: object
     intersection lookup-union ;
 
 : define-class ( class metaclass -- )
-    dupd "metaclass" set-word-property
+    dupd "metaclass" set-word-prop
     dup builtin-supertypes [ > ] sort
     classes get set-hash ;
 

library/generic/null.factor

@@ -5,9 +5,9 @@ USING: kernel words ;
 
 ! Null metaclass with no instances.
 SYMBOL: null
-null [ drop [ ] ] "builtin-supertypes" set-word-property
+null [ drop [ ] ] "builtin-supertypes" set-word-prop
-null [ 2drop 2drop ] "add-method" set-word-property
+null [ 2drop 2drop ] "add-method" set-word-prop
-null [ drop f ] "predicate" set-word-property
+null [ drop f ] "predicate" set-word-prop
-null 100 "priority" set-word-property
+null 100 "priority" set-word-prop
-null [ 2drop t ] "class<" set-word-property
+null [ 2drop t ] "class<" set-word-prop
 null null define-class

library/generic/object.factor

@@ -8,19 +8,19 @@ SYMBOL: object
 
 object [
     drop num-types count
-] "builtin-supertypes" set-word-property
+] "builtin-supertypes" set-word-prop
 
 object [
     ( generic vtable definition class -- )
     drop over vector-length [
         3dup rot set-vector-nth
     ] repeat 3drop
-] "add-method" set-word-property
+] "add-method" set-word-prop
 
-object [ drop t ] "predicate" set-word-property
+object [ drop t ] "predicate" set-word-prop
 
-object 100 "priority" set-word-property
+object 100 "priority" set-word-prop
 
-object [ 2drop t ] "class<" set-word-property
+object [ 2drop t ] "class<" set-word-prop
 
 object object define-class

library/generic/predicate.factor

@@ -9,7 +9,7 @@ SYMBOL: predicate
 
 : predicate-dispatch ( existing definition class -- dispatch )
     [
-        \ dup , "predicate" word-property append, , , \ ifte ,
+        \ dup , "predicate" word-prop append, , , \ ifte ,
     ] make-list ;
 
 : predicate-method ( vtable definition class type# -- )
@@ -20,8 +20,8 @@ SYMBOL: predicate
     ] 2keep set-vector-nth ;
 
 predicate [
-    "superclass" word-property builtin-supertypes
+    "superclass" word-prop builtin-supertypes
-] "builtin-supertypes" set-word-property
+] "builtin-supertypes" set-word-prop
 
 predicate [
     ( generic vtable definition class -- )
@@ -29,20 +29,20 @@ predicate [
         ( vtable definition class type# )
         >r 3dup r> predicate-method
     ] each 2drop 2drop
-] "add-method" set-word-property
+] "add-method" set-word-prop
 
-predicate 25 "priority" set-word-property
+predicate 25 "priority" set-word-prop
 
 predicate [
     2dup = [
         2drop t
     ] [
-        >r "superclass" word-property r> class<
+        >r "superclass" word-prop r> class<
     ] ifte
-] "class<" set-word-property
+] "class<" set-word-prop
 
 : define-predicate ( class predicate definition -- )
-    pick "superclass" word-property "predicate" word-property
+    pick "superclass" word-prop "predicate" word-prop
     [ \ dup , append, , [ drop f ] , \ ifte , ] make-list
     define-compound
-    predicate "metaclass" set-word-property ;
+    predicate "metaclass" set-word-prop ;

library/generic/slots.factor

@@ -43,7 +43,7 @@ strings words ;
     #! the form [ slot reader writer ]. slot is an integer,
     #! reader and writer are either words, strings or f.
     intern-slots
-    2dup "slots" set-word-property
+    2dup "slots" set-word-prop
     [ 3unlist define-slot ] each-with ;
 
 : reader-word ( class name -- word )
@@ -63,7 +63,7 @@ strings words ;
     #! the benefit of tuples. Built-in types do not have
     #! delegate slots.
     swap >r [ "delegate" = dup [ >r 1 + r> ] unless ] some? [
-        r> swap "delegate-slot" set-word-property
+        r> swap "delegate-slot" set-word-prop
     ] [
         r> 2drop
     ] ifte ;

library/generic/tuple.factor

@@ -30,7 +30,7 @@ UNION: arrayed array tuple ;
     ] repeat nip ;
 
 : literal-tuple ( list -- tuple )
-    dup car "tuple-size" word-property over length over = [
+    dup car "tuple-size" word-prop over length over = [
         (literal-tuple)
     ] [
         "Incorrect tuple length" throw
@@ -46,14 +46,14 @@ UNION: arrayed array tuple ;
     #! If the new list of slots is different from the previous,
     #! forget the old definition.
     >r "use" get search dup [
-        dup "tuple-size" word-property r> length 1 + =
+        dup "tuple-size" word-prop r> length 1 + =
         [ drop ] [ forget ] ifte
     ] [
         r> 2drop
     ] ifte ;
 
 : tuple-slots ( tuple slots -- )
-    2dup length 1 + "tuple-size" set-word-property
+    2dup length 1 + "tuple-size" set-word-prop
     3 -rot simple-slots ;
 
 : constructor-word ( word -- word )
@@ -61,12 +61,12 @@ UNION: arrayed array tuple ;
 
 : define-constructor ( word def -- )
     >r [ constructor-word ] keep [
-        dup literal, "tuple-size" word-property , \ make-tuple ,
+        dup literal, "tuple-size" word-prop , \ make-tuple ,
     ] make-list r> append define-compound ;
 
 : default-constructor ( tuple -- )
     dup [
-        "slots" word-property
+        "slots" word-prop
         reverse [ last unit , \ keep , ] each
     ] make-list define-constructor ;
 
@@ -76,13 +76,13 @@ UNION: arrayed array tuple ;
     dup save-location
     dup intern-symbol
     dup tuple-predicate
-    dup tuple "metaclass" set-word-property
+    dup tuple "metaclass" set-word-prop
     dup r> tuple-slots
     default-constructor ;
 
 : tuple-delegate ( tuple -- obj )
     dup tuple? [
-        dup class "delegate-slot" word-property dup [
+        dup class "delegate-slot" word-prop dup [
             >fixnum slot
         ] [
             2drop f
@@ -123,7 +123,7 @@ UNION: arrayed array tuple ;
 : default-tuple-method ( generic -- quot )
     #! If the generic does not define a specific method for a
     #! tuple, execute the return value of this.
-    dup "methods" word-property
+    dup "methods" word-prop
     tuple over hash* dup [
         2nip cdr
     ] [
@@ -141,7 +141,7 @@ UNION: arrayed array tuple ;
     #! Generate a quotation that performs tuple class dispatch
     #! for methods defined on the given generic.
     dup default-tuple-method \ drop swons
-    swap "methods" word-property hash>quot
+    swap "methods" word-prop hash>quot
     [ dup class ] swap append ;
 
 : add-tuple-dispatch ( word vtable -- )
@@ -153,7 +153,7 @@ UNION: arrayed array tuple ;
     dup array-capacity dup <tuple> [ -rot copy-array ] keep ;
 
 : clone-delegate ( tuple -- )
-    dup class "delegate-slot" word-property dup [
+    dup class "delegate-slot" word-prop dup [
         [ >fixnum slot clone ] 2keep set-slot
     ] [
         2drop
@@ -187,12 +187,12 @@ M: tuple hashcode ( vec -- n )
 tuple [
     ( generic vtable definition class -- )
     2drop add-tuple-dispatch
-] "add-method" set-word-property
+] "add-method" set-word-prop
 
 tuple [
-    drop tuple "builtin-type" word-property unit
+    drop tuple "builtin-type" word-prop unit
-] "builtin-supertypes" set-word-property
+] "builtin-supertypes" set-word-prop
 
-tuple 10 "priority" set-word-property
+tuple 10 "priority" set-word-prop
 
-tuple [ 2drop t ] "class<" set-word-property
+tuple [ 2drop t ] "class<" set-word-prop

library/generic/union.factor

@@ -8,25 +8,25 @@ words vectors ;
 SYMBOL: union
 
 union [
-    [ ] swap "members" word-property [
+    [ ] swap "members" word-prop [
         builtin-supertypes append
     ] each
-] "builtin-supertypes" set-word-property
+] "builtin-supertypes" set-word-prop
 
 union [
     ( generic vtable definition class -- )
-    "members" word-property [ >r 3dup r> add-method ] each 3drop
+    "members" word-prop [ >r 3dup r> add-method ] each 3drop
-] "add-method" set-word-property
+] "add-method" set-word-prop
 
-union 30 "priority" set-word-property
+union 30 "priority" set-word-prop
 
-union [ 2drop t ] "class<" set-word-property
+union [ 2drop t ] "class<" set-word-prop
 
 : union-predicate ( definition -- list )
     [
         [
             \ dup ,
-            unswons "predicate" word-property append,
+            unswons "predicate" word-prop append,
             [ drop t ] ,
             union-predicate ,
             \ ifte ,
@@ -46,5 +46,5 @@ union [ 2drop t ] "class<" set-word-property
         ] keep ?
     ] map
     [ union-predicate define-compound ] keep
-    dupd "members" set-word-property
+    dupd "members" set-word-prop
     union define-class ;

library/httpd/browser-responder.factor

@@ -123,7 +123,7 @@ errors unparser logging listener url-encoding hashtables memory ;
 
 : word-uses ( word -- list )
   #! Return a list of vocabularies that the given word uses.
-  word-parameter flatten [ word? ] subset [
+  word-def flatten [ word? ] subset [
     word-vocabulary
   ] map ;
 

library/inference/branches.factor

@@ -210,7 +210,7 @@ SYMBOL: cloned
         dynamic-ifte
     ] ifte ;
 
-\ ifte [ infer-ifte ] "infer" set-word-property
+\ ifte [ infer-ifte ] "infer" set-word-prop
 
 : vtable>list ( value -- list )
     dup value-recursion swap literal-value vector>list
@@ -247,6 +247,6 @@ USE: kernel-internals
         dynamic-dispatch
     ] ifte ;
 
-\ dispatch [ infer-dispatch ] "infer" set-word-property
+\ dispatch [ infer-dispatch ] "infer" set-word-prop
 \ dispatch [ [ fixnum vector ] [ ] ]
-"infer-effect" set-word-property
+"infer-effect" set-word-prop

library/inference/dataflow.factor

@@ -110,7 +110,7 @@ SYMBOL: node-param
     #! if its not defined, apply default quotation to
     #! ( node ) otherwise apply property quotation to
     #! ( node ).
-    >r >r dup [ node-op get ] bind r> word-property dup [
+    >r >r dup [ node-op get ] bind r> word-prop dup [
         call r> drop
     ] [
         drop r> call

library/inference/inference.factor

@@ -156,7 +156,7 @@ M: object apply-object apply-literal ;
 
 : terminator? ( obj -- ? )
     #! Does it throw an error?
-    dup word? [ "terminator" word-property ] [ drop f ] ifte ;
+    dup word? [ "terminator" word-prop ] [ drop f ] ifte ;
 
 : handle-terminator ( quot -- )
     #! If the quotation throws an error, do not count its stack

library/inference/stack.factor

@@ -36,22 +36,22 @@ USE: words
     f \ >r dataflow, [ 1 0 node-inputs ] extend
     pop-d push-r
     [ 0 1 node-outputs ] bind
-] "infer" set-word-property
+] "infer" set-word-prop
 
 \ r> [
     f \ r> dataflow, [ 0 1 node-inputs ] extend
     pop-r push-d
     [ 1 0 node-outputs ] bind
-] "infer" set-word-property
+] "infer" set-word-prop
 
 : partial-eval ( word -- )
     #! Partially evaluate a word.
     f over dup
-    "infer-effect" word-property
+    "infer-effect" word-prop
     [ host-word ] with-dataflow ;
 
-\ drop [ \ drop partial-eval ] "infer" set-word-property
+\ drop [ \ drop partial-eval ] "infer" set-word-prop
-\ dup  [ \ dup  partial-eval ] "infer" set-word-property
+\ dup  [ \ dup  partial-eval ] "infer" set-word-prop
-\ swap [ \ swap partial-eval ] "infer" set-word-property
+\ swap [ \ swap partial-eval ] "infer" set-word-prop
-\ over [ \ over partial-eval ] "infer" set-word-property
+\ over [ \ over partial-eval ] "infer" set-word-prop
-\ pick [ \ pick partial-eval ] "infer" set-word-property
+\ pick [ \ pick partial-eval ] "infer" set-word-prop

library/inference/types.factor

@@ -18,12 +18,12 @@ lists math namespaces strings vectors words stdio prettyprint ;
 
 : computed-slot ( -- )
     "Computed slot access is slower" inference-warning
-    \ slot dup "infer-effect" word-property consume/produce ;
+    \ slot dup "infer-effect" word-prop consume/produce ;
 
 \ slot [
     [ object fixnum ] ensure-d
     fast-slot? [ fast-slot ] [ computed-slot ] ifte
-] "infer" set-word-property
+] "infer" set-word-prop
 
 : type-value-map ( value -- )
     num-types
@@ -47,4 +47,4 @@ lists math namespaces strings vectors words stdio prettyprint ;
 \ type [
     [ object ] ensure-d
     literal-type? [ literal-type ] [ computed-type ] ifte
-] "infer" set-word-property
+] "infer" set-word-prop

library/inference/words.factor

@@ -32,15 +32,12 @@ strings vectors words hashtables parser prettyprint ;
 : no-effect ( word -- )
     "Unknown stack effect: " swap word-name cat2 inference-error ;
 
-: recursive? ( word -- ? )
-    dup word-parameter tree-contains? ;
-
 : inline-compound ( word -- effect node )
     #! Infer the stack effect of a compound word in the current
     #! inferencer instance. If the word in question is recursive
     #! we infer its stack effect inside a new block.
-    gensym over word-parameter cons [
+    gensym over word-def cons [
-        word-parameter infer-quot effect
+        word-def infer-quot effect
     ] with-block ;
 
 : infer-compound ( word -- )
@@ -50,14 +47,14 @@ strings vectors words hashtables parser prettyprint ;
         [
             recursive-state get init-inference
             dup dup inline-compound drop present-effect
-            [ "infer-effect" set-word-property ] keep
+            [ "infer-effect" set-word-prop ] keep
         ] with-scope consume/produce
     ] [
         [
             >r branches-can-fail? [
                 drop
             ] [
-                t "no-effect" set-word-property
+                t "no-effect" set-word-prop
             ] ifte r> rethrow
         ] when*
     ] catch ;
@@ -70,7 +67,7 @@ M: object (apply-word) ( word -- )
 
 M: compound (apply-word) ( word -- )
     #! Infer a compound word's stack effect.
-    dup "no-effect" word-property [
+    dup "no-effect" word-prop [
         no-effect
     ] [
         infer-compound
@@ -82,8 +79,8 @@ M: symbol (apply-word) ( word -- )
 GENERIC: apply-word
 
 : apply-default ( word -- )
-    dup "infer-effect" word-property [
+    dup "infer-effect" word-prop [
-        over "infer" word-property [
+        over "infer" word-prop [
             swap car ensure-d call drop
         ] [
             consume/produce
@@ -96,7 +93,7 @@ M: word apply-word ( word -- )
     apply-default ;
 
 M: compound apply-word ( word -- )
-    dup "inline" word-property [
+    dup "inline" word-prop [
         inline-compound 2drop
     ] [
         apply-default
@@ -168,15 +165,15 @@ M: word apply-object ( word -- )
     [ general-list ] ensure-d
     dataflow-drop, pop-d infer-quot-value ;
 
-\ call [ infer-call ] "infer" set-word-property
+\ call [ infer-call ] "infer" set-word-prop
 
 ! These hacks will go away soon
-\ * [ [ number number ] [ number ] ] "infer-effect" set-word-property
+\ * [ [ number number ] [ number ] ] "infer-effect" set-word-prop
-\ - [ [ number number ] [ number ] ] "infer-effect" set-word-property
+\ - [ [ number number ] [ number ] ] "infer-effect" set-word-prop
-\ + [ [ number number ] [ number ] ] "infer-effect" set-word-property
+\ + [ [ number number ] [ number ] ] "infer-effect" set-word-prop
-\ = [ [ object object ] [ object ] ] "infer-effect" set-word-property
+\ = [ [ object object ] [ object ] ] "infer-effect" set-word-prop
 
-\ undefined-method t "terminator" set-word-property
+\ undefined-method t "terminator" set-word-prop
-\ undefined-method [ [ object word ] [ ] ] "infer-effect" set-word-property
+\ undefined-method [ [ object word ] [ ] ] "infer-effect" set-word-prop
-\ not-a-number t "terminator" set-word-property
+\ not-a-number t "terminator" set-word-prop
-\ throw t "terminator" set-word-property
+\ throw t "terminator" set-word-prop

library/sdl/sdl-utils.factor

@@ -39,6 +39,7 @@ SYMBOL: surface
     swap bitor ;
 
 : black [ 0   0   0   ] ;
+: gray  [ 128 128 128 ] ;
 : white [ 255 255 255 ] ;
 : red   [ 255 0   0   ] ;
 : green [ 0   255 0   ] ;

library/syntax/generic.factor

@@ -34,16 +34,16 @@ USING: syntax generic kernel lists namespaces parser words ;
     CREATE
     dup intern-symbol
     dup predicate-word
-    [ dupd unit "predicate" set-word-property ] keep
+    [ dupd unit "predicate" set-word-prop ] keep
     [ define-union ] [ ] ; parsing
 
 : PREDICATE: ( -- class predicate definition )
     #! Followed by a superclass name, then a class name.
     scan-word
     CREATE dup intern-symbol
-    dup rot "superclass" set-word-property
+    dup rot "superclass" set-word-prop
     dup predicate-word
-    [ dupd unit "predicate" set-word-property ] keep
+    [ dupd unit "predicate" set-word-prop ] keep
     [ define-predicate ] [ ] ; parsing
 
 : TUPLE:

library/syntax/parse-syntax.factor

@@ -10,11 +10,11 @@ math namespaces parser strings words vectors unparse ;
     #! Mark the most recently defined word to execute at parse
     #! time, rather than run time. The word can use 'scan' to
     #! read ahead in the input stream.
-    word t "parsing" set-word-property ; parsing
+    word t "parsing" set-word-prop ; parsing
 
 : inline ( -- )
     #! Mark the last word to be inlined.
-    word  t "inline" set-word-property ; parsing
+    word  t "inline" set-word-prop ; parsing
 
 ! The variable "in-definition" is set inside a : ... ;.
 ! ( and #! then add "stack-effect" and "documentation"

library/syntax/parser.factor

@@ -15,7 +15,7 @@ unparser ;
 ! immediately. Otherwise it is appended to the parse tree.
 
 : parsing? ( word -- ? )
-    dup word? [ "parsing" word-property ] [ drop f ] ifte ;
+    dup word? [ "parsing" word-prop ] [ drop f ] ifte ;
 
 : skip ( n line quot -- n )
     #! Find the next character that satisfies the quotation,
@@ -109,9 +109,9 @@ global [ string-mode off ] bind
 : save-location ( word -- )
     #! Remember where this word was defined.
     dup set-word
-    dup line-number get "line" set-word-property
+    dup line-number get "line" set-word-prop
-    dup "col" get "col"  set-word-property
+    dup "col" get "col"  set-word-prop
-    file get "file" set-word-property ;
+    file get "file" set-word-prop ;
 
 : create-in "in" get create ;
 
@@ -150,20 +150,20 @@ global [ string-mode off ] bind
 
 : parsed-stack-effect ( parsed str -- parsed )
     over doc-comment-here? [
-        word "stack-effect" word-property [
+        word "stack-effect" word-prop [
             drop
         ] [
-            word swap "stack-effect" set-word-property
+            word swap "stack-effect" set-word-prop
         ] ifte
     ] [
         drop
     ] ifte ;
 
 : documentation+ ( word str -- )
-    over "documentation" word-property [
+    over "documentation" word-prop [
         swap "\n" swap cat3
     ] when*
-    "documentation" set-word-property ;
+    "documentation" set-word-prop ;
 
 : parsed-documentation ( parsed str -- parsed )
     over doc-comment-here? [

library/syntax/see.factor

@@ -33,7 +33,7 @@ presentation unparser words ;
     tab-size get - ;
 
 : prettyprint-prop ( word prop -- )
-    tuck word-name word-property [
+    tuck word-name word-prop [
         " " write prettyprint-word
     ] [
         drop
@@ -57,12 +57,12 @@ presentation unparser words ;
     ] make-string comment. ;
 
 : stack-effect. ( indent word -- indent )
-    dup "stack-effect" word-property [
+    dup "stack-effect" word-prop [
         " " write
         [ CHAR: ( , , CHAR: ) , ] make-string
         comment.
     ] [
-        "infer-effect" word-property dup [
+        "infer-effect" word-prop dup [
             infer-effect.
         ] [
             drop
@@ -70,7 +70,7 @@ presentation unparser words ;
     ] ?ifte ;
 
 : documentation. ( indent word -- indent )
-    "documentation" word-property [
+    "documentation" word-prop [
         "\n" split [
             "#!" swap cat2 comment.
             dup prettyprint-newline
@@ -92,10 +92,7 @@ M: compound see ( word -- )
     0 prettyprint-: swap
     [ prettyprint-word ] keep
     [ prettyprint-docs ] keep
-    [
+    [ word-def prettyprint-elements prettyprint-; ] keep
-        word-parameter prettyprint-elements
-        prettyprint-;
-    ] keep
     prettyprint-plist prettyprint-newline ;
 
 : see-method ( indent word class method -- indent )

library/test/compiler/linearizer.factor

@@ -7,4 +7,4 @@ USE: words
 
 : foo [ drop ] each-word ;
 
-[ ] [ \ foo word-parameter dataflow linearize drop ] unit-test
+[ ] [ \ foo word-def dataflow linearize drop ] unit-test

library/test/compiler/optimizer.factor

@@ -9,7 +9,7 @@ USE: lists
 
 : foo 1 2 3 ;
 
-[ [ ] ] [ \ foo word-parameter dataflow kill-set ] unit-test
+[ [ ] ] [ \ foo word-def dataflow kill-set ] unit-test
 
 [ [ [ + ] [ - ] ] ] [ [ 3 4 1 2 > [ + ] [ - ] ifte ] dataflow kill-set ] unit-test
 

library/test/dataflow.factor

@@ -73,7 +73,7 @@ USE: generic
 
 SYMBOL: #test
 
-#test f "foobar" set-word-property
+#test f "foobar" set-word-prop
 
 [ 6 ] [
     {{
@@ -82,7 +82,7 @@ SYMBOL: #test
     }} "foobar" [ [ node-param get ] bind 1 + ] apply-dataflow
 ] unit-test
 
-#test [ [ node-param get ] bind sq ] "foobar" set-word-property
+#test [ [ node-param get ] bind sq ] "foobar" set-word-prop
 
 [ 25 ] [
     {{

library/test/memory.factor

@@ -4,7 +4,7 @@ USING: generic kernel lists math memory words ;
 num-types [
     [
         builtin-type [
-            "predicate" word-property instances [
+            "predicate" word-prop instances [
                 class drop
             ] each
         ] when*

library/test/parsing-word.factor

@@ -19,5 +19,5 @@ DEFER: foo
 ! Test > 1 ( ) comment; only the first one should be used.
 [ t ] [
     "a" ": foo ( a ) ( b ) ;" parse drop word
-    "stack-effect" word-property str-contains?
+    "stack-effect" word-prop str-contains?
 ] unit-test

library/test/words.factor

@@ -1,10 +1,5 @@
 IN: scratchpad
-USE: math
+USING: generic kernel lists math namespaces test words ;
-USE: test
-USE: words
-USE: namespaces
-USE: lists
-USE: kernel
 
 [ 4 ] [
     "poo" "scratchpad" create [ 2 2 + ] define-compound
@@ -16,20 +11,20 @@ USE: kernel
 DEFER: plist-test
 
 [ t ] [
-    \ plist-test t "sample-property" set-word-property
+    \ plist-test t "sample-property" set-word-prop
-    \ plist-test "sample-property" word-property
+    \ plist-test "sample-property" word-prop
 ] unit-test
 
 [ f ] [
-    \ plist-test f "sample-property" set-word-property
+    \ plist-test f "sample-property" set-word-prop
-    \ plist-test "sample-property" word-property
+    \ plist-test "sample-property" word-prop
 ] unit-test
 
 [ f ] [ 5 compound? ] unit-test
 
-"create-test" "scratchpad" create { 1 2 } "testing" set-word-property
+"create-test" "scratchpad" create { 1 2 } "testing" set-word-prop
 [ { 1 2 } ] [
-    "create-test" [ "scratchpad" ] search "testing" word-property
+    "create-test" [ "scratchpad" ] search "testing" word-prop
 ] unit-test
 
 [
@@ -56,6 +51,14 @@ SYMBOL: a-symbol
 [ f ] [ \ a-symbol compound? ] unit-test
 [ t ] [ \ a-symbol symbol? ] unit-test
 
+! See if redefining a generic as a colon def clears some
+! word props.
+GENERIC: testing
+: testing ;
+
+[ f ] [ \ testing generic? ] unit-test
+
+! This has to be the last test in the file.
 : test-last ( -- ) ;
 word word-name "last-word-test" set
 

library/tools/interpreter.factor

@@ -63,21 +63,17 @@ SYMBOL: meta-cf
     meta-cf [ [ push-r ] when* ] change ;
 
 : meta-word ( word -- )
-    dup "meta-word" word-property [
+    dup "meta-word" word-prop [
         call
     ] [
-        dup compound? [
+        dup compound? [ word-def meta-call ] [ host-word ] ifte
-            word-parameter meta-call
-        ] [
-            host-word
-        ] ifte
     ] ?ifte ;
 
 : do ( obj -- )
     dup word? [ meta-word ] [ push-d ] ifte ;
 
 : meta-word-1 ( word -- )
-    dup "meta-word" word-property [ call ] [ host-word ] ?ifte ;
+    dup "meta-word" word-prop [ call ] [ host-word ] ?ifte ;
 
 : do-1 ( obj -- )
     dup word? [ meta-word-1 ] [ push-d ] ifte ;
@@ -89,7 +85,7 @@ SYMBOL: meta-cf
 : run ( -- ) [ do ] interpret ;
 
 : set-meta-word ( word quot -- )
-    "meta-word" set-word-property ;
+    "meta-word" set-word-prop ;
 
 \ datastack [ meta-d get clone push-d ] set-meta-word
 \ set-datastack [ pop-d clone meta-d set ] set-meta-word

library/tools/jedit-wire.factor

@@ -108,7 +108,7 @@ C: jedit-stream ( stream -- stream )
             "name"
             "stack-effect"
         ] [
-            word-property
+            word-prop
         ] map-with
     ] when ;
 

library/tools/jedit.factor

@@ -40,7 +40,7 @@ strings unparser words ;
 : jedit ( word -- )
     #! Note that line numbers here start from 1
     dup word-file dup [
-        swap "line" word-property jedit-line/file
+        swap "line" word-prop jedit-line/file
     ] [
         2drop "Unknown source" print
     ] ifte ;

library/tools/memory.factor

@@ -50,7 +50,7 @@ M: arrayed (each-slot) ( quot array -- )
     ] repeat 2drop ;
 
 M: object (each-slot) ( quot obj -- )
-    dup class "slots" word-property [
+    dup class "slots" word-prop [
         pick pick >r >r car slot swap call r> r>
     ] each 2drop ;
 

library/tools/word-tools.factor

@@ -8,19 +8,14 @@ parser ;
 GENERIC: word-uses? ( of in -- ? )
 M: word word-uses? 2drop f ;
 M: compound word-uses? ( of in -- ? )
-    2dup = [
+    #! Don't say that a word uses itself.
-        2drop f ! Don't say that a word uses itself
+    2dup = [ 2drop f  ] [ word-def tree-contains? ] ifte ;
-    ] [
-        word-parameter tree-contains?
-    ] ifte ;
 
 : generic-uses? ( of in -- ? )
-    "methods" word-property hash>alist tree-contains? ;
+    "methods" word-prop hash>alist tree-contains? ;
 
-M: generic word-uses? ( of in -- ? )
+M: generic word-uses? ( of in -- ? ) generic-uses? ;
-    generic-uses? ;
+M: 2generic word-uses? ( of in -- ? ) generic-uses? ;
-M: 2generic word-uses? ( of in -- ? )
-    generic-uses? ;
 
 : usages-in-vocab ( of vocab -- usages )
     #! Push a list of all usages of a word in a vocabulary.
@@ -82,7 +77,7 @@ M: 2generic word-uses? ( of in -- ? )
     words . ;
 
 : word-file ( word -- file )
-    "file" word-property dup [
+    "file" word-prop dup [
         "resource:/" ?str-head [
             resource-path swap path+
         ] when

library/ui/gadgets.factor

@@ -94,7 +94,7 @@ C: gadget ( shape -- gadget )
     #! The position of the gadget on the screen.
     0 swap [ shape-pos + t ] each-parent drop ;
 
-: relative ( g1 g2 -- g2-p1 )
+: relative ( g1 g2 -- g2-g1 )
     shape-pos swap screen-pos - ;
 
 : child? ( parent child -- ? )

library/ui/halo.factor

@@ -3,7 +3,23 @@
 IN: gadgets
 USING: kernel math namespaces prettyprint sdl ;
 
-TUPLE: halo selected delegate ;
+: drag-sizer ( sizer -- )
+    gadget-parent ( - halo) [
+        dup hand relative >rect
+        rot halo-selected resize-gadget
+    ] keep relayout ;
+
+: sizer-actions ( sizer -- )
+    dup [ drop ] [ button-down 1 ] set-action
+    [ drag-sizer ] [ drag 1 ] set-action ;
+
+: <sizer> ( -- sizer )
+    0 0 10 10 <plain-rect> <gadget>
+    dup sizer-actions ;
+
+! A halo retains the gadget its surrounding, as well as the
+! resizing gadget and a delegate.
+TUPLE: halo selected sizer delegate ;
 
 : show-halo* ( gadget -- )
     #! Show the halo on a specific gadget.
@@ -39,13 +55,25 @@ DEFER: halo-menu
 C: halo ( -- halo )
     0 0 0 0 <hollow-rect> <gadget> over set-halo-delegate
     dup red foreground set-paint-property
+    dup red background set-paint-property
+    <sizer> over 2dup set-halo-sizer add-gadget
     dup halo-actions ;
 
-M: halo layout* ( halo -- )
+: halo-update ( halo -- )
+    #! Move the halo to the position of its selected gadget.
     dup halo-selected
     2dup screen-pos >rect rot move-gadget
     dup shape-w swap shape-h rot resize-gadget ;
 
+: sizer-layout ( halo -- )
+    #! Position the sizer to the bottom right corner.
+    dup halo-sizer
+    over shape-h over shape-h -
+    >r over shape-w over shape-w - r> rot move-gadget drop ;
+
+M: halo layout* ( halo -- )
+    dup halo-update sizer-layout ;
+
 : default-actions ( gadget -- )
     [ show-halo ] [ button-down 2 ] set-action ;
 

library/ui/inspector.factor

@@ -29,7 +29,7 @@ lists namespaces strings unparser vectors words ;
     <line-pile> [ add-gadget ] keep [ add-gadget ] keep ;
 
 : object>alist ( obj -- assoc )
-    dup class "slots" word-property [
+    dup class "slots" word-prop [
         cdr car [ execute ] keep swons
     ] map-with ;
 
@@ -43,7 +43,7 @@ GENERIC: custom-sheet ( obj -- gadget )
     over top-sheet over add-gadget
     over slot-sheet over add-gadget
     swap custom-sheet over add-gadget
-    line-border ;
+    <scroller> line-border ;
 
 M: object custom-sheet drop <empty-gadget> ;
 

library/vocabularies.factor

@@ -59,8 +59,8 @@ IN: words USING: hashtables kernel lists namespaces strings ;
     #! returned.
     2dup (search) [
         nip
-        dup f "documentation" set-word-property
+        dup f "documentation" set-word-prop
-        dup f "stack-effect" set-word-property
+        dup f "stack-effect" set-word-prop
     ] [
         (create) dup reveal
     ] ?ifte ;

library/words.factor

@@ -6,7 +6,7 @@ namespaces strings ;
 
 BUILTIN: word 17
     [ 1 hashcode f ]
-    [ 4 "word-parameter" "set-word-parameter" ]
+    [ 4 "word-def" "set-word-def" ]
     [ 5 "word-props" "set-word-props" ] ;
 
 GENERIC: word-xt
@@ -32,11 +32,8 @@ M: word set-allot-count ( n w -- ) 7 set-integer-slot ;
 
 SYMBOL: vocabularies
 
-: word-property ( word pname -- pvalue )
+: word-prop ( word name -- value ) swap word-props hash ;
-    swap word-props hash ;
+: set-word-prop ( word value name -- ) rot word-props set-hash ;
-
-: set-word-property ( word pvalue pname -- )
-    rot word-props set-hash ;
 
 PREDICATE: word compound  ( obj -- ? ) word-primitive 1 = ;
 PREDICATE: word primitive ( obj -- ? ) word-primitive 2 > ;
@@ -44,16 +41,24 @@ PREDICATE: word symbol    ( obj -- ? ) word-primitive 2 = ;
 PREDICATE: word undefined ( obj -- ? ) word-primitive 0 = ;
 
 : define ( word primitive parameter -- )
-    pick set-word-parameter
+    pick set-word-def
     over set-word-primitive
-    f "parsing" set-word-property ;
+    f "parsing" set-word-prop ;
 
-: define-compound ( word def -- ) 1 swap define ;
+: (define-compound) ( word def -- ) 1 swap define ;
-: define-symbol   ( word -- ) 2 over define ;
+
+: define-compound ( word def -- )
+    #! If the word is a generic word, clear the properties 
+    #! involved so that 'see' can work properly.
+    over f "definer" set-word-prop
+    over f "methods" set-word-prop
+    over f "combination" set-word-prop
+    (define-compound) ;
+
+: define-symbol ( word -- ) 2 over define ;
 
 : intern-symbol ( word -- )
     dup undefined? [ define-symbol ] [ drop ] ifte ;
 
-: word-name ( word -- str ) "name" word-property ;
+: word-name ( word -- str ) "name" word-prop ;
-
+: word-vocabulary ( word -- str ) "vocabulary" word-prop ;
-: word-vocabulary ( word -- str ) "vocabulary" word-property ;

native/debug.c

@@ -94,7 +94,7 @@ void print_cons(CELL cons)
 
 void print_word(F_WORD* word)
 {
-	CELL name = hash(word->plist,tag_object(from_c_string("name")));
+	CELL name = hash(word->props,tag_object(from_c_string("name")));
 	if(type_of(name) == STRING_TYPE)
 		fprintf(stderr,"%s",to_c_string(untag_string(name)));
 	else

native/run.c

@@ -69,14 +69,14 @@ void undefined(F_WORD* word)
 /* XT of compound definitions */
 void docol(F_WORD* word)
 {
-	call(word->parameter);
+	call(word->def);
 	executing = tag_object(word);
 }
 
 /* pushes word parameter */
 void dosym(F_WORD* word)
 {
-	dpush(word->parameter);
+	dpush(word->def);
 }
 
 void primitive_execute(void)

native/word.c

@@ -19,8 +19,8 @@ void primitive_word(void)
 	word->hashcode = tag_fixnum((CELL)word); /* initial address */
 	word->xt = (CELL)undefined;
 	word->primitive = 0;
-	word->parameter = F;
+	word->def = F;
-	word->plist = F;
+	word->props = F;
 	word->call_count = 0;
 	word->allot_count = 0;
 	dpush(tag_object(word));
@@ -46,12 +46,12 @@ void fixup_word(F_WORD* word)
 	else
 		update_xt(word);
 
-	data_fixup(&word->parameter);
+	data_fixup(&word->def);
-	data_fixup(&word->plist);
+	data_fixup(&word->props);
 }
 
 void collect_word(F_WORD* word)
 {
-	COPY_OBJECT(word->parameter);
+	COPY_OBJECT(word->def);
-	COPY_OBJECT(word->plist);
+	COPY_OBJECT(word->props);
 }

native/word.h

@@ -8,9 +8,9 @@ typedef struct {
 	/* untagged on-disk primitive number */
 	CELL primitive;
 	/* TAGGED parameter to xt; used for colon definitions */
-	CELL parameter;
+	CELL def;
-	/* TAGGED property list for library code */
+	/* TAGGED property hash for library code */
-	CELL plist;
+	CELL props;
 	/* UNTAGGED call count incremented by profiler */
 	CELL call_count;
 	/* UNTAGGED amount of memory allocated in word */