The Lambda Lab
/
projects
/
scheme.forth.jl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Primitives are now GC-safe.
[scheme.forth.jl.git]
/
scheme-primitives.4th
diff --git
a/scheme-primitives.4th
b/scheme-primitives.4th
index
b347d8a
..
1d2e21c
100644
(file)
--- a/
scheme-primitives.4th
+++ b/
scheme-primitives.4th
@@
-64,34
+64,39
@@
drop character-type
; make-primitive integer->char
drop character-type
; make-primitive integer->char
-: num-to-charlist ( num -- charlist )
- ?dup 0= if
+: fixnum-to-charlist ( fixnum -- charlist )
+ over 0= if
+ 2drop
[char] 0 character-type nil cons
exit
then
[char] 0 character-type nil cons
exit
then
- nil
rot
+ nil
2swap ( charlist fixnum )
begin
begin
-
?dup
0>
+
over
0>
while
while
- dup 10 mod swap 10 / swap
- 2swap rot
- [char] 0 + character-type 2swap
- cons
- rot
+ 2dup swap 10 mod swap ( charlist fixnum fixnummod )
+ 2swap swap 10 / swap ( charlist fixnummod fixnumdiv )
+ -2rot ( fixnumdiv charlist fixnummod )
+
+ drop [char] 0 + character-type 2swap
+ cons ( fixnumdiv newcharlist )
+
+ 2swap
repeat
repeat
+
+ 2drop
;
:noname ( args -- string )
2dup 1 ensure-arg-count
car fixnum-type ensure-arg-type
;
:noname ( args -- string )
2dup 1 ensure-arg-count
car fixnum-type ensure-arg-type
-
dro
p
+
2dup swap abs swa
p
- dup 0< swap abs ( bool num )
- num-to-charlist
- rot if
+ fixnum-to-charlist ( fixnum charlist )
+ 2swap drop 0< if
[char] - character-type 2swap cons
then
[char] - character-type 2swap cons
then