         rot slice-seq <slice>
     ] if ;
 
-TUPLE: token-parser string ;
-
-C: token token-parser ( string -- parser )
+: string= ( str1 str2 ignore-case -- ? )
+    [ [ >upper ] 2apply ] when sequence= ;
+
+: string-head? ( str head ignore-case -- ? )
+    pick pick shorter? [
+        3drop f
+    ] [
+        >r [ length head-slice ] keep r> string=
+    ] if ;
+
+: ?string-head ( str head ignore-case -- newstr ? )
+    >r 2dup r> string-head?
+    [ length tail-slice t ] [ drop f ] if ;
+
+TUPLE: token-parser string ignore-case? ;
+
+C: <token-parser> token-parser
+
+: token ( string -- parser ) f <token-parser> ;
+
+: case-insensitive-token ( string -- parser ) t <token-parser> ;
 
 M: token-parser parse ( input parser -- list )
-    token-parser-string swap over ?head-slice [
-        <parse-result> 1list
-    ] [
-        2drop nil
-    ] if ;
+    dup token-parser-string swap token-parser-ignore-case?
+    >r tuck r> ?string-head
+    [ <parse-result> 1list ] [ 2drop nil ] if ;
 
 : 1token ( n -- parser ) 1string token ;
 

    dupd exactly-n swap <*> <&> ;

: from-m-to-n ( parser m n -- parser' )
    >r [ exactly-n ] 2keep r> swap - at-most-n <&> ;

    #! required.
    <?> only-first ;

LAZY: <(?)> ( parser -- parser )
    #! Like <?> but take shortest match first.
    f succeed swap [ 1array ] <@ <|> ;

LAZY: <(*)> ( parser -- parser )
    #! Like <*> but take shortest match first.
    #! Implementation by Matthew Willis.
