wip

tl-rpc.asd

@@ -8,4 +8,6 @@
   :author "Innokenty Enikeev"
   :license "MIT"
   :depends-on (:parser-combinators)
-  :description "VK's TL-RPC")
+  :description "VK's TL-RPC"
+  :serial t
+  :components ((:file "tl-rpc")))

tl-rpc.lisp

@@ -83,22 +83,28 @@
               (<- tl (many? (<ident-char>)))
               (coerce (cons hd tl) 'string)))
 
+(def-string-parser <hex-string> (&optional len)
+  (between? (<hex-digit>) len len))
+
 (defun <namespace-ident> () (<lc-ident>))
 
+(defstruct ident ns id name)
+
 (defun <lc-ident-ns> ()
   (named-seq? (<- ns (opt? (seq-list? (<namespace-ident>) #\.)))
               (<- id (<lc-ident>))
-              (concat (when ns (string-concat ns)) id)))
+              (make-ident :ns (car ns) :id id)))
 
 (defun <uc-ident-ns> ()
   (named-seq? (<- ns (opt? (seq-list? (<namespace-ident>) #\.)))
               (<- id (<uc-ident>))
-              (concat (when ns (string-concat ns)) id)))
+              (make-ident :ns (car ns) :id id)))
 
 (defun <lc-ident-full> ()
   (named-seq? (<- id (<lc-ident-ns>))
-              (<- name (opt? (seq-list? #\# (times? (<hex-digit>) 8))))
-              (concat id (when name (coerce (apply #'cons name) 'string)))))
+              (<- name (opt? (seq-list? #\# (<hex-string> 8))))
+              (progn (when name (setf (ident-name id) (second name)))
+                     id)))
 
 (defun <nat-const> ()
   (many1? (digit?)))
@@ -221,7 +227,6 @@
 (defun <final-decl> ()
   (named-seq?
    (<- type (choices "New" "Final" "Empty"))
-   (whitespace?)
    (<- ind (<boxed-type-ident>)) #\;
    (list :final-decl type ind)))
 
@@ -237,13 +242,17 @@
 (defun <fun-declarations> ()
   (many? (named-seq? (<- dec (<declaration>)) #\; dec)))
 
+(defstruct tl-program constructors functions)
 (defun <tl-program> ()
   (named-seq? (<- hd (<constr-declarations>))
-              (whitespace? :accept-empty t)
               (<- tl (many?
                       (choice
-                       (mdo "---" "functions" "---"
-                            (<fun-declarations>))
-                       (mdo "---" "types" "---"
-                            (<constr-declarations>)))))
-              (cons hd tl)))
+                       (named-seq? "---" "functions" "---"
+                                   (<- decs (<fun-declarations>))
+                                   (cons :funcs decs))
+                       (named-seq? "---" "types" "---"
+                                   (<- decs (<constr-declarations>))
+                                   (cons :constrs decs)))))
+              (make-tl-program
+               :constructors (append hd (mapcar #'cdr (remove :funcs tl :key #'car)))
+               :functions (mapcar #'cdr (remove :constrs tl :key #'car)))))