X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=scheme.4th;h=8da2772ef290dd9107860d037cd2134990143cb6;hb=c2f2262e11ea022568bc7cbb43f666baf89236e7;hp=5c8f57dc4bdf91f878b132834784980b6b75cc64;hpb=e89a16664498692522a02e93de4493d93288748e;p=scheme.forth.jl.git diff --git a/scheme.4th b/scheme.4th index 5c8f57d..8da2772 100644 --- a/scheme.4th +++ b/scheme.4th @@ -277,17 +277,16 @@ global-env setobj global-env fetchobj define-var ; -: add-prim ( args -- ) - nil objeq? if +:noname ( args -- ) + 2dup nil objeq? if + 2drop 0 number-type else 2dup cdr recurse drop -rot car drop + number-type then -; - -' add-prim make-primitive + +; make-primitive + \ }}} @@ -374,9 +373,19 @@ parse-idx-stack parse-idx-sp ! nextchar [char] - = ; : number? ( -- bool ) - digit? minus? or false = if - false - exit + minus? if + inc-parse-idx + + delim? if + dec-parse-idx + false exit + else + dec-parse-idx + then + else + digit? false = if + false exit + then then push-parse-idx @@ -821,7 +830,7 @@ defer eval : true? ( boolobj -- bool ) false? invert ; -: applicaion? ( obj -- obj bool) +: application? ( obj -- obj bool) pair-type istype? ; : operator ( obj -- operator ) @@ -831,7 +840,7 @@ defer eval cdr ; : nooperands? ( operands -- bool ) - cdr nil objeq? ; + nil objeq? ; : first-operand ( operands -- operand ) car ; @@ -840,7 +849,15 @@ defer eval cdr ; : list-of-vals ( args env -- vals ) + 2swap + 2dup nooperands? if + 2swap 2drop + else + 2over 2over first-operand 2swap eval + -2rot rest-operands 2swap recurse + cons + then ; :noname ( obj env -- result )