From: Tim Vaughan Date: Wed, 20 Jul 2016 18:56:12 +0000 (+1200) Subject: Debugging number->string X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=f4e635c7b49321b5ba6f6a4609985aea4768d209;p=scheme.forth.jl.git Debugging number->string --- diff --git a/scheme-primitives.4th b/scheme-primitives.4th index 4cba91e..8e83f97 100644 --- a/scheme-primitives.4th +++ b/scheme-primitives.4th @@ -57,13 +57,38 @@ drop fixnum-type ; make-primitive char->integer -:noname ( args -- fixnum ) +:noname ( args -- char ) 2dup 1 ensure-arg-count car fixnum-type ensure-arg-type drop character-type ; 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 + then +; +:noname ( args -- string ) + 2dup 1 ensure-arg-count + car fixnum-type ensure-arg-type + + drop + + dup 0< swap abs ( bool num ) + build-fixnum-charlist + rot drop + rot if + [char] - character-type 2swap cons + then + + drop string-type +; make-primitive number->string + ( = Arithmeic = ) : add-prim ( args -- fixnum ) diff --git a/scheme.4th b/scheme.4th index 644ee19..ecbb91b 100644 --- a/scheme.4th +++ b/scheme.4th @@ -301,7 +301,7 @@ global-env setobj abort ; -: ensure-arg-type ( arg type -- ) +: ensure-arg-type ( arg type -- arg ) istype? false = if arg-type-error then