X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=scheme.forth.jl.git;a=blobdiff_plain;f=src%2Fscheme-primitives.4th;h=1ed995b2439a3a5169105dd535f97fe3bd4d9e70;hp=ba48b9e365a0f99ae7af8a6e241eecabb3d2e9d0;hb=bc2450b4b29d6bb8ba5422fb9eb7a75d1b6b5a57;hpb=aa76b536aa3e1a90b31a64fd9147b2b16153ec8b diff --git a/src/scheme-primitives.4th b/src/scheme-primitives.4th index ba48b9e..1ed995b 100644 --- a/src/scheme-primitives.4th +++ b/src/scheme-primitives.4th @@ -153,6 +153,37 @@ charlist>symbol ; make-primitive string->symbol +:noname ( charlist -- string ) + 2dup 1 ensure-arg-count + + car nil? if + 2drop + nil nil cons + drop string-type + exit + then + + pair-type ensure-arg-type + + duplicate-charlist + drop string-type +; make-primitive list->string + +:noname ( string -- charlist ) + 2dup 1 ensure-arg-count + car string-type ensure-arg-type + + drop pair-type + + 2dup car nil? if + 2swap 2drop + else + 2drop + duplicate-charlist + then + +; make-primitive string->list + \ }}} \ ==== Numeric types ==== {{{ @@ -432,6 +463,32 @@ \ ==== Input/Output ==== {{{ +:noname ( -- port ) + console-i/o-port obj@ +; 0 make-fa-primitive console-i/o-port + +:noname ( -- port ) + current-input-port obj@ +; 0 make-fa-primitive current-input-port + +: charlist>cstr ( charlist addr -- n ) + + dup 2swap ( origaddr addr charlist ) + + begin + nil? false = + while + 2dup cdr 2swap car + drop ( origaddr addr charlist char ) + -rot 2swap ( origaddr charlist addr char ) + over ! + 1+ -rot ( origaddr nextaddr charlist ) + repeat + + 2drop ( origaddr finaladdr ) + swap - +; + :noname ( args -- finalResult ) drop pair-type pad charlist>cstr