lexer.f

   1 REQUIRE STARTS-WITH? utils.f
   2 REQUIRE { lib/ext/locals.f
   3 REQUIRE /TEST ~profit/lib/testing.f
   4 REQUIRE LAMBDA{ ~pinka/lib/lambda.f
   5 REQUIRE /GIVE ~ygrek/lib/parse.f
   6 REQUIRE PRO ~profit/lib/bac4th.f
   7 REQUIRE re_match? ~ygrek/lib/re/re.f
   8 REQUIRE FINE-HEAD ~pinka/samples/2005/lib/split-white.f
   9
  10 : | 2DUP ;
  11 : => S" ?DUP IF /GIVE" EVALUATE ; IMMEDIATE
  12 : ;; S" EXIT THEN" EVALUATE ; IMMEDIATE
  13
  14 : match? ( a u `str -- n ) DUP { n } STARTS-WITH? IF n ELSE 0 THEN ;
  15 : _ 2DROP 1 ;
  16
  17 : lexer ( `str xt -- ) { xt } BEGIN xt EXECUTE DUP 0= UNTIL 2DROP ;
  18 : }LEXER S" } lexer" EVALUATE ; IMMEDIATE
  19
  20 \ : lexer=> ( `str xt --> i*x \ <-- ) PRO { xt } BEGIN xt EXECUTE CONT DUP 0= UNTIL 2DROP ;
  21
  22 /TEST
  23
  24 REQUIRE AsQWord ~pinka/spf/quoted-word.f
  25 REQUIRE TESTCASES ~ygrek/lib/testcase.f
  26
  27 : test
  28   LAMBDA{
  29   | `+ match? => 2DROP 1 % ;;
  30   | `- match? => 2DROP -1 % ;;
  31   | _ => 2DROP 0 % ;;
  32   } %[ lexer ]% 0 SWAP ['] + list::iter ;
  33
  34 TESTCASES lexer
  35 (( S" ++--ewew++" test -> 2 ))
  36 (( S" **dsds**er**dqew" test -> 0 ))
  37 END-TESTCASES
  38