X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=scheme.forth.jl.git;a=blobdiff_plain;f=scheme-primitives.4th;h=b71b98dfa6a8d1cd0038ef7b837eb623bc495360;hp=97c098ff8ae6716db18fe94ecd8df132fdb0e722;hb=988c879292acffbbf86367601c41ad7c010ff160;hpb=f81ffb05496dc3490c0c7469017d9c7ba7c0113a diff --git a/scheme-primitives.4th b/scheme-primitives.4th index 97c098f..b71b98d 100644 --- a/scheme-primitives.4th +++ b/scheme-primitives.4th @@ -367,19 +367,31 @@ defer display 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 -- ) - 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 - string-type istype? if (printstring) exit then + string-type istype? if displaystring exit then print ; is display @@ -388,7 +400,7 @@ defer display 2dup 1 ensure-arg-count car string-type ensure-arg-type - (printstring) + displaystring none ; make-primitive display-string