yoda

#!/bin/bash
# shellcheck disable=SC2016 disable=SC2034 disable=SC2154 disable=SC2288
v="0.8.4"
# ----- about -------------------------------------------- #fold00

# times in UTC
# dates in post-gregorian Sol3
# numbers in decimal. Mostly.
# changelog now in directory changes. Or, type "changes" in yoda
# for changes to current version.

# yoda is an acronym of Yet Onather Delirious Application, and does
# naturally not refer to any greenish midget with pointy ears, albeit
# it had been said that reading yoda source aloud sounds like the very
# same midget talking.
# yoda implements a compiler which converts a close resemblance of Forth
# source code to bash functions, an interpreter which runs them, and
# a base vocabulary of useful functions, strongly orientated towards
# what a common Forth interpreter offers.
# What learned you have, unlearn you must!

# editor used is efte, folds in source files are therefore efte compatible.


# ----- shellcheck ignores ------------------------------- #fold00
# invoke shellcheck with:    shellcheck -x yoda.

# SC2016: "expressions don't expand between single quotes"
#         right, that's the reason for using single quotes there.
# SC2034  "... appears unused. Verify use (or export if used externally)"
#         in most cases is "appears" the correct term.
# SC2154 "(warning): base is referenced but not assigned."
#        is assigned, but shellcheck can't see how
# SC2288 This is interpreted as a command name ending with ','.
#        That's how it's meant to be done.

# ----- declarations ------------------------------------- #fold00

shopt -s extglob
shopt -u nullglob

config="yoda.conf"                                                   # name of configuration file which may override any of the below settings
declare -i break=2                                                   # break will return (0), exit (1) or execute coldvector (2)
declare -i clean=1                                                   # empty stack on error/ctrl-c

read -r tmp _ < <(realpath "$0")
read -ra version <<< "${v//./ }"
mydir="${tmp%/*}"
doc="$mydir/doc"                                                     # documentation base directory
worddoc_prefix="word"                                                # used as part of file names, prevents files to go hidden by leading period
worddoc="$doc/words/$worddoc_prefix"                                 # directory of words documentation, also first part of word doc file name
dependencies="$mydir/dependencies"                                   # dependency file, path and name

# only first added directory - and its subdirectories -
# contain forward referencable libs.
libdirs=()                                                           # array of possible library paths
for dir in                          \
   "$mydir/lib"                     \
   "$mydir"                         \
   "/usr/local/lib/yoda"
do                                                                   # loop through directory candidates
   [[ -d "$dir" ]] && libdirs+=("$dir")                              # add directory if existing
done
nameprefix="yoda"                                                    # prefix to bash function names,  _${xt} will be appended upon header creation
declare -i firstxt="1000"                                            # names enumeration, initially. Can be any positive integer
declare -i xt=firstxt                                                # names enumeration, incremented, starting with xt

declare -ai r=() s=(0) m=()
declare -a strings=()                                                # string memory
declare -i sp=0 rp=0 dp=0 sdp=0
declare -a ss=()
declare -i s0 s1 s2 s3                                               # temp variables to hold stack items
declare -a raw target
declare -A doescode                                                  # items associated with defining word. Detokeniser extracted code

# naming:
#  wordlist:     name of a wordlist
#  wordlistwid:  wid of a wordlist
# convert wid to wordlist:   $@    ( ${strings[wid]} )
declare -a wordlists                                                 # list of wordlists
declare -a builtin_wordlists=("only" "forth" "compiler" "unresolved")
for wordlist in "${builtin_wordlists[@]}"; do
   declare -Ai "flags_$sdp"                                          # header flags per vocabulary
   declare -A  "wordlist_$sdp"                                       # this is the name of the wordlist array, named "wordlist_$wid"
   declare -n  "$wordlist"="wordlist_$sdp"                           # allow referencing builtins by name without indirection ( ${unresolved[...]} )
   ((${wordlist}wid=sdp))                                            # builtins can also be refered by wid, assigned here
   wordlists+=("$sdp")
   strings[sdp++]="$wordlist"                                        # finally associate wid with name.
done

declare -ai order=("$forthwid" "$onlywid")                           # only forth
declare -i  currentwid="${order[0]}"                                 # definitions

declare -n  context="wordlist_${order[0]}"                           # set pointer variables to array name of wordlists
declare -n  current="wordlist_$currentwid"
declare -n  flags="flags_$currentwid"                                # pointer var to vocabulary specific header flags

declare -a body                                                      # xt -> body for create
declare -a names                                                     # xt -> name
declare -a transients                                                # transient headers.

declare -A where                                                     # source location file:line
declare -A lib                                                       # dependencies cache

declare -i filehandle=1                                              # 1=yoda. 0=tty.  >1=loaded source
declare -a files=("tty" "$(realpath "$0")")                          # list of included files
declare -a loaded                                                    # list of inclusion counters for included files
declare -a conclude=()                                               # compiler words can add actions to array conclude, which
                                                                     # will be executed when semicolon executes
declare -a lasterror
lasterror=("" "-1" "0")

# header flags:
inline=1                                                             # inlined words compile code rather than function call.
protected=2                                                          # protect code body against trashing when set.
# detokeniser flags:
flagscount="0"
newflag()  {
   (( $1 = 1<<flagscount++ ))                                        # name -> value
   flagname["${!1}"]="$1"                                            # value -> name
}

newflag functionheader                                               # create header
newflag sourcelocation                                               # store source location
newflag does                                                         # rip code apart into define- and run time portions

# what to execute when no command line args given
default='from defaults'                                              # load defaults from file

# number of bits per cell.
# one address increment is always a cell, this setting
# won't change that.
declare -i bits
# Can't use 64 bit - bash doesn't know unsigned, and in the
# rare cases that carry needs detection, bit msb<<1 is used.
bits=63                                                              # 63 bit is best I can do for now.
#bits=62
#bits=48                                                              # 0...281,474,976,710,655
#bits=32                                                              # 0...4,294,967,295
#bits=21                                                              # covers 6 decimal digits signed numeric space
#bits=20                                                              # 20 bits, unusual but not impractical. 8086 address space
#bits=16                                                              # 16 bits, a tad retro
#bits=11                                                              # covers 3 decimal digits signed numeric space
#bits=8                                                               # 8 bits are nice for testing
((bits<8 && bits>63))&&{
   echo "illegal cell width: $bits bits"
   exit 1
}

declare -i msb="$((1<<(bits-1)))"
declare -i carry="$((msb*2))"
declare -i maxint="msb-1"
declare -i maxuint="maxint|msb"
declare -i true="maxuint"
declare -i false=0
declare -i compiling="false"                                         # state flag: interpreting or compiling
declare -l lastword=""                                               # most recently created word, set by defining words
line=""                                                              # source line being worked on. modified during parsing and processing
word=""                                                              # bl delimited string from line currently being processed

# xeditor runs detached from yoda process and doesn't block input
# therefore an xeditor should open its own window
editor="vi"
#xeditor="efte"
[[ -n "$editor" ]]  && editor()  { $editor "$@"; }                   # used with doc, edit
[[ -n "$xeditor" ]] && {
   editor()  { $xeditor "$@" & }                                     # used with doc, edit
   editor="$xeditor"
}

webview()  { lynx -dump "$1"; }

declare -i magic=100000
remagic()  { magic+=RANDOM+10000; }
remagic

declare -Ai bases=(['%']=2 ['#']=10 ['$']=16)
declare -Ai asc=()                                                   # ascii table
declare -a  char=()                                                  # character table
for i in {1..255}; do                                                # ascii->char LUT for emit, pack$, char$
   char[i]="$(echo -en "\\x$(printf "%x" "$i")")"
   ((i == 10)) || asc["${char[i]}"]="$i"                             # linefeed is invalid hash key
done

# ----- diagnostics  ------------------------------------- #fold00

trace()  {
   printf "### %-1s %-20s %s\n" "${char[$(((compiling&1)?58:32))]}" "[${FUNCNAME[1]}]" "$@"
#                                                        :  bl
}

pretend()         {
   echo "${FUNCNAME[1]} pretends to $*"; }                           # placeholder for use in unfinished code


# ----- headers ------------------------------------------ #fold00

#setheaderflag()  { (( flags["$lastword"] |= "$1" )); }              # a bash glitch doesn't allow me to use this form, because it produces errors with
                                                                     # some array keys like "'".
setheaderflag()  {                                                   # where against this form has no problem with those,
   flags["$lastword"]="$(( ${flags["$lastword"]} | "$1" ))"
}

inline()     { setheaderflag "$inline" ; }
protect()    { setheaderflag "$protected"; }


# remove header and flags of word passed as arg1
# from current wordlist
# arg1: word
removeheaderfromcurrent()  {
   unset -v 'current["$1"]'                                          # remove from source wordlist
   unset -v 'flags["$1"]'
}

# copy header of last word, along with header flags,
# to wordlist passed as arg1
# header is assumed in current vocabulary, where it
# has just been created.
# arg1: destination wid
copytowordlist()  {
   local dest destflags
   declare -n dest="wordlist_$1"                                     # set up pointers to destination wordlist
   declare -n destflags="flags_$1"
   dest["$lastword"]="${current[$lastword]}"                         # copy function name and header flags
   destflags["$lastword"]="${flags[$lastword]}"
}

# move header of last word, along with header flags,
# to wordlist passed as arg1
# header is assumed in current vocabulary, where it
# has just been created.
# arg1: destination wid
movetowordlist()  {
   copytowordlist "$1"                                               # destination wid
   removeheaderfromcurrent "$lastword"
}

compiled()     { movetowordlist "$compilerwid"; }                    # move last header to compiler context vocabulary
immediate()    { copytowordlist "$compilerwid"; }


# create header, but don't compile, and don't generate function yet.
# arg1: word name
# arg2: function name
# NOTE: leave it to header to prepend $nameprefix.
header()  {
   lastword="$1"
   [[ -z "${current["$lastword"]}" ]] ||
      echo "redefining $lastword"
   current["$lastword"]="$2"                                         # associate word with name
   flags["$lastword"]="0"                                            # default to no flags
}



# ----- detokeniser / pretend optimiser ------------------ #fold00
# currently only a detokeniser. Plugged preparing further use.
# The way it works:
#    when a word gets compiled to a function, it will first be
#    cached in an array "raw". semicolon then calls compile,
#    which generates a bash function from raw.
#    first thing compile does is calling optimise, which visits
#    all items in raw, potentially modifies or substitutes them
#    while transferring to an array named target.
#    compile then creates the bash function from target, which
#    at that point is expected to contain literal code only.
#    Compiling words which add to raw array can tag entries,
#    informing optimiser/detokeniser about their nature, so it
#    can respond in an appropriate way to raw array entries.


# construct function name from xt
# arg1:xt
# result: name:functionname
name()  {
   name="${nameprefix}_$1"                                           # create function name from xt as argument
}


# return a new function name in variable name
# arg1:word
# result: name:functionname
newname()  {
   names[xt]="$1"                                                    # keep word name for .name, name$
   name="${nameprefix}_$((xt++))"                                    # create function name from xt as argument
}


# arg1: code token
# arg2: code token type (opt)
code()  {                                                            # instruction stream injector
   raw+=("$1")
   analyser+=("${2:-0}")                                             # default to literal code
}

# arg1: file handle
# arg2: line number
where()  {
   code "$1:$2" "$sourcelocation"
}


declare -i dodoes_at

# return values of all these analyser_${flagname} mean:
# 0: append raw or generated code to target
# 1: continue optimiser loop without adding code to target
analyser_functionheader()  {
   word="$rawline"                                                  # word name of new word
   if [[ -n "${unresolved[$word]}" ]]; then
      name="${unresolved[$word]}"                                    # if forward ref, reuse function name of forward ref
      unset -v "unresolved['$word']"                                 # going to resolve word, remove from forward refs
   else
      newname "$word"                                                # not a forward ref: invent new name
   fi
   header "$word" "$name"                                            # create new header
   return 1
}

analyser_sourcelocation()  {
   where["$lastword"]="$rawline"                                     # remember source location
   return 1
}

analyser_does()  {
   dodoes_at="$((${#target[@]}+1))"                                  # remember end of target for splitting code (but only when whole word
}


compiler_init()  {
   raw=()
   target=()
   analyser=()                                                       # reinitialise code tags for analyser
   conclude=()
}

# doesn't actually do any optimizing.
# Function is limited to:
# - generating code for pushing
# - generating code for function calls from xts
# - dealing with does>
# - delayed headers creation
# - storing source location
optimise()  {                                                        # run code generator on ${analyser[@]} data
   ((${#raw[@]}==${#analyser[@]}))||echo "raw/analyser<>1"
   target=()
   dodoes_at=0
   for ((tmp=0; tmp<${#raw[@]}; tmp++)); do
      rawline="${raw[tmp]}"
      rawflag="${analyser[tmp]}"
      targetline="$rawline"                                          # assume code
      ((rawflag)) && {
         analyser_"${flagname[rawflag]}" || continue                 # flags: examine and act upon
      }
      [[ -z "$targetline" ]] || target+=("$targetline")
   done
   ((dodoes_at)) && {
# in raw code was a does> encountered: split generated code in
# two parts. first part is compiled to defining word, second part
# is seperated to an array item associated with defining word.
# dodoes, when executed, knows how to retrieve and
# compile that code to defined word.
     if (( ${#target[@]} > dodoes_at )); then                        # everything ok: there was code between does> and ; - extract and store it.
        doescode[${current[$lastword]}]=$(printf "%s\n" "${target[@]:$dodoes_at}")
        target=("${target[@]:0:$dodoes_at}")
     else                                                            # but does> without code ...
        unset "target[-1]"                                           # will cause to compile without any does run time action. no code behind does>
     fi                                                              # results in no additional action at all, therefore the whole does> can be dropped.
   }
}


# ----- compile and resolve forward refs ----------------- #fold00

newheaders() {
   ((tmp=previousheaders, previousheaders=xt, xt!=tmp))
}

# create a forward ref for word
# arg1: word
forwardref()  {
   local word="${1,,}"
   [[ -z ${unresolved["$1"]} ]] && {                                 # don't re-forwardref and already forward ref'ed word
      newname "$word"                                                # generate new function name
      unresolved["$word"]="$name"                                    # keep in unresolved vocabulary
   }
}

# arg1: word
compile_forwardref()  {
   local word="${1,,}"
   [[ -z ${unresolved["$word"]} ]] && {                              # don't re-forwardref and already forward ref'ed word
      newname "$word"                                                # generate new function name
      unresolved["$word"]="$name"                                    # keep in unresolved vocabulary
   }
   code "$name"                                                      # compile dangling call to unresolved name.
}


# satisfy one single reference, passed as arg1.
# tries by loading source immediately if available.
# if source isn't available, a forward ref will be generated.
satisfy1()  {
   exists "$1" "${order[@]}" && return                               # word already defined, nothing to do
   local word="${1,,}"
   [[ -n "${lib[$word]}" ]] && {                                     # library of needed word known?
      forwardref "$word"                                             # yes: create forward ref only
      ((${#raw[@]})) && return 1                                     #   refuse to satisfy while building new word is in progress
      tmp="${libdirs[0]}/${lib["$word"]}"                            #   path and name of lib file
      [[ -f "$tmp" ]] && from "$tmp"                                 #   load if file exists
      return 0
   }
}

resolving=0                                                          # early termination helper
# looping resolve until header count stabilised.
# doing so because resolving forward references may create
# new forward references, which also need resolving.
resolve()  {
   (( ! ${#unresolved[@]} || compiling || resolving )) && return     # only run without recursing if unresolved words exist
   local file resolving=1                                            # prevent recursion
   while newheaders && ((${#unresolved[@]})); do                     # loop while unresolved until header count stabilises
      for word in "${!unresolved[@]}"; do                            # try to resolve all in unresolved vocabulary
         satisfy1 "$word"                                            # satisfying a word can create new forward references
      done
   done
}

compiler_init()  {
   raw=()
   target=()
   analyser=()                                                       # reinitialise code tags for analyser
   conclude=()
}

# create a function from raw[@]
compile()  {
   optimise                                                          # rewrite ${raw[@]} to ${target[@]}
   use "${target[@]}"                                                # generate function from $target[@] with name of $lastword
   compiler_init
}


# ----- line parser -------------------------------------- #fold00

# these need extglobs, set with "shopt -s extglob"

minwhitespace()  {
   line="${line##+([[:space:]])}"                                    # remove all leading spaces (needs extglobs)
}

# read space delimited word from line without removing it.
peek_word()  {
   word="${line##+([[:space:]])}"                                    # remove all leading spaces (needs extglobs)
   word="${word%%[[:space:]]*}"                                      # bl lookahead
}

# read space delimited word from line, remove it,
# remove single leading space from remainder of line.
word()  {
   peek_word
   line="${line#*"$word"}"                                           # quotes around word are needed
   line="${line#+([[:space:]])}"                                     # remove single leading space (n
   [[ -n "$word" ]]
}

# read string from line and remove it, also remove delimiter.
# delimiter passed as arg1.
# leading spaces aren't removed from remainder of line.
parse()  {
   [[ -z "$1" ]] && word="$line" || word="${line%%"${1}"*}"
   line="${line#"${word}"}"
   [[ "${line:0:1}" == "$1" ]] && line="${line:1}"
}

# ----- compiler support words --------------------------- #fold00

# arg1: xt
codebody()  {                                                        # inline compiler
   local i codebody
   name "$1"                                                         # xt to function name
   readarray -t codebody < <(type "$name")
   for ((i=0; i<${#codebody[@]}; i++)); do
      [[ "${codebody[i]:0:1}" == " " ]] &&
      code "${codebody[i]}"
   done
}

# rewrite run time semantics of most recently defined word
# arg1+: new run time code.
use()  {
   eval "${current["$lastword"]}() { $(printf '%s\n' "$@"); }"       # rewrites function "$name", using instructions received as arguments
}

# arg1: xt
# arg2: new run time code
apply()  {
   name "$1"; shift                                                  # rewrites function "yoda_$1",
   eval "$name() { $*; }"                                            # using instructions received as arguments
}


# arg1: add action for semicolon to execute to conclude[@]
conclude()  { conclude+=("$@"); }


# execute or compile args.
stateless()   {
   if ((compiling)); then
      code "$@"
   else
      eval "$*"
   fi
}


# ----- defining words ----------------------------------- #fold00

put()   { code "((s[sp]=$1))"; }                                     # push without pointer inc
push()  { code "((s[++sp]=$1))"; }
get()   { code "(($1=s[sp]))"; }                                     # pop without point dec
pop()   { code "(($1=s[sp--]))"; }
call()  { code "${nameprefix}_$1"; }
execute() {
   tmp="${context[$1]}"
   [[ -n "$tmp" ]] || notfound "$1"
   code "$tmp"
}

# arg1: wordname
# arg2: filehandle
# arg3: line number
delayheader()  {
   [[ -z "$1" ]] && missingname
   compiler_init
   lastword="$1"
   code "$lastword" "$functionheader"
   [[ -z "$2" ]] || where "$2" "$3"
}

# arg1: wordname
# arg2: filehandle
# arg3: line number
nowheader()  {
   delayheader "$1" "$2" "$3"
   optimise
   compiler_init
}


# primitive "wordname"  "functionname|code"
primitive()  {
   nowheader "$1" "$filehandle" "${BASH_LINENO[0]}"
   use "$2"
   inline
}

colon()  {
   tmp="${BASH_LINENO[0]}"                                           # assume not evaluate
   (( filehandle == 1 )) &&                                          # if defined in yoda
   [[ "${FUNCNAME[2]}" == "evaluate" ]] &&                           # by evaluate
   tmp="${BASH_LINENO[2]}"                                           # then take line number from different entry
   delayheader "$1" "$filehandle" "${linenr:-$tmp}"
}


semicolon()  {
   for ((nextconclude=0; nextconclude<${#conclude[@]};nextconclude++)); do
      eval "${conclude[nextconclude]}"
   done
   compile                                                           # compilation is gathered in an array raw. Only
   ((compiling=false))                                               # when semicolon completes compilation, is
}                                                                    # a function created from contents of array.


constant()  {
   delayheader "$1" "$filehandle" "${linenr:-${BASH_LINENO[0]}}"
   push "$2"
   ((body[xt]=dp))
   semicolon
   inline
}


# arg1=name  arg2=val
# initialized with 0 or optional arg2
variable()  {
   local linenr="${linenr:-${BASH_LINENO[0]}}"
   (( "$1"="$dp" ))
   m[dp]="${2:-0}"
   constant "$1" "$((dp++))"
}

# dual headed variables. in bash do their names represent
# indici into m.  in yoda is that index pushed and used
# as memory address. therefore, this code for variable foo
# is equivlant:    bash:  m[foo]=123     yoda:   123 foo !
variable 'shell'              "0"
variable 'forwardrefs'        "1"

# NOTE: here is an interesting bug:  last does> test
# only succeeds if here's a variable with value of 1
m[dp++]=1

variable 'callstack'          "0"
variable 'base'               "10"
variable 'state'              "0"

constant 'maxuint'            "$maxuint"
constant 'maxint'             "$maxint"
constant 'msb'                "$msb"
constant 'true'               "$true"
constant 'false'              "false"
constant 'esc'                "27"
constant 'bl'                 "32"
constant 'bits'               "$bits"
constant 'cell'               "1"



# may not inline: value may change, inlined code won't
value()  {
   nowheader "$1" "$filehandle" "${linenr:-${BASH_LINENO[0]}}"
   use "((s[++sp]=$2))"
}


# ----- errors, traps, entry points----------------------- #FOLD00

warm()  {
   r=() rp=0
   ((sp<0))&&s=(0) sp=0                                              # always clear stack underflow
   ((clean))&&s=(0) sp=0 ss=()                                       # empty stacks
   ((filehandle=0, linenr=-1, compiling=false, error=0, m[base]=10))
   line=""                                                           # signal to evaluate to stop evaluation of current line
   compiler_init
}

coldvector=""                                                        # colon word "boot" assigns coldvector. started when compilation completed.
cold()  {                                                            # also by running cold. error restarts interpreter at cold
   [[ -z "$coldvector" ]] && exit 1
   warm; $coldvector
}

callstack()  {
   printf "%s: " "Call stack"
   printf "%s " "${FUNCNAME[@]:5:${m[callstack]}}"                   # remove callstack and error from output
   printf "\n"
}


read -r redbg  < <(tput setab 1)
read -r normal < <(tput sgr0)

error() {
   printf "%s%s %s\n" "${tib%"${word}"*"${line}"}" "${redbg}${word}${normal}" "$line"
   printf 'ERROR: %s\n' "$@"
   row=$((${#tib}-${#line}-${#word}))
# NOTE: passing file name in lasterror - could pass file handle instead
   lasterror=("$file" "$linenr" "$row")
   (( linenr < 0 )) || printf "at %s of %s\n" "$linenr,$row" "$file"
   ((m[callstack]))&&callstack
   cold
}

declare -a errortext
declare -i nexterror=0

errornr()   {
   error="$1"
   shift
   error "${errortext[error]} $*"
}

# a somewhat wild construct, sort of attempting
# to emulate Forth's create ... does> here. I'm
# surprised that shellcheck finds this acceptable
newerror() {
   (( "$1"=nexterror ))                                              # assign new error number to error name
   eval "$1()  { errornr \"$1\" "\"\$*"\"; }"                        # synthesise error function with error name
   shift
   errortext[nexterror++]="$*"                                       # associate error message with error number
}

newerror "noerror"         "no error"
newerror "missingname"     "no or empty name"
newerror "missing"         "missing"
newerror "stackunderflow"  "stack underflow"
newerror "notfound"        "not found:"
newerror "nosource"        "no source for"
newerror "stillcompiling"  "still compiling after"
newerror "unbalancedstack" "unbalanced stack in file"
newerror "unstructured"    "unstructured: missing"
newerror "shellerror"      "shell returned"
newerror "filenotfound"    "file not found:"

ctrl-c()  {                                                          # "break" is configurable item to control
   printf "%s\n" "break"                                             # how yoda responds to break signal.
   ((break == 1))  && exit 1                                         # This is due to not having a clean
   ((m[callstack]))&& callstack                                      # warm start procedure.
   ((break == 2))  && cold
}
trap ctrl-c SIGINT

#err()  { echo "error trap:  $word ${FUNCNAME[1]}"; }
# trap err ERR


# ----- wordlist searching ------------------------------- #fold01

# results array
declare -ai exists                                                   # result array:  exists[0]=0|xt, [1]=flags, [2]: wid

# arg1:word  arg2+:wids
# returns: exists[0]=0|xt, [1]=flags,  [2]=wid where word was found
exists()  {
   local context word="${1,,}"                                       # this is what we're looking for
   shift
   for wid in "$@"; do                                               # in these word lists
      declare -n context="wordlist_$wid"                             # make next wordlist visible
      declare -n flags                                               # appease shellcheck
      declare -n flags="flags_$wid"
      [[ -n "${context[${word}]}" ]] && {                            # word found in it?
         exists=(                                                    # yes: return xt, flags and wid as result
            "${context[${word}]##*_}"
            "${flags[${word}]}"
            "$wid"
            )
         return 0
      }
   done                                                              # not yet found: loop through all wids in arguments
   exists=(0)                                                        # word not found: return 0
   return 1                                                          # and indicate error
}


# ----- patterns ----------------------------------------- #fold00


# arg1: number string:    123456.
# arg2: radix
# return values in dh:dl are not masked with $true
alldigits="0123456789abcdefghijklmnopqrstuvwxyz"                     # cut legal chars for base
number_radix()  {                                                    # base passed as argument
   local word="${1,,}" radix="$2" i j digit
   local legaldigits="${alldigits:0:radix}" sign="" dh=0 dl=0
   [[ ${word:0:1} == - ]]&&{                                         # leading dash?
      sign="-"
      word="${word:1}"                                               # strip dash
   }
   local tail="${word#*[!"$legaldigits"]}"                           # remove up to and including first non-digit character
   local left="${word%%"$tail"}"                                     # the removed part
   [[ -z "$left" ]]&&{                                               # no non-digit chars in string
      ((tmp=$sign$radix#$tail&true))
      stateless "((s[++sp]=$tmp))"                                   # push or compile as single signed or unsigned number
      return 0
   }
   ((${#left}>1))||return 1                                          # leading decimal point: not a number
   [[ ${left:0-1} == . ]]&&left="${left:0:-1}"                       # remove dot
   word="${left}${tail}"                                             # recombine number without decimal point
   [[ -z "${word//[$legaldigits]/}" ]]||return 1                     # number contains other chars than legal digits: not a number
   ((dpl=${#tail}))                                                  # write dot position to dpl
   for ((j=0; j<${#word};j++)); do
      digit="${word:j:1}"
      ((s1=dh*radix, s2=dl, dl=0))
      for ((i=bits; i--;)); do
         ((dl*=2, s2*=2, dl&carry))&&((s2++, dl&=true))
         ((s2&carry))&&((dl+=radix, dl&carry))&&((s2++))
      done
      ((digit=asc[$digit]-48, digit>9))&&((digit-=39))
      ((dh=s1+s2, dl+=digit, dl&carry))&&((dh++))
   done
   [[ -z "$sign" ]]||{                                               # reapply sign
      ((dl^=true, dh^=true, dl++, dl&carry))&&((dh++))
   }
   ((dl&=true, dh&=true))
   stateless "((s[++sp]=$dl, s[++sp]=$dh))"                          # push or compile signed or unsigned double number
   return 0                                                          # indicate success: no need for further examination
}

declare -a patterns
add_pattern()  { patterns+=("$1"); }

# patternlets must return a value=0 if matching, <>0 otherwise.
# return value determines whether search for matching pattern will continue.
add_pattern "number"                                                 # 123 -123 123.456 -123.456
number()  { number_radix "$word" "${m[base ]}"; }                    # respecting base

add_pattern "prefixednumber"                                         # #123 #123.456 #-123 #-123.456 $abc $abc.def $-abc $-abc.def %101 %101.01 %-101 %-101.01
prefixednumber()  {                                                  # base override by number prefix
   [[ $char1 == [%\$\#] ]] &&
   number_radix "$tail" "${bases[$char1]}"
}

add_pattern "tick_char"                                              # 'c'  and   'c
tick_char()  {
   [[ ${word} == \'? || ${word} == \'?\' ]] || return 1
   stateless "s[++sp]=\"$(printf "%d" "'$tail'")\""
}

add_pattern "ctrl_char"                                              # ^c and ^C
ctrl_char() {
   [[ ${word,,} == ^[a-z\[] ]] || return 1
   stateless "s[++sp]=\"$(($(printf "%d" "'$tail'")&31))\""
}

add_pattern "string_dquote"                                          # "string", "multi string"
string_dquote()  {
   [[ "$char1" == '"' ]] || return 1
   if [[ "${tail:0-1}" == '"' ]]; then                               # "string"
      tmp="${tail:0:-1}"
   else                                                              # 'string multi'
      parse '"' || missing "closing double quotes"                   # parses into variable "word"
      tmp="$tail $word"
   fi
   stateless "ss+=(\"$tmp\")"
}


add_pattern "string_squote"                                          # 'string', 'multi string'
string_squote()  {
   [[ "$char1" == "'" ]] || return 1
   if [[ "${tail:0-1}" == "'" ]]; then                               # 'string'
      tmp="${tail:0:-1}"
   else                                                              # 'string multi'
      parse "'" || missing "closing single quote"                    # parses into variable "word"
      tmp="$tail $word"
   fi
   stateless "ss+=('$tmp')"
}


add_pattern "hashbang"                                               # #!hashbang
hashbang()  { [[ "${word:0:2}" == '#!' ]] && line=""; }

add_pattern "shellcommand"                                           # >shell command
shellcommand()  {
   [[ "$char1" == '>' ]] || return 1
   tmp="$tail"                                                       # >foo... ->  foo...
   if [[ ${tmp:0-1} == ";" ]]; then                                  # semicolon attached to command
      tmp="${tmp:0:-1}"                                              # foo; -> foo
   elif [[ "$line" == *';'* ]]; then                                 # semicolon space seperated from command
      parse ';'                                                      # parse input until ;
      tmp+=" $word"
   else                                                              # no semicolon at all
      tmp+=" $line"
      line=""                                                        # and removed from further evaluation
   fi
   stateless "$tmp"                                                  # execute or compile the parsed shell command
   return 0
}


# ----- line interpreter, evaluate------------------------ #fold00

# text compiler and interpreter, the so-called outer interpreter

# interpret/compile the line passed as argument
# in here most compiling and interpreting work is done.
# time to split this thing up, as it's getting a tad unwieldy
evaluate()  {
# line may get modified, and that must be. some words depend on being able to empty it.
# tib remains unaffected unless explicitely modified (query et al), for error reporting.
   local line="$*" tib="$line"
   while [[ -n "$line" ]]; do                                        # still more to process on line (parsing removes strings from line)
      ((error || (sp<0)))&&break
      word || continue                                               # parse white space delimited word.
      local wordlower="${word,,}"
# examine compiler wordlist first
      if ((compiling)); then                                         # word wasn't found. search state specific vocabularies
         [[ -z "${compiler["$wordlower"]}" ]] || {                   # found in in compiler while compiling
            ${compiler["$wordlower"]}                                # word in there are inherently "immediate", therefore they're executed here
            continue                                                 #     because that also deals with inline compilation.
         }
         [[ -z "${unresolved["$wordlower"]}" ]] || {                 # found in unresolved while compiling
            code "${unresolved[$wordlower]}"                         # compile it
            continue
         }
      fi
# --- search word in order ---
      exists "$wordlower" "${order[@]}" && {                         # stateless word found?
         tmp="${exists[0]}"
         ((compiling)) && {
            ((exists[1]&inline)) && {
               codebody "$tmp"                                       # inline: compile function body
               continue
            }
            call "$tmp"
            continue
         }
         name "$tmp"                                                 # not compiling: convert xt to function name
         $name                                                       # execute function
         continue                                                    # done processing this word
      }
# --- word not in a searched wordlist
# --- pattern?
      local char1="${word:0:1}" tail="${word:1}"                     # many patternlets look at first char and use the remainder
      for pattern in "${patterns[@]}"; do
         $pattern && continue 2                                      # arguments in $word, $char1, $tail
      done

# --- can be included?
      (( m[forwardrefs] )) && {                                      # forwardrefs can be 0, 1 or 2 for levels of forward referencing.
         if ((compiling)); then                                      # level 1 during compilation: forward resolve only word found in library
            (( m[forwardrefs] == 2 || ${#lib[$wordlower]} )) && {    # level 2 during compilation: forward reference all unknown words
               compile_forwardref "$wordlower"
               continue
            }
         else                                                        # any level during interpretation: compile from library or throw error
            satisfy1 "$wordlower" && {                               # attempt to load word
               exists "$wordlower" "${order[@]}" || notfound "$word" # word not found: error (though it was compiled successfully)
               name "${exists[0]}"                                   # into is in search order. Therefore search order is searched for word.
               $name                                                 # word found in search order -> execute
               continue
            }
         fi
      }

# --- can be shelled to?
      ((m[shell])) && {                                              # done unless shell flag was set
         stateless "${word} ${line}" ||                              # in which case execution as shell command is attempted (cmd not found returns 127)
         shellerror "$?"                                             # non-zero exit values of shell commands will be passed on to yoda error handler
         line=""                                                     # assignment sets return value to 0
         continue
      }
# --- can be reported?
      notfound "$word"                                               # nothing helped. get grouchy.
      line=""                                                        # stop evaluation: nothing left
   done
   ((sp<0))&&stackunderflow
}


# ----- load source files -------------------------------- #fold00

# return filehandle pointing to matching file in array files,
# or to end of array where new file will be added if no
# matching file was found. Also return a return values (1)
# if not loaded, return 0 when loaded.
# (seems twisted but allows condition  "if loaded; then ..."

# return filehandle as result, and return value
# indicating first time load or reload
# arg1: file name (fully qualified)
loaded()  {
   local file="$1"
   for ((filehandle=1; filehandle<${#files[@]}; filehandle++)); do   # while multiple inclusion is allowed, those files won't be recorded multiple times
      [[ "${files[filehandle]}" == "$file" ]] && break               # so when already recorded, break out
   done
   return $(( filehandle >= ${#files[@]}))
}


# arg1: wid
# arg2: any for alternative set of options
set-current()  {
   currentwid="$1"
   declare -gn current="wordlist_$currentwid"
   declare -gn flags="flags_$currentwid"
}


# trashed name as argument
# expects word in current
# ( -- )
trash()  {
   local current flags word="${1,,}"
   declare -n current="wordlist_$currentwid"
   declare -n flags="flags_$currentwid"
   tmp="${flags[$word]}"
   (((tmp&inline) && (!(tmp&protected)))) && unset -f "${current[$word]}"
   removeheaderfromcurrent "$word"
}


# trash transient headers
notransients()  {
   ((${#transients[@]})) && {                                        # only if any transients exist at all
      local current flags currentwid wid transient word
      currentwid="-1"                                                # make sure current will be declared, because local variables
      for transient in "${transients[@]}"; do
         wid="${transient%% *}"                                      # wid of transient
         word="${transient##* }"                                     # transient word
         ((currentwid == wid)) || set-current "$wid"                 # must change wids
         trash "$word"                                               # remove header
      done                                                           # repeat for all headers in list of transients
   }
}

# nestable source include
# this from differs from the colon word, as it doesn't
# try the different ${libdirs[@}} directories.
# file, possible with path, must exist, or no go.
# Callers did a check prior to calling.
from()  {
   [[ -z "$1" ]] && return 2                                         # no file
   local line lines linenr file="" filehandle word                      # must protect for nested includes.
   local stackeffect="$sp"                                           # included files must have net stack effect of 0
   if [[ "$1" == */* ]]; then                                        # file contains slash(es): don't search
      file="$1"
   else
      for dir in "${libdirs[@]}"; do
         [[ -f "$dir/$1" ]] && { file="$dir/$1"; break; }            # search through lib dirs, break when/if found
      done
   fi
   [[ -f "$file" ]] || return 1                                      # file not found
   file="$(realpath "$file")"                                        # canonical or original name of file
   loaded "$file" || files[filehandle]="$file"                       # first time inclusion: add to files array
   readarray -t lines < "$file"                                      # read whole file into lines array
   local transients=()                                               # list of headers marked transient
   for ((linenr=0; linenr<${#lines[@]};)); do                        # looping through line number, not through lines so that
      line="${lines[linenr++]}"                                      #   source can change line numbers for jumping
      evaluate "$line"                                               # process next line
      ((error | (linenr < 0)))&&break                                # source can flag "stop loading" with negative linenr
   done                                                              #   (warm and done do so)
   notransients                                                      # trash transient headers
   ((compiling)) && stillcompiling "$1"                              # can't have that, files leaving a dangling compiler
   ((stackeffect == sp)) || unbalancedstack "$1"                     # demanding stack clean files with net effect zero.
   ((loaded[filehandle]++))                                          # increment load counter, mark as loaded
   return 0
}

# ----- primitives --------------------------------------- #FOLD00
# ----- colon/semicolon ---------------------------------- #fold01

colon ';'
   code "((s[sp--] == $magic))||{ unstructured ':'; return; }"       # check the magic left by :
   code '((${s[sp--]} == ${#raw[@]}))&& code "(())"'                 # insert a noop into empty function bodies
   code 'semicolon'                                                  # compile $lastword from $raw[@], resume interpreting
semicolon
compiled


colon ':'                                                            # ( s: word )
   code 'word || missingname'                                        # parse space delimited word from input stream
   code 'colon "$word"'                                              # generate synthetic name, associate with word
   push '${#raw[@]}'                                                 # allow check of empty function
   push "$magic"                                                     # allow check of proper nesting
   code '((compiling=true))'
semicolon


# ----- diagnostics -------------------------------------- #fold01



words() {
   local context width word columns i=0
   declare -n context="wordlist_${order[0]}"
   (( ${#context[@]} )) && {
      for word in "${!context[@]}"; do                               # determine longest word name
         (( ${#word} > width )) && width="${#word}"
      done
      ((width+=2))                                                   # add spacing
      ((columns=${COLUMNS:-80}/width))
      for word in "${!context[@]}"; do
         printf  "%-${width}s" "$word"                               # output words width padded
         ((++i % columns)) || printf "\n"
      done
   }
}


wordsplus() {
   local context wid
   for wid in "${order[@]}" "$compilerwid" "$unresolvedwid"; do
      wordlist="wordlist_$wid"
      declare -n context="$wordlist"
      (( ${#context[@]} )) && {
         printf '%s\n' "--- ${strings[$wid]} ---"
         printf  "%s  " "${!context[@]}"
         printf "\n\n"
      }
   done
}



see1()  {
    local i see s0
    readarray -t see < <(type "$1")
    echo "{"
    for ((i=0; i<${#see[@]}; i++)); do
        s0="${see[i]}"
        [[ "${s0:0:1}" == [[:space:]] ]]||continue
        s0="${s0##+([[:space:]])}"
        [[ "${s0}" == "${nameprefix}_"* ]] && {
            s0="${s0#"${nameprefix}_"}"
            s0="${names[${s0%;}]}"
        }
        printf "   %s\n" "$s0"
    done
    echo "}"
}

see()  {
   local context wid name found=0
   word || missingname
   word=${word,,}
   for wid in "${order[@]}" "$compilerwid"; do
      declare -n context="wordlist_$wid"
      name="${context["$word"]}"
      [[ -z "$name" ]] || {
         printf "found in %s:\n" "${strings[wid]}"
         see1 "$name"
         ((found++))
      }
   done
   ((found))||notfound "$word"
}

# see word  "decompiles" and shows word.
primitive 'see' 'see'                                                # ( -- ) ( s: word )


# ----- does> -------------------------------------------- #fold01

# compiled to the end of a defining word,
# is therefore called by create part, and
# will consequently know who its caller is
# (function name).  Will also know, by virtue
# of $lastword, what function to add code to.
# (or rather, instruct detokeniser to add code
# to). Appends all defining word associated code
# portion of does> to the original address push
# compiled by create.
dodoes()  {                                                          # append does> part to original address pushing create semantics
   ${current[$lastword]}
   use  "s[++sp]=\"${s[sp--]}\"
         ${doescode[${FUNCNAME[1]}]}"
}

# detokeniser detects and reacts to this "$does" tagged code:
# code after does> is removed from defining word and written to
# an array item associated with it.
# dodoes then uses that code to rewrite run time semantics of
# defined word.
# Though somewhat Rube-Goldbergish, it's simpler than the other
# approaches I was thinking of.
primitive 'does>'  'code "dodoes" "$does"';   compiled




# ----- defining words ----------------------------------- #fold01

create()  {
   code 'word || missingname'
   code "constant \"\${word}\" \"$1\""                               # not using single quotes because want $1 to expand
}


colon 'constant'                                                     # create: ( x -- ) ( s: word )  exec: ( -- x )
   create '${s[sp--]}'
semicolon
inline


createstring()  {
   code "constant \"\${ss[-1]}\" \"$1\""
   code 'unset "ss[-1]"'
}


colon 'constant$'                                                    # create: ( x -- ) ( $1 -- )  exec: ( -- x )
   createstring '${s[sp--]}'
semicolon
inline


# NOTE: factor code common with header
# ' foo alias bar
colon 'alias'                                                        # create: ( xt -- ) ( s: word )
   create ''                                                         # value irrelevant, will point to different function anyway
   code 'where["$lastword"]="${filehandle}:${linenr:-${BASH_LINENO[2]}}"'
   code 'name "${s[sp--]}"'                                          # convert xt to function name
   code 'current["$word"]="$name"'                                   # let new header execute same function
   code 'flags["$word"]="$protected"'                                # define, through constant, sets inline flag. we don't want that.
semicolon                                                            # as trash without protect needs some attention too, the aliased
                                                                     # header has its protect flag set, meaning that trashing the alias
                                                                     # header won't trash code, which seems the easiest way to deal with it.

# ----- deferred words ----------------------------------- #fold01

# new deferred words are initialised to noop
((noop_xt=xt))
primitive 'noop' '(())'                                              # ( -- )


# NOTE: be aware of possibility to defer an inlined word by xt,
# then trash header of inlined word. trashing function body in
# that situation will leave the deferred word with a dangling xt.
# header flag "protect" disables code trashing, so does not setting
# the word to "inline"
# arg1: name of deferred word

# because a deferred word is neither defined by create nor does it
# correpond with a memory address which hold the xt of bound word,
# but defer! and defer@ are facilitated by those, defer simulates
# memory boundedness. So (will) do is, defer@, defer!
defer()  {
   ((body[xt]=dp, m[dp++]=noop_xt))
   nowheader "$1" "$filehandle" "${linenr:-${BASH_LINENO[0]}}"
   use "(())"
}

# example:  defer foo      ' bar is foo
colon "defer"                                                        # create: ( -- ) ( s: word )
   code 'word || missingname'
   code 'defer "$word"'
semicolon
inline

primitive 'defer@'   '((s[sp]=m[body[s[sp]]]))'                      # ( xt1 -- xt2 )

colon 'defer!'                                                       # ( xt1 xt2 -- )
   pop 's0'
   pop 's1'
   code '((m[body[s0]]=s1))'
   code 'name "$s1"'
   code 'apply "$s0" "$name"'
semicolon


colon 'is'                                                           # compile: ( -- ) ( s: word ) exec: ( xt -- )
   code 'word || missingname'
   code 'exists "$word" "${order[@]}" || notfound "$word"'
   code 'code "((m[${body[exists[0]]}]=s[sp]))"'
   code 'name "\${s[sp--]}"'
   code 'code "apply \"${exists[0]}\" \"$name\""'
semicolon
compiled

colon 'is'                                                           # ( xt -- ) ( s: word )
   code 'word || missingname'
   code 'exists "$word" "${order[@]}" || notfound "$word"'
   pop  's0'
   code '((m[body[exists[0]]]=s0))'
   code 'name "$s0"'
   code 'apply "${exists[0]}" "$name"'
semicolon

# ----- value, to ---------------------------------------- #fold01

colon "value"                                                        # create: ( x -- ) ( s: word )  exec: ( -- x )
   code 'word || missingname'
   code 'value "$word" "${s[sp--]}"'
semicolon
inline

colon 'to'                                                           # compile: ( -- ) ( s: word ) exec: ( x -- )
   code 'word || missingname'
   code 'exists "$word" "${order}" || notfound "$word"'
   code 'code "apply \"${exists[0]}\" \"s[++sp]=\${s[sp--]}\""'
semicolon
compiled

colon 'to'                                                           # ( x -- ) ( s: word )
   code 'word || missingname'
   code 'exists "$word" "${order}" || notfound "$word"'
   code 'apply  "${exists[0]}" "s[++sp]=${s[sp--]}"'
semicolon




# ----- parameter stack ---------------------------------- #fold01


colon 'swap'                                                         # ( x1 x2 -- x2 x1 )
   code '((tmp=s[sp-1]))'
   get 's[sp-1]'
   put  'tmp'
semicolon
inline

colon '2swap'                                                        # ( x1 x2 x3 x4 -- x3 x4 x1 x2 )
   code '((tmp=s[sp-3], s[sp-3]=s[sp-1], s[sp-1]=tmp))'
   code '((tmp=s[sp-2], s[sp-2]=s[sp], s[sp]=tmp))'
semicolon

colon 'tuck'                                                         # ( x1 x2 -- x2 x1 x2 )
   push 's[sp]'                                                      # s2 s1 s1
   code '((s[sp-1]=s[sp-2]))'                                        # s2 s2 s1
   get 's[sp-2]'                                                     # s1 s2 s1
semicolon
inline

colon 'rot'                                                          # ( x1 x2 x3 -- x2 x3 x1 )
   get  'tmp'
   code '((s[sp]=s[sp-2], s[sp-2]=s[sp-1], s[sp-1]=tmp))'
semicolon
inline

colon '-rot'                                                         # ( x1 x2 x3 -- x3 x1 x2 )
   get  'tmp'
   code '((s[sp]=s[sp-1], s[sp-1]=s[sp-2], s[sp-2]=tmp))'
semicolon
inline

colon 'nip'                                                          # ( x1 x2 -- x2 )
   pop 's[sp]'
semicolon
inline

colon 'roll'
   code '((s0=s[sp--], tmp=sp-s0))'
   code 's=(${s[@]:0:tmp} ${s[@]:tmp+1:s0} ${s[@]:tmp:1})'
semicolon
inline

# ----- numeric comparison ------------------------------- #fold01

colon '0='                                                           # ( x -- flag )
   put  's[sp]?false:true'                                           # 0->true  x->false
semicolon
inline

colon '0<>'                                                          # ( x -- flag )
   put  's[sp]?true:false'                                           # 0->0   x->true
semicolon
inline

colon '0<'                                                           # ( n -- flag )
   put  's[sp]&msb?true:false'                                       # &msb: 0->0   msb->true
semicolon
inline

colon '='                                                            # ( x1 x2 -- flag )
   pop  's0'
   put  's0==s[sp]?true:false'
semicolon
inline

colon '<>'                                                           # ( x1 x2 -- flag )
   pop  's0'
   put  's0==s[sp]?false:true'
semicolon
inline

colon 'u<'                                                           # ( u1 u2 -- flag )
   pop  's0'
   put  '(s[sp]&true)<s0?true:false'
semicolon
inline

colon 'u>'                                                           # ( u1 u2 -- flag )
   pop  's0'
   put  '(s[sp]&true)>s0?true:false'
semicolon
inline

colon '<'                                                            # ( n1 n2 -- flag )
   pop  's0'
   code '((sign=((s0^s[sp])&msb)?1:0))'                              # set bit 0 if signs differ
   put  '((s0>s[sp]&true)^sign)?true:false'
semicolon
inline

colon '>'                                                            # ( n1 n2 -- flag )
   pop  's0'
   code '((sign=((s0^s[sp])&msb)?1:0))'                              # set bit 0 if signs differ
   put  '((s0<s[sp]&true)^sign)?true:false'
semicolon
inline

#    flag
#   s2 < s1        sign           result
#   0 (true)       0   (same)     true
#   1 (false)      0   (same)     false
#   0 (true)       msb (diff)     false
#   1 (false)      msb (diff)     true

#  flag  sign      result
#  0     0         true
#  1     0         false
#  0     $xxx1     false
#  1     $xxx1     true

# ( x1 x2 x3 x4 -- 0 | -1 )
colon 'd='                                                           # ( d1 d2 -- flag )
  code '((s[sp-3]=((s[sp]==s[sp-2])&&(s[sp-1]==s[sp-3]))?true:false))'
  code '((sp-=3))'
semicolon
inline

# ----- line i/o ----------------------------------------- #fold01


# parse input for string delimited by character specified by ASCII value on stack
#colon 'parse\$'
#   code 'parsebacksl "${char[s[sp--]]}"'
#   code 'ss+=("$word")'
#semicolon
#inline


# parse input for string delimited by character specified by ASCII value on stack
colon 'parse$'                                                       # ( c -- ) ( -- $1 )
   code 'parse "${char[s[sp--]]}"'
   code 'ss+=("$word")'
semicolon
inline

# ( -- ) ( -- $1 )
colon 'word$'                                                        # ( -- ) ( -- $1 )
   code 'word'
    code 'ss+=("$word")'
 semicolon
 inline


# read line, push to string stack
# TODO: configurable attributes
keybuf=""
accept=""
# arg1: char count
accept()  {
   IFS="" read -ern "$1" -i "$keybuf" "accept"
   keybuf=""
}

colon 'accept'                                                       # ( a n1 -- n2 )
   code 'accept "${s[sp--]}"'
   code 'unpack "$accept"'
semicolon
inline


colon 'simplequery$'                                                 # ( -- ) ( -- $1 )
   code 'accept "65535"'
   code 'ss+=("$accept")'
semicolon


colon 'evaluate$'                                                    # ( -- ) ( $1 -- )
   code 'local tib="${ss[-1]}"'
   code 'unset "ss[-1]"'
   code 'evaluate "$tib"'
   code "resolve"
semicolon


# ----- compiler, dictionary search related -------------- #fold01

primitive '[' '((compiling=false))'; compiled                        # ( -- )
primitive ']' '((compiling=true))'                                   # ( -- )

colon 'state'                                                        # ( -- a )
   push 'state'                                                      # mem address is pushed.
   code '((m[state]=compiling))'                                     # then value of compiling is stored so that state reflects actual state.
   trash 'state'                                                     # as header of colon word state doesn't yet exist, this trashes the variable.
semicolon                                                            # use in colon word state was the only purpose of variable state.
inline

dropstring,()  {
   code 'unset "ss[-1]"'
}

colon 'push,'                                                        # compile:  ( -- ) ( $1 -- )   run: ( -- x )
   code 'push "${ss[-1]}"'
   dropstring,
semicolon
immediate

colon 'pop,'                                                         # compile: ( -- ) ( $1 -- )   run: ( x -- )
   code 'code "((${ss[-1]}=s[sp--]))"'
   dropstring,
semicolon
immediate

colon 'code'                                                         # ( -- ) ( s: word )
   code 'word || missingname'
   code 'delayheader "$word" "$filehandle" "$linenr"'
semicolon
inline

colon ';code'                                                        # ( -- )
   code "compile"
semicolon
inline

colon 'code,'                                                        # ( -- ) ( $1 -- )
   code 'code "${ss[-1]}"'
   dropstring,
semicolon
immediate


primitive 'literal,'       'push ${s[sp--]}'                         # ( -- ) ( compile time: x -- ) ( run time: -- x )

# ( x -- )
colon 'literal'
   code  'push ${s[sp--]}'                                           # ( -- ) ( compile time: x -- ) ( run time: -- x )
semicolon
compiled


colon 'literal$'                                                     # ( compile: $1 -- ) ( run: -- $1 )
   code 'code "ss+=(\"${ss[-1]}\")"'
   dropstring,
semicolon
compiled


colon "'"                                                            # ( -- xt ) ( stream: word )
   code 'word || missingname'
   code 'exists "$word" "${order[@]}" "$compilerwid" || notfound "$word"'
   push 'exists[0]'
semicolon

                                                                     # similar to find, but name from string stack rather than input stream
colon 'have$'                                                        # ( -- 0|xt ) ( $1 -- )
   code 'tmp="${ss[-1]}"'
   code 'unset "ss[-1]"'
   code '[[ -z "$tmp" ]]&&missingname'
   code 'exists "$tmp" "${order[@]}" "$compilerwid"'
   push 'exists[0]'
semicolon

# ' word  "signalname"  trap
colon 'trap'                                                         # ( xt - ) ( $1 -- )
   code 'name "${s[sp--]}"'                                          # convert xt to function name
   code 'trap "$name" "${ss[-1]}"'
   dropstring,
semicolon

primitive 'execute' "${nameprefix}_\${s[sp--]}"                      # ( xt -- )
primitive 'name$'   'ss+=("${names[s[sp--]]}")'                      # ( xt -- ) ( string: -- $1 )
primitive '.name'   'printf "%s" "${names[s[sp--]]}"'                # ( xt -- )

primitive 'resolve' 'resolve'                                        # ( -- )    attempt to resolve forward references
primitive '.unresolved'  '((${#unresolved[@]}))&&printf "%s " "${!unresolved[@]}"'   # ( -- ) print unresolved
primitive 'recurse' 'call "$xt"'; compiled                           # ( -- )

# apply run time semantic from string stack
colon 'use$'                                                         # ( -- ) ( $1 -- )
   code 'use "${ss[-1]}"'
   dropstring,
semicolon
inline

# trashed name from input stream
colon 'trash'                                                        # ( -- ) ( s: word )
   code 'word || missingname'
   code 'trash "$word"'
semicolon
inline

# trashed name from string stack
# word expected in current vocabulary
# ( -- )  ( $1 -- )
colon 'trash$'                                                       # ( -- ) ( $1 -- )
   code 'trash "${ss[-1]}"'
   dropstring,
semicolon
inline

# name of last word to string stack
primitive 'last$'   'ss+=("$lastword")'                              # ( -- $1 )

# this version doesn't allow postponing forward references yet.
# postpone doesn't search compiler context wordlist.
# for including those, add them to order.
colon 'postpone'                                                     # ( -- ) ( s: word )
   code 'word || missingname'
   code 'exists "$word" "$compilerwid" "${order[@]}" || notfound "$word"'
   code 'if ((exists[2] == compilerwid)); then call "${exists[0]}"'
   code 'else code "call \"${exists[0]}\""; fi'
semicolon
compiled


#find$
#( -- 0 | xt 1 | xt -1 )   ( $1 -- $1 | )

#FIND
#( c-addr -- c-addr 0 | xt 1 | xt -1 )

#Find the definition named in the counted string at c-addr.
#If the definition is not found, return c-addr and zero.
#If the definition is found, return its execution token xt.
#If the definition is immediate, also return one (1),
#otherwise also return minus-one (-1).
#For a given string, the values returned by FIND while compiling
#may differ from those returned while not compiling.


colon 'where$'                                                       # ( -- n1 n2 ) ( $1 -- )
    code 'tmp="${ss[-1],,}"'                                         # name of word to look up
    code 'unset "ss[-1]"'
    code '[[ -z "$tmp" ]]&&missingname'                              # no name given
    code 'tmp1="${where[$tmp]}"'                                     # "file:line"
    code '((${tmp1%%:*}))||nosource "$tmp"'                          # file handle empty or 0: no source available
    push '${tmp1%%:*}'                                               # push file handle
    push '${tmp1##*:}'                                               # push line number
semicolon


# ----- bit logic ---------------------------------------- #fold01

colon 'and'                                                          # ( x1 x2 -- x3 )
   pop 's[sp-1]&'
semicolon
inline

colon 'or'                                                           # ( x1 x2 -- x3 )
   pop 's[sp-1]|'
semicolon
inline

colon 'xor'                                                          # ( x1 x2 -- x3 )
   pop 's[sp-1]^'
semicolon
inline

colon 'lshift'                                                       # ( x1 u -- x2 )
   put '(s[sp-1]<<s[sp--])&true'
semicolon
inline

colon 'rshift'                                                       # ( x1 u -- x2 )
   put '(s[sp-1]&true)>>s[sp--]'
semicolon
inline


# ----- flow control ------------------------------------- #fold01

remagic

colon 'if'                                                           # compile: ( -- ifsys ) run: ( x -- )
   code 'code "if ((s[sp--])); then"'
   push '${#raw[@]}'                                                 # allow check of empty function
   push "$magic"                                                     # allow check of structure
semicolon
compiled

colon 'else'                                                         # compile: ( ifsys1 -- ifsys2 ) run: ( -- )
   code "((s[sp]++ == \"$magic\")) || { unstructured 'if'; return; }"
   code '((s[sp-1] == ${#raw[@]})) && code "(())"'
   code 'code "else"'
   code '((s[sp-1]=${#raw[@]}))'
semicolon
compiled

colon 'then'                                                         # compile: ( ifsys -- ) run: ( -- )
   code "((s[sp] == $magic ||  s[sp] == $((magic+1)))) || { unstructured 'if or else'; return; }"
   code '((sp--))'
   code '((s[sp--] == ${#raw[@]})) && code "(())"'
   code 'code "fi"'
semicolon
compiled


remagic

colon 'begin'                                                        # compile: ( -- beginsys )  run: ( -- )
   code 'code "while :; do"'
   push '${#raw[@]}'                                                 # allow check of empty function
   push "$magic"                                                     # allow check of structure
semicolon
compiled


colon 'again'                                                        # compile: ( beginsys -- )  run: ( -- )
   code "(( s[sp--] == \"$magic\" )) || { unstructured 'begin'; return; }"
   code '(( s[sp--] == ${#raw[@]} )) && code "(())"'
   code 'code "done"'
semicolon
compiled

colon 'until'                                                        # compile: ( beginsys -- )  run: ( x -- )
   code "(( s[sp--] == \"$magic\" )) || { unstructured 'begin'; return; }"
   code 'code "((s[sp--]))&&break"'
   code '((sp--))'
   code 'code "done"'
semicolon
compiled

colon 'while'                                                        # compile: ( beginsys1 -- beginsys2 )  run: ( x -- )
   code "(( s[sp] == $magic+1 )) || (( s[sp]++ == $magic )) || { unstructured 'begin'; return; }"
   code 'code "((s[sp--]))||break"'
semicolon
compiled

colon 'repeat'                                                       # compile: ( beginsys1 -- )  run: ( -- )
   code "(( s[sp--] == $((magic+1)) )) || { unstructured 'while'; return; }"
   code '((sp--))'
   code 'code "done"'
semicolon
compiled


remagic
colon 'for'                                                          # compile: ( -- forsys )  run: ( u -- )
   code 'code "((r[++rp]=i))"'
   code 'code "for ((i=s[sp--]; i--; )); do"'
   push '${#raw[@]}'                                                 # allow check of empty function
   push "$magic"                                                     # allow check of structure and empty function
semicolon
compiled

colon 'next'                                                         # compile: ( forsys -- )  run: ( -- )
   code "((s[sp--] == $magic))|| { unstructured 'for'; return; }"
   code '((s[sp--]-${#raw[@]}))||code "(())"'
   code 'code "done"'
   code "code '((i=r[rp--]))'"
semicolon
compiled


# : bounds   over + swap ;
colon 'bounds'                                                       # ( x1 x2 -- x1+x2 x1 )
   get  's1'
   code '((s2=s[sp-1]))'
   put  's2'
   code '((s[sp-1]=(s1+s2)&true))'
semicolon
inline

remagic
dodo()  {
   ((r[++rp]=ibar, r[++rp]=i, i=s[sp--], ibar=s[sp--]))
}

colon 'do'                                                           # compile: ( -- dosys )  exec: ( n1 n2 -- )
   code 'code "dodo"'
   code 'code "while :;do"'
   push "$magic"                                                     # allow check of structure and empty function
semicolon
compiled

colon '?do'                                                          # compile: ( -- dosys )  exec: ( n1 n2 -- )
   code 'code "dodo"'
   code 'code "while :;do"'
   code 'code "((ibar-i))||break"'
   push "$magic"                                                     # allow check of structure and empty function
semicolon
compiled

colon 'loop'                                                         # compile: ( dosys -- )  exec: ( -- )
   code "((s[sp--] == $magic))|| { unstructured 'do'; return; }"
   code 'code "((i=(i+1)&true))"'
   code 'code "((ibar-i))||break"'
   code 'code "done"'
   code "code '((i=r[rp--]))'"
   code "code '((ibar=r[rp--]))'"
semicolon
compiled

colon '+loop'                                                        # compile: ( dosys -- )  exec: ( n -- )
   code "((s[sp--] == $magic))|| { unstructured 'do'; return; }"
   code 'code "((s0=s[sp--]))"'
   code 'code "((s1=i-ibar))"'
   code 'code "((i=(i+s0)&true))"'
   code 'code "(((s1^(i-ibar))&msb))&&break"'
   code 'code "done"'
   code "code '((i=r[rp--]))'"
   code "code '((ibar=r[rp--]))'"
semicolon
compiled

primitive 'lest'   'code "((s[sp--]))||return"'; compiled            # compile: ( -- )  exec: ( x -- )   # exit when false
primitive 'lest'   '((s[sp--]))||line=""'      ;                     # ( x -- )                          # skip rest of line when false
primitive 'unless' 'code "((s[sp--]))&&return"'; compiled            # compile: ( -- )  exec: ( x -- )   # exit when true
primitive 'unless' '((s[sp--]))&&line=""'      ;                     # ( x -- )                          # skip rest of line when true

colon 'times'                                                        # compile: ( -- )  exec: ( u -- )
   code 'code "((r[++rp]=i))"'
   code 'code "for ((i=s[sp--];i--;)); do"'
   code 'conclude "code \"done\""'
   code 'conclude "code \"((i=r[rp--]))\""'
semicolon
compiled

# interpreting version: u times repeat evaluation of input line remainder
colon 'times'                                                        # ( u -- ) ( s: line )
   code '((r[++rp]=i))'                                              # by using i, and pushing previous i to rstack,
   pop  'i'                                                          # we make times, and nested times, compatible with i and j
   code 'while ((i--)); do evaluate "$line"; done'                   # evaluate line i times
   code '((i=r[rp--]))'                                              # restore old i
   code 'line=""'                                                    # prevent re-evaluation of line when times has completed
semicolon

# this is the prefered version, repeating the line upon encountering many
# prefered because its use is more symmetrical with times, both specified
# before the repeated sequence.  times is harder to put at the end.
colon 'many'                                                         # ( -- ) ( s: line )
   code 'until read -rsn1 -t 0.01; do evaluate "$line"; done'
   code 'line=""'
semicolon

# NOTE: add compiled version of many

colon 'boot'                                                         # ( -- ) ( s: word )
   code 'word || missingname'
   code 'satisfy1 "$word"'
   code 'exists "$word" "currentwid" "${order[@]}"'                  # search current first because satisfy may have compiled it there
   code 'name "${exists[0]}"'                                        # convert xt to function name
   code 'coldvector="$name"'
semicolon


# ----- arithmetics, single ------------------------------ #fold01

colon '+'                                                            # ( n1 n2 -- n3 )
   put '(s[sp-1]+s[sp--])&true'
semicolon
inline

colon '-'                                                            # ( n1 n2 -- n3 )
   put '(s[sp-1]-s[sp--])&true'
semicolon
inline

colon '*'                                                            # ( n1 n2 -- n3 )
   put '(s[sp-1]*s[sp--])&true'
semicolon
inline

# ----- arithmetics, mixed ------------------------------- #fold01

# s0:s1
umstar()  {                                                          # ( u1 u2 -- ud )
   local s0="${s[sp]}" s1="${s[sp-1]}" dl=0 i=bits
   for ((; i--;)); do
      ((dl*=2, s1*=2, dl&carry))&&((s1++, dl&=true))
      ((s1&carry))&&((dl+=s0,dl&carry))&&((s1++))
   done
   ((s[sp-1]=dl&true, s[sp]=s1&true))
}

colon 'um*'                                                          # ( u1 u2 -- ud )
   code 'umstar'
semicolon
inline

mstar()  {
   local s0="${s[sp]}" s1="${s[sp-1]}" dl=0 sign i=bits
   sign=$(((s0^s1)&msb))
   ((s0&msb))&&((s0=(-s0&true)))
   ((s1&msb))&&((s1=-s1))
   for ((; i--;)); do
      ((dl*=2, s1*=2, dl&carry))&&((s1++, dl&=true))
      ((s1&carry))&&((dl+=s0,dl&carry))&&((s1++))
   done
   ((sign))&&{
      ((dl^=true, s1=true, dl=(dl+1)&true, dl))||((s1++))
   }
   ((s[sp-1]=dl&true, s[sp]=s1&true))
}

colon 'm*'                                                           # ( n1 n2 -- d )
   code 'mstar'
semicolon
inline

# for >number:  ud*u -> ud
# ( ud u -- ud )    dum*
dumstar()  {
   local s0="${s[sp--]}" s1="${s[sp]}" s2="${s[sp-1]}" i=bits dl=0
   ((s1*=s0))
   for ((; i--;)); do
      ((dl*=2, s2*=2, dl&carry))&&((s2++, dl&=true))
      ((s2&carry))&&((dl+=s0,dl&carry))&&((s2++))
   done
   ((s2+=s1, s[sp-1]=dl&true, s[sp]=s2&true))
}

primitive 'dum*'  'dumstar'                                          # ( ud u -- ud )

# arg1=asc
digit() {
   ((digit=$1-48, digit>9))&&((digit-=39))
   ((digit<0 || digit>=m[base])) && return 1
   return 0
}

# rough early version
# ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 )
tonumber()  {
   local s0="${s[sp--]}" s1="${s[sp--]}"
   for ((; s0;)); do
      digit "${m[s1]}" || break
      ((s[++sp]=m[base]))
      dumstar
      ((s[sp-1]+=digit, s[sp-1]&carry))&&((s[sp]++))
      ((s1++, s0--))
   done
   ((s[sp]&=true, s[sp-1]&=true, s[++sp]=s1, s[++sp]=s0))
}

primitive '>number'  'tonumber'                                      # ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 )

colon 'dpl'                                                          # ( -- u )
   push 'dpl'
semicolon
inline

#                     msb&    msb&
#  s3 s2 s1 -- r q  s1^s2^s3  s2^s3
# ---------------------------------
#  +  +  +     + +     0        0
#  +  +  -     + -     1        0
#  +  -  +     - -     1        1
#  +  -  -     - +     0        1
#  -  +  +     - -     1        1
#  -  +  -     - +     0        1
#  -  -  +     + +     0        0
#  -  -  -     + -     1        0
# ( s3 s2 s1  -- s3*s2%s1 s3*s2/s1 )
colon '*/mod'                                                        # ( n1 n2 n3 -- n4 n5 )
   get  's1'
   code '((s2=s[sp-1], s3=s[sp-2], sp--, signr=(s2^s3)))'
   code '((signq=(signr^s1),s1&msb&&(s1=-s1&true)))'
   code '((s2*=s3,s2&msb&&(s2=-s2&true)))'
   code '((s[sp-1]=(signr&msb?(-s2%s1)&true:s2%s1)))'
   put  '(signq&msb?-(s2/s1)&true:(s2/s1)&true)'
semicolon


# divide d1 by u1, resulting in quotient d2 and remainder u2
# ( d1 u1 -- u2 d2 )
udslashmod()  {
    local u1="${s[sp--]}" d1h="${s[sp--]}" d1l="${s[sp--]}" d2h=0 d2l=0 u2=0 i
    for ((i=bits*2; i--;)); do
        ((d2h*=2, d2l&msb))&&((d2h++))
        ((d2l=(d2l*2)&maxuint, u2*=2, d1h&msb))&&((u2++))
        ((u2>=u1))&&((d2l++, u2-=u1))
        ((d1h*=2, d1l&msb))&&((d1h++))
        ((d1h&=maxuint, d1l=(d1l*2)&maxuint))
    done
    ((s[++sp]=u2, s[++sp]=d2l, s[++sp]=d2h))
}

# ( d1 u1 -- u2 d2 )   d1/u2 -> d2 remainder u2
primitive 'ud/mod'   'udslashmod'

# ----- arithmetics, double ------------------------------ #fold01

colon 'dnegate'                                                      # ( d1 -- d2 )
   code 'local dh="${s[sp]}" dl="${s[sp-1]}"'
   code '((dl^=true, dh^=true, dl++, dl&carry))&&((dh++))'
   code '((s[sp-1]=dl&true, s[sp]=dh&true))'
semicolon

colon 'd+'                                                           # ( d1 d2 -- d3 )
   code 'local d2h="${s[sp--]}" d2l="${s[sp--]}" d1h="${s[sp]}" d1l="${s[sp-1]}"'
   code '((d1l+=d2l, d1h+=d2h, d1l&carry))&&((d1h++))'
   code '((s[sp-1]=d1l&true, s[sp]=d1h&true))'
semicolon

# ----- string stack operators---------------------------- #fold01

primitive 'empty$'   'ss=()'
primitive 'dup$'     'ss+=("${ss[-1]}")'
primitive '?dup$'    '[[ -z ${ss[-1]} ]] || ss+=("${ss[-1]}")'
primitive 'drop$'    'unset "ss[-1]"'
primitive 'over$'    'ss+=("${ss[-2]}")'
primitive 'pluck$'   'ss+=("${ss[-3]}")'
primitive 'pick$'    'ss+=("${ss[-s[sp--]-1]}")'
primitive 'count$'   '((s[++sp]=${#ss[-1]})); unset "ss[-1]"'        # ( -- u ) ( $1 -- )

colon '2dup$'
   code 'ss+=("${ss[-2]}")'
   code 'ss+=("${ss[-2]}")'
semicolon
inline

colon '2drop$'
   code 'unset "ss[-1]"'
   code 'unset "ss[-1]"'
semicolon
inline

colon '2swap$'
   code 'tmp="${ss[-4]}"; ss[-4]="${ss[-2]}"; ss[-2]="$tmp"'
   code 'tmp="${ss[-3]}"; ss[-3]="${ss[-1]}"; ss[-1]="$tmp"'
semicolon

colon 'swap$'
   code 'tmp="${ss[-2]}"; ss[-2]="${ss[-1]}"; ss[-1]="$tmp"'
semicolon
inline

colon 'nip$'
   code 'ss[-2]="${ss[-1]}"'
   code 'unset "ss[-1]"'
semicolon
inline

colon 'tuck$'
   code 'ss+=("${ss[-1]}"); ss[-2]="${ss[-3]}"; ss[-3]="${ss[-1]}"'
semicolon
inline

colon 'rot$'
   code 'tmp="${ss[-1]}"; ss[-1]="${ss[-3]}"; ss[-3]="${ss[-2]}"; ss[-2]="$tmp"'
semicolon

colon '-rot$'
   code 'tmp="${ss[-1]}"; ss[-1]="${ss[-2]}"; ss[-2]="${ss[-3]}"; ss[-3]="$tmp"'
semicolon

primitive '-leading$'   'ss[-1]="${ss[-1]##+([[:space:]])}"'         # ( $1 -- $2 )
primitive '-trailing$'  'ss[-1]="${ss[-1]%%+([[:space:]])}"'         # ( $1 -- $2 )

colon 'trim$'                                                        # ( $1 -- $2 )
   code 'ss[-1]="${ss[-1]##+([[:space:]])}"'
   code 'ss[-1]="${ss[-1]%%+([[:space:]])}"'
semicolon

# ( -- u )  string: ( $1 $2 -- $3 )     remove  $2* from $1, return removed chars count
colon 'cut$'
   push '${#ss[-2]}'
   code 'ss[-2]="${ss[-2]%${ss[-1]}*}"'
   code '((s[sp]-=${#ss[-2]}))'
   code 'unset "ss[-1]"'
semicolon

# count substring occurances
# : #substrings  swap$ 0 begin over$ cut$ while 1+ repeat 2drop$ ;
# -leading$:  ${myVar##*( )}
# -trailing$: ${myVar%%*( )}

colon '.ss'
   code '((${#ss[@]})) &&'
   code 'printf "\"%s\" " "${ss[@]}"'
semicolon

colon 'type$'
   code 'printf "%s" "${ss[-1]}"'
   code 'unset "ss[-1]"'
semicolon
inline

# ( $1 -- $2 )
primitive 'uppercase1$'   'ss[-1]="${ss[-1]^}"'                      # foobar -> Foobar
primitive 'lowercase1$'   'ss[-1]="${ss[-1],}"'                      # FooBar -> fooBar
primitive 'othercase1$'   'ss[-1]="${ss[-1]~}"'                      # fooBar -> FooBar
primitive 'uppercase$'    'ss[-1]="${ss[-1]^^}"'                     # FooBar -> FOOBAR
primitive 'lowercase$'    'ss[-1]="${ss[-1],,}"'                     # FooBar -> foobar
primitive 'othercase$'    'ss[-1]="${ss[-1]~~}"'                     # FooBar -> fOObAR

# split string into single words at white space, return count of resulting single word strings.
# ( -- u )   ss: ( $ -- $1 $2 $3 ?.. $u )
colon 'chop$'
   code 'tmp="${ss[-1]}"'
   code 'unset "ss[-1]"'
   code '((s1=${#ss[@]}))'
   code 'ss+=($tmp)'
   push '${#ss[@]}-s1'
semicolon

# ( $1 -- $2 )
primitive 'quote$' 'ss[-1]="\"${ss[-1]}\""'

# ---------- command ---------      - output -        ----- mnemonic -----
# "abcdefgh"   2  left$   type$      ab                "keep 2 left"
# "abcdefgh"  -2  left$   type$      abcdef            "keep left all but last 2"
# "abcdefgh"   2  right$  type$      gh                "keep 2 right"
# "abcdefgh"  -2  right$  type$      cdefgh            "keep right all but first 2"
# "abcdefgh"   2  split$  type$      ab cdefgh         "split at left"
# "abcdefgh"  -2  split$  type$      abcdef gh         "split at right"
# "abcdefgh"   3  2 mid$  type$      de                "abcdefgh" -> "defgh" -> "de"
# "abcdefgh"  -3  2 mid$  type$      fg                "abcdefgh" -> "fgh"   -> "fg"
# "abcdefgh"   3 -2 mid$  type$      def               "abcdefgh" -> "defgh" -> "def"
# "abcdefgh"  -3 -2 mid$  type$      f                 "abcdefgh" -> "fgh"   -> "f"


colon 'left$'
   pop  'tmp'
   code '((tmp&msb))&&((tmp|=~maxuint))'
   code 'ss[-1]=${ss[-1]:0:tmp}'
semicolon

colon 'right$'
   pop  'tmp'
   code '((tmp&msb))&&((tmp|=~maxuint))'
   code 'ss[-1]=${ss[-1]:0-tmp}'
semicolon

# ( u -- ) ( $1 -- $2 $3 )
colon 'split$'
   pop  'tmp'
   code '((tmp&msb))&&((tmp|=~maxuint))'
   code 'ss+=("${ss[-1]:tmp}")'
   code 'ss[-2]="${ss[-2]:0:tmp}"'
semicolon

colon 'join$'
   code 'ss[-2]+="${ss[-1]}"'
   code 'unset "ss[-1]"'
semicolon
inline

colon 'indent$'                                                      # ( u -- ) ( $1 -- $2 )
   code 'ss[-1]="$(printf "%${s[sp]}s")${ss[-1]}"'
   code '((sp--))'
semicolon

colon '$='
   code '[[ ${ss[-1]} != ${ss[-2]} ]]'
   push '(-$?)&true'
   code 'unset "ss[-1]"'
   code 'unset "ss[-1]"'
semicolon

colon '$<'
   code '[[ ${ss[-1]} > ${ss[-2]} ]]'
   push '($?-1)&true'
   code 'unset "ss[-1]"'
   code 'unset "ss[-1]"'
semicolon

colon '$>'
   code '[[ ${ss[-1]} < ${ss[-2]} ]]'
   push '($?-1)&true'
   code 'unset "ss[-1]"'
   code 'unset "ss[-1]"'
semicolon

# "nice"    "this is a very *** foo"   "***" replace$    ->   "this is a very nice foo"
# "nope"    "this is a very *** foo"   "?" replace$      ->   "this is a very *** foo"
# "123"     "abcd" 1 insert$  -> "a123bcd"

#primitive 'allot$' '((sdp+=s[sp--]))'
colon 'allot$'
   pop 'sdp+'
semicolon
inline

colon '$,'
   code 'strings[sdp++]="${ss[-1]}"'
   code 'unset "ss[-1]"'
semicolon
inline

# push string array item u to string stack
# ( u -- ) ( -- $1 )
primitive '$@'  'ss+=("${strings[s[sp--]]}")'

# store string stack item in string array
# ( u -- )  ( $1 -- )
colon '$!'
   code 'strings[s[sp--]]="${ss[-1]}"'
   code 'unset "ss[-1]"'
semicolon
inline

# --- mixed mode operations, exchanges between stack and string stack ---
# remove first character from top of string stack, push its ASCII value
# on stack, or 0 if no char, empty string.
# ( -- c )  ( $1 -- $2 )
asc()  {
   [[ -n "${ss[-1]}" ]] || { ((s[++sp]=0)); return; }
   ((s[++sp]=${asc[${ss[-1]:0:1}]}))
   ss[-1]="${ss[-1]:1}"
}

primitive  'asc'    'asc'
primitive  'char$'  'ss+=("${char[s[sp--]]}")'

# arg1:string
# ( a -- len )
unpack()  {                                                          # ( a -- len )
   local a="${s[sp]}" u=0 i=${#1}
   for ((; i--;)); do
      ((m[a++]=asc["\\${1:u++:1}"]))
   done
   ((s[sp]=u))
}

colon 'unpack$'
   code 'unpack "${ss[-1]}"'
   code 'unset "ss[-1]"'
semicolon
inline

# arg1: a   arg2: u
pack()  {
   local a="$1" u="$2" tmp=""
   for ((; u--; )); do tmp+="${char[m[a++]]}"; done
   ss+=("$tmp")
}

# ( a n -- ) ( string: -- $ )
colon 'pack$'
   pop  's0'
   pop  's1'
   code 'tmp=""'
   code 'for ((; s0--; )); do tmp+="${char[m[s1++]]}"; done'
   code 'ss+=("$tmp")'
semicolon

primitive 'append$' 'ss[-1]+="${char[s[sp--]]}"'                     # ( c -- ) ( string: $1 -- $2 )
primitive 'prepend$' 'ss[-1]="${char[s[sp--]]}${ss[-1]}"'            # ( c -- ) ( string: $1 -- $2 )


# ----- environment--------------------------------------- #fold01

# ( -- x ) ( $1 -- )
colon 'env'
   push '${!ss[-1]}+0&true'
   code 'unset "ss[-1]"'
semicolon
inline

# store $1 in bash environment variable with name $2
# ( x -- ) ( string:  $1 -- )
colon '>env'
   code 'eval "${ss[-1]}=$((s[sp--]))"'
   code 'unset "ss[-1]"'
semicolon
inline

# read string from environment variable with name on string stack
# ( string:  $1 -- $2 )
primitive 'env$' 'ss[-1]="${!ss[-1]}"'

# store string $1 in bash environment variable with name $2
# ( string:  $1 $2 -- )
colon '>env$'
   code 'eval "${ss[-1]}=${ss[-2]}"'
   code 'unset "ss[-1]"'
   code 'unset "ss[-1]"'
semicolon


# ( a u wid -- 0 | x )
colon 'searchwordlist'
   code 'local wordlist'
   code 'declare -n wordlist="wordlist_${s[sp--]}"'
   code 'pack "${s[sp-1]}" "${s[sp--]}"'
   code 's[sp]="${wordlist[${ss[-1]:-0}]}"'
   code 'unset "ss[-1]"'
semicolon

# ( x c-addr u wid -- )
colon 'writewordlist'
   code 'local wordlist'
   code 'declare -n wordlist="wordlist_${s[sp--]}"'
   code 'pack "${s[sp-1]}" "${s[sp]}"'
   code '((sp-=2))'
   code 'wordlist[${ss[-1]}]="${s[sp--]}"'
   code 'unset "ss[-1]"'
semicolon

# ----- memory ------------------------------------------- #fold01


colon '!'
   code '((m[s[sp--]]=s[sp-1]))'
   code '((sp--))'
semicolon
inline

colon 'c@'
   put 'm[s[sp]]'
semicolon
inline


colon 'c!'
   code '((m[s[sp--]]=s[sp-1]))'
   code '((sp--))'
semicolon
inline

# ( a -- [a+cell] [a] )
colon '2@'
   push 'm[s[sp]]'
   code 's[sp-1]=m[s[sp-1]+1]'
semicolon
inline


# ( [a+cell] [a] a -- )
colon '2!'
   pop  's0'
   pop  'm[s0]'
   pop  'm[s0+1]'
semicolon
inline

colon '+!'
   code '((m[s[sp--]]=(s[sp-1]+m[s[sp]])&true, sp--))'
semicolon
inline

primitive 'on'   '((m[s[sp--]]=true))'
primitive 'off'  '((m[s[sp--]]=false))'
primitive 'inc'  '((m[s[sp--]]=(m[s[sp]]+1)&true))'
primitive 'dec'  '((m[s[sp--]]=(m[s[sp]]-1)&true))'

# replace contents of a against x1,
# while returning former contents as x2
# ( x1 a -- x2 )
colon 'exchange'
   code '((tmp=m[s[sp]], m[s[sp]]=s[sp-1], s[--sp]=tmp))'
semicolon
inline

# replace contents of a and a+cell against x1 x2,
# while returning former contents as x3 x4
# ( x1 x2 a -- x3 x4 )
colon '2exchange'
  pop  's0'
  get  's1'
  code '((s2=s[sp-1]))'
  put  'm[s0]'
  code '((s[sp-1]=m[s0+1], m[s0]=s1, m[s0+1]=s2))'
semicolon

colon 'allot'
   pop 'dp+'
semicolon
inline

# c -> m[a++],  u times
# ( a u c -- )
colon 'fill'
   code '((s0=s[sp--], s1=s[sp--], s2=s[sp--]))'
   code 'for ((;s1--;)); do ((m[s2++]=s0)); done'                    # c -> m[a++],  u times
semicolon
inline

# ( a1 a2 u -- )
move()  {                                                            # deals with destination overlapping source
   ((s0=s[sp--],s1=s[sp--],s2=s[sp--]))
   if ((s2 < s1)); then                                              # copy highest to lowest:
      ((s1+=s0, s2+=s0))                                             # m[--a1+u} -> m[--a2+u],  u times
      for ((;s0--;)); do
         ((m[--s1]=m[--s2]))
      done
   else                                                              # copy lowest tio highest
      for ((;s0--;)); do                                             # m[a1++} -> m[a2++],  u times
         ((m[s1++]=m[s2++]))
      done
   fi
}

# ( a1 a2 u -- )
primitive 'move'   'move'


# ----- character i/o ------------------------------------ #fold01

# given an ASCII, print the character
primitive 'emit'  'printf "%c" "${char[s[sp--]&255]}"'

# duplicating 'char functionality because quoting in evaluate
# becomes sometimes hard when using ' ' for characters' ASCIIs
# ( -- c )
colon 'char'
   code 'word || missing "character"'
   code '((s[++sp]=asc["\\${word:0:1}"]))'
semicolon
inline

colon '[char]'
   execute 'char'
   code 'code "((s[++sp]=${s[sp--]}))"'
semicolon
compiled


colon 'key'
   code 'if [[ -z "$keybuf" ]]; then'                                # key? may have put chars into keybuf
   code 'IFS="" read -rsn1 tmp'                                      # keybuf empty: read from console
   code 'keybuf+="${tmp}"'                                           # consider space if -z $tmp
   code 'fi'
   code 'tmp="${keybuf:0:1}"'                                        # read key from keybuf
   code 'tmp=$(printf "%d" '"\"'""\${tmp}\")"                        # treat ctrls as spaces, convert to ASCII
   push 'tmp'                                                        # push ASCII
   code 'keybuf="${keybuf:1}"'                                       # strip key from keybuf
semicolon

colon 'key?'
   code '[[ -z "$keybuf" ]] || { s+=("$true"); return; }'            # key in keybuf: yes, flag "key ready"
   code 'IFS=""'                                                     # no key in keybuf: poll console
   code 'if read -rsn1 -t0.01 tmp; then'
   code 'keybuf+="$tmp"'                                             # add key to buffer. maybe add space if -z $tmp
   push 'true'
   code 'return'
   code 'fi'
   push 'false'
semicolon


colon 'spaces'
   pop  's0'
   code '((s0&msb))||printf "%${s0}s" ""'
semicolon
inline

# ----- file i/o ----------------------------------------- #fold01


# load file whose name is given on string stack
colon 'from$'                                                        # ( -- ) ( string: $1 -- )
   code 'file="${ss[-1]}"'
   code 'unset "ss[-1]"'
   code 'from "$file"||filenotfound "$file"'
semicolon


# NOTE: test with tabs and spaces instead of empty lines
# omit block of source lines up to next empty line
colon 'omit'                                                         # ( -- ) ( s: lines )
   code 'until (( linenr > ${#lines[@]} )); do'
   code 'line="${lines[linenr++]}"'
   code '[[ -z "$line" ]] && break'
   code 'done'
semicolon


# ----- foward referencing support words ----------------- #fold01

need()  {
   [[ -z "$1" ]]&&missingname
   exists "$1" "${order[@]}" "$compilerwid" ||
   forwardref "$1"                                                   # forwardref protects itself against already forwardref'd words
}

colon 'need'                                                         # ( -- )  ( stream: bl delimited string )
   code 'word || missingname'
   code 'need "$word" ""'                                            # empty arg indicates explicit need, no referer
semicolon

colon 'needed$'                                                      # ( -- f ) ( $1 -- )
   code '[[ -z "${unresolved[${ss[-1],,}]}" ]]'                      # check unresolved status of word
   push '$??true:false'                                              # return result
   code 'unset "ss[-1]"'
semicolon


colon 'neededanyof'                                                  # ( -- f ) ( stream: bl delimited strings, whole input line )
   push "false"
   code 'while [[ -n "$line" ]]; do'
   code 'word'
   code '[[ -z "${unresolved[${word,,}]}" ]] || {'                   # check unresolved status of word
   put  'true'                                                       # unresolved -> needed
   code 'line=""'                                                    # "wired or" - one needed is enough, skip rest
   code '}'
   code 'done'
semicolon



generate_dependencies()  {                                           # library inclusion dependency file builder
   local provided
   { echo "$v version"
     grep -r "^provides: " "${libdirs[0]}"
   } | while read -r file words; do
      read -ra provided <<< "$words"
      file="${file%:provides:}"
      file="${file#"${libdirs[0]}"/}"
      printf "%-31s $file\n" "${provided[@]}"
   done > "$dependencies"
}

cache_dependencies()  {
   lib=()
   while read -r word file _; do
   lib["${word,,}"]="$file"
   done < "$dependencies"
}

# try to resolve all words given on input line.
# args:  names of words
satisfy()  {
   local line
# SC2068 (error): Double quote array expansions to avoid re-splitting elements:
# I don't want to avoid re-splitting, I want re-splitting to happen.
#shellcheck disable=2068
   for word in $@; do
      satisfy1 "$word" || notfound "$word"
   done
}

primitive 'dependencies' 'generate_dependencies; cache_dependencies' # ( -- )
primitive "provides:"   'line=""'                                    # ( -- ) ( s: line )

colon 'satisfy'                                                      # ( -- ) ( s: line )
   code  'satisfy "$line"'
   code  'line=""'
semicolon


#
# satisfy references from top string stack item
colon 'satisfy$'                                                     # ( -- ) ( $1 -- )
   code 'satisfy "${ss[-1]}"'
   code 'unset "ss[-1]"'
semicolon



# ----- vocabularies and wordlists -----------------------

primitive 'transient'   'transients+=("$currentwid $lastword")'      # ( -- )

colon 'newwordlist$'                                                 # ( -- wid )  ( $1 -- )
   code 'declare -gA "flags_$sdp=()"'
   code 'declare -gA "wordlist_$sdp=()"'
   code 'wordlists+=("$sdp")'
   push 'sdp'
   code 'strings[sdp++]=${ss[-1]}'
   dropstring,
semicolon

colon '.wordlists'                                                   # ( -- )
   code 'local wid'
   code 'for wid in "${wordlists[@]}"; do'
   code    'printf "%5d %s\n" "$wid" "${strings[wid]}"'
   code 'done'
semicolon


# ----- documentation ------------------------------------ #fold01

# NOTE: whole undoc section is library candidate
# arg1: word name
# arg2: headerlist
undoc_template()  {
cat << EOF
created:             auto     (remove line after having checked and revised description)
name:                $1
stack:               ( -- )
return stack:        ( -- )
string stack:        ( -- )
contexts:            ${2#"headers"}
category:
input stream:

description:         none

example:             none
notes:               none
standard:            no
deviation:           standard has no equivalent
url:                 https://forth-standard.org/standard/core/${1^^}
EOF
}

# changes problematic chars in arg1.
# sanitised string is returned in variable file
declare -A sanitised=(
   ['/']="slash"
   ["\\"]="backslash"
   [';']="semi"
   ['$']="dollar"
   ['>']="gt"
   ['<']="ls"
   ['!']="excl"
   ['#']="hash"
   ["'"]="tick"
   ['?']="qmrk"
   ['*']="star")
sanitise()  {
   sanitise="${1,,}"
   for tmp in "${!sanitised[@]}"; do
      sanitise="${sanitise//"$tmp"/"[${sanitised[$tmp]}]"}"
   done
}


undoc()  {
   local wid wordlist context
   for wid in "$forthwid" "$onlywid" "$compilerwid"; do
      wordlist="${strings[wid]}"
      declare -n context="$wordlist"
      for word in "${!context[@]}"; do                               # run through all headers
         sanitise "$word"
         file="$worddoc:$sanitise"
         [[ -f "$file" ]] || {                                       # found one for which no doc file exists
            (( wid == forthwid )) && wordlist="stateless"
            undoc_template "$word" "$wordlist" >> "$file"
            editor "$file"
            return
         }
      done
   done
}
primitive 'undoc' 'undoc'                                            # ( -- )

colon 'doc'                                                          # ( -- ) ( s: word )
   code 'word || missingname'
   code 'sanitise "$word"'
   code 'editor "$worddoc:$sanitise"'
semicolon

colon 'about'                                                        # ( -- ) ( s: word )
   code 'word || missingname'
   code 'sanitise "$word"'
   code 'cat "$worddoc:$sanitise"'
semicolon

colon 'concerning'                                                   # ( -- ) ( s: word )
   code 'word || missingname'
   code 'concerning=($(grep -il "$word" "${worddoc%/*}"/*))'
   code 'grep -h "^name: " "${concerning[@]}"'
   code 'unset -v "concerning"'
semicolon

colon 'standard'                                                     # ( -- ) ( s: word )
   code 'word || missingname'
   code 'sanitise "$word"'
   code 'read -r _ url _  < <(grep "^url:" "$worddoc:$sanitise")'
   code '[[ -z "$url" ]] || webview "$url"'
semicolon


# ----- shell --------------------------------------------- #fold01
# TODO: optimiser: invalidate all stack register contents
# execute shell command "$2" with args "$1"
colon 'shell$'                                                       # ( -- ) ( $1 -- )
   code '${ss[-1]}'
   dropstring,
semicolon

colon 'command$'                                                     # ( -- ) ( $1 $2 -- )
   code '${ss[-2]} "${ss[-1]}"'
   dropstring,
   dropstring,
semicolon


# ----- files -------------------------------------------- #fold01



# push name of file u (from output of files) to string stack
colon 'filename$'                                                    # ( u -- ) ( string: -- $1 )
   code 'ss+=("${files[s[sp--]]}")'
semicolon
inline

# return handle of source. 0=console, >0 correspond files handle
# allows words to determine whether they're executed while loaded
# from file or console, as well as the path/name of the file they're
# loaded from.
colon 'origin'                                                       # ( -- u )
   push '${filehandle:-"0"}'
semicolon
inline


# copy remainder of input line to string stack without affecting it.
primitive 'source$'  'ss+=("$line")'                                 # ( -- )  ( -- $1 )

# stop loading file
colon 'done'                                                         # ( -- )
   code 'line=""'                                                    # nothing more to process on current line
   code 'linenr="-1"'                                                # signal "all done" to from
semicolon
inline

# check whether current source had already been
# compiled from before. most useful when used
# interpretatively in a file, for testing whether
# it will be or has been reloaded, such as with
# "loaded lest done" returned u is the count
# the file has been loaded.
primitive 'loaded'         '((s[++sp]=loaded[filehandle]))'          # ( -- u )
# true: loading from file?,  false: interactive
# (console). pipe or redirection is indicated as
# loading from file.
primitive 'loading'        '((s[++sp]=linenr<0?false:true))'         # ( -- flag )
primitive '#files'         '((s[++sp]=${#files[@]}))'                # ( -- u )

# ----- populate only wordlist --------------------------- #FOLD01

set-current "$onlywid"

colon 'order'                                                        # ( -- )
   code 'printf "context:"'
   code 'for wid in "${order[@]}"; do'
   code 'printf " %s" "${strings[wid]}"'
   code 'done'
   code 'printf "\ncurrent: %s\n" "${strings[currentwid]}"'
semicolon

primitive 'previous'   '((${#order[@]}>1))&&order=("${order[@]:1}")' # ( -- )
primitive 'also'       'order=("${order[0]}" "${order[@]}")'         # ( -- )
primitive 'words'      'words'                                       # ( -- )
primitive 'forth'      '((order[0]=forthwid))'                       # ( -- )
primitive 'definitions' 'set-current "${order[0]}"'                  # ( -- )
colon 'only'                                                         # ( -- )
   code 'order=("$onlywid" "$onlywid")'
semicolon
inline

set-current "$forthwid"

# ----- misc --------------------------------------------- #fold01

# header will be trashed after it served its purpose, which
# is for single length pictured number conversion only, used
# like  <x x x x x>
# ( x1 -- x2 ) ( string: $1 -- $2 )
colon 'x'                                                            # : #
   code '((radix=m[base]))'                                          # base @
   code '((s0=s[sp]&true, s[sp]=s0/radix, tmp=s0%radix+48))'         # /mod swap '0 +
   code '((tmp>57))&&((tmp+=39))'                                    # dup '9 > 39 and +
   code 'ss[-1]="${char[tmp]}${ss[-1]}"'                             # hold
semicolon                                                            # ;
inline

primitive 'random'      '((s[++sp]=SRANDOM&true))'                   # ( -- u )
primitive 'realtime'    '((s[++sp]=${EPOCHREALTIME//[,.]/}&true))'   # ( -- u )     \ a 51 bit microseconds epoch
primitive 'secs'     'sleep "${s[sp--]}"'                            # ( u -- )

colon 'version'                                                      # ( -- u1 u2 u3 )
   push '${version[0]}'
   push '${version[1]}'
   push '${version[2]}'
semicolon

#functional alternative. keeping as example
#for words which push more than 3 items
#colon 'version'                                                      # ( -- u1 u2 u3 )
#   code 's=( ${s[@]:0:sp+1} ${version[@]})'
#   code '((sp+=3))'
#semicolon




# ----- former yoda.core primitives ---------------------- #fold01
# moved back for faster loading

primitive "\\"             'line=""'                   ; immediate   # ( -- ) ( s: line )
primitive '('              'parse ")"'                 ; immediate   # ( -- ) ( s: delim )

# ----- dictionary and compiling -------------------------

primitive 'set-current'    'set-current ${s[sp--]}'                  # ( wid -- )
primitive 'get-context'    '((s[++sp]=order[0]))'                    # ( -- wid )
primitive 'set-context'    '((order[0]=s[sp--]))'                    # ( wid -- )
primitive 'get-current'    '((s[++sp]=currentwid))'                  # ( -- wid )
primitive '#unresolved'    '((s[++sp]=${#unresolved[@]}))'           # ( -- u )
primitive 'compiling'      '((s[++sp]=compiling))'                   # ( -- flag )
primitive 'words+'         'wordsplus'                               # ( -- )
primitive 'inline'         'inline'                                  # ( -- )
primitive 'immediate'      'immediate'                               # ( -- )
primitive 'compiled'       'compiled'                                # ( -- )
primitive 'protect'        'protect'                                 # ( -- )
primitive 'compile,'       'call ${s[sp--]}'                         # ( -- ) ( compile time: x -- ) ( run time: -- x )
primitive '>body'          '((s[sp]=body[s[sp]]))'                   # ( xt -- pfa )
primitive 'compiler'       '((order[0]=compilerwid))'                # ( -- )
primitive 'me'             'push "$xt"'; compiled                    # ( compile: -- )   ( run: -- x )

# ----- numbers ------------------------------------------

primitive 'decimal'        'm[base]=10'                              # ( -- )
primitive 'hex'            'm[base]=16'                              # ( -- )
primitive 'binary'         'm[base]=2'                               # ( -- )

# ----- stacks -------------------------------------------

primitive 'depth'         '((s[++sp]=sp))'                           # ( ?? -- ?? u )
primitive 'dup'           '((s[++sp]=s[sp]))'                        # ( x -- x x )
primitive 'over'          '((s[++sp]=s[sp-1]))'                      # ( x1 x2 -- x1 x2 x1 )
primitive 'pluck'         '((s[++sp]=s[sp-2]))'                      # ( x1 x2 x3 -- x1 x2 x3 x1 )
primitive 'pick'          '((s[++sp]=s[sp-s[sp--]-1]))'              # ( ... x2 x1 x0 u -- ... x2 x1 x0 xu )
primitive '?dup'          '((s[sp]))&&((s[++sp]=s[sp]))'             # ( x -- 0 | x x )
primitive '2dup'          '((s[++sp]=s[sp-1], s[++sp]=s[sp-1]))'     # ( x1 x2 -- x1 x2 x1 x2 )
primitive 'r@'            '((s[++sp]=r[rp]))'                        # ( -- x )  ( r: x -- x )
primitive 'r>'            '((s[++sp]=r[rp--]))'                      # ( -- x ) ( r: x -- )
primitive 'rdepth'        '((s[++sp]=rp))'                           # ( -- u )
primitive 'depth$'        '((s[++sp]=${#ss[@]}))'                    # ( -- u )

colon '2over'                                                        # ( x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2 )
   push 's[sp-3]'
   push 's[sp-3]'
semicolon
inline

colon '>r'                                                           # ( x -- ) ( r: -- x )
   pop   'r[++rp]'
semicolon
inline

colon '2r>'                                                          # ( -- x1 x2 )  ( r: x1 x2 -- )
   push  'r[rp-1]'
   push  'r[rp--]'
   code  '((rp--))'
semicolon
inline

colon '2>r'                                                          # ( x1 x2 -- )  ( r: -- x1 x2 )
   code '((++rp))'
   pop 'r[++rp]'
   pop 'r[rp-1]'
semicolon
inline

primitive 'ndrop'          '((sp-=s[sp]+1))'                         # ( [x items] u -- [x-u items] )
primitive 'drop'           '((sp--))'                                # ( x -- )
primitive 'rdrop'          '((rp--))'                                # ( -- ) ( r: x -- )
primitive '2drop'          '((sp-=2))'                               # ( x1 x2 -- )
primitive '2nip'           '((s[sp-1]=s[sp--],s[sp-1]=s[sp--]))'     # ( x1 x2 x3 x4 -- x3 x4 )
primitive 'empty'          's=(0) sp=0'                              # ( ??? -- )
primitive 'rempty'         'r=() rp=0'                               # ( -- ) ( r: ??? -- )

# ----- flow ---------------------------------------------
# compiles exit into word under
# construction due to inline, which is
# therefore essential. primitives have
# inline flag set by default.

primitive 'i'              '((s[++sp]=i))'                           # ( -- x )
primitive 'j'              '((s[++sp]=r[rp]))'                       # ( -- x )
primitive 'unloop'         '((i=r[rp--], ibar=r[rp--]))'             # ( -- x )
primitive 'exit'           'return'                                  # ( -- )
primitive 'leave'          'code "break"'                ; compiled  # ( -- )
primitive 'warm'           'warm'                                    # ( ??? - ) ( r: ??? -- )
primitive 'bye'            'exit 0'                                  # ( -- )
primitive '?leave'         'code "((s[sp--]))&&break"'  ; compiled   # ( flag -- )

# ----- arithmetics --------------------------------------

primitive '1+'             '((s[sp]=(s[sp]+1)&true))'                # ( x1 -- x2 )
primitive '1-'             '((s[sp]=(s[sp]-1)&true))'                # ( x1 -- x2 )
primitive '2*'             '((s[sp]=(s[sp]<<1)&true))'               # ( x1 -- x2 )
primitive '2/'             '((s[sp]=(s[sp]>>1)|(s[sp]&msb)))'        # ( x1 -- x2 )
primitive 'invert'         '((s[sp]^=maxuint))'                      # ( x1 -- x2 )
primitive 'negate'         '((s[sp]=(-s[sp]&true)))'                 # ( n1 -- n2 )
primitive '?negate'        '((s[sp--]))&&((s[sp]=(-s[sp]&true)))'    # ( n flag -- n | -n )
primitive 'abs'            '((s[sp]&msb))&&((s[sp]=(-s[sp]&true)))'  # ( n -- u )

# ----- memory -------------------------------------------

primitive '@'              '((s[sp]=m[s[sp]]))'                      # ( a -- x )
primitive 'c,'             '((m[dp++]=s[sp--]))'                     # ( c -- )
primitive 'count'          '((s[++sp]=m[s[sp]++]))'                  # ( a -- a+1 c )
primitive 'skim'           '((s[++sp]=m[s[sp]++]))'                  # ( a -- a+cell x )
primitive '<-'             '((m[s[sp--]]=s[sp--]))'                  # ( a x -- )
primitive 'here$'          '((s[++sp]=sdp))'                         # ( -- u )
primitive 'here'           '((s[++sp]=dp))'                          # ( -- a )
primitive ','              '((m[dp++]=s[sp--]))'                     # ( x -- )

# ----- I/O ----------------------------------------------
primitive '-whitespace'    'minwhitespace'                           # ( -- )
primitive  'cr'            'printf "\n"'                             # ( -- )
primitive  'space'         'printf " "'                              # ( -- )
primitive  'page'          'clear'                                   # ( -- )
primitive  'simpleprompt'  '((compiling)) || printf " %s\n" "ok"'    # ( -- )
defer      'prompt'        'simpleprompt'                            # ( -- )


# ----- launch ------------------------------------------- #fold00
config()  {
# shellcheck disable=SC1090
   [[ -f "$HOME/$config" ]]  && { source "$HOME/$config"; return; }  # config in $HOME has priority over config in yoda dir
# shellcheck source=./yoda.conf                                      # try to load custom configuration
   [[ -f "$mydir/$config" ]] && source "$mydir/$config"
}
# -------------------------------------------------------
config
[[ -f "$dependencies" ]] || generate_dependencies                    # no dependencies -> generate
read -r _ tmp < <(grep '^version ' "$dependencies")                  # check version
[[ "$tmp" == "$v" ]] || generate_dependencies                        # new yoda -> generate
cache_dependencies                                                   # read dependencies into memory
# -------------------------------------------------------
#corefiles="$filehandle"                                              # reading source location is different for later files
file="$mydir/yoda.core"
from "$file" || filenotfound "$file"
# -------------------------------------------------------
args=("$@")                                                          # read command line
(( ${#args[@]} )) || read -rst 0.01 "args"                           # no command line specified: check whether commands are piped
[[ -z ${args[0]} ]] && args[0]="$default"                            # neither pipe nor command line: load default launch commands
evaluate "${args[*]}"                                                # evaluate piped command, command line or default initial commands
# -------------------------------------------------------
if [[ -n "$coldvector" ]]; then                                      # if cold launch point was specified, try to run.
   resolve                                                           # still unresolved words? try to resolve those.
   if (( ${#unresolved[@]} )); then                                  # still unresolved words
      printf "%s\n" "unresolved forward references:"
      printf "%s\n" "${!unresolved[@]}"
      printf "%s\n" "Run this not I will."
   else
      cold
   fi
fi