X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=scheme-primitives.4th;h=e446b2e57cfea95bc5efd91d1fb5f8faa240020c;hb=480095585b96fbcc5a4fb58fb57188609aadb6e5;hp=56ecab0e5fb3c3d6f0bfa2248dd3649e74e49bc6;hpb=7e44c5ca79a16106aefa315ccf38e74dcd365554;p=scheme.forth.jl.git

diff --git a/scheme-primitives.4th b/scheme-primitives.4th
index 56ecab0..e446b2e 100644
--- a/scheme-primitives.4th
+++ b/scheme-primitives.4th
@@ -354,7 +354,8 @@ hide relcfa
 
 ' read make-primitive read
 
-:noname ( args -- )
+defer display
+:noname ( args -- none )
     2dup 1 ensure-arg-count
 
     car print cr
@@ -362,6 +363,62 @@ hide relcfa
     none
 ; make-primitive write
 
+: displaypair ( pairobj -- )
+    2dup
+    car display
+    cdr
+    nil-type istype? if 2drop exit then
+    pair-type istype? if space recurse exit then
+    ."  . " display
+;
+
+: displaychar ( charobj -- )
+    drop emit
+;
+
+:noname ( obj -- )
+    pair-type istype? if ." (" displaypair ." )" exit then
+    character-type istype? if displaychar exit then
+    string-type istype? if (printstring) exit then
+    
+    print
+; is display
+
+:noname ( args -- none )
+    2dup 1 ensure-arg-count
+    car string-type ensure-arg-type
+
+    (printstring) cr
+
+    none
+; make-primitive display-string
+
+:noname ( args -- none )
+    2dup 1 ensure-arg-count
+    car character-type ensure-arg-type
+
+    displaychar cr
+
+    none
+; make-primitive display-character
+
+:noname ( args -- none )
+    2dup 1 ensure-arg-count
+    car
+
+    display cr
+
+    none
+; make-primitive display
+
+:noname ( args -- none )
+    0 ensure-arg-count
+
+    cr
+
+    none
+; make-primitive newline
+
 ( ==== Evaluation ==== )
 
 :noname