new change word factors out foo get ... foo set pattern

TODO.FACTOR.txt

@@ -12,10 +12,8 @@
 - handle recursion with when, when* etc
 - optimizer rewrite stack ops
 - optimizer nested ifte
-- optimizer recursive call
-- dataflow make block nodes for inlined words
-- dataflow recursive calls marked as so
 - alien-call need special nodes
+- fix dataflow unit tests
 
 + linearizer/generator:
 
@@ -83,5 +81,4 @@
 + httpd:
 
 - log with date
-- basic authentication, using httpdAuth function from a config file
 - file responder; last-modified field

library/bootstrap/init-stage2.factor

@@ -66,7 +66,7 @@ USE: unparser
     ! The first CLI arg is the image name.
     cli-args uncons parse-command-line "image" set
 
-    "ansi" get [ stdio get <ansi-stream> stdio set ] when
+    "ansi" get [ stdio [ <ansi-stream> ] change ] when
 
     "compile" get [ compile-all ] when
 

library/compiler/optimizer.factor

@@ -94,20 +94,23 @@ USE: logic
     #! Check if the literal appears in either branch.
     [ node-param get ] bind [ dupd can-kill? ] all? nip ;
 
-: kill-literal ( literals node -- )
-    #! Remove the literals from the node and , it if it is not a
-    #! NOP.
+: (kill-node) ( literals node -- )
     swap [
         over 2dup consumes-literal? >r produces-literal? r> or
     ] some?
     [ drop ] [ , ] ifte ;
 
-: kill-literals ( literals dataflow -- )
-    #! Remove literals and construct a list.
-    [ dupd kill-literal ] each drop ;
+: kill-node ( literals node -- )
+    #! Remove the literals from the node and , it if it is not a
+    #! NOP.
+    "kill-node" [ (kill-node) ] apply-dataflow ;
 
-: optimize ( dataflow -- )
-    [ dup kill-set swap kill-literals ] make-list ;
+: kill-nodes ( literals dataflow -- )
+    #! Remove literals and construct a list.
+    [ dupd kill-node ] each drop ;
+
+: optimize ( dataflow -- dataflow )
+    [ dup kill-set swap kill-nodes ] make-list ;
 
 #push [
     [ node-param get ] bind ,
@@ -121,6 +124,10 @@ USE: logic
     [ node-param get ] bind can-kill?
 ] "can-kill" set-word-property
 
+#label [ ( literals node -- )
+    [ node-param [ kill-nodes ] change ] bind
+] "kill-node" set-word-property
+
 #ifte [ scan-branches ] "scan-literal" set-word-property
 #ifte [ can-kill-branches? ] "can-kill" set-word-property
 #generic [ scan-branches ] "scan-literal" set-word-property

library/gensym.factor

@@ -36,7 +36,7 @@ SYMBOL: gensym-count
 
 : (gensym) ( -- name )
     "G:" global [
-        gensym-count get succ dup gensym-count set
+        gensym-count [ succ dup ] change
     ] bind unparse cat2 ;
 
 : gensym ( -- word )

library/httpd/html.factor

@@ -162,10 +162,10 @@ C: html-stream ( stream -- stream )
     #! underline
     #! size
     #! link - an object path
-    [ dup delegate set stdio set ] extend ;
+    [ dup delegate set stdio set ] extend ;C
 
 : with-html-stream ( quot -- )
-    [ stdio get <html-stream> stdio set call ] with-scope ;
+    [ stdio [ <html-stream> ] change  call ] with-scope ;
 
 : html-document ( title quot -- )
     swap chars>entities dup

library/inference/inference.factor

@@ -77,7 +77,7 @@ SYMBOL: recursive-label
 
 : ensure-d ( count -- )
     #! Ensure count of unknown results are on the stack.
-    meta-d get ensure meta-d set d-in +@ ;
+    meta-d [ ensure ] change d-in +@ ;
 
 : consume-d ( count -- )
     #! Remove count of elements.

library/list-namespaces.factor

@@ -34,26 +34,26 @@ USE: math
 
 : cons@ ( x var -- )
     #! Prepend x to the list stored in var.
-    tuck get cons put ;
+    [ cons ] change ;
 
 : acons@ ( value key var -- )
     #! Prepend [ key | value ] to the alist stored in var.
-    [ get acons ] keep set ;
+    [ acons ] change ;
 
 : uncons@ ( var -- car )
     #! Push the car of the list in var, and set the var to the
     #! cdr.
-    dup get uncons rot set ;
+    [ uncons ] change ;
 
 : remove@ ( obj var -- )
     #! Remove all occurrences of the object from the list
     #! stored in the variable.
-    tuck get remove put ;
+    [ remove ] change ;
 
 : unique@ ( elem var -- )
     #! Prepend an element to the proper list stored in a
     #! variable if it is not already contained in the list.
-    tuck get unique put ;
+    [ unique ] change ;
 
 SYMBOL: list-buffer
 

library/namespaces.factor

@@ -101,6 +101,12 @@ USE: vectors
 : set ( value variable -- ) namespace set-hash ;
 : put ( variable value -- ) swap set ;
 
+: change ( var quot -- )
+    #! Execute the quotation with the variable value on the
+    #! stack. The set the variable to the return value of the
+    #! quotation.
+    >r dup get r> rot slip set ;
+
 : bind ( namespace quot -- )
     #! Execute a quotation with a namespace on the namestack.
     swap >n call n> drop ; inline
@@ -118,11 +124,6 @@ USE: vectors
     #!      ] extend ;
     over >r bind r> ; inline
 
-: lazy ( var [ a ] -- value )
-    #! If the value of the variable is f, set the value to the
-    #! result of evaluating [ a ].
-    over get [ drop get ] [ swap >r call dup r> set ] ifte ;
-
 : traverse-path ( name object -- object )
     dup hashtable? [ hash ] [ 2drop f ] ifte ;
 

library/test/words.factor

@@ -55,3 +55,5 @@ word word-name "last-word-test" set
 
 [ t ] [ vocabs list? ] unit-test
 [ t ] [ vocabs [ words [ word? ] all? ] all? ] unit-test
+
+[ f ] [ gensym gensym = ] unit-test

library/tools/interpreter.factor

@@ -67,10 +67,10 @@ SYMBOL: meta-cf
 
 : copy-interpreter ( -- )
     #! Copy interpreter state from containing namespaces.
-    meta-r get vector-clone meta-r set
-    meta-d get vector-clone meta-d set
-    meta-n get meta-n set
-    meta-c get meta-c set ;
+    meta-r [ vector-clone ] change
+    meta-d [ vector-clone ] change
+    meta-n [ ] change
+    meta-c [ ] change ;
 
 : done-cf? ( -- ? )
     meta-cf get not ;
@@ -95,7 +95,7 @@ SYMBOL: meta-cf
 
 : meta-call ( quot -- )
     #! Note we do tail call optimization here.
-    meta-cf get [ push-r ] when* meta-cf set ;
+    meta-cf [ [ push-r ] when* ] change ;
 
 : meta-word ( word -- )
     dup "meta-word" word-property dup [

library/tools/jedit-wire.factor

@@ -94,8 +94,7 @@ C: jedit-stream ( stream -- stream )
 
 : stream-server ( -- )
     #! Execute this in the inferior Factor.
-    stdio get <jedit-stream> stdio set
-    print-banner ;
+    stdio [ <jedit-stream> ] change  print-banner ;
 
 : jedit-lookup ( word vocabs -- )
     #! A utility word called by the Factor plugin to get some