X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=scheme.4th;h=75055ff09b6bd83fc2269d48317e5d650a277cf7;hb=47b94d7af3449341b96f8e1b420c708c9a4c2fc2;hp=7fcbb30dd377f85e4e5ffe4bc1cf2e752aed0ace;hpb=926748a17c5ba8eca3bc7379d3c52f6e94ef5c36;p=scheme.forth.jl.git diff --git a/scheme.4th b/scheme.4th index 7fcbb30..75055ff 100644 --- a/scheme.4th +++ b/scheme.4th @@ -259,7 +259,6 @@ parse-idx-stack parse-idx-sp ! defer read : readpair ( -- obj ) - inc-parse-idx eatspaces \ Empty lists @@ -272,7 +271,9 @@ defer read reset-term abort then - nil-type exit + dec-parse-idx + + 0 nil-type exit then \ Read first pair element @@ -320,7 +321,21 @@ defer read then pair? if + inc-parse-idx + + eatspaces + readpair + + eatspaces + + nextchar [char] ) <> if + bold red ." Missing closing paren." reset-term cr + abort + then + + inc-parse-idx + exit then @@ -383,13 +398,12 @@ defer read defer print : printpair ( pairobj -- ) - ." (" 2dup car print cdr nil-type istype? if 2drop ." )" exit then - pair-type istype? if recurse ." )" exit then - ." . " print ." )" + pair-type istype? if space recurse exit then + ." . " print ; :noname ( obj -- ) @@ -397,7 +411,7 @@ defer print boolean-type istype? if printbool exit then character-type istype? if printchar exit then nil-type istype? if printnil exit then - pair-type istype? if printpair exit then + pair-type istype? if ." (" printpair ." )" exit then bold fg red ." Error printing expression - unrecognized type. Aborting" reset-term cr abort