# POLYWORDS

# the previous abort-driven retry mechansm is replaced by an exception
# based mechanism to make polywords re-entrant.

# TODO: it might be interesting to add 'snapping' to polywords:
# i.e. a wrapper that executes a polyword, records the last
# success and tries that on the next run. if it fails after that,
# the process can repeat itself. (looking at traces, a lot of
# time is spent in the poly code).




# NEW

# ( poly.ip -- )
: poly-enter
	dup if
	    >r r @ try execute
	    recover swap drop			# ( error )
		    r> follow swap		# ( next.ip error )
		    e_type route poly-enter	# next one
		    throw			# rethrow error
	    endtry rdrop  leave
	then e_type throw ;

: link-polyword
        link-buffer (),
does>   head poly-enter ;

# ( xt poly.xt -- )
: poly-add      xt>body push ;
: poly-add-back xt>body queue ;


: create-polyword read link-polyword record-location ;




: read-polyword
	read try find
	recover drop link-polyword latestxt
	endtry ;



# old interface
: polyword-front read-polyword poly-add ;
	
# add to back of list
: polyword-back read-polyword poly-add-back ;

: polyword polyword-back ;


create-polyword + "( a b -- a+b )\tAdd two items on the stack." doc 
create-polyword - "( a b -- a-b )\tSubtract two items on the stack. (polyword)" doc
create-polyword * "( a b -- a*b )\tMultiply two items on the stack. (polyword)" doc
create-polyword / "( a b -- a/b )\tDivide two items on the stack. (polyword)" doc
create-polyword mod "( a b -- a%b )\tCompute integer division modulo. (polyword)" doc
create-polyword mirror "( a b -- c )\tCompute mirror folding between 0 and b. (polyword)" doc
create-polyword and "( a b -- a&&b )\tCompute logical and. (polyword)" doc
create-polyword or "( a b --  a||b )\tCompute logical or. (polyword)" doc
create-polyword not "( a --  ~a )\tCompute logical not. (polyword)" doc

create-polyword xor "( a b -- a^b )\tCompute logical exclusive or. (polyword)" doc
create-polyword min "( a b -- min )\tReturn minimum value. (polyword)" doc
create-polyword max "( a b -- max )\tReturn maximum value. (polyword)" doc
create-polyword clip "( a -- a' )\tTruncate all values to [-1..1] (polyword)" doc
create-polyword abs "( a -- abs(a) )\tReturn absolute value. (polyword)" doc
create-polyword sqrt "( a -- sqrt(a) )\tReturn square root. (polyword)" doc
create-polyword >   "( a b -- flag )\tReturn true if a>b. (polyword)" doc
create-polyword <   "( a b -- flag )\tReturn true if a<b. (polyword)" doc
create-polyword <=   "( a b -- flag )\tReturn true if a<=b. (polyword)" doc
create-polyword >=   "( a b -- flag )\tReturn true if a>=b. (polyword)" doc
create-polyword >>   "( a b -- a>>b )\tShift arithmic right. (polyword)" doc
create-polyword <<   "( a b -- a<<b )\tShift arithmic left. (polyword)" doc
create-polyword >int   "( a -- int )\tConvert atom to integer. (polyword)" doc
create-polyword >float   "( a -- float )\tConvert atom to floating point number. (polyword)" doc
create-polyword >symbol  "( a -- symbol )\tConvert atom to symbol. (polyword)" doc
create-polyword >string  "( a -- string )\tConvert atom to string. (polyword)" doc
create-polyword >list  "( a -- list )\tConvert atom to list. (polyword)" doc
create-polyword fixedpoint  "( number -- float.fraction int.power.of.2 )\tConvert a number to fixed point representation. Mantissa has absolute value < 1. (polyword)" doc
create-polyword transpose "( a -- aT )\tTranspose a 2D entity. (swap indices)" doc
create-polyword unpack "( container -- atoms.. )\tUnpack the elements of a container to the data stack." doc
create-polyword size "( container -- container size )\tReturns the an integer representing the number of elements in container." doc
create-polyword index@ "( index container -- thing )\tFetch a thing from an indexable container. Index can be an abstract object." doc
create-polyword index! "( thing index container -- )\tStore a thing into an indexable container. Index can be an abstract object." doc

create-polyword convert "( packet type -- packet )\tConvert a packet." doc
create-polyword >texture " ( thing -- texture )\tConvert something to a texture." doc

create-polyword concat "( a b -- ab )\tConcatenate 2 objects." doc

create-polyword inverse "( a -- a^-1 }\tCompute the multiplicative inverse." doc

create-polyword % "??" doc
create-polyword exp2
create-polyword log2
create-polyword exp
create-polyword log
create-polyword sin
create-polyword cos
create-polyword asin
create-polyword acos
create-polyword tan
create-polyword atan
create-polyword reverse
create-polyword shuffle
create-polyword pack
create-polyword perm
create-polyword =
create-polyword *+
create-polyword -abs



# type convertors
<'> scalar>int     polyword >int
<'> scalar>float   polyword >float
# <'> scalar>pointer polyword >pointer
<'> scalar>string  polyword >string
<'> scalar>symbol  polyword >symbol

# integer polywords
<'> int:> polyword >
<'> int:< polyword <
<'> int:>= polyword >=
<'> int:<= polyword <=


<'> int:+ polyword +
<'> int:- polyword -
<'> int:/ polyword /
<'> int:* polyword *
<'> int:% polyword %

<'> int:mod polyword mod
<'> int:>> polyword >>
<'> int:<< polyword <<

<'> float:mirror polyword mirror

<'> int:and polyword and
<'> int:or  polyword or
<'> int:xor polyword xor
<'> int:not polyword not
<'> int:log2 polyword log2
<'> int:exp2 polyword exp2



<'> int:abs polyword abs
<'> int:max polyword max
<'> int:min polyword min

# float polywords
<'> float:+ polyword +
<'> float:- polyword -
<'> float:/ polyword /
<'> float:* polyword *
<'> float:% polyword %
<'> float:mod polyword mod
<'> float:min polyword min
<'> float:max polyword max

<'> float:inverse polyword inverse


<'> float:> polyword >
<'> float:< polyword <
<'> float:>= polyword >=
<'> float:<= polyword <=


<'> float:sin  polyword sin
<'> float:asin polyword asin
<'> float:cos  polyword cos
<'> float:acos polyword acos
<'> float:exp  polyword exp
<'> float:log  polyword log
<'> float:tan  polyword tan
<'> float:atan polyword atan

<'> float:fixedpoint polyword fixedpoint

<'> float:abs polyword abs
<'> float:sqrt polyword sqrt


# list polywords
<'> list:reverse   polyword reverse
<'> list:shuffle   polyword shuffle
<'> list:pack      polyword pack
<'> list:unpack    polyword unpack
<'> list:perm      polyword perm
<'> list:transpose polyword transpose
<'> list:size      polyword size
<'> list:concat    polyword concat


# string polywords
<'> string:size   polyword size
<'> string:=      polyword =
<'> string:%      polyword %
<'> string:concat polyword concat


# other scalar words
: scalar:*+ * + ;
<'> scalar:=      polyword =
<'> scalar:*+	polyword *+

<'> symbol:size   polyword size

# TODO: fix these stubs
: default:-abs  - abs ;

<'> default:-abs  polyword -abs