From: Alex Klinkhamer Date: Mon, 18 Aug 2008 15:43:59 +0000 (-0400) Subject: +Shell, +A LOT X-Git-Url: https://repo.or.cz/w/lineal.git/commitdiff_plain/b4c4cb5517fc0a10b349d0dffdcc1048927dd1be +Shell, +A LOT +Run script, config files are now hidden a bit. +Now CLISP, CMUCL, and ECL work. +Better matrix and vector creation with [] and () -Uneeded methods for catching lists like tuples. -Compilation, it's only done for SBCL. --- diff --git a/INSTALL b/INSTALL index 8232797..62a156f 100644 --- a/INSTALL +++ b/INSTALL @@ -1,4 +1,21 @@ +------ Shell Lineal ---------------------------------------------------- + +> ./run.sh -l sbcl -m shell + +This is the default, so you can instead do: +> ./run.sh + +If you don't fancy the run script, boot up a lisp and +> (load "src/shell/devvars") + +Type 'exit' or 'quit' to get out of Lineal's REPL + +CLISP, CMUCL, ECL and SBCL are known to work with the shell version. + + + THE REST OF THIS FILE IS SPECIFIC TO THE WEB INTERFACE + ------ Required Libraries ---------------------------------------------- Hunchentoot - http://www.cliki.net/hunchentoot @@ -11,26 +28,19 @@ SBCL, others *should* work though. ------ Steps to Run ---------------------------------------------------- -1. Boot up a lisp in the toplevel directory. -(where the INSTALL file is) +Use the invocation script +> ./run.sh -l sbcl -m webui + +or boot up a lisp and +> (load "src/webui/devvars.lisp") -2. (load "run") -You can also do - (load "/src/webui/serv") -Of course this means that custom options -set in "run.lisp" will not take effect. If all the libraries are installed correctly, this should signal no errors or warnings. If something goes wrong here, let me know. - -Or do steps 1 and 2 via command line options such as: - sbcl --load run.lisp - clisp -i run.lisp - - -3. Go to localhost:41938 in a web browser. +For the web interface, +Go to localhost:41938 in a web browser. Port 41938 was chosen to stand for 'AlgEB'ra There are surely lots of bugs and security issues @@ -48,7 +58,7 @@ Common sense. The save/restore feature is no longer more hazardous than the regular calculator, but the option to disable it still exists. You can do this by uncommenting the line -where 'no-save-restore is set in "run.lisp". +where 'no-save-restore is set in "src/webui/config.lisp". ----------------------------------------------------------------------- vim:ft=:expandtab:tw=72: diff --git a/README b/README index 8911b20..4756eaf 100644 --- a/README +++ b/README @@ -1,10 +1,10 @@ -This is Lineal v0.1.6 +This is Lineal v0.1.7 Important files: INSTALL for details on running Lineal... not really installing it. HACKING for info on contributing to the project. -COPYING for license information. +COPYING for license information. (MIT-style) doc/index.txt for plain text documentation. http_root/doc/index.html for the (partially) html documentation. diff --git a/run.lisp b/run.lisp deleted file mode 100644 index a26c78b..0000000 --- a/run.lisp +++ /dev/null @@ -1,73 +0,0 @@ -#| - | To run me, boot up your lisp and type - (load "run") - | If any unmet dependencies crop up, - | see the INSTALL file for the packages - | used directly. They have their own dependencies. - | - | Set your options in here, - | see the CONFIG OPTIONS section. - |# - -(defpackage :lineal.devvars (:use :cl)) -(in-package :lineal.devvars) -;^ Don't pollute the standard namespace.^ - - -;VVV CONFIG OPTIONS VVV -; -; To uncomment an option, change #+(or) to #-(or) -; All pathnames are relative to this file's directory. -; -; Lineal will output confirmation of all options -; set here near the end of it's load-time output. -; -; If any of these options is true/false, the actual -; value of the option is not checked, only if it's bound. -; ie: if the option is explicitly set to nil, -; (set 'option nil) -; it is still treated as true. -; Use (makunbound 'option) to falsify. - -; Set Hunchentoot's temporary directory to -; a folder named "tmp" in Lineal's toplevel -; directory. -#+(or) -(set 'tmp-directory - (make-pathname :directory '(:relative "tmp"))) - -; Make the log file's name "requests.log" -; and have it appear in Lineal's toplevel -; directory. -#+(or) -(set 'log-file - (make-pathname :name "requests.log")) - -; Log calculator input and replies. -#+(or) (set 'log-calcs t) - -; Enable the reload page for easy changes. -#+(or) (set 'reload-page t) - -; Disable save/restore. -#+(or) (set 'no-save-restore t) - -; On boot, restore the session specified in the file. -#+(or) (set 'restore-from-file - (make-pathname :name "captured_session")) -; To use this effectively, call -; (local-capture) -; before quitting to save the file - -; Set Hunchentoot listens to listen on port 8080 -; instead of the default 41938 -#+(or) (set 'port 8080) - -;^^^ CONFIG OPTIONS ^^^ - - -;V Load the program.V -(load (make-pathname :directory '(:relative "src" "webui") - :name "serv" :type "lisp")) - - diff --git a/run.sh b/run.sh new file mode 100755 index 0000000..e5c8c58 --- /dev/null +++ b/run.sh @@ -0,0 +1,49 @@ +#!/bin/bash + +# Default Values +LNAME="sbcl" # Lisp name +MODE="shell" # Mode in which to run Lineal + +LISP_NAMES=( "clisp" "cmucl" "ecl" "sbcl" ) + +usage() +{ + cat << EOF + usage: ./run.sh [options] + + OPTIONS: + -h Show this message + -l Lisp name (${LISP_NAMES[@]}) + -m Mode (shell, webui) + + (edit script to change default values) +EOF +} + +while getopts "hl:m:" OPTION +do + case $OPTION in + h) usage + exit 0 ;; + l) LNAME="$OPTARG" ;; + m) MODE="$OPTARG" ;; + ?) usage + exit ;; + esac +done + +LFILE="src/${MODE}/devvars.lisp" + +case "$LNAME" in + 'clisp') clisp --quiet -i $LFILE ;; + 'cmucl') cmucl -quiet -load $LFILE ;; + 'ecl') ecl -load $LFILE ;; + 'sbcl') sbcl --noinform --load $LFILE ;; + *) + echo "$LNAME is not one of: ${LISP_NAMES[@]}" + exit 1 + ;; +esac + +exit + diff --git a/src/config.lisp b/src/config.lisp new file mode 100644 index 0000000..e1ce557 --- /dev/null +++ b/src/config.lisp @@ -0,0 +1,22 @@ + +; To uncomment an option, change #+(or) to #-(or) +; All pathnames are relative to this file's directory. +; +; Lineal will output confirmation of all options +; set here near the end of it's load-time output. +; +; If any of these options is true/false, the actual +; value of the option is not checked, only if it's bound. +; ie: if the option is explicitly set to nil, +; (set 'option nil) +; it is still treated as true. +; Use (makunbound 'option) to falsify. + + +; On boot, restore the session specified in the file. +#+(or) (set 'restore-from-file + (make-pathname :name "captured_session")) +; To use this effectively, call +; (local-capture) +; before quitting to save the file + diff --git a/src/devvars.lisp b/src/devvars.lisp index 019cc2c..3d808f7 100644 --- a/src/devvars.lisp +++ b/src/devvars.lisp @@ -2,6 +2,10 @@ ;;; Just in case. (setq *read-default-float-format* 'double-float) +;;; Just make the package exist here, +;;; define its guts later in globals.lisp +(defpackage :lineal) + (defpackage :lineal.devvars (:use :cl) (:export *file-tree* compile-if-new compile-lineal)) @@ -36,6 +40,10 @@ (fasl-file (make-pathname :directory fasl-dir :name name :type "fasl"))) + #-sbcl (load src-file) + ;; todo: this should be handled better, + ;; even if loading is superfast. + #+sbcl (if (and (not compile-all) (probe-file fasl-file) (< (file-write-date src-file) @@ -65,7 +73,8 @@ (recurse x)))) (recurse (file-tree) - (ctypecase file-tree + (ctypecase + file-tree (cons ;; We have a new directory to recurse. (let ((tmp-src-tail src-tail) diff --git a/src/infix-parser.lisp b/src/infix-parser.lisp index 9b652aa..ab7f27a 100644 --- a/src/infix-parser.lisp +++ b/src/infix-parser.lisp @@ -234,7 +234,9 @@ +factorial-rank+ *last-read*))) nil) - +;;; Specialized function to gobble whitespace +;;; and return true if the terminating char +;;; is an opening parenthesis. (defun open-paren-after-whitespace-peekp () (declare (special *parse-strm* *parse-next*)) (unless *parse-next* @@ -247,12 +249,15 @@ (unless *parse-next* (char= #\) (peek-char nil *parse-strm*)))) +;;; A function was read, passed as /this-fn/, +;;; its arguments have yet to be parsed. (defun parse-function-scope (this-fn) - (declare (special *unwind-rank-fn* *last-read*)) + (declare (special *unwind-rank-fn* *last-read* *parse-strm*)) (when (open-paren-after-whitespace-peekp) ;; User chose to enclose the ;; argument(s) in parentheses. - (read-next-infix) + (read-char *parse-strm*) + (paren-scope t) (setq *last-read* (if (consp *last-read*) (apply this-fn *last-read*) @@ -327,11 +332,21 @@ 'fn-scope (read-next-infix)))))) -(defun open-paren-reader (strm ch) - (declare (ignore strm ch)) +(defun paren-scope (paramsp) + (declare (special *last-read*)) (multn-if-last-read) (catch 'break-paren-scope (parse-infix)) + (when (and (not paramsp) (consp *last-read*)) + ;; Convert the list into a tuple + ;; since it's not a function's parameters. + (setq *last-read* + (lineal.overload::vcat-list *last-read*)))) + +;;; A parenthesis has been opened! +(defun open-paren-reader (strm ch) + (declare (ignore strm ch)) + (paren-scope nil) nil) ;;; Unwind the operation stack. @@ -344,6 +359,21 @@ (funcall *unwind-rank-fn* +paren-rank+ *last-read*)) +;;; Much like open-paren-reader +;;; but creates a row matrix. +;;; (uses close-paren-reader +;;; for closed brackets) +(defun open-bracket-reader (strm ch) + (declare (ignore strm ch) + (special *last-read*)) + (multn-if-last-read) + (catch 'break-paren-scope + (parse-infix)) + (when (consp *last-read*) + (setq *last-read* + (lineal.overload::cat-list *last-read*))) + nil) + ;;; If *last-read* is nil, an operator ;;; was read last, we can't logically ;;; break from a function in that case. @@ -400,6 +430,8 @@ (setf (readtable-case *readtable*) :preserve) (set-macro-character #\( #'open-paren-reader) (set-macro-character #\) #'close-paren-reader) + (set-macro-character #\[ #'open-bracket-reader) + (set-macro-character #\] #'close-paren-reader) (set-macro-character #\Space #'space-reader) (set-macro-character #\, #'comma-reader) (set-opern-reader #\+ +addn-rank+ #'addn) diff --git a/src/overload/client-fns.lisp b/src/overload/client-fns.lisp index 3acdc76..cb777ab 100644 --- a/src/overload/client-fns.lisp +++ b/src/overload/client-fns.lisp @@ -21,7 +21,7 @@ ("recall" lineal::over-recall) ("ref" over-r-ef) ("rref" over-rr-ef) ("sin" sin) - ("sqrt" sqrt) + ("sqrt" over-sqrt) ("store" lineal::over-store) ("tan" tan) ("tr" over-trace) diff --git a/src/overload/concatenate.lisp b/src/overload/concatenate.lisp index e27b541..21121a7 100644 --- a/src/overload/concatenate.lisp +++ b/src/overload/concatenate.lisp @@ -1,30 +1,14 @@ (defun over-cat (&rest args) (if args - (if (cdr args) - (reduce #'cat2 args :from-end t) - (car args)) + (cat-list args) (throw 'over-ex "Can't cat nothing."))) (defun over-vcat (&rest args) (if args - (if (cdr args) - (reduce #'vcat2 args :from-end t) - (car args)) + (vcat-list args) (throw 'over-ex "Can't vcat nothing."))) -(defmethod cat2 ((u list) v) - (cat2 (tuple-list u) v)) - -(defmethod cat2 (u (v list)) - (cat2 u (tuple-list v))) - -(defmethod vcat2 ((u list) v) - (vcat2 (tuple-list u) v)) - -(defmethod vcat2 (u (v list)) - (vcat2 u (tuple-list v))) - (defmacro cat2-fill (((arow s-arows) (brow s-brows) diff --git a/src/overload/crop.lisp b/src/overload/crop.lisp index f7091b4..d09d118 100644 --- a/src/overload/crop.lisp +++ b/src/overload/crop.lisp @@ -4,11 +4,6 @@ (defmethod over-crop ((u tuple) (n integer)) (declare (ignore n)) u) -(defmethod over-crop ((u list) n) - (declare (ignore n)) u) -(defmethod over-crop (n (u list)) - (declare (ignore n)) u) - (defmethod over-vcrop ((n integer) (u tuple)) (if (= 1 n) (car (tuple-elems u)) @@ -19,9 +14,6 @@ :finally (return (make-tuple :dim dim :elems elems))))) -(defmethod over-vcrop (n (u list)) - (over-vcrop n (tuple-list u))) - (defmethod over-vcrop ((u tuple) (n integer)) (if (= 1 n) @@ -31,9 +23,6 @@ :elems (nthcdr (- (tuple-dim u) dim) (tuple-elems u)))))) -(defmethod over-vcrop ((u list) n) - (over-vcrop (tuple-list u) n)) - (defmethod over-crop ((n integer) (a mtrix)) (if (= n 1) diff --git a/src/overload/format.lisp b/src/overload/format.lisp index 782481d..6d235c8 100644 --- a/src/overload/format.lisp +++ b/src/overload/format.lisp @@ -22,22 +22,23 @@ ((zerop (imagpart n)) (over-format (realpart n) s)) ((zerop (realpart n)) - (over-format (imagpart n) s) + (case (imagpart n) (1) + (-1 (write-char #\- s)) + (t (over-format (imagpart n) s))) (write-char #\i s)) (t (over-format (realpart n) s) - (over-format - (if (plusp (imagpart n)) - (progn (princ " + " s) - (imagpart n)) - (progn (princ " - " s) - (- (imagpart n)))) - s) + (let ((tmp + (if (plusp (imagpart n)) + (progn (princ " + " s) + (imagpart n)) + (progn (princ " - " s) + (- (imagpart n)))))) + (unless (= tmp 1) + (over-format tmp s))) (write-char #\i s)))) (defmethod over-format ((a number) s) (princ a s)) -(defmethod over-format ((a cons) s) - (output-tuple a s)) (defmethod over-format ((a tuple) s) (output-tuple (tuple-elems a) s)) (defmethod over-format ((a mtrix) s) diff --git a/src/overload/overload.lisp b/src/overload/overload.lisp index 46cf928..deff0c2 100644 --- a/src/overload/overload.lisp +++ b/src/overload/overload.lisp @@ -1,8 +1,4 @@ -;V Just make the package exist here, V -;V define its guts later in globals.lisp V -(defpackage :lineal) - (defpackage :lineal.overload (:use :cl) (:export *accep-table* mtrix tuple @@ -46,8 +42,16 @@ (defgeneric over-multv-inverse (a)) ;;; Concatenate Horizontally (defgeneric cat2 (term1 term2)) +(defun cat-list (elems) + (if (cdr elems) + (reduce #'cat2 elems :from-end t) + (car elems))) ;;; Concatenate Vertically (or vector-wise) (defgeneric vcat2 (a b)) +(defun vcat-list (elems) + (if (cdr elems) + (reduce #'vcat2 elems :from-end t) + (car elems))) (defgeneric over-crop (a b)) (defgeneric over-vcrop (a b)) diff --git a/src/overload/tuples.lisp b/src/overload/tuples.lisp index 075198c..6c7e1ed 100644 --- a/src/overload/tuples.lisp +++ b/src/overload/tuples.lisp @@ -72,12 +72,6 @@ :elems (tuple-addn (tuple-elems u) (tuple-elems v))) (throw 'over-ex "don't add vectors of different dimension"))) -(defmethod add2n ((u tuple) (v list)) - (add2n u (tuple-list v))) - -(defmethod add2n ((u list) v) - (add2n (tuple-list u) v)) - ;;; u - v (defmethod subtr2n ((u tuple) (v tuple)) (if (= (tuple-dim u) (tuple-dim v)) @@ -86,11 +80,6 @@ :elems (tuple-subtrn (tuple-elems u) (tuple-elems v))) (throw 'over-ex "don't subtract vectors of different dimension"))) -(defmethod subtr2n ((u tuple) (v list)) - (subtr2n u (tuple-list v))) - -(defmethod subtr2n ((u list) v) - (subtr2n (tuple-list u) v)) ;;; k * u (defmethod mult2n ((k number) (u tuple)) @@ -98,18 +87,12 @@ :elems (scalar-tuple-multn k (tuple-elems u)))) -(defmethod mult2n ((k number) (u list)) - (make-tuple :dim (length u) - :elems (scalar-tuple-multn k u))) (defmethod mult2n ((u tuple) (k number)) (make-tuple :dim (tuple-dim u) :elems (scalar-tuple-multn k (tuple-elems u)))) -(defmethod mult2n ((u list) (k number)) - (make-tuple :dim (length u) - :elems (scalar-tuple-multn k u))) ;;; u / k (defmethod divis2n ((u tuple) (k number)) @@ -117,8 +100,4 @@ :elems (tuple-scalar-divisn (tuple-elems u) k))) -(defmethod divis2n ((u list) (k number)) - (make-tuple :dim (length u) - :elems (tuple-scalar-divisn u k))) - diff --git a/src/save-restore.lisp b/src/save-restore.lisp index d18c796..ffe9951 100644 --- a/src/save-restore.lisp +++ b/src/save-restore.lisp @@ -52,7 +52,7 @@ :if-exists :supersede) (save-to-stream strm))) -;V Restore from a capture file.V +;;; Restore from a capture file. (defun local-restore (&optional (file (make-pathname :name "captured_session"))) diff --git a/src/shell/config.lisp b/src/shell/config.lisp new file mode 100644 index 0000000..1c089b4 --- /dev/null +++ b/src/shell/config.lisp @@ -0,0 +1,6 @@ + +;;;; See ../config.lisp + +;;; Use prefix instead of infix notation. +#+(or)(set 'use-infix-p nil) + diff --git a/src/shell/devvars.lisp b/src/shell/devvars.lisp new file mode 100644 index 0000000..2d75e18 --- /dev/null +++ b/src/shell/devvars.lisp @@ -0,0 +1,32 @@ + +;;; Load main dev vars +(load (make-pathname :directory '(:relative "src") + :name "devvars" :type "lisp")) + +(in-package :lineal.devvars) + +;;; Load user preferences for shell Lineal. +(load (make-pathname :directory '(:relative "src") + :name "config" :type "lisp")) + +(unless (boundp 'use-infix-p) + (set 'use-infix-p t)) + +(setq *file-tree* + (nconc *file-tree* + '(("shell" "main")))) + +(compile-lineal) + +;;; Load up restore file if desired. +(when (boundp 'restore-from-file) + (let ((file (symbol-value 'restore-from-file))) + (unless (pathnamep file) + (setq file (make-pathname :name "captured_session"))) + (format t "Restoring session from: \"~A\"...~%" + (namestring file)) + (princ (lineal::local-restore file)) + (fresh-line))) + +(lineal.shell::shell-repl) + diff --git a/src/shell/main.lisp b/src/shell/main.lisp new file mode 100644 index 0000000..1c75f29 --- /dev/null +++ b/src/shell/main.lisp @@ -0,0 +1,28 @@ + +(defpackage :lineal.shell + (:use :cl :lineal :lineal.overload)) +(in-package :lineal.shell) + +(defun greeting (infixp) + (format t "~&Welcome to Lineal, ") + (format t "using ~:[prefix~;infix~] notation." infixp) + (format t "~%To leave, use exit or quit.") + (format t "~%> ")) + +;;; Main loop for shell. +(defun shell-repl () + (let ((infixp (symbol-value + 'lineal.devvars::use-infix-p))) + (greeting infixp) + (handler-case + (do ((str (read-line) (read-line))) + ((or (string= "quit" str) + (string= "exit" str))) + (over-format + (process-input-from-string + str infixp) + *standard-output*) + (format t "~&> ")) + (end-of-file (condit) + (declare (ignore condit)))))) + diff --git a/src/webui/config.lisp b/src/webui/config.lisp new file mode 100644 index 0000000..fe66f4b --- /dev/null +++ b/src/webui/config.lisp @@ -0,0 +1,31 @@ + +;;;; See ../config.lisp + +; Set Hunchentoot's temporary directory to +; a folder named "tmp" in Lineal's toplevel +; directory. +#+(or) +(set 'tmp-directory + (make-pathname :directory '(:relative "tmp"))) + +; Make the log file's name "requests.log" +; and have it appear in Lineal's toplevel +; directory. +#+(or) +(set 'log-file + (make-pathname :name "requests.log")) + +; Log calculator input and replies. +#+(or) (set 'log-calcs t) + +; Enable the reload page for easy changes. +#+(or) (set 'reload-page t) + +; Disable save/restore. +#+(or) (set 'no-save-restore t) + +; Set Hunchentoot listens to listen on port 8080 +; instead of the default 41938 +#+(or) (set 'port 8080) + + diff --git a/src/webui/devvars.lisp b/src/webui/devvars.lisp index 657388f..8f8c423 100644 --- a/src/webui/devvars.lisp +++ b/src/webui/devvars.lisp @@ -1,4 +1,8 @@ +;;; Load main dev vars +(load (make-pathname :directory '(:relative "src") + :name "devvars" :type "lisp")) + (in-package :lineal.devvars) ;;; Add webui-specific stuff to list of program files. @@ -10,3 +14,11 @@ "matrixui" "calcupage-buttons" "calcupage" "save-restore" "reload")))) +;;; Set any user-defined preferences specific to the web server. +(load (make-pathname :directory '(:relative "src" "webui") + :name "config" :type "lisp")) + +;;; Saddle up and start riding. +(load (make-pathname :directory '(:relative "src" "webui") + :name "serv" :type "lisp")) + diff --git a/src/webui/index.lisp b/src/webui/index.lisp index eb8948f..3c74b49 100644 --- a/src/webui/index.lisp +++ b/src/webui/index.lisp @@ -1,12 +1,12 @@ -;V Insert javascript tags.V +;;; Insert javascript tags. (defmacro js-tag (s . body) `(progn (princ "" ,s))) -;V Easily insert parenscript.V +;;; Easily insert parenscript. (defmacro ps-tag (s . body) `(js-tag ,s (princ (ps ,@body) ,s))) @@ -16,8 +16,8 @@ (princ ,file ,s) (princ ".js\">" ,s))) -;V URL: /recall_vrbl -;V Get a variable out of memory.V +;;; URL: /recall_vrbl +;;; Get a variable out of memory. (defun web-recall-vrbl () (recall-vrbl (parameter "name")) "varible wiped") @@ -29,13 +29,13 @@ " the regular way, or in " (:a :href "/calcupage-prefix" "lisp style") ".")) -;V URL: / -;V The main page.V +;;; URL: / +;;; The main page. (defun front-page () (with-html-output-to-string (s nil :prologue t) (:html - (:head (:title "Welcome to Lineal v0.1.6")) + (:head (:title "Welcome to Lineal v0.1.7")) (:body (:form :name "optionForm" @@ -56,5 +56,5 @@ (with-html-output (s) (:a :href "/reload" "Reload for changes") :br)) :br (:a :href "/COPYING.txt" - "This software is subject to the MIT License"))))))) + "This software is subject to the MIT-style License"))))))) diff --git a/src/webui/serv.lisp b/src/webui/serv.lisp index 74a46e4..50ec28a 100644 --- a/src/webui/serv.lisp +++ b/src/webui/serv.lisp @@ -1,21 +1,7 @@ -; This file should be called from the toplevel directory. -; You can call it like (load "src/webui/serv"), -; use a system link, -; or *default-pathname-defaults* +;;; In the :lineal.webui package. -;V Just in case user loaded this file first.V -(defpackage :lineal.devvars (:use :cl)) -(in-package :lineal.devvars) - -(format t "serv.lisp is loaded...~%") - -(load (make-pathname :directory '(:relative "src") - :name "devvars")) -(load (make-pathname :directory '(:relative "src" "webui") - :name "devvars")) - -(format t "No errors? Relative path is good...~%") +(format t "serv.lisp is loading...~%") (format t "Using ASDF, you better have it loaded already...~%") (use-package :asdf)