X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=scheme-primitives.4th;h=a9ea386f919397377da00babfcd045367638a00d;hb=871b6800c52715e27f968bf1203e7f3144893a9c;hp=8e83f971bcc98bf8c36ac1cedeb3290d1cb984db;hpb=f4e635c7b49321b5ba6f6a4609985aea4768d209;p=scheme.forth.jl.git diff --git a/scheme-primitives.4th b/scheme-primitives.4th index 8e83f97..a9ea386 100644 --- a/scheme-primitives.4th +++ b/scheme-primitives.4th @@ -65,14 +65,24 @@ ; make-primitive integer->char : build-fixnum-charlist ( num ) - dup 0= if - nil - else - dup 10 / recurse - rot 10 mod [char] 0 + character-type 2swap - cons + ?dup 0= if + [char] 0 character-type nil cons + exit then + + nil rot + + begin + ?dup 0> + while + dup 10 mod swap 10 / swap + 2swap rot + [char] 0 + character-type 2swap + cons + rot + repeat ; + :noname ( args -- string ) 2dup 1 ensure-arg-count car fixnum-type ensure-arg-type @@ -81,7 +91,6 @@ dup 0< swap abs ( bool num ) build-fixnum-charlist - rot drop rot if [char] - character-type 2swap cons then @@ -89,7 +98,7 @@ drop string-type ; make-primitive number->string -( = Arithmeic = ) +( = Arithmetic = ) : add-prim ( args -- fixnum ) 2dup nil objeq? if