[func2exec]: Turn your lisp function to executable

1. About
- 1.1. Usage
2. Implementation
- 2.1. ASDF
- 2.2. Package
3. Examples of f2e Usage
- 3.1. [Example 1] JSCL Compiler
  - 3.1.1. Help Flag
  - 3.1.2. Here it goes
4. License

1. About

So there's a lot of command line arguments parsing libraries for Common Lisp… But what if I just want to make an executable as fast as I can?

So you may give this project (func2exec) a try:

(func2exec:f2e 'a-function-you-want-to-call)

That should be all you need to save lisp image as a stand alone executable (named as a-function-you-want-to-call by default).

Note: Only support SBCL now.

1.1. Usage

(func2exec:f2e function
               &key executable compression documentation
               parse-hint flag-nicknames
               external depends-on loads)

1.1.1. Basic executable arguments

executable: path to output executable file
compression: non nil for compress the output executable (SBCL)
documentation: documentation string

if not provided, the documentation will be evaluated by func2exec::function-docstring.

1.1.2. Argument parsing rules

parse-hint: an alist for function lambda list type hints

The alist element should be like (var . type):
- var: should be the variable name lambda list
- type: should be one of:
  - :stdin: as the *standard-input* (only one)
```
cat hello | func # (stream . :stdin) ;; => (func *standard-input*)
```
  - :stdin*: read *standard-input* as string (only one)
```
cat hello | length # (sequence . :stdin*) => (length "hello") ;; => 5
```
  - :read: read as lisp expression (literally)
```
length "(1 2 3)" # (sequence . :read) => (length '(1 2 3)) ;; => 3
```
  - :eval: read and evaluate the lisp expression
```
length "(list 1 2 3)" # (sequence . :eval) => (length (list 1 2 3)) ;; => 3
```
  - :plain: just read as string
```
length "(1 2 3)" # (sequence . :plain) => (length "(1 2 3)") ;; => 7
```
  - :flag: if not given, it's value would be nil, otherwise, t (key only)
```
func --flag # (func :flag t)
func        # (func :flag nil)
```
  See func2exec::read-arg for reading type implementation.
  
  See for default parse type hint.
See func2exec:parse-argv.
flag-nicknames: an alist of function flag nicknames

1.1.3. Build using external SBCL process (experimental)

external: non nil means to build executable using external SBCL process (this will not quit current Lisp process)
depends-on: a list of package names that current function depends on
loads: a list of scripts the function should be loaded

When loading the scripts, will switch to the scripts directory. So this will ensure that script will have correct relative path.

2. Implementation

2.1. ASDF

(asdf:defsystem #:func2exec
  :author ("凉凉")
  :version "0.1"
  :description "Turn function to executable. "
  :depends-on (:SB-INTROSPECT)
  :serial t
  :components
  ((:file "func2exec")))

2.2. Package

(defpackage #:func2exec
  (:use :cl)
  (:export
   ;; Configure
   #:*executable*
   #:*dynamic-space-size*
   #:*control-stack-size*
   #:*parse-hint*
   #:*default-parse-hint*
   #:*flag-nicknames*
   #:*help-flags*

   #:f2e
   #:func2exec))

(in-package :func2exec)

2.2.1. Configure

These values are used to configure how to generate the executable:

*executable*: default executable output name (fallback)

(defparameter *executable* "executable"
  "Default `func2exec' executable name fallback. ")

*dynamic-space-size*

(defparameter *dynamic-space-size* nil
  "Runtime option --dynamic-space-size for external SBCL.
Set to be `nil' will use current image runtime option. ")

*control-stack-size*

(defparameter *control-stack-size* nil
  "Runtime option --control-stack-size for external SBCL.
Set to be `nil' will use current image runtime option. ")

*flag-nicknames*: predefined flag nicknames

(defparameter *flag-nicknames* '((:h . :help))
  "Flag nicknames as fallback. ")

*parse-hint*: predefined parse hints

(defparameter *parse-hint* '((:help . :flag))
  "Parse hint fallbacks. ")

*default-parse-hint*: default parse hint option

(defparameter *default-parse-hint* :read
  "Default parse hint type. ")

*help-flags*: a list of help flags

(defparameter *help-flags* '(:help)
  "A list of keys that will be used to print help message.  ")

2.2.2. Utils

These utils function

(function-lambda-list function) → lambda list of function

#+sbcl
(require :sb-introspect)

(defun function-lambda-list (function)
  "Return `function' lambda list. "
  #+sbcl (sb-introspect:function-lambda-list function))

(command-line-arguments) → a list of command line arguments (ARGV)
```
(defun command-line-arguments ()
  #+sbcl (rest sb-ext:*posix-argv*))
```
The command line arguments should strip the first argument, the name of executable file.

(lisp-runtime-arguments) → a list of lisp runtime arguments

(defun lisp-runtime-arguments ()
  #+sbcl
  (list "--dynamic-space-size"
        (format nil "~d"
                (or *dynamic-space-size*
                    (/ (sb-ext:dynamic-space-size)
                       1024 1024)))
        "--control-stack-size"
        (format nil "~d"
                (or *control-stack-size*
                    (/ (- sb-vm:*control-stack-end*
                          sb-vm:*control-stack-start*)
                       1024 1024)))
        "--non-interactive"))

The runtime arguments should extracted from current Lisp image.

(symbol->keyword symbol) → keyword of symbol

(defun symbol->keyword (symbol)
  (declare (type symbol symbol))
  (intern (symbol-name symbol) :keyword))

(normalize-parse-hint parse-hint) → normalized parse hint alist

A normailzed parse-hint alist is an alist with elements:

var: name as keyword ← symbol, keyword, string
type: keyword as valid parse-hint rule ! error if not

(defun normalize-parse-hint (parse-hint)
  (loop for (var* . type) in parse-hint
        for var = (etypecase var*
                    (keyword var*)
                    (symbol  (symbol->keyword var*))
                    (string  (intern (string-upcase var*) :keyword)))
        do (assert (member type '(:stdin :stdin* :read :eval :plain :flag)))
        collect (cons var type)))

Test:

(normalize-parse-hint '((:foo . :read) ("bar" . :flag)))
;; => ((:foo . :read) (:bar . :flag))

(parse-lambda-list lambda-list parse-hint) → normal, optional, key, rest-p, other-keys-p

(defun parse-lambda-list (lambda-list &optional parse-hint)
  "Parse `lambda-list' with `parse-hint' annotated.
Return values are normal, optional, key, rest-p, other-keys-p.

Parameters:
+ `lambda-list': should having the syntax

      <lambda-list> ::= <normal>*
                        (&optional <option>*)?
                        (&key <key>* &allow-other-keys?)?

+ `parse-hint': the alist of variable type hint
  See `func2exec:func2exec'.
"
  (loop with stat         = :normal
        with skip         = nil
        with rest-p       = nil
        with other-keys-p = nil
        with parse-hint   = (normalize-parse-hint
                             (append parse-hint *parse-hint*))

        for var* in lambda-list
        for sym  = (if (listp var*) (first var*) var*)
        for var  = (symbol->keyword sym)
        for type = (or (cdr (assoc var parse-hint))
                       *default-parse-hint*)

        do (cond ((eq sym '&optional)
                  (setf skip :optional
                        stat nil))
                 ((eq sym '&key)
                  (setf skip :key
                        stat nil))
                 ((eq sym '&rest)
                  (setf skip   :rest
                        stat   nil
                        rest-p t))
                 ((eq sym '&allow-other-keys)
                  (setf stat         nil
                        skip         nil
                        other-keys-p t)))

        if (eq stat :normal)
          collect (cons var type) into normal
        if (eq stat :optional)
          collect (cons var type) into optional
        if (eq stat :key)
          collect (cons var type) into key

        if skip
          do (shiftf stat skip nil)

        finally (return (values normal optional key rest-p other-keys-p))))

Test:

Basic

(parse-lambda-list (function-lambda-list #'parse-lambda-list))
;; => ((:lambda-list . :read)), ((:parse-hint . :read)), nil, nil, nil

Parse hint

With parse-hint for normal arguments:

(parse-lambda-list (function-lambda-list #'parse-lambda-list)
                   '((lambda-list . :plain)))
;; => ((:lambda-list . :plain)), ((:parse-hint . :read)), nil, nil, nil

With parse-hint for key arguments:

(parse-lambda-list '(x &key y z) '((y . :flag)))
;; => ((:x . :read)), nil, ((:y . :flag) (:z . :read)), nil, nil

Complex

With &key and &allow-other-keys:

(parse-lambda-list '(x &rest args &key y &allow-other-keys))
;; => ((:x . :read)), nil, ((:y . :read)), t, t

Complex lambda list:

(parse-lambda-list '(x &rest y &key z &allow-other-keys))
;; => ((:x . :read)), nil, ((:z . :read)), t, t

(function-docstring function exec &optional parse-hint) → documentation string of function

This should generate a docstring for --help key print out.

the first line should be the executable name, args input
then the rest should list all arguments and how they are parsed
the last of docstring should be the lisp function documentation string

(defun function-docstring (function exec &key parse-hint)
  "Return the documentation string of `function'"
  (with-output-to-string (*standard-output*)
    (multiple-value-bind (normal optional keys rest-p other-key-p)
        (parse-lambda-list (function-lambda-list function) parse-hint)

      ;; exec args [optional args] { --key ... } (ref:docstr.first)
      (format t "~A ~{~A~^ ~}" exec (mapcar #'car normal))
      (when optional (format t " [~{~A~^ ~}]" (mapcar #'car optional)))
      (when rest-p (format t " ... "))
      (when keys   (format t " { --key ... }"))
      (format t "~%~%")

      ;; list of keys                            (ref:docstr.rest)
      (let ((lines ())
            (types ()))
        (loop for (var . type) in normal
              do (push (format nil "  ~A" var)         lines)
              do (push (format nil " [~:@(~A~)]" type) types))
        (when optional
          (push "  &optional" lines)
          (push ""            types)
          (loop for (var . type) in optional
                do (push (format nil "  ~A" var)         lines)
                do (push (format nil " [~:@(~A~)]" type) types)))
        (loop for (var . type) in keys
              do (push (format nil "  --~A"      var)  lines)
              do (push (format nil " [~:@(~A~)]" type) types))
        (when lines
          (let ((max (reduce #'max (mapcar #'length lines))))
            (loop for line in (reverse lines)
                  for type in (reverse types)
                  do (format t "~vA ~A~%" (1+ max) line type))))
        (when other-key-p
          (format t "  ... allow other keys~%"))

        ;; Lisp function docstrings                (ref:docstr.last)
        (format t "~&~%~A~&" (or (documentation function 'function) ""))))))

Test:

Basic

(function-docstring #'function-docstring "function-docstring")
;; => "function-docstring function exec { --key ... }
;; 
;;   function       [READ]
;;   exec           [READ]
;;   --parse-hint   [READ]
;; 
;; Return the documentation string of `function'
;; "

Return empty string for function with no docstring:

(function-docstring (lambda ()) "nodoc")
;; => "nodoc 
;; 
;; 
;; "

Parsed hint

(function-docstring (lambda (&key foo bar) (declare (ignore foo bar))) "key"
                    :parse-hint '((:foo . :flag)))
;; => "key  { --key ... }
;; 
;;   --foo   [FLAG]
;;   --bar   [READ]
;; 
;; "

Complex

(function-docstring #'parse-argv "complex"
                    :parse-hint '((:lambda-list . :eval)))
;; => "complex lambda-list argv { --key ... }
;; 
;;   lambda-list            [EVAL]
;;   argv                   [READ]
;;   --parse-hint           [READ]
;;   --flag-nicknames       [READ]
;;   --default-parse-hint   [READ]
;; 
;; Parse ARGV and return the calling form. 
;; "

2.2.3. ARGV → Function calling arguments: `parse-argv`

Parse the (command-line-arguments).

(key-arg-p arg) → test if arg is --key like arguments

(defun key-arg-p (arg)
  (and (> (length arg) 2)
       (char= (aref arg 0) #\-)
       (char= (aref arg 1) #\-)))

Test:

(key-arg-p "--key")
;; => t

(read-arg type arg) → return the argument parsed from type

(defun read-arg (type arg)
  (declare (type (member :stdin :stdin* :read :eval :plain :flag) type))
  (ecase type
    (:stdin  *standard-input*)
    (:stdin* (with-output-to-string (in)
               (loop for line = (read-line *standard-input* nil nil)
                     while line
                     do (write-line line in))))
    (:read   (read-from-string arg))
    (:eval   (eval (read-from-string arg)))
    (:plain  arg)
    (:flag   t)))

Test:

The :stdin* should read *standard-input* as string and use it.

(with-input-from-string (*standard-input* "foo") (read-arg :stdin* nil))
;; => "foo
;; "

(parse-argv lambda-list argv &key parse-hint flag-nicknames) → funcall argument list

(defun parse-argv (lambda-list argv
                   &key parse-hint flag-nicknames
                     (default-parse-hint *default-parse-hint*))
  "Parse ARGV and return the calling form. "
  (let ((*default-parse-hint* default-parse-hint)
        (flag-nicknames       (append flag-nicknames *flag-nicknames*)))
    (multiple-value-bind (normal optional keys rest-p other-key-p)
        (parse-lambda-list lambda-list parse-hint)
      (loop with key*    = ()
            with normal* = ()
            with help?   = nil

            while (not (endp argv))

            do (let ((arg (pop argv)))
                 (if (key-arg-p arg)
                     ;; Parse keys
                     (let* ((key  (symbol->keyword
                                   (read-from-string arg t nil :start 2)))
                            (key  (or (cdr (assoc key flag-nicknames)) key))
                            (help (find key *help-flags*))
                            (type (or (cdr (assoc key keys))
                                      (and other-key-p default-parse-hint)
                                      help
                                      (error "Unknown key ~S" key)))
                            (arg  (read-arg (if help :flag type)
                                            (unless (or (eq type :flag) help)
                                              (pop argv)))))
                       (when help (setf help? t))
                       (push arg key*)
                       (push key key*))
                     ;; Parse normal and optional arguments
                     (let* ((type (if (endp normal)
                                      (if (endp optional)
                                          (if rest-p
                                              :plain
                                              (error "Too many input arguments. "))
                                          (cdr (pop optional)))
                                      (cdr (pop normal)))))
                       (push (read-arg type arg) normal*))))

            finally (progn
                      (unless (or (endp normal) help?)
                        (error "Too few input arguments. "))
                      (return (values (nconc (nreverse normal*) key*))))))))

TODO: Make it more neat

Test:

Basic

(parse-argv '(x y) '("x" "y") :parse-hint '((y . :plain)))
;; => (x "y")

Default parse hint

(parse-argv '(output &rest files) '("foo.js" "foo.lisp")
            :default-parse-hint :plain)
;; => ("foo.js" "foo.lisp")

Help flag

(parse-argv '(x y) '("--help"))
;; => (:help t)

(parse-argv '(x y) '("--h"))
;; => (:help t)

Arguments number test

Will raise error if given too few arguments:

(parse-argv '(x y) '("x"))
;; => Error: Too few input arguments.

Will raise error if given too many arguments:

(parse-argv '(x y) '("x" "y" "z"))
;; => Error: Too many input arguments.

Will accept any number arguments if &rest:

(parse-argv '(x y &rest more) '("x" "y" "z"))
;; => (x y "z")

Will raise error when given unknown arguments with fixed keys:

(parse-argv '(&key x y) '("--y" "foo" "--z" "bar"))
;; => Error: Unknown key :z

Will accept any keys if &allow-other-keys:

(parse-argv '(&key x y &allow-other-keys) '("--y" "foo" "--z" "bar"))
;; => (:z bar :y foo)

Will accept key nicknames:

(parse-argv '(&key x) '("--xxx" "foo") :flag-nicknames '((:xxx . :x)))
;; => (:x foo)

2.2.4. Function → Executable: `func2exec`

(func2exec-here executable function ...)

Call save-lisp-and-die in local SBCL image:

(defun func2exec-here (executable function
                       &key
                         (default-parse-hint *default-parse-hint*)
                         parse-hint
                         flag-nicknames
                         compression
                         result)
  (let* ((lambda-list (function-lambda-list function))
         (exec        (file-namestring executable))
         (document    (function-docstring function exec
                                          :parse-hint parse-hint))
         (print-fn    (ecase result
                        (:none   (lambda (res) (declare (ignore res))))
                        (:plain  #'print)
                        (:pretty #'pprint)))
         (toplevel    (lambda ()
                        (let ((args (parse-argv
                                     lambda-list
                                     (command-line-arguments)
                                     :default-parse-hint default-parse-hint
                                     :parse-hint     parse-hint
                                     :flag-nicknames flag-nicknames)))
                          (cond ((find :help args)
                                 (write-string document)
                                 (format t "~&~%Input: ~%")
                                 (format t "  ~{~S~^ ~}~%" args))
                                (t
                                 (funcall print-fn (apply function args))))))))
    #+sbcl
    (sb-ext:save-lisp-and-die executable
                              :toplevel             toplevel
                              :compression          compression
                              :executable           t
                              :save-runtime-options t)))

(func2exec-external executable function ...) → executable

Call save-lisp-and-die in external SBCL image:

(defun func2exec-external (executable function
                           &key
                             (default-parse-hint *default-parse-hint*)
                             parse-hint
                             flag-nicknames
                             compression
                             result
                             depends-on
                             loads
                             no-evaluate)
  (unless (symbolp function)
    (error "Building externally should provide function as symbol. "))
  (let* ((*print-pretty* nil)
         (cmd
           `("sbcl"
             ,@(lisp-runtime-arguments)
             "--eval" "(ql:quickload :func2exec)"
             ,@(when depends-on
                 (list "--eval" (format nil "(ql:quickload '~S)" depends-on)))
             ,@(loop for load in loads
                     for path = (truename load)
                     for dir  = (format nil "/~{~A~^/~}/"
                                        (cdr (pathname-directory path)))
                     for src  = (file-namestring path)
                     collect "--eval"
                     collect (format nil
                                     "(uiop:with-current-directory (~S) (load ~S))"
                                     dir src))
             "--eval"
             ,(format nil
                      (concatenate 'string
                                   "(func2exec:f2e #'~A::~A "
                                   ":executable '~S "
                                   ":parse-hint '~S "
                                   ":default-parse-hint '~S "
                                   ":flag-nicknames '~S "
                                   ":no-compression '~S "
                                   ":result '~S)")
                      (package-name (symbol-package function)) (symbol-name function)
                      executable
                      parse-hint
                      default-parse-hint
                      flag-nicknames
                      (not compression)
                      result))))
    (if no-evaluate
        cmd
        (uiop:run-program cmd :ignore-error-status t
                              :output              t
                              :error-output        t))))

Test:

(func2exec-external "foo" 'func2exec :no-evaluate t)
;; => ("sbcl" "--dynamic-space-size" "20480" "--control-stack-size" "12"
;;     "--non-interactive" "--eval" "(ql:quickload :func2exec)" "--eval"
;;     "(func2exec:f2e #'FUNC2EXEC::FUNC2EXEC :executable '\"foo\" :parse-hint 'nil :default-parse-hint ':read :flag-nicknames 'nil :no-compression 't :result 'nil)")

The given function argument should be symbol, otherwise, raise error.

(func2exec-external "foo" #'func2exec :no-evaluate t)
;; => Error: Building externally should provide function as symbol.

(func2exec function &key ...)

(defun func2exec (function &key (executable (if (symbolp function)
                                                (format nil "~A" function)
                                                *executable*))
                             (no-compression nil)
                             (result :none)
                             (default-parse-hint *default-parse-hint*)
                             parse-hint
                             flag-nicknames
                             external
                             depends-on
                             loads)
  "Turn lisp `function' into `executable'.
Return the path to executable.

Parameters:
+ `function': a symbol for function or function itself
+ `executable': name to output executale file
+ `compression': non `nil' to compress the output executable (SBCL)
+ `documentation': documentation string of `function'

  if not provided, the documentation will be evaluated by
  `function-docstring'.
+ `result': how to output (serialize) function return values

  the `result' could be:
  + `:none'   for not output result
  + `:plain'  just print the result
  + `:pretty' pretty print the result
+ `parse-hint': an alist
+ `flag-nicknames': an alist
+ `external': non-nil for using external SBCL to build executable
+ `depends-on': system dependence
+ `loads': loading scripts
"
  (declare (type (or symbol function) function))
  (let ((*default-parse-hint* default-parse-hint))
    (if external
        (func2exec-external executable function
                            :parse-hint parse-hint
                            :flag-nicknames flag-nicknames
                            :compression    (not no-compression)
                            :result         (or result :none)
                            :depends-on     depends-on
                            :loads          loads)
        (func2exec-here executable function
                        :parse-hint     parse-hint
                        :flag-nicknames flag-nicknames
                        :compression    (not no-compression)
                        :result         (or result :none)))
    executable))

(f2e function ...) ⇔ func2exec
f2e is the alias of func2exec.
```
(setf (fdefinition 'f2e) #'func2exec)
```

3. Examples of `f2e` Usage

3.1. [Example 1] JSCL Compiler

So I was using JSCL to compile some of my scripts to JavaScripts and deploy them as little toy for the web.

Assuming that the script is like below:

(in-package :func2exec)

(jscl:bootstrap)

(defun jscl-build (output &rest files)
  "Build Lisp scripts `files' as `output'.

Parameters:
+ `output': the output JS files
+ `files':  the Lisp files

Note:
due to the JSCL feature, all the files should be placed
within a same directory.

Example:

    (jscl-build \"foo.js\" \"foo1.lisp\" \"foo2.lisp\")
"
  (jscl:compile-application files output))

Thus to build a jscl-builder executable:

(func2exec:f2e 'jscl-build
               :external t
               :default-parse-hint :plain
               :loads '("~/quicklisp/local-projects/jscl/jscl.lisp"
                        "jscl-builder.lisp"))

Test:

3.1.1. Help Flag

Print help message with --help flag:

./jscl-build --help

The --help flag will print the parsed input for debug usage:

./jscl-build --help foo.js foo.lisp

3.1.2. Here it goes

Assuming having the lisp script to be compiled by JSCL compiler:

(defun sum (&rest args) (reduce #'+ args))

Then using the built jscl-build executable:

./jscl-build foo.js foo.lisp && head foo.js

Lucky, :).

4. License

this package is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published
by the Free Software Foundation, either version 3 of the License,
or (at your option) any later version.

this package is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this package. If not, see <https://www.gnu.org/licenses/>.

[func2exec]: Turn your lisp function to executable

Table of Contents

1. About

1.1. Usage

1.1.1. Basic executable arguments

1.1.2. Argument parsing rules

1.1.3. Build using external SBCL process (experimental)

2. Implementation

2.1. ASDF

2.2. Package

2.2.1. Configure

2.2.2. Utils

2.2.3. ARGV → Function calling arguments: parse-argv

2.2.4. Function → Executable: func2exec

3. Examples of f2e Usage

3.1. [Example 1] JSCL Compiler

3.1.1. Help Flag

3.1.2. Here it goes

4. License

2.2.3. ARGV → Function calling arguments: `parse-argv`

2.2.4. Function → Executable: `func2exec`

3. Examples of `f2e` Usage