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
Fixed bug in (display)
[scheme.forth.jl.git]
/
scheme-primitives.4th
diff --git
a/scheme-primitives.4th
b/scheme-primitives.4th
index
97c098f
..
b71b98d
100644
(file)
--- a/
scheme-primitives.4th
+++ b/
scheme-primitives.4th
@@
-367,19
+367,31
@@
defer display
2dup
car display
cdr
2dup
car display
cdr
- nil
-type istype
? if 2drop exit then
+ nil? if 2drop exit then
pair-type istype? if space recurse exit then
." . " display
;
: displaychar ( charobj -- )
pair-type istype? if space recurse exit then
." . " display
;
: displaychar ( charobj -- )
- drop emit
+ drop emit ;
+
+: (displaystring) ( charlist -- )
+ nil? if
+ 2drop
+ else
+ 2dup car displaychar
+ cdr recurse
+ then
+;
+
+: displaystring ( stringobj -- )
+ drop pair-type (displaystring)
;
:noname ( obj -- )
pair-type istype? if ." (" displaypair ." )" exit then
character-type istype? if displaychar exit then
;
:noname ( obj -- )
pair-type istype? if ." (" displaypair ." )" exit then
character-type istype? if displaychar exit then
- string-type istype? if
(printstring)
exit then
+ string-type istype? if
displaystring
exit then
print
; is display
print
; is display
@@
-388,7
+400,7
@@
defer display
2dup 1 ensure-arg-count
car string-type ensure-arg-type
2dup 1 ensure-arg-count
car string-type ensure-arg-type
- (printstring)
+ displaystring
none
; make-primitive display-string
none
; make-primitive display-string