gen_ast.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  #+quicklisp(ql:quickload '(:split-sequence) :silent t)
  )

(defpackage :ros.script.gen_ast.3835859183
  (:use :cl)
  (:import-from :split-sequence :split-sequence))
(in-package :ros.script.gen_ast.3835859183)

(declaim (ftype (function (file-stream string string) def-visitor)))
(declaim (ftype (function (file-stream string string string)) def-type))
(declaim (ftype (function (string string list)) def-ast))

(defun def-ast (output-dir base-name types)
  (let ((path (format nil "~a/~a.java" output-dir base-name)))
    (with-open-file (stream path :direction :output
                                 :if-exists :supersede
                                 :if-does-not-exist :create)
      (format stream "package co.prismarine.lox;~%~%import java.util.List;~%~%abstract class ~a {~%" base-name)

      (def-visitor stream base-name types)

      (dolist (typedef types)
        (let* ((typedef-split (split-sequence #\: typedef))
               (type (string-trim " " (first typedef-split)))
               (fields (string-trim " " (second typedef-split))))
          (def-type stream base-name type fields)))

      ;; The base accept() method.
      (format stream "~%    abstract <R> R accept(Visitor<R> visitor);~%")

      (format stream "}~%"))))

(defun def-visitor (outstream base-name types)
  (format outstream "    interface Visitor<R> {~%")

  (dolist (typedef types)
    (let ((typename (string-trim " " (first (split-sequence #\: typedef)))))
      (format outstream "        R visit~a~a(~a ~a);~%" typename base-name typename (string-downcase base-name))))

  (format outstream "    }~%"))

(defun def-type (outstream base-name class-name fields)
  (format outstream "    static class ~a extends ~a {~%" class-name base-name)

  ;; Constructor.
  (format outstream "        ~a(~a) {~%" class-name fields)

  ;; Store parameters in fields
  (let ((field-list (mapcar (lambda (x) (string-trim " " x)) (split-sequence #\, fields))))
    (dolist (field field-list)
            (let ((name (second (split-sequence #\Space (string-trim " " field)))))
              (format outstream "              this.~a = ~a;~%" name name)))
    (format outstream "        }~%")
    ;; Fields.
    (dolist (field field-list)
      (format outstream "        final ~a;~%" field)))


  (format outstream "
        @Override
        <R> R accept(Visitor<R> visitor) {
            return visitor.visit~a~a(this);
        }~%        ~%"
          class-name
          base-name)

  (format outstream "    }~%"))

(defun main (&rest argv)
  (let ((output-dir (if argv (first argv) ".")))
    (def-ast output-dir "Expr"
      (list
        "Binary : Expr left, Token operator, Expr right"
        "Grouping : Expr expression"
        "Literal : Object value"
        "Unary : Token operator, Expr right"))))
;;; vim: set ft=lisp lisp: