Ruby AST parse（一部）

ruby-ast.lisp

(defun parse-program (s)
  "expect:
(:program
 ((:class
    .....
    ....)))"
  (loop for program in (cadr s)
        do (cond ((and (listp program)
                       (eq (car program) :class))
                  (parse-class program))
                 (t (format T "unsupported in program: ~A~%" program)))))


(defun parse-class (s)
  (progn
    (parse-class-name (cadr s))
    (parse-class-parent-class (caddr s))
    (parse-class-body (cadddr s))))

(defun parse-class-name (s)
  (cond ((and (listp s)
              (eq (car s) :const_ref))
         (parse-const_ref s))
        (t (format T "unsupported in class-name: ~A~%" s))))

(defun parse-const_ref (s)
  "expect: (:const_ref (:@const \"Test\" (1 6)))"
  (let ((ref (cadr s)))
    (cond ((atom ref) ref)
          ((eq (car ref) :@const)
           (parse-const ref))
          (t (format T "unsupported in const_ref:~A~%" ref)))))

(defun parse-const (s)
  "expect: (:@const \"Test\" (1 6))"
  (cadr s))

(defun parse-class-parent-class (s)
  (cond ((and (listp s)
              (eq (car s) :var_ref))
         (parse-var_ref s))
        (t (format T "unsupported in class-parent-class: ~A~%" s))))

(defun parse-var_ref (s)
  "expect: (:var_ref (:@const \"B\" (1 10)))"
  (let ((ref (cadr s)))
    (cond ((atom ref) ref)
          ((eq (car ref) :@const)
           (parse-const ref))
          (t (format T "unsupported in var_ref:~A~%" ref)))))

(defun parse-class-body (s)
  (parse-bodystmt s))

(defun parse-bodystmt (s)
  (loop for bodystmt in (cadr s)
        do (cond ((and (listp bodystmt)
                       (eq (car bodystmt) :void_stmt))
                  (parse-void_stmt bodystmt))
                 ((and (listp bodystmt)
                       (eq (car bodystmt) :def))
                  (parse-def bodystmt))
                 ((and (listp bodystmt)
                       (eq (car bodystmt) :command))
                  (parse-command bodystmt))
                 ((and (listp bodystmt)
                       (eq (car bodystmt) :command_call))
                  (parse-command_call bodystmt))
                 (t
                  (format T "unsupported in bodystmt:~A~%" s)))))

(defun parse-void_stmt (s)
  (declare (ignore s))
  (format T "finish parse at void_stmt!!~%"))

(defun parse-def (s)
  (progn
    (parse-method-name (cadr s))
    (parse-method-args (caddr s))
    (parse-method-body (cadddr s))))

(defun parse-method-name (s)
  "expect: (:@ident \"say\" (2 6))"
  (if (eq (car s) :@ident)
      (cadr s)
      (format T "unsupported in method-name:~A~%" s)))

(defun parse-method-args (s)
  (declare (ignore s))
  'ok)

(defun parse-method-body (s)
  (parse-bodystmt s))

(defun parse-command (s)
  (progn
    (parse-command-name (cadr s))
    (parse-command-args (caddr s))))

(defun parse-command-name (s)
  "expect: (:@ident \"say\" (2 6))"
  (if (eq (car s) :@ident)
      (cadr s)
      (format T "unsupported in command-name:~A~%" s)))

(defun parse-command-args (s)
  "expect: (:args_add_block ((:string_literal (:string_content (:@tstring_content \"say\" (6 27))))))"
  (loop for arg in (cadr s)
        do (cond ((and (listp arg)
                       (eq (car arg) :string_literal))
                  (parse-string_literal arg))
                 ((and (listp arg)
                       (eq (car arg) :@int))
                  (parse-int arg))
                 ((and (listp arg)
                       (eq (car arg) :@float))
                  (parse-float arg))
                 ((and (listp arg)
                       (eq (car arg) :vcall))
                  (parse-vcall arg))
                 ((and (listp arg)
                       (eq (car arg) :method_add_arg))
                  (parse-method_add_arg arg))
                 ((and (listp arg)
                       (eq (car arg) :binary))
                  (parse-binary arg))
                 (t
                  (format T "unsupported in method-arg:~A~%" arg)))))

(defun parse-string_literal (s)
  "expect: (:string_literal (:string_content (:@tstring_content \"hello world\" (3 10))))"
  (let ((literal (cadr s)))
    (cond ((atom literal) literal)
          ((eq (car literal) :string_content)
           (parse-string_content literal))
          (t
           (format t "unsupported in string_literal:~A~%" literal)))))

(defun parse-string_content (s)
  "expect: (:string_content (:@tstring_content \"hello world\" (3 10)))"
  (let ((content (cadr s)))
    (cond ((atom content) content)
          ((eq (car content) :@tstring_content)
           (parse-tstring_content content))
          (t
           (format t "unsupported in string_content:~A~%" content)))))

(defun parse-tstring_content (s)
  "expect: (:@tstring_content \"hello world\" (3 10))"
  (cadr s))

(defun parse-command_call (s)
  (progn
    (parse-object (cadr s))
    (parse-method-name (caddr s))
    (parse-method-args (cadddr s))))

(defun parse-object (s)
  "expect: (:var_ref (:@const \"Command\" (6 4)))"
  (cond ((eq (car s) :var_ref)
         (parse-var_ref s))
        (t
         (format T "unsupported in object:~A~%" s))))