crcx

Original from docl:
: :: here ] ;
: nv-key ['] key 2 + compile ; immediate  ( unvectored key )
:: nv-key dup 27 =if nv-key dup . nip ;then ; is key


Rather than "nv-key", a more generic word to get the default (non-vectored) definition can be used:

: default: ' drop which @ d->xt @ 2 + compile ; immediate

crcx

Compiler macros are often used to lay down code in the calling word. You'll see something like:

: foo ['] + compile ['] . compile ; immediate

This is fine, but sometimes you need to deal with other macros:

crcx

It's sometimes useful to be able to create an empty stub which will be pointed to a real definition later.

The simple solution is just to do:

  : foo ;

This creates a new defintion ("foo"), with no runtime action. In Retro all colon definitions can be revectored, so this is all that is strictly required. It does have a downside with regard to readability. We can address this by defining a new word specifically to create stubs.

  : stub ( "- ) create 0 , 0 , 9 , ['] .word last @ d->class ! ;

crcx

We couldn’t find that file to show.

crcx

: :create ( $- )
  push                    :: save string pointer
  here last dup @ , !     :: start new header, pointing to here
  ['] .data ,             :: class of .data
  here 0 ,                :: xt = 0 (patched later)
  pop dup getLength here  :: get length of string, setup for copy
  swap dup allot          :: but first, allocate space for the name
  copy 0 ,                :: copy name to allocated space, terminate string properly
  here swap ! ;           :: go back and patch the xt to point to here

crcx

A Macro for Appending Code Before Evaluation

With this macro loaded, you can append code to a string and evaluate the results easily.

( A macro for appending code blocks. )
{{
  ifNotExists prepend { : prepend ( $$-$ ) here -rot 2 for dup here swap getLength dup allot copy next 0 , ; }

crcx

First, the header describing the library.

( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( do ... until                                                )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Value n is taken from the stack and stored to a virtual     )
( variable. When this number is equal to the TOS at the time  )
( until is executed, the loop terminates.                     )

crcx

Original

{{
  : :find ( a-af ) last repeat @ 2dup =if drop @ -1 ;; else dup 0 =if ;then then again ;
  : .vocab ( a- ) dup 1+ @ :find nip if shut else open then ;
---reveal---
  : as-vocab ( a- ) last @ d->class ['] .vocab swap ! ;

crcx

chain: parable
  {{
    create   stack here , 10 allot
    : push   stack dup ++ @ ! ;
    : pop    stack dup @ @ swap -- ;
    : empty? stack dup @ = ;
    : nest   compiler on here push 0 , 0 , ;
    : unnest pop empty? not !compiler ;
  ---reveal---
    : [ nest ; immediate

crcx

with quotes'

( compare two strings from the beginning and return how many )
( similar characters there are before the strings diverge. )
: ^match ( $$-n )
  0 -rot repeat @+ [ swap @+ ] dip =if rot 1+ -rot else 2drop ;then again ;

( test each word in the dictionary for similarity. if similar up )
( to the current point, add to the suggestions queue. )
create list here , 100 allot