tokenize and string parser

tl-rpc.asd

@@ -7,5 +7,5 @@
   :version "0.1"
   :author "Innokenty Enikeev"
   :license "MIT"
-  :depends-on (:graylex)  
-  :description "")
+  :depends-on (:parser-combinators)
+  :description "VK's TL-RPC")

tl-rpc.lisp

@@ -1,10 +1,6 @@
-;;; This file contains modified code from cl-m4 that demonstrates how graylex
-;;; can be used. If you want a full-fledged example including recursive descent
-;;; parsing, please checkout http://github.com/e-user/cl-m4
-
-(defpackage example
+(defpackage tl-rpc
   (:use :cl :parser-combinators :alexandria))
-(in-package :example)
+(in-package :tl-rpc)
 
 (defun not-equal (a b)
   (not (equal a b)))
@@ -41,20 +37,16 @@
                                     (member i '(#\_))))) 1 nil 'string)
    (quoted? :quote-char #\`)))
 
-(defun strip-comments (input)
-  (apply #'concatenate 'string
-         (remove :comment
-                 (substitute " " nil
-                             (parse-string*
-                              (many? (choices (<token>)
-                                              (named-seq? (<- p (<punctuation>)) (string p))
-                                              "---"
-                                              (whitespace?)
-                                              (named-seq? (<sl-comment>) :comment)
-                                              (named-seq? (<ml-comment>) :comment)))
-                              input)))))
-
-;; Actual parser
+(defun tokenize (input)
+  (remove :whitespace
+          (parse-string*
+           (many? (choices (<token>)
+                           (<punctuation>)
+                           (chook? :whitespace
+                                   (choices (whitespace?) "---" (<sl-comment>) (<ml-comment>)))))
+           input)))
+
+;; Actual parsers
 (defun <hex-digit> ()
   (choice (digit?) (sat (rcurry #'member '(#\a #\b #\c #\d #\e #\f)))))
 
@@ -64,18 +56,29 @@
 (defun <ident-char> ()
   (choices (<letter>) (digit?) #\_))
 
+
+(defmacro def-string-parser (name arguments &body body)
+  (with-unique-names (inp)
+    (multiple-value-bind (forms declarations docstring) (parse-body body :documentation t)
+      `(defun ,name ,arguments
+         ,docstring
+         ,@declarations
+         (sat (lambda (,inp)
+                (and (stringp ,inp)
+                     (parse-string* ,@forms ,inp :complete t))))))))
+
 (defun concat (&rest args)
   (apply #'concatenate 'string args))
 
 (defun string-concat (args)
   (apply #'concatenate 'string (mapcar 'string args)))
 
-(defun <lc-ident> ()
+(def-string-parser <lc-ident> ()
   (named-seq? (<- hd (lower?))
               (<- tl (many? (<ident-char>)))
               (coerce (cons hd tl) 'string)))
 
-(defun <uc-ident> ()
+(def-string-parser <uc-ident> ()
   (named-seq? (<- hd (upper?))
               (<- tl (many? (<ident-char>)))
               (coerce (cons hd tl) 'string)))