-\ ==== Type predicates ==== {{{
+\ ==== Type predilcates ==== {{{
:noname ( args -- boolobj )
nil objeq? boolean-type
fixnum-type istype? -rot 2drop boolean-type
; 1 make-fa-primitive fixnum?
+:noname ( args -- boolobj )
+ flonum-type istype? -rot 2drop boolean-type
+; 1 make-fa-primitive flonum?
+
:noname ( args -- boolobj )
character-type istype? -rot 2drop boolean-type
; 1 make-fa-primitive char?
drop swap drop >= boolean-type
; 2 make-fa-primitive fix:>=
-:noname ( fixnum fixnum -- boolobj )
+:noname ( fixnum -- boolobj )
drop 0= boolean-type
; 1 make-fa-primitive fix:zero?
-:noname ( fixnum fixnum -- boolobj )
+:noname ( fixnum -- boolobj )
drop 0> boolean-type
; 1 make-fa-primitive fix:positive?
-:noname ( fixnum fixnum -- boolobj )
+:noname ( fixnum -- boolobj )
drop 0< boolean-type
; 1 make-fa-primitive fix:negative?
;
+\ --- Flonums ---
+
+:noname ( flonum flonum -- bool )
+ objeq? boolean-type
+; 2 make-fa-primitive flo:=
+
+:noname ( flonum flonum -- bool )
+ drop swap drop f< boolean-type
+; 2 make-fa-primitive flo:<
+
+:noname ( flonum flonum -- bool )
+ drop swap drop f> boolean-type
+; 2 make-fa-primitive flo:>
+
+
+:noname ( flonum -- bool )
+ drop 0.0 = boolean-type
+; 1 make-fa-primitive flo:zero?
+
+:noname ( flonum -- bool )
+ drop 0.0 f> boolean-type
+; 1 make-fa-primitive flo:positive?
+
+:noname ( flonum -- bool )
+ drop 0.0 f< boolean-type
+; 1 make-fa-primitive flo:negative?
+
+
+:noname ( flonum1 flonum2 -- flonum1+flonum2 )
+ drop swap drop f+ flonum-type
+; 2 make-fa-primitive flo:+
+
+:noname ( flonum1 flonum2 -- flonum1-flonum2 )
+ drop swap drop f- flonum-type
+; 2 make-fa-primitive flo:-
+
+:noname ( flonum1 flonum2 -- flonum1*flonum2 )
+ drop swap drop f* flonum-type
+; 2 make-fa-primitive flo:*
+
+:noname ( flonum1 flonum2 -- flonum1/flonum2 )
+ drop swap drop f/ flonum-type
+; 2 make-fa-primitive flo:/
+
+:noname ( flonum1 flonum2 -- flonum1/flonum2 )
+ drop swap drop f/ flonum-type
+; 2 make-fa-primitive flo:/
+
+
+:noname ( flonum -- bool )
+ drop dup
+ fnan? swap finf? or invert
+; 1 make-fa-primitive flo:finite?
+
+
+:noname ( flonum -- flonum )
+ swap fabs swap
+; 1 make-fa-primitive flo:abs
+
+:noname ( flonum -- flonum )
+ swap fexp swap
+; 1 make-fa-primitive flo:exp
+
+:noname ( flonum -- flonum )
+ swap flog swap
+; 1 make-fa-primitive flo:log
+
+:noname ( flonum -- flonum )
+ swap fsin swap
+; 1 make-fa-primitive flo:sin
+
+:noname ( flonum -- flonum )
+ swap fcos swap
+; 1 make-fa-primitive flo:cos
+
+:noname ( flonum -- flonum )
+ swap ftan swap
+; 1 make-fa-primitive flo:tan
+
+:noname ( flonum -- flonum )
+ swap fasin swap
+; 1 make-fa-primitive flo:asin
+
+:noname ( flonum -- flonum )
+ swap facos swap
+; 1 make-fa-primitive flo:acos
+
+:noname ( flonum -- flonum )
+ swap fatan swap
+; 1 make-fa-primitive flo:atan
+
+:noname ( flonum -- flonum )
+ swap fsqrt swap
+; 1 make-fa-primitive flo:sqrt
+
+:noname ( flonum flonum -- flonum )
+ drop swap drop f^ flonum-type
+; 2 make-fa-primitive flo:expt
+
+:noname ( flonum -- flonum )
+ swap floor swap
+; 1 make-fa-primitive flo:floor
+
+:noname ( flonum -- flonum )
+ swap ceiling swap
+; 1 make-fa-primitive flo:ceiling
+
+:noname ( flonum -- flonum )
+ swap truncate swap
+; 1 make-fa-primitive flo:truncate
+
+:noname ( flonum -- flonum )
+ swap fround swap
+; 1 make-fa-primitive flo:round
+
+:noname ( flonum -- flonum )
+ drop floor f->i fixnum-type
+; 1 make-fa-primitive flo:floor->exact
+
+:noname ( flonum -- flonum )
+ drop ceiling f->i fixnum-type
+; 1 make-fa-primitive flo:ceiling->exact
+
+:noname ( flonum -- flonum )
+ drop truncate f->i fixnum-type
+; 1 make-fa-primitive flo:truncate->exact
+
+:noname ( flonum -- flonum )
+ drop f->i fixnum-type
+; 1 make-fa-primitive flo:round->exact
+
+:noname ( flonum flonum -- flonum )
+ drop swap drop f/ fatan flonum-type
+; 2 make-fa-primitive flo:atan2
+
\ }}}
\ ==== Pairs and Lists ==== {{{