From: Tim Vaughan Date: Thu, 21 Jul 2016 08:29:10 +0000 (+1200) Subject: string->number works. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=af4ada618d8d096645f783f40508a1bd6ad0d95d;p=scheme.forth.jl.git string->number works. --- diff --git a/scheme-primitives.4th b/scheme-primitives.4th index a9ea386..b268051 100644 --- a/scheme-primitives.4th +++ b/scheme-primitives.4th @@ -64,7 +64,7 @@ drop character-type ; make-primitive integer->char -: build-fixnum-charlist ( num ) +: num-to-charlist ( num -- charlist ) ?dup 0= if [char] 0 character-type nil cons exit @@ -90,7 +90,7 @@ drop dup 0< swap abs ( bool num ) - build-fixnum-charlist + num-to-charlist rot if [char] - character-type 2swap cons then @@ -98,6 +98,38 @@ drop string-type ; make-primitive number->string +:noname ( args -- symbol ) + 2dup 1 ensure-arg-count + car string-type ensure-arg-type + + drop pair-type + + 2dup car [char] - character-type objeq? if + cdr + true -rot + else + 2dup car [char] + character-type objeq? if + cdr + then + false -rot + then + + 0 -rot + begin + 2dup nil objeq? false = + while + 2dup car drop [char] 0 - -rot + 2swap swap 10 * + -rot + cdr + repeat + + 2drop + + swap if -1 * then + + fixnum-type +; make-primitive string->number + ( = Arithmetic = ) : add-prim ( args -- fixnum ) diff --git a/scheme.4th b/scheme.4th index ecbb91b..19848b6 100644 --- a/scheme.4th +++ b/scheme.4th @@ -393,8 +393,11 @@ parse-idx-stack parse-idx-sp ! : minus? ( -- bool ) nextchar [char] - = ; +: plus? ( -- bool ) + nextchar [char] + = ; + : fixnum? ( -- bool ) - minus? if + minus? plus? or if inc-parse-idx delim? if @@ -493,8 +496,11 @@ parse-idx-stack parse-idx-sp ! nextchar [char] " = ; : readnum ( -- num-atom ) - minus? dup if + plus? minus? or if + minus? inc-parse-idx + else + false then 0