From 002c9cb100f78caaae5a1ebf624859459239c146 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ond=C5=99ej=20Hru=C5=A1ka?= Date: Sat, 27 Nov 2021 11:00:09 +0100 Subject: [PATCH] add PARSE, PARSE-NAME --- README.md | 8 +++---- src/fh_builtins_meta.c | 46 ++++++++++++++++++++++++++++++++++++++++ src/fh_parse.c | 6 +++--- testfiles/combinedtest.f | 3 +++ 4 files changed, 56 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index 33c5d92..fdb5601 100644 --- a/README.md +++ b/README.md @@ -49,13 +49,13 @@ Implemented and tested: ``` CORE: ! ' ( * */ */MOD + +! +LOOP , - . ." # #> #S <# >BODY >NUMBER / /mod 0< 0= 1+ 1- 2! 2* 2/ 2@ 2DROP 2DUP 2OVER 2SWAP -: ; < = > >IN >R ?DUP @ ABORT ABS ALIGN ALIGNED ALLOT AND BASE BEGIN BL C! C, C@ CELL CELL+ CELLS CHAR CHAR+ +: ; < = > >IN >R ?DUP @ ABS ALIGN ALIGNED ALLOT AND BASE BEGIN BL C! C, C@ CELL CELL+ CELLS CHAR CHAR+ CHARS CONSTANT COUNT CR CREATE DECIMAL DEPTH DO DOES> DROP DUP ELSE EMIT ENVIRONMENT? EVALUATE EXECUTE EXIT FILL FM/MOD FIND HERE HOLD I IF IMMEDIATE INVERT J LEAVE LITERAL LOOP LSHIFT M* MAX MIN MOD MOVE NEGATE OR OVER POSTPONE QUIT R> R@ RECURSE REPEAT ROT RSHIFT S>D S" SIGN SM/REM SOURCE SPACE SPACES STATE SWAP THEN TYPE U. U< UNTIL UM* UM/MOD UNLOOP VARIABLE WHILE WORD XOR [ ['] [CHAR] ] CORE-EXT: -.( .R :NONAME 0<> 0> 2>R 2R> 2R@ <> ?DO AGAIN BUFFER: C" CASE COMPILE, ENDCASE ENDOF ERASE FALSE HEX HOLDS MARKER NIP OF PAD PICK ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE WITHIN +.( .R :NONAME 0<> 0> 2>R 2R> 2R@ <> ?DO AGAIN BUFFER: C" CASE COMPILE, ENDCASE ENDOF ERASE FALSE HEX HOLDS MARKER NIP OF PAD PARSE PARSE-NAME PICK RESTORE-INPUT SAVE-INPUT ROLL S\" TO TRUE TUCK U.R U> UNUSED VALUE WITHIN \ Other sets: @@ -66,10 +66,10 @@ Missing: ``` CORE: -ABORT" ACCEPT KEY +ABORT ABORT" ACCEPT KEY CORE-EXT: -ACTION-OF DEFER DEFER! DEFER@ IS PARSE PARSE-NAME REFILL RESTORE-INPUT SAVE-INPUT SOURCE-ID [COMPILE] +ACTION-OF DEFER DEFER! DEFER@ IS REFILL SOURCE-ID [COMPILE] ``` . diff --git a/src/fh_builtins_meta.c b/src/fh_builtins_meta.c index d63472b..b1bef6f 100644 --- a/src/fh_builtins_meta.c +++ b/src/fh_builtins_meta.c @@ -723,6 +723,50 @@ static enum fh_error w_env_query(struct fh_thread_s *fh, const struct fh_word_s return FH_OK; } +static enum fh_error w_parse(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + uint32_t ch; + TRY(ds_pop(fh, &ch)); + if (ch > 0xFF) { + LOGE("Char out of ASCII bounds!"); + return FH_ERR_NOT_APPLICABLE; + } + + char *out; + size_t len; + fh_input_read_delimited(fh, &out, &len, chartest_equals_or_end, &ch); + if (len >= WORDBUF_SIZE) { + LOGE("PARSE parsed string too long: %d", len); + return FH_ERR_NAME_TOO_LONG; + } + + LOG("Parsed %d", len); + + TRY(ds_push(fh, (void*) out - (void*) &fh->heap[0])); + TRY(ds_push(fh, len)); + return FH_OK; +} + +static enum fh_error w_parse_name(struct fh_thread_s *fh, const struct fh_word_s *w) +{ + (void) w; + enum fh_error rv; + + fh_input_consume_spaces(fh); + + char * ww; + size_t len; + TRY(fh_input_read_word(fh, &ww, &len)); + + LOG("Parsed %.*s", len, ww); + + TRY(ds_push(fh, (void*) ww - (void*) &fh->heap[0])); + TRY(ds_push(fh, len)); + return FH_OK; +} + const struct name_and_handler fh_builtins_meta[] = { {"depth", w_depth, 0, 0}, {"unused", w_unused, 0, 0}, @@ -748,6 +792,8 @@ const struct name_and_handler fh_builtins_meta[] = { {"value", wp_variable, 1, 1}, {"constant", wp_variable, 1, 2}, {"word", w_word, 0, 0}, + {"parse", w_parse, 0, 0}, + {"parse-name", w_parse_name, 0, 0}, {"count", w_count, 0, 0}, {"create", w_create, 0, 0}, {"find", w_find, 0, 0}, diff --git a/src/fh_parse.c b/src/fh_parse.c index 15247f2..b4902dd 100644 --- a/src/fh_parse.c +++ b/src/fh_parse.c @@ -103,8 +103,8 @@ enum fh_error fh_input_read_delimited(struct fh_thread_s *fh, char **out, size_t char c = *rp; if (test(c, param)) { if (rp == start) { - LOGE("Expected a word!"); - return FH_ERR_SYNTAX; + // nothing was found, this is probably OK. + LOG("Parsed an empty word"); } *out = start; *len = rp - start; @@ -391,7 +391,7 @@ enum fh_error fh_process_line(struct fh_thread_s *fh) } else { if (EQ(rp, "\\", length)) { // discard to EOL - LOG("Discard \"%.*s\"", (int)(fh->inputlen - fh->inputptr + length), rp); +// LOG("Discard \"%.*s\"", (int)(fh->inputlen - fh->inputptr + length), rp); goto done; } diff --git a/testfiles/combinedtest.f b/testfiles/combinedtest.f index 8bd3662..ea93358 100644 --- a/testfiles/combinedtest.f +++ b/testfiles/combinedtest.f @@ -1712,6 +1712,9 @@ T{ CHAR " PARSE 4567 "DUP ROT ROT EVALUATE -> 5 4567 }T TESTING PARSE-NAME (Forth 2012) \ Adapted from the PARSE-NAME RfD tests +: STR1 S" abcd" ; +: STR2 S" abcde" ; + T{ PARSE-NAME abcd STR1 S= -> TRUE }T \ No leading spaces T{ PARSE-NAME abcde STR2 S= -> TRUE }T \ Leading spaces