aboutsummaryrefslogtreecommitdiff
(in-package #:chains)

(defclass text ()
  ((content :reader content
            :initarg :content
            :type string
            :documentation "")))

(defun textp (object)
  (typep object 'text))

(defun make-text (content)
  (make-instance 'text :content content))

(defun concat-text (&rest text)
  (let ((strings (mapcar #'content text)))
    (make-text (apply #'concatenate 'string strings))))

(defmethod content ((object (eql 'empty-line)))
  (list (make-text "")))

(defmethod print-object ((object text) stream)
  (format stream "#<TEXT \"~A\">" (content object)))

(defclass closure ()
  ((function :reader closure-function
             :initarg :function
             :type function
             :documentation "")
   (lambda-list :reader closure-lambda-list
                :initarg :lambda-list
                :type list
             :documentation "")
   (environment :reader closure-environment
                :initarg :environment
                :type list
                :documentation "Environment captured by the closure")
   (specialp :reader closure-special-p
             :initarg :specialp
             :type boolean
             :documentation "")
   (groupp :reader closure-group-p
           :initarg :groupp
           :type function
           :documentation "")))

(defun make-closure (function lambda-list groupp &optional environment specialp)
  (make-instance 'closure :function function
                          :lambda-list lambda-list
                          :groupp groupp
                          :environment environment
                          :specialp specialp))

(defun closurep (object)
  (typep object 'closure))

(defun whitespacep (char-or-string)
  (if (stringp char-or-string)
      (every #'whitespacep char-or-string)
      (member char-or-string +whitespace+)))

(defun whitespace-text-p (object)
  (and (textp object) (whitespacep (content object))))

(defun special-char-p (x)
  (member x +special-characters+))

(defun empty-line-p (x)
  (or (emptyp x) (every #'whitespacep x)))

(defun newlinep (x)
  (eql x #\Newline))

(defun concat (&rest strings)
  (apply #'concatenate 'string strings))

(defclass object ()
  ((type :reader object-type
         :initarg :type
         :type keyword
         :documentation "")
   (value :reader object-value
          :initarg :value
          :type t
          :documentation "")))

(defun make-object (type value)
  (make-instance 'object :type type :value value))

(defun objectp (object)
  (typep object 'object))

(defun object-symbol-p (object)
  (and (objectp object) (eq (object-type object) :symbol)))

(deftype object-symbol ()
  `(satisfies object-symbol-p))

(defmethod print-object ((object object) stream)
  (format stream "#<OBJECT :TYPE ~A :VALUE ~A>"
          (object-type object) (object-value object)))

(defclass chain ()
  ((links :reader chain-links
          :initarg :links
          :type list
          :documentation "")))

(defun make-chain (links)
  (make-instance 'chain :links links))

(defun chainp (object)
  (typep object 'chain))

(defmethod print-object ((object chain) stream)
  (format stream "#<CHAIN :LINKS ~A>" (chain-links object)))