X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Fscheme-primitives.4th;h=c3eeb5d472e523b6c6aaaf18c52e94e3030376ad;hb=ed0aaed61b10e03e5f064404f506eaa73e50c87d;hp=183efec11895d274e57b5d6ce5cfc39fbc1f7634;hpb=6cb6a8d3e4449a1cf70ac4cbb0b88cf2c38d6434;p=scheme.forth.jl.git diff --git a/src/scheme-primitives.4th b/src/scheme-primitives.4th index 183efec..c3eeb5d 100644 --- a/src/scheme-primitives.4th +++ b/src/scheme-primitives.4th @@ -280,6 +280,13 @@ 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 flonum -- bool ) + drop swap drop f>= boolean-type +; 2 make-fa-primitive flo:>= :noname ( flonum -- bool ) drop 0.0 = boolean-type @@ -592,13 +599,25 @@ defer display \ ==== Evaluation ==== {{{ -\ :noname ( args -- result ) -\ 2dup car 2swap cdr -\ -\ nil? false = if car then ( proc argvals ) -\ -\ apply -\ ; make-primitive apply +:noname ( args -- result ) + 2dup car 2swap cdr + + nil? false = if car then ( proc argvals ) + + 2swap apply +; make-primitive apply + +:noname ( proc -- result ) + make-continuation + + drop if + nil cons + 2swap apply + else + 2swap 2drop + then + +; 1 make-fa-primitive call-with-current-continuation \ }}}