From f4e635c7b49321b5ba6f6a4609985aea4768d209 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Thu, 21 Jul 2016 06:56:12 +1200 Subject: [PATCH] Debugging number->string --- scheme-primitives.4th | 27 ++++++++++++++++++++++++++- scheme.4th | 2 +- 2 files changed, 27 insertions(+), 2 deletions(-) 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 -- 2.20.1