Completed Lisp To Tex

lisp-to-tex.org

@@ -19,15 +19,22 @@ Foo
 #+TOC: headlines 3
 #+TOC: listings
 
-* Matching And Generating
+* WORKING Matching And Generating [0/4]
+:PROPERTIES:
+:CREATED:  <2016-04-30 Sat 16:19>
+:END:
 
-** Match Test
+** TODO Match Test
+:PROPERTIES:
+:ID:       9d165cb9-95f2-4006-a8a1-73a0750b2000
+:CREATED:  <2016-04-30 Sat 16:19>
+:END:
 
 #+Caption: Generate Match Test
 #+Name: gen-match-test
 #+BEGIN_SRC lisp
   (defun generate-match-expression (op arity &optional (type '=))
-    (declare (symbol on type)
+    (declare (symbol op type)
              (integer arity))
     (ecase type
       (=
@@ -41,45 +48,250 @@ Foo
            (>= arg-count ,arity)))))
 #+END_SRC
 
-** Define Rule
+** TODO Define Rule
+:PROPERTIES:
+:ID:       d4f77ac3-a059-4fb6-b936-1b9e972646ee
+:CREATED:  <2016-04-30 Sat 16:19>
+:END:
 
 #+Caption: Define Matching Rule
 #+Name: def-match-rule
 #+BEGIN_SRC lisp
-  (defmacro defrule (name (on arity &optional type) (&rest arguments) &body rule))
+  (defmacro defrule (name (on arity &optional type) (&rest arguments) &body rule)
+    (let ((match-expression (generate-match-expression on arity type))
+          (test-name (symbolicate name '-test))
+          (expansion-name (symbolicate name '-expansion)))
+      `(progn
+         (defun ,test-name (function &rest arguments &aux (arg-count (length arguments)))
+           ,match-expression)
+         (defun ,expansion-name (,@arguments)
+           ,@rule)
+         (setf (aget *rules* ',name)
+               (make-rule :name ',name
+                          :test-function #',test-name
+                          :expansion-function #',expansion-name))
+         ',name)))
 #+END_SRC
 
-** Store Rules
+** TODO Store Rules
+:PROPERTIES:
+:ID:       002ea704-4286-429f-9149-0f29fb73c503
+:CREATED:  <2016-04-30 Sat 16:19>
+:END:
 
 #+Caption: Rule Storage
 #+Name: rule-storage
 #+BEGIN_SRC lisp
+  (defstruct (rule (:type list))
+    name test-function expansion-function)
 
+  (defvar *rules* '())
 #+END_SRC
 
-* Rules
+** TODO Retrieve Rule
+:PROPERTIES:
+:CREATED:  <2016-04-30 Sat 15:25>
+:ID:       e3f34100-d0a5-4039-8b9d-115cfcb0804e
+:END:
 
-** Multiplication
+#+Caption: Retrieve Rule
+#+Name: retrieve-rule
+#+BEGIN_SRC lisp
+  (defun get-expansion (expression)
+    (rule-expansion-function (rest
+                              (first
+                               (remove-if-not #'(lambda (nte)
+                                                  (let ((test (rule-test-function (rest nte))))
+                                                    (apply test expression)))
+                                              ,*rules*)))))
+#+END_SRC
+
+* WORKING Rules [0/6]
+:PROPERTIES:
+:CREATED:  <2016-04-30 Sat 16:19>
+:END:
+
+** TODO Multiplication
+:PROPERTIES:
+:CREATED:  <2016-04-30 Sat 16:19>
+:ID:       5417a6bf-f265-418a-984b-6bfd14b79a80
+:END:
+
+#+Caption: Multiplication Rule
+#+Name: multiplication-rule
+#+BEGIN_SRC lisp
+  (defrule multiplication (* 2 >=) (&rest elements)
+    (format nil "{~{{~a}~^ \\cdot ~}}"
+            (map 'list #'convert-to-tex
+                 (map 'list #'ensure-list
+                      elements))))
+#+END_SRC
+
+** TODO Division
+:PROPERTIES:
+:CREATED:  <2016-04-30 Sat 16:19>
+:ID:       056aa99c-f2b9-4ab6-99ba-bfb87e3baed5
+:END:
+
+#+Caption: Division Rule
+#+Name: division-rule
+#+BEGIN_SRC lisp
+  (defrule division (/ 2 =) (a b)
+    (format nil "{\\frac{~a}{~a}}"
+            (convert-to-tex (ensure-list a))
+            (convert-to-tex (ensure-list b))))
+#+END_SRC
+
+** TODO Addition
+:PROPERTIES:
+:ID:       68f3dac3-9f0a-4fee-8da6-a39f4491f3ce
+:CREATED:  <2016-04-30 Sat 16:19>
+:END:
+
+#+Caption: Rule for addition
+#+Name: addition-rule
+#+BEGIN_SRC lisp
+  (defrule addition (+ 2 >=) (&rest elements)
+           (format nil "{~{{~a}~^ + ~}}"
+                   (map 'list #'convert-to-tex
+                        (map 'list #'ensure-list
+                             elements))))
+#+END_SRC
+
+** TODO Subtraction
+:PROPERTIES:
+:ID:       9a908130-af5e-4c87-bb07-13bd66c35fcf
+:CREATED:  <2016-04-30 Sat 16:19>
+:END:
+
+#+Caption: Subtraction Rule
+#+Name: subtraction-rule
+#+BEGIN_SRC lisp
+  (defrule subtraction (- 2 >=) (&rest elements)
+    (format nil "{~{{~a}~^ - ~}}"
+            (map 'list #'convert-to-tex
+                 (map 'list #'ensure-list
+                      elements))))
+#+END_SRC
+
+** TODO Exponentials and Logarithmics
+:PROPERTIES:
+:CREATED:  <2016-04-30 Sat 16:19>
+:ID:       269dc47f-5062-4081-a08e-d50188af6a57
+:END:
+
+#+Caption: Exponentials and Logarithms
+#+Name: exponentials-and-logarithms
+#+BEGIN_SRC lisp
+  (defrule exp (exp 1 =) (expression)
+    (format nil "{e^{~a}}"
+            (convert-to-tex (ensure-list expression))))
+
+  (defrule expt (expt 2 =) (base exponent)
+    (format nil "{~a ^ {~a}}"
+            (convert-to-tex (ensure-list base))
+            (convert-to-tex (ensure-list exponent))))
 
-** Division
+  (defrule natlog (log 1 =) (expression)
+    (format nil "{\\ln {~a}}"
+            (convert-to-tex (ensure-list expression))))
 
-** Addition
+  (defrule logarithm (log 2 =) (expression base)
+    (format nil "{\\log_{~a}~a}"
+            (convert-to-tex (ensure-list base))
+            (convert-to-tex (ensure-list expression))))
+#+END_SRC
+
+** TODO Trigonometrics
+:PROPERTIES:
+:CREATED:  <2016-04-30 Sat 16:19>
+:END:
+
+#+Caption: Trigonometric Functions
+#+Name: trigonometrics
+#+BEGIN_SRC lisp
+  (defrule sin (sin 1 =) (arg)
+    (format nil "{\\sin {~a}}"
+            (convert-to-tex (ensure-list arg))))
+
+  (defrule cos (cos 1 =) (arg)
+    (format nil "{\\cos {~a}}"
+            (convert-to-tex (ensure-list arg))))
+
+  (defrule tan (tan 1 =) (arg)
+    (format nil "{\\tan {~a}}"
+            (convert-to-tex (ensure-list arg))))
 
-** Subtraction
+  (defrule csc (csc 1 =) (arg)
+    (format nil "{\\csc {~a}}"
+            (convert-to-tex (ensure-list arg))))
 
-** Exponentials and Logarithmics
+  (defrule sec (sec 1 =) (arg)
+    (format nil "{\\sec {~a}}"
+            (convert-to-tex (ensure-list arg))))
 
-** Trigonometrics
+  (defrule cot (cot 1 =) (arg)
+    (format nil "{\\cot {~a}}"
+            (convert-to-tex (ensure-list arg))))
+#+END_SRC
 
-* Conversion Driver
+* TODO Conversion Driver
+:PROPERTIES:
+:ID:       b395bdb7-7b98-49a1-b6d6-4256fb40d4fa
+:CREATED:  <2016-04-30 Sat 16:19>
+:END:
 
 #+Caption: Conversion Driver
 #+Name: conversion-driver
 #+BEGIN_SRC lisp
+  (defvar *tex-outputp* nil)
+  (declaim (special *tex-outputp*))
+
+  (defmacro with-tex-output (&body body)
+    `(if *tex-outputp*
+         (progn
+           ,@body)
+         (let ((*tex-outputp* t))
+           (format nil "$~a$"
+                   (progn
+                     ,@body)))))
+
+  (defun convert-to-tex (function)
+    (check-type function cons)
+    (let ((op (first function)))
+      (with-tex-output
+        (cond
+          ((numberp op)
+           (format nil "~a" op))
+          ((and (symbolp op)
+              (= 1 (length function)))
+           (string-downcase op))
+          (t
+           (let ((expansion-function (get-expansion function)))
+             (if (functionp expansion-function)
+                 (apply expansion-function (rest function))
+                 (error "Undefined expansion for operation: ~a." op))))))))
+#+END_SRC
+
+* TODO Miscellaneous Functions
+:PROPERTIES:
+:CREATED:  <2016-04-30 Sat 16:09>
+:END:
 
+#+Caption: Misc Functions
+#+Name: misc-functions
+#+BEGIN_SRC lisp
+  (defun ensure-list (list)
+    (if (listp list)
+        list
+        (list list)))
 #+END_SRC
 
-* Putting it Together
+* TODO Putting it Together
+:PROPERTIES:
+:ID:       fdef3016-cb12-43ad-ba5f-14dd6ccd973c
+:CREATED:  <2016-04-30 Sat 16:25>
+:END:
 
 #+Caption: Packaging
 #+Name: packaging
@@ -89,14 +301,39 @@ Foo
   ;;;; Copyright (c) 2015 Samuel W. Flint <swflint@flintfam.org>
 
   (defpackage #:to-tex
-    (:use #:cl)
-    (:export #:convert))
+    (:use #:cl
+          #:com.informatimago.common-lisp.cesarum.list)
+    (:import-from #:alexandria
+                  #:symbolicate)
+    (:export #:convert-to-tex))
 
   (in-package #:to-tex)
 
   ;;; "to-tex" goes here.
 
+  <<misc-function>>
+
+  <<rule-storage>>
+
+  <<gen-match-test>>
+
+  <<def-match-rule>>
+
+  <<retrieve-rule>>
+
   <<conversion-driver>>
 
+  <<addition-rule>>
+
+  <<subtraction-rule>>
+
+  <<multiplication-rule>>
+
+  <<division-rule>>
+
+  <<exponentials-and-logarithms>>
+
+  <<trigonometrics>>
+
   ;;; End to-tex
 #+END_SRC