]> gitweb.factorcode.org Git - factor.git/commitdiff
lexer: make CHAR: ! work.
authorJohn Benediktsson <mrjbq7@gmail.com>
Thu, 31 Mar 2016 04:21:40 +0000 (21:21 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Thu, 31 Mar 2016 04:21:40 +0000 (21:21 -0700)
core/lexer/lexer.factor
core/syntax/syntax.factor

index 36ea984b2f7d5897a05ba38300ea42ddae9da4ad..2e23e7352beb3247e6aebd711c71dc79e5066752 100644 (file)
@@ -94,9 +94,22 @@ M: lexer skip-word
 : still-parsing-line? ( lexer -- ? )
     check-lexer [ column>> ] [ line-length>> ] bi < ;
 
-DEFER: parse-token
+: (parse-raw) ( lexer -- str )
+    check-lexer {
+        [ column>> ]
+        [ skip-word ]
+        [ column>> ]
+        [ line-text>> ]
+    } cleave subseq ;
 
-<PRIVATE
+: parse-raw ( lexer -- str/f )
+    dup still-parsing? [
+        dup skip-blank
+        dup still-parsing-line?
+        [ (parse-raw) ] [ dup next-line parse-raw ] if
+    ] [ drop f ] if ;
+
+DEFER: parse-token
 
 : skip-comments ( lexer str -- str' )
     dup "!" = [
@@ -105,22 +118,8 @@ DEFER: parse-token
         nip
     ] if ;
 
-PRIVATE>
-
-: (parse-token) ( lexer -- str )
-    dup check-lexer {
-        [ column>> ]
-        [ skip-word ]
-        [ column>> ]
-        [ line-text>> ]
-    } cleave subseq skip-comments ;
-
 : parse-token ( lexer -- str/f )
-    dup still-parsing? [
-        dup skip-blank
-        dup still-parsing-line?
-        [ (parse-token) ] [ dup next-line parse-token ] if
-    ] [ drop f ] if ;
+    dup parse-raw [ skip-comments ] [ drop f ] if* ;
 
 : ?scan-token ( -- str/f ) lexer get parse-token ;
 
index 78b41e211660f63e6cd0ae5001d344fdb6b91c03..13f07fcddce1db554e47cffbf006b60bb3bd8baf 100644 (file)
@@ -81,7 +81,7 @@ IN: bootstrap.syntax
     "f" [ f suffix! ] define-core-syntax
 
     "CHAR:" [
-        scan-token {
+        lexer get parse-raw [ "token" throw-unexpected-eof ] unless* {
             { [ dup length 1 = ] [ first ] }
             { [ "\\" ?head ] [ next-escape >string "" assert= ] }
             [ name>char-hook get call( name -- char ) ]