ruv · May 15, 2021 14:23 · ruv · May 15, 2021
diff --git a/dual-semantics-via-immediacy.fth b/dual-semantics-via-immediacy.fth
 \ 2019-09-24 ruv
 \ 2019-10-09


 \ Implementation of some dual-semantics words
 \ as STATE-dependent immediate words.

 \ The following dual-semantics words are implemented here:
 \   S" TO IS ACTION-OF
 \ and the counterparts they depend on:
 \   VALUE DEFER DEFER@ DEFER!
 \ NB: this "TO" cannot be applied to the local variables

 \ NB: 2VALUE and FVALUE can be easy implemeted too,
 \ with a bit modification of TO and VALUE

 \ see-also: An implementation of POSPONE via FIND -- https://git.io/J30D6 



 \ Some well known but yet non standard words
 [undefined] lit,    [if]  : lit,    postpone literal  ;   [then]
 [undefined] slit,   [if]  : slit,   postpone sliteral ;   [then]

 : xt, compile, ; \ ensure default interpretation semantics


 \ Token translators
 : tt-xt ( i*x xt -- j*x ) state @ if xt, else execute then ;
 : tt-lit ( x -- x| ) state @ if lit, then ;
 : tt-slit ( c-addr u -- | c-addr u -- c-addr2 u ) state @ if slit, then ;
 \ Note: separate buffering of the string literal in interpretation state
 \ is absent for the sake of this example simplicity.


 \ An initial action for a deferred word
 : error-np ( -- ) -21 throw ; \ Not Provided, "unsupported operation"


 \ Implementing of: 'to', 'is', 'action-of', 's"'
 : value create , does> @ ;
 : defer create ['] error-np , does> @ execute ;
 : defer@ >body @ ;
 : defer! >body ! ;
 : is ' >body tt-lit ['] ! tt-xt ; immediate
 : to [ ' is xt, ] ; immediate \ synonym; don't use postpone
 : action-of ' >body tt-lit ['] @ tt-xt ; immediate
 : s" [char] " parse tt-slit ; immediate


 \ end
	\ 2019-09-24 ruv
	\ 2019-10-09


	\ Implementation of some dual-semantics words
	\ as STATE-dependent immediate words.

	\ The following dual-semantics words are implemented here:
	\ S" TO IS ACTION-OF
	\ and the counterparts they depend on:
	\ VALUE DEFER DEFER@ DEFER!
	\ NB: this "TO" cannot be applied to the local variables

	\ NB: 2VALUE and FVALUE can be easy implemeted too,
	\ with a bit modification of TO and VALUE

	\ see-also: An implementation of POSPONE via FIND -- https://git.io/J30D6



	\ Some well known but yet non standard words
	[undefined] lit, [if] : lit, postpone literal ; [then]
	[undefined] slit, [if] : slit, postpone sliteral ; [then]

	: xt, compile, ; \ ensure default interpretation semantics


	\ Token translators
	: tt-xt ( ix xt -- jx ) state @ if xt, else execute then ;
	: tt-lit ( x -- x\| ) state @ if lit, then ;
	: tt-slit ( c-addr u -- \| c-addr u -- c-addr2 u ) state @ if slit, then ;
	\ Note: separate buffering of the string literal in interpretation state
	\ is absent for the sake of this example simplicity.


	\ An initial action for a deferred word
	: error-np ( -- ) -21 throw ; \ Not Provided, "unsupported operation"


	\ Implementing of: 'to', 'is', 'action-of', 's"'
	: value create , does> @ ;
	: defer create ['] error-np , does> @ execute ;
	: defer@ >body @ ;
	: defer! >body ! ;
	: is ' >body tt-lit ['] ! tt-xt ; immediate
	: to [ ' is xt, ] ; immediate \ synonym; don't use postpone
	: action-of ' >body tt-lit ['] @ tt-xt ; immediate
	: s" [char] " parse tt-slit ; immediate


	\ end