diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | README.md | 98 | ||||
| -rw-r--r-- | chains.asd | 19 | ||||
| -rw-r--r-- | src/core.lisp | 76 | ||||
| -rw-r--r-- | src/eval.lisp | 44 | ||||
| -rw-r--r-- | src/package.lisp | 10 | ||||
| -rw-r--r-- | src/parser.lisp | 144 | ||||
| -rw-r--r-- | src/types.lisp | 85 | ||||
| -rw-r--r-- | t/test1.chn | 14 | ||||
| -rw-r--r-- | t/test2.chn | 19 | ||||
| -rw-r--r-- | t/test3.chn | 3 |
11 files changed, 514 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e5aa101 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +sandbox.lisp +archive/* diff --git a/README.md b/README.md new file mode 100644 index 0000000..0f030a8 --- /dev/null +++ b/README.md @@ -0,0 +1,98 @@ +# About chains + +Chains is a Lisp inspired programming language designed to serve as a +preprocessor replacement. Just as Lisp stands for List Processing, Chains is in +a sense Tree Processing. It was originaly designed with the generation of HTML +in mind, but it does not restrict itself to this task. + +The result of evaluating a program is a tree, which may then be used to generate +other markup languages. However, chains is not a macro language like the +C preprocessor or m4. + +One of the issues of generating markup text from within a conventional +programming language is how cumbersome this is. Due to the syntax rules of the +language, the markup must be in a way escaped e.g. by writing a string between +quotes. Meanwhile unquoted items are syntactic elements of the language. This +way writing code is "easy" while writing markup is "cumbersome". + +In Chains, text is a first class citizen and all other syntactic elements have +to be escaped. Because of this, you probably won't want to write Chains code +directly but instead define it inside of the interpreter. On the other hand, +writing markup is as easy as writing markdown or TeX. + +The language also has a built-in notion of paragraph + +At the moment, chains is more a proof of concept rather than a complete +language. Many features are still undecided. + +# Syntax + +| Character | Description | +|-----------|-------------------------------------------------------------------------| +| % | | +| \\ | | +| { } | | +| \[ \] | | +| # | Raw function. All special characters in the arguments are taken literal | +| @ | | +| $ | | + +## Primitives +Chains is built on 3 type of objects: text, chains and atoms. + +## Evaluation rules + +Unless a chain is escaped, the following rules apply. The chain to be evaluated +may only have a single object inside the first link. The function is value of +evaluating this first element. + +Text evaluates to itself. + +Atoms consists of symbols or numbers. Symbols evaluate to the bound value in the +environment. Numbers evaluate to themselves. + +# How to contribute + +If you would like to contibute to the development of chains please send a mail +with your patch to the following address: thomas _at_ thomaslabs _dot_ org + +# Misc + +;; next-token : cache raw block for further reads. avoid creating list (1 pass) +;; build link directly instead of returning block start tokens + +;; read link +;; {} link := list of objects +;; { }{ }{ } chain := list of links +;; + +;; special form : does not get its arguments pre-evaluated + +;; after eval, unevaluated links are spliced into tree +;; {@if}{{@=}{2}{2}}{1}{2} -> {1} ;; needs to return link, in case text is also inside +;; @if{@={@2}{@2}}{1}{2} ;; alias syntax + + +;; use chains as library for static website generator, define-syntax and define +;; to define "callbacks" from library and read/eval file + +;; tree from file may be discarded ;; writing libraries + +;; a chain is evaluated by first evaluating the first link and applying the +;; other links as arguments for the function + +;; a link with one element is evaluated to that element + +;; inside the evaluation of a lambda, the argument is spliced into the link of +;; the body + +;; {{@lambda}{@x @y}{@x}}{Hello}{World} -> {{Hello}} -> {Hello} -> Hello + +;; Metaprogramming is hard :( + +;; make closure return links instead of plain lists? dont use flatten? + +;; type 1 - {{@lambda}{{@x}{@y}}{@x}}{Hello}{World} +;; type 2 - {{@lambda}{@x @y}{@x}}{Hello}{World} + +;; semantically. What exactly is a chain? diff --git a/chains.asd b/chains.asd new file mode 100644 index 0000000..82df35a --- /dev/null +++ b/chains.asd @@ -0,0 +1,19 @@ +;;;; chains.asd + +(asdf:defsystem #:chains + :description "" + :author ("") + :license "" + :version "0.0.1" + :serial t + :depends-on (:split-sequence + :cl-ppcre + :alexandria + :trivia + :spinneret) + :pathname "src" + :components ((:file "package") + (:file "types") + (:file "parser") + (:file "eval") + (:file "core"))) diff --git a/src/core.lisp b/src/core.lisp new file mode 100644 index 0000000..6c151ce --- /dev/null +++ b/src/core.lisp @@ -0,0 +1,76 @@ +(in-package #:chains) + +(defun get-var (env key) + (if-let ((slot (assoc key env))) + (cdr slot) + (error "var ~A not found~% ~A~%" key env))) + +;; Built-in functions and variables used inside the interpreter use their own +;; package. This allows the language to have keywords like lambda which +;; otherwise would be reserved words from the cl package + +(defmacro define-function (name (&rest args) &body body) + (let ((siblings (gensym))) + `(make-closure #'(lambda (environment ,siblings ,@args) + (declare (ignore ,siblings)) + ,@body) + ',args + nil + (complement #'identity)))) + +(defmacro define-function* (name (&rest args) (siblings group-predicate) + &body body) + `(make-closure #'(lambda (environment ,siblings ,@args) + ,@body) + ',args + nil + ,group-predicate)) + +(defmacro define-syntax (name (&rest args) &body body) + `(make-closure #'(lambda (environment siblings ,@args) + ,@body) + ',args + t + (complement #'identity))) + +(defmacro define-syntax* (name (&rest args) (siblings group-predicate) + &body body) + `(make-closure #'(lambda (environment ,siblings ,@args) + ,@body) + ',args + t + ,group-predicate)) + +(defparameter *lambda* + (define-syntax lambda (arglist body) + (setf arglist (remove-if #'whitespace-text-p arglist)) + (assert (every #'object-symbolp arglist)) + (setf arglist (mapcar #'cdr arglist)) + (let ((env environment)) + (make-closure #'(lambda (environment siblings &rest args) + (tree-eval (append (pairlis arglist args) + env + environment) + body)) + arglist nil (complement #'identity) env)))) + +(defparameter *syntax* + (define-syntax syntax (arglist body) + (setf arglist (remove-if #'whitespace-text-p arglist)) + (assert (every #'object-symbolp arglist)) + (setf arglist (mapcar #'cdr arglist)) + (let ((env environment)) + (make-closure #'(lambda (environment siblings &rest args) + (tree-eval (append (pairlis arglist args) + env + environment) + body)) + arglist t (complement #'identity) env)))) + +(defparameter *define* + (define-syntax* define (name value) (siblings #'identity) + (assert (object-symbolp (first name))) + (setf name (cdr (first name))) + (setf value (first (tree-eval environment value))) + (tree-eval (acons name value environment) + siblings))) diff --git a/src/eval.lisp b/src/eval.lisp new file mode 100644 index 0000000..4962ade --- /dev/null +++ b/src/eval.lisp @@ -0,0 +1,44 @@ +(in-package #:chains) + +(defun chainp (object) + (and (consp object) (eq (first object) 'chain))) + +(defun chain-links (chain) + (rest chain)) + +(defun object-symbolp (object) + (and (consp object) (eq (first object) 'symbol))) + +(defun tree-eval (environment node) + (cond ((null node) + nil) + ((object-symbolp node) + (get-var environment (cdr node))) + ((not (consp node)) + node) + ((chainp (first node)) + (destructuring-bind (flink &rest rlinks) (chain-links (first node)) + (setf flink (tree-eval environment flink)) + (assert (and (consp flink) + (closurep (first flink)) + (null (rest flink))) + (flink) + "~A ~A" flink (content (second flink))) + (let* ((closure (first flink)) + (function (closure-function closure)) + (group-predicate (closure-group-p closure))) + (multiple-value-bind (siblings rest) + (group-if group-predicate (rest node)) + (append + ;; Evaluating a function returns a sublink, flatten all sublink + (flatten + (let ((eval-with-environment (curry #'tree-eval environment))) + (if (closure-special-p closure) + (ensure-list (apply function environment siblings rlinks)) + (let ((args (mapcar eval-with-environment rlinks)) + (siblings (funcall eval-with-environment siblings))) + (ensure-list (apply function environment siblings args)))))) + (tree-eval environment rest)))))) + (t + (cons (tree-eval environment (first node)) + (tree-eval environment (rest node)))))) diff --git a/src/package.lisp b/src/package.lisp new file mode 100644 index 0000000..962ce17 --- /dev/null +++ b/src/package.lisp @@ -0,0 +1,10 @@ +(defpackage #:chains + (:use #:cl + #:split-sequence + #:alexandria + #:trivia) + (:export)) + +(in-package #:chains) + +(defvar *interpreter-package* (make-package 'interpreter)) diff --git a/src/parser.lisp b/src/parser.lisp new file mode 100644 index 0000000..60e7ac4 --- /dev/null +++ b/src/parser.lisp @@ -0,0 +1,144 @@ +(in-package #:chains) + +(defconstant +special-characters+ + '(#\\ #\% #\# #\@ #\$ #\{ #\} #\[ #\] #\Newline) + "") + +(defconstant +whitespace+ '(#\Tab #\Newline #\Return #\Space) + "") + +;; TODO: (read-char stream nil) +(defun read-if (predicate stream) + "Read characters from STREAM into a string as long as PREDICATE is true" + (let ((string (with-output-to-string (value) + (loop :for c = (read-char stream nil) + :while (and c (funcall predicate c)) + :do (write-char c value) + :finally + (when c (unread-char c stream)))))) + (if (emptyp string) nil string))) + +(defun read-if-not (predicate stream) + "Read characters from STREAM into a string as long as PREDICATE is false" + (read-if (complement predicate) stream)) + +(defun read-text (stream start-of-line) + "Read text from STREAM" + (let* ((text (read-if-not #'special-char-p stream)) + (peek (peek-char nil stream nil))) + (when text (setf start-of-line nil)) + (cond ((and (null text) (null peek)) + nil) + ((and (not start-of-line) (newlinep peek)) + (read-char stream nil) + (let ((rest (read-text stream t))) + (when (eq rest 'empty-line) + (setf rest nil) + (unread-char #\Newline stream)) + (list* text (string #\Newline) rest))) + ((newlinep peek) + (read-char stream nil) + 'empty-line) + (t + (ensure-list text))))) + +(defun atom-char-p (char) + (or (alphanumericp char) (eql char #\-))) + +(defun next-token (stream start-of-line &aux c) + "Read the next token inside STREAM" + (case (setf c (read-char stream nil)) + ('nil nil) + (#\\ + (concat-text (make-text (string (read-char stream nil))) + (make-text (read-if-not #'special-char-p stream)))) + (#\% + (peek-char #\Newline stream) + (read-char stream nil) + ;;(next-token stream nil) + 'separator) + ((#\@ #\$) + (let* ((text (read-if #'atom-char-p stream)) + (value (read-from-string text)) + (type (cond ((symbolp value) 'symbol) + ((integerp value) 'integer) + (t (error "Unknown type of object @~A~%" text))))) + ;; (unless (or (symbolp value) (integerp value)) + ;; (error "Unknown type of object @~A~%" text)) + (cons type value))) + (#\# + (case (read-char stream nil) + (#\@ (cons 'raw-function (read-if #'alphanumericp stream))) + (#\$ (cons 'inline-raw-function (read-if #'alphanumericp stream))))) + (#\{ 'link-start) + (#\} 'link-end) + (#\[ 'raw-link-start) + (#\] 'raw-link-end) + (t + (unread-char c stream) + (let ((text (read-text stream start-of-line))) + (cond ((null text) nil) + ((symbolp text) text) + (t (make-text (apply #'concatenate 'string text)))))))) + +(defun build-tree (tokens) + "Groups a list of tokens into a tree. Returns a subtree and a list of unused +tokens." + (flet ((build-chain (tokens) + (loop :with tokens = tokens + :for (link rest) = (multiple-value-list (build-tree tokens)) + :collect link :into links + :while (member (first rest) '(raw-link-start link-start)) + :do (setf tokens (rest rest)) + :finally + (setf tokens rest) + (return (values links tokens))))) + (destructuring-bind (&optional head &rest tail) tokens + (cond ((null head) + (values nil '())) + ((or (eq head 'link-end) (eq head 'raw-link-end)) + (values '() (rest tokens))) + ((eq head 'separator) + (multiple-value-bind (tree rest) (build-tree tail) + (values tree rest))) + ((eq head 'link-start) + (multiple-value-bind (links rest) (build-chain tail) + (multiple-value-bind (tree rest) (build-tree rest) + (values (cons (cons 'chain links) tree) rest)))) + (t + (multiple-value-bind (tree rest) (build-tree tail) + (values (cons head tree) rest))))))) + +(defun read-raw-link (stream) + "Read argument of a raw function" + (flet ((squarep (x) (member x '(#\])))) + ;; Text omits closing ], may therefore be nil, for example when reading ]] + (loop :for text = (read-if-not #'squarep stream) + :for c = (peek-char nil stream nil) + :when text :collect text :into text-list + :while (and c text (eql (last-elt text) #\\)) + :collect (string (read-char stream nil)) :into text-list + :finally + ;; Keep ] inside stream + (return (list (make-text (apply #'concat text-list))))))) + +(defun start-of-line-p (last-token) + ;; Keep track if new line starts a paragraph + (or (eq last-token 'empty-line) + (and (textp last-token) + (newlinep (last-elt (content last-token)))))) + +(defun read-tree (stream) + "Build a syntax tree from the contents of STREAM" + (loop :with start-of-line = t + :for token = (next-token stream start-of-line) + :while token + :if (eq token 'raw-link-start) + :append (cons 'raw-link-start (read-raw-link stream)) :into tokens + :and :do + (setf start-of-line nil) + :else + :collect token :into tokens :and :do + (setf start-of-line (start-of-line-p token)) + :finally ;; (build-tree) + (return tokens))) diff --git a/src/types.lisp b/src/types.lisp new file mode 100644 index 0000000..09ede2b --- /dev/null +++ b/src/types.lisp @@ -0,0 +1,85 @@ +(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 ""))) + +(defclass closure () + ((function :reader closure-function + :initarg :function + :type function + :documentation "") + (arg-list :reader closure-arg-list + :initarg :arg-list + :type list + :documentation "") + (environment :reader closure-environment + :initarg :environment + :type list + :documentation "") + (specialp :reader closure-special-p + :initarg :specialp + :type boolean + :documentation "") + (groupp :reader closure-group-p + :initarg :groupp + :type function + :documentation ""))) + +(defun make-closure (function arg-list specialp groupp &optional environment) + (make-instance 'closure :function function :arg-list arg-list + :specialp specialp :groupp groupp + :environment environment)) + +(defun closurep (object) + (typep object 'closure)) + +(defun group (item sequence &key (test #'eql)) + (group-if #'(lambda (x) (funcall test item x)) sequence)) + +(defun group-if (predicate sequence) + (loop :for (head . tail) :on sequence + :while (funcall predicate head) + :collect head :into group + :finally + (return (values group (if (not (funcall predicate head)) + (cons head tail) + tail))))) + +(defun group-if-not (predicate sequence) + (group-if (complement predicate) sequence)) + +(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)) diff --git a/t/test1.chn b/t/test1.chn new file mode 100644 index 0000000..f55fb70 --- /dev/null +++ b/t/test1.chn @@ -0,0 +1,14 @@ +{@define}{@author}{Thomas Albers Raviola}% +{@define}{@today}{May 12, 2024}% +{@define}{@printdate}{{@lambda}{@date}{the date is @date}}% +{@section}{Introduction} + +Hello, this is a sample of a program written in chains + +Chains was created by @author to help him write articles of questionable +usefulness. + +{@printdate}{@today} +{@section}[Conclusion] + +idk man, guess it works, don't it? diff --git a/t/test2.chn b/t/test2.chn new file mode 100644 index 0000000..a637b61 --- /dev/null +++ b/t/test2.chn @@ -0,0 +1,19 @@ +{@define}{@html-element}{{@lambda}{@name}{{@lambda}{@attr @content}{<@name @attr> +@content +</@name>}}}% +% +% +{@define}{@html-html}{{@html-element}{html}}% +{@define}{@html-head}{{@html-element}{head}}% +{@define}{@html-body}{{@html-element}{body}}% +{@define}{@html-title}{{@html-element}{title}}% +{@define}{@html-h1}{{@html-element}{h1}}% +{@define}{@html-p}{{@html-element}{p}}% +% +% +{@html-html}{}{% +{@html-head}{}{{@html-title}{}{Website}}% + +{@html-body}{}{ +{@html-h1}{}{Chains test} +{@html-p}{}{Hello World!}}} diff --git a/t/test3.chn b/t/test3.chn new file mode 100644 index 0000000..d989187 --- /dev/null +++ b/t/test3.chn @@ -0,0 +1,3 @@ +{@define}{@define-function}{{@syntax}{@name @args @body}{{@define}{@name}{{@lambda}{@args}{@body}}}}% +{@define-function}{@foo}{@a}{hola @a}% +%{@foo}{mundo} |