[202] 2021-05-19 13:04:00 ruv wrote:

referenceImplementation - Portable implementation for SYNONYM

The specification for SYNONYM doesn't require that the execution semantics for newname are the same as for oldname (if the latter are defined). But it looks like just an omission.

So the implementation bellow also guarantees that the execution semantics for newname are to perform the execution semantics for oldname (if they are defined).

This implementation relies on the full-fledged FIND (according to the proposal).

If POSTPONE in the system correctly appends the compilation semantics of a user-defined STATE-dependent immediate word, then it correctly works for the words created by this SYNONYM too. Otherwise the system has the corresponding environmental restriction, and a program should obey to a99-q027.

[undefined] lit, [if]
  : lit, ( x -- ) postpone literal ;
[then]

: error-no-interp ( -- ) -14 throw ;
: compilation ( -- flag ) state @ 0<> ;

: synonym ( "\<spaces\>newname" "\<spaces\>oldname" -- )
  : \ start the new definition for newname
  bl word \ parse oldname
  \ find oldname in interpretation state
  dup >r postpone [ find ] \ NB: revert compilation state
  \ if oldname is not found in interpretation state,
  \ then provide a replacement, since it can still be found in compilation state
  dup 0= if 2drop ['] error-no-interp 1 then ( xt1 n1 ) ( R: c-addr )
  \ if n1=-1, then the word is ordinary, it's the simplest case
  \ : newname [xt1] ;
  -1 = if compile, postpone ; r> drop exit then ( xt1 )
  \ otherwise, find oldname in compilation state (that is the current state)
  r> find  dup 0= -13 and throw  1 = if \ n1=1 n2=1   ( xt1 xt2 )
    \ if xts are the same, the word is immediate, create a wrapper
    \ : newname [xt1] ; immediate    
    2dup = if drop compile, postpone ; immediate exit then
    \ otherwise, create an immediate word using both xt-s
    \ : newname state @ if [xt2] exit then [xt1] ; immediate
    2>r postpone compilation postpone if  ( R: xt1 xt2 )
    r> compile, postpone exit postpone then
    r> compile, postpone ; immediate exit
  then \ n1=1 n2=-1  - it could be something like "leave"
  \ create a possibly dual-semantics word as
  \ : newname state @ if xt2 compile, exit then [xt1] ; immediate
  2>r postpone compilation postpone if  ( R: xt1 xt2 )
  r> lit, postpone compile, postpone exit postpone then
  r> compile, postpone ; immediate
;

---

A side note.

We have a proposal for a more advanced SYNONYM that also guarantees that newname have the same "TO oldname" run-time semantics, "IS oldname" run-time semantics, "defined by CREATE" property, "defined by DEFER" property, etc, if they have place for oldname.

It's difficult to make all these requirements formally consistent, they produce changes in many other glossary entries of the standard, and it can be difficult to implement them in some Forth systems. So a more simple SYNONYM could be good enough option at the present time.