X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=scheme-primitives.4th;h=a9ea386f919397377da00babfcd045367638a00d;hb=871b6800c52715e27f968bf1203e7f3144893a9c;hp=3de4d3770f7ee823f3f52e72747ce3a098f58f82;hpb=dc6e0cea1e1e982da8029c94d78ee66ab7e8fd82;p=scheme.forth.jl.git diff --git a/scheme-primitives.4th b/scheme-primitives.4th index 3de4d37..a9ea386 100644 --- a/scheme-primitives.4th +++ b/scheme-primitives.4th @@ -48,7 +48,57 @@ car primitive-type istype? -rot 2drop boolean-type ; make-primitive procedure? -( = Arithmeic = ) +( = Type conversions = ) + +:noname ( args -- fixnum ) + 2dup 1 ensure-arg-count + car character-type ensure-arg-type + + drop fixnum-type +; make-primitive char->integer + +: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 + [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 + + drop + + dup 0< swap abs ( bool num ) + build-fixnum-charlist + rot if + [char] - character-type 2swap cons + then + + drop string-type +; make-primitive number->string + +( = Arithmetic = ) : add-prim ( args -- fixnum ) 2dup nil objeq? if