chiark - git - mdw - runlisp/blob - eval.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; Evaluate expressions and run scripts
   4 ;;;
   5 ;;; (c) 2020 Mark Wooding
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This file is part of Runlisp, a tool for invoking Common Lisp scripts.
  11 ;;;
  12 ;;; Runlisp is free software: you can redistribute it and/or modify it
  13 ;;; under the terms of the GNU General Public License as published by the
  14 ;;; Free Software Foundation; either version 3 of the License, or (at your
  15 ;;; option) any later version.
  16 ;;;
  17 ;;; Runlisp is distributed in the hope that it will be useful, but WITHOUT
  18 ;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  19 ;;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  20 ;;; for more details.
  21 ;;;
  22 ;;; You should have received a copy of the GNU General Public License
  23 ;;; along with Runlisp.  If not, see <https://www.gnu.org/licenses/>.
  24
  25 (cl:defpackage #:runlisp
  26   (:use #:common-lisp))
  27 (cl:in-package #:runlisp)
  28
  29 (setf *features* (remove :runlisp-script *features*))
  30
  31 (let ((*package* (find-package "COMMON-LISP-USER")))
  32   (let ((token (cons 'token nil))
  33         (args uiop:*command-line-arguments*)
  34         (list nil))
  35     (flet ((foreach-form (func arg)
  36              (with-input-from-string (in arg)
  37                (loop (let ((form (read in nil token)))
  38                        (when (eq form token) (return))
  39                        (funcall func form)))))
  40            (print-form (form)
  41              (format t "~@[~{~S~^ ~}~%~]"
  42                      (multiple-value-list (eval form)))))
  43       (loop (let ((arg (pop args)))
  44               (when (or (null arg) (string= arg "--")) (return))
  45               (when (zerop (length arg))
  46                 (error "empty argument (no indicator)"))
  47               (let ((rest (subseq arg 1)))
  48                 (ecase (char arg 0)
  49                   (#\! (push (lambda ()
  50                                (foreach-form #'eval rest))
  51                              list))
  52                   (#\? (push (lambda ()
  53                                (foreach-form #'print-form rest))
  54                              list))
  55                   (#\< (push (lambda ()
  56                                (load rest))
  57                              list)))))))
  58     (let ((uiop:*command-line-arguments* args))
  59       (mapc #'funcall (nreverse list)))))