X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=forth.jl.git;a=blobdiff_plain;f=src%2Flib_6_strings.4th;h=753e756a12a8b4ba222b9b4eee607132241e44da;hp=56a2174bf1325c2c87a0ab4f5e838dcadfd009a5;hb=6a34e447b5d32310f63850a794816e30e350cc5c;hpb=30a093845e2d1097242e948bb577fb71f73bc860 diff --git a/src/lib_6_strings.4th b/src/lib_6_strings.4th index 56a2174..753e756 100644 --- a/src/lib_6_strings.4th +++ b/src/lib_6_strings.4th @@ -37,29 +37,41 @@ DROP ; -( Compile-mode word which compiles everything until the next - double quote as a litstring. ) -: S" IMMEDIATE ( -- addr len ) - ['] LITSTRING , ( compile LITSTRING ) - HERE ( save the address of the length word on the stack ) - 0 , ( dummy length - we don't know what it is yet ) +: COMPILING? STATE @ 0<> ; + +( In compile mode, word compiles everything until the next + double quote as a litstring. Otherwise, dynamically allocates + memory and stores string there, returning address and length. ) +: S" IMMEDIATE ( -- addr len ) + COMPILING? IF + ['] LITSTRING , ( compile LITSTRING ) + HERE ( save the address of the length word on the stack ) + 0 , ( dummy length - we don't know what it is yet ) + ELSE + HERE ( save the starting address on the stack ) + THEN BEGIN - >IN @ #IB @ >= IF \ End of TIB? + >IN @ #IB @ >= IF \ End of IB? QUERY-INPUT \ Get next line THEN - IB >IN @ + @ 1 >IN +! \ Get char from TIB + IB >IN @ + @ 1 >IN +! \ Get char from IB DUP [CHAR] " <> WHILE - C, ( copy character ) + , ( copy character ) REPEAT DROP ( drop the double quote character at the end ) - DUP ( get the saved address of the length word ) - HERE SWAP - ( calculate the length ) - 1- ( subtract 1 (because we measured from the start of the length word) ) - SWAP ! ( and back-fill the length location ) + + COMPILING? IF + DUP ( get the saved address of the length word ) + HERE SWAP - ( calculate the length ) + 1- ( subtract 1 (because we measured from the start of the length word) ) + SWAP ! ( and back-fill the length location ) + ELSE + DUP HERE SWAP - + THEN ; ( Compile-mode word which compiles everything until the @@ -73,11 +85,11 @@ right-paren to the terminal. ) : .( BEGIN - >IN @ #IB @ >= IF \ End of TIB? + >IN @ #IB @ >= IF \ End of IB? QUERY-INPUT \ Get next line THEN - IB >IN @ + @ 1 >IN +! \ Get char from TIB + IB >IN @ + @ 1 >IN +! \ Get char from IB DUP [CHAR] ) = IF DROP ( drop the double quote character ) @@ -92,6 +104,39 @@ : COUNT ( addr1 -- addr2 n ) DUP 1+ SWAP @ ; +( Compares two strings, returns 0 if identical. ) +: COMPARE ( addr1 n1 addr2 n2 -- res ) + rot 2dup <> if + 2drop 2drop 1 exit + then + + drop + + 0 do + 2dup i + @ swap i + @ <> if + unloop 2drop 1 exit + then + loop + + 2drop 0 +; + +( Converts a string to lower case. ) +: TOLOWER ( addr n -- ) + 0 do + dup i + @ dup dup ( addr char char char ) + [char] A >= + swap [char] Z <= and if + [char] A - [char] a + + over i + ! + else + drop + then + loop + + drop +; + ( Abort if flag is true. ) : ABORT" IMMEDIATE ( flag -- ) [COMPILE] S"