Naming conventions and definers for TO: and DEFER: actions

closures.fs

@@ -129,9 +129,9 @@ false [IF]
     : homeloc <{: w^ a w^ b w^ c :}h a b c ;> ;
     1 2 3 homeloc >r ? ? ? r> free throw cr
 
-    : A {: w^ k x1 x2 x3 x4 x5 | w^ B :} recursive
-	k @ 0<= IF  x4 execute x5 execute f+  ELSE
-	    B k x1 x2 x3 x4 [{: B k x1 x2 x3 x4 :}L
+    : A {: w^ k x1 x2 x3 xt: x4 xt: x5 | w^ B :} recursive
+	k @ 0<= IF  x4 x5 f+  ELSE
+	    B k x1 x2 x3 action-of x4 [{: B k x1 x2 x3 x4 :}L
 		-1 k +!
 		k @ B @ x1 x2 x3 x4 A ;] dup B !
 	    execute  THEN ;

cross.fs

@@ -715,6 +715,8 @@ Variable comp-state
 
 : pi-undefined -1 ABORT" Plugin undefined" ;
 
+[IFDEF] value! ' value! alias value-to [THEN]
+
 : Plugin ( -- : pluginname )
   Create 
   \ for normal cross-compiling only one action
@@ -724,12 +726,7 @@ Variable comp-state
   ['] pi-undefined , \ action
   ['] pi-undefined , \ target plugin action
   8765 ,     \ plugin magic
-[IFDEF] set-to
-  ['] value! set-to
-[THEN]
-[IFDEF] !to
-  ['] value! !to
-[THEN]
+  ['] value-to set-to
   DOES> perform ;
 
 Plugin DummyPlugin
@@ -3022,7 +3019,7 @@ ghost user,
 ghost defer,
 2drop
 ghost u-compile,
-ghost u-to
+ghost uvalue-to
 2drop
 ghost field+,
 ghost abi-code,
@@ -3037,9 +3034,9 @@ ghost i/c>comp
 2drop
 ghost no-to
 ghost no-defer@
-ghost >body@
+ghost defer-defer@
 2drop drop
-ghost value!
+ghost value-to
 ghost umethod,
 2drop
 ghost umethod!
@@ -3320,7 +3317,7 @@ T has? rom H [IF]
     Builder (Value)
     Build:  ( n -- ) ;Build
     by: :dovalue ( target-body-addr -- n ) T @ @ H ;DO
-    vt: [G'] value, gset-optimizer [G'] value! gset-to ;vt
+    vt: [G'] value, gset-optimizer [G'] value-to gset-to ;vt
     
     Builder Value
     Build: T here 0 A, H switchram T align here swap ! , H ;Build
@@ -3333,7 +3330,7 @@ T has? rom H [IF]
     Builder (Value)
     Build:  ( n -- ) ;Build
     by: :dovalue ( target-body-addr -- n ) T @ H ;DO
-    vt: [G'] value, gset-optimizer [G'] value! gset-to ;vt
+    vt: [G'] value, gset-optimizer [G'] value-to gset-to ;vt
 
     Builder Value
     BuildSmart: T , H ;Build
@@ -3347,7 +3344,7 @@ T has? rom H [IF]
 Builder UValue
 Build: 0 u, T , H ;Build
 DO: X @ tup@ + X @ ;DO
-vt: [G'] u-compile, gset-optimizer [G'] u-to gset-to ;vt
+vt: [G'] u-compile, gset-optimizer [G'] uvalue-to gset-to ;vt
 
 Defer texecute
 
@@ -3361,8 +3358,8 @@ T has? rom H [IF]
 [THEN]
 vt:
 [G'] defer, gset-optimizer
-[G'] value! gset-to
-[G'] >body@ gset-defer@ ;vt
+[G'] value-to gset-to
+[G'] defer-defer@ gset-defer@ ;vt
 
 \ Sturctures                                           23feb95py
 

debugs.fs

@@ -186,7 +186,7 @@ is ?warning
 
 : ~~Value ( n "name" -- )
     \G Value that will be watched on every access
-    Value [: ~~ >body ! ; opt: drop ]] Literal ~~ >body ! [[ ;] set-to ;
+    Value [: >body ~~ ! ; to-opt: >body ]] Literal ~~ ! [[ ;] set-to ;
 
 \ trace lines
 

float.fs

@@ -63,10 +63,17 @@
     \G @i{f} in the space.
     here 1 floats allot f! ;
 
-: comp-fval ( xt -- )  >body postpone Literal postpone f@ ;
+: FLiteral ( compilation r -- ; run-time -- r ) \ float f-literal
+    \G Compile appropriate code such that, at run-time, @i{r} is placed
+    \G on the (floating-point) stack. Interpretation semantics are undefined.
+    here cell+ dup faligned <> IF  postpone noop  THEN
+    postpone flit f, ;  immediate
+
+: opt-fcon ( xt -- )  >body f@ postpone FLiteral ;
+: opt-fval ( xt -- )  >body postpone Literal postpone f@ ;
 
 : fconstant  ( r "name" -- ) \ float f-constant
-    Create f, ['] comp-fval set-optimizer
+    Create f, ['] opt-fcon set-optimizer
 DOES> ( -- r )
     f@ ;
 
@@ -74,24 +81,18 @@ DOES> ( -- r )
 
 Create f!-table ' f! , ' f+! ,
 
-: fvalue! ( xt xt-deferred -- ) \ gforth  defer-store
+to: fvalue-to ( xt xt-deferred -- ) \ gforth  defer-store
     >body f!-table to-!exec ;
-opt: drop >body postpone ALiteral f!-table to-!, ;
+to-opt: >body postpone ALiteral f!-table to-!, ;
 
 : fvalue ( r "name" -- ) \ float-ext f-value
-    fconstant ['] fvalue! set-to ['] comp-fval set-optimizer ;
+    fconstant ['] fvalue-to set-to ['] opt-fval set-optimizer ;
 
 : fdepth ( -- +n ) \ float f-depth
     \G @i{+n} is the current number of (floating-point) values on the
     \G floating-point stack.
     fp0 @ fp@ - [ 1 floats ] Literal / ;
 
-: FLiteral ( compilation r -- ; run-time -- r ) \ float f-literal
-    \G Compile appropriate code such that, at run-time, @i{r} is placed
-    \G on the (floating-point) stack. Interpretation semantics are undefined.
-    here cell+ dup faligned <> IF  postpone noop  THEN
-    postpone flit f, ;  immediate
-
 &15 Value precision ( -- u ) \ float-ext
 \G @i{u} is the number of significant digits currently used by
 \G @code{F.} @code{FE.} and @code{FS.} 

glocals.fs

@@ -350,16 +350,17 @@ variable locals-dp \ so here's the special dp for locals.
 
 Create 2!-table ' 2! , ' 2+! ,
 Create c!-table ' c! , ' c+! ,
-: to-w: ( -- ) -14 throw ;
-opt: ( !!?addr!! ) drop POSTPONE laddr# >body @ lp-offset, !-table to-!, ;
-: to-d: ( -- ) -14 throw ;
-opt: ( !!?addr!! ) drop POSTPONE laddr# >body @ lp-offset, 2!-table to-!, ;
-: to-c: ( -- ) -14 throw ;
-opt: ( !!?addr!! ) drop POSTPONE laddr# >body @ lp-offset, c!-table to-!, ;
-: to-f: ( -- ) -14 throw ;
-opt: ( !!?addr!! ) drop POSTPONE laddr# >body @ lp-offset, f!-table to-!, ;
-: defer@-xt: ( -- ) -14 throw ;
-opt: drop POSTPONE laddr# >body @ lp-offset, postpone @ ;
+to: to-w: ( -- ) -14 throw ;
+to-opt: ( !!?addr!! ) POSTPONE laddr# >body @ lp-offset, !-table to-!, ;
+to: to-d: ( -- ) -14 throw ;
+to-opt: ( !!?addr!! ) POSTPONE laddr# >body @ lp-offset, 2!-table to-!, ;
+to: to-c: ( -- ) -14 throw ;
+to-opt: ( !!?addr!! ) POSTPONE laddr# >body @ lp-offset, c!-table to-!, ;
+to: to-f: ( -- ) -14 throw ;
+to-opt: ( !!?addr!! ) POSTPONE laddr# >body @ lp-offset, f!-table to-!, ;
+
+defer@: defer@-xt: ( -- ) -14 throw ;
+defer@-opt: POSTPONE laddr# >body @ lp-offset, postpone @ ;
 
 : val-part-off ( -- ) val-part off ;
 

kernel/comp.fs

@@ -461,16 +461,16 @@ Variable to-style# 0 to-style# !
 
 : !!?addr!! ( -- ) to-style# @ -1 = -2056 and throw ;
 
-: u-to ( n uvalue-xt -- ) !!?addr!! >body @ next-task +  !-table to-!exec ;
+: uvalue-to ( n uvalue-xt -- ) !!?addr!! >body @ next-task +  !-table to-!exec ;
 opt: ( uvalue-xt to-xt -- )
     !!?addr!! drop >body @ postpone useraddr , !-table to-!, ;
-\g u-to is the to-method for user values; it's xt is only
+\g uvalue-to is the to-method for user values; it's xt is only
 \g there to be consumed by @code{set-to}.
 : u-compile, ( xt -- )  >body @ postpone user@ , ;
 
 : UValue ( "name" -- )
     \G Define a per-thread value
-    Create cell uallot , ['] u-to set-to
+    Create cell uallot , ['] uvalue-to set-to
     ['] u-compile, set-optimizer
   DOES> @ next-task + @ ;
 
@@ -487,7 +487,7 @@ opt: ( uvalue-xt to-xt -- )
 defer defer-default ( -- )
 ' abort is defer-default
 \ default action for deferred words (overridden by a warning later)
-    
+
 : Defer ( "name" -- ) \ gforth
 \G Define a deferred word @i{name}; its execution semantics can be
 \G set with @code{defer!} or @code{is} (and they have to, before first
@@ -495,7 +495,7 @@ defer defer-default ( -- )
     Header Reveal dodefer, ?noname-vt
     ['] defer-default A, ;
 
-: >body@ >body @ ;
+: defer-defer@ >body @ ;
 opt: drop >body lit, postpone @ ;
 
 : Defers ( compilation "name" -- ; run-time ... -- ... ) \ gforth
@@ -599,6 +599,11 @@ interpret/compile: opt:
 interpret/compile: comp:
 ( compilation colon-sys1 -- colon-sys2 ; run-time nest-sys -- ) \ gforth
 
+: to-opt: ( -- colon-sys ) start-xt  set-optimizer postpone drop ;
+' to-opt: alias defer@-opt:
+: to: : ;
+' to: alias defer@:
+
 \ defer and friends
 
 ' (int-to) alias defer! ( xt xt-deferred -- ) \ gforth  defer-store
@@ -613,11 +618,11 @@ interpret/compile: comp:
     \g effect.
     dup >namevt @ >vtto @ compile, ;
 
-: value! ( n value-xt -- ) \ gforth  value-store
+: value-to ( n value-xt -- ) \ gforth  value-store
     \g this is the TO-method for normal values; it's tickable, but
     \g the only purpose of its xt is to be consumed by @code{set-to}.
     >body !-table to-!exec ;
-opt: ( value-xt to-xt -- )
+opt: ( value-xt -- ) \ run-time: ( n -- )
     drop >body postpone ALiteral !-table to-!, ;
 
 : <IS> ( "name" xt -- ) \ gforth

mini-oof2.fs

@@ -24,11 +24,12 @@ Defer default-method ' noop IS default-method
 \ template for methods and ivars
 
 Create o 0 ,  DOES> @ o#+ [ 0 , ] + ;
-comp: >body @ postpone o#+ , ;
-: to-m >body @ + ! ;
+opt: >body @ postpone o#+ , ;
+to: m-to >body @ + ! ;
+to-opt: >body @ postpone lit+ , postpone ! ;
 Create m 0 ,  DOES> @ o#+ [ -1 cells , ] @ + perform ;
-comp: >body @ cell/ postpone o#exec , ;
-' to-m set-to
+opt: >body @ cell/ postpone o#exec , ;
+' m-to set-to
 ' o Value var-xt
 ' m Value method-xt
 : current-o  ['] o to var-xt  ['] m to method-xt ;
@@ -37,7 +38,7 @@ comp: >body @ cell/ postpone o#exec , ;
 
 : o+field, ( addr body -- addr' )
     @ o + ;
-comp: drop @ postpone o#+ , ;
+opt: drop @ postpone o#+ , ;
 
 \ core system
 

struct-val.fs

@@ -21,7 +21,7 @@ Defer +field,
 
 : standard+field, ( addr body -- addr' )
     @ + ;
-comp: drop @ ?dup-IF ['] lit+ peephole-compile, , THEN ;
+opt: drop @ ?dup-IF ['] lit+ peephole-compile, , THEN ;
 
 warnings @ warnings off
 : standard:field ( -- )
@@ -41,7 +41,7 @@ standard:field
 : create+defer ( n1 addr "name" -- n3 )
     create+value
     [: ( addr -- xt ) >body vfield-int, @ ;
-    opt: drop >body vfield-comp, postpone @ ;] set-defer@ ;
+    defer@-opt: >body vfield-comp, postpone @ ;] set-defer@ ;
 
 : wrapper-xts ( xt@ !-table -- xt-does xt-opt xt-to ) { xt@ xt! }
     :noname ]] vfield-int, [[ xt@ compile, postpone ; \ xt-does