kiln/scripts/math.lisp at master · ruricolist/kiln · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
(defpackage :kiln/scripts/math
  (:use :cl :alexandria :serapeum :with-c-syntax
        :named-readtables)
  (:import-from :floating-point-contractions
   :lg :lb :ln :sq :hypot)
  (:local-nicknames
   (:c :with-c-syntax)
   (:cli :clingon)
   (:dec :wu-decimal)
   (:fp :floating-point-contractions))
  (:documentation "Do math with C-style syntax but a Lisp numeric tower")
  (:export :main))
(in-package :kiln/scripts/math)

(def +options+
  (list
   (cli:make-option
    :flag
    :description "Print ratios as ratios"
    :short-name #\R
    :long-name "print-ratios"
    :key :ratiop)))

(def +command+
  (cli:make-command
   :name "kiln-math"
   :options +options+))

(defun main (args)
  (let* ((opts (cli:parse-command-line +command+ args))
         (args (cli:command-arguments opts))
         (string (string-join args ""))
         ;; Print double floats without suffix.
         (*read-default-float-format* 'double-float)
         (*readtable*
           (find-readtable 'c:with-c-syntax-readtable))
         (*package*
           (find-package :kiln/scripts/math))
         (result
           (handler-bind ((warning #'muffle-warning))
             (eval
              (read-from-string
               ;; 2 means to split C operators inside Lisp symbols.
               (string+ "#2{" string "}#"))))))
    (unless (cli:getopt opts :ratiop)
      (dec:enable-decimal-printing-for-ratios))
    (let ((*print-pretty* t)
          (output (format nil "~a~%" result)))
      (eif (typep result 'ratio)
          (eif (search "/" output)
              (eif (cli:getopt opts :ratiop)
                  (write-string output)
                  (progn
                    ;; Coerce to a float.
                    (format *error-output* "≅")
                    (force-output *error-output*)
                    (format t "~a~%" (coerce result 'double-float))))
              (write-string output))
          (write-string output)))))

(defsubst log1p (x) (fp:log1+ x))
(defsubst log1m (x) (fp:log1- x))
(defsubst expm1 (x) (fp:exp-1 x))
(defsubst exptm1 (a z) (fp:expt-1 a z))
(defsubst log10 (x) (lg x))
(defsubst log2 (x) (lb x))