Symbols in argument position are resolved

This removes the need to deref script functions.  Script functions are
now regular functions, with a custom dispatch mechanism.  Plain
clojure functions can now be used as script functions.

Fixes #22.

src/pallet/script.clj

@@ -131,41 +131,40 @@
           :line line
           })))))
 
-(defn invoke
-  "Invoke `script` with the given `args`.  The implementations of `script` is
-   found based on the current `*script-context*` value.  If no matching
-   implementation is found, then nil is returned."
-  ([script args]
-     (invoke script args nil nil))
-  ([script args file line]
-     {:pre [(::script-fn script)]}
-     (logging/tracef
-      "invoke-target [%s:%s] %s %s"
-      file line (or (:kw script) (::script-kw script))
-      (print-args args))
-     (when-let [f (best-match @(:methods script))]
-       (logging/tracef
-        "Found implementation for %s - %s invoking with %s empty? %s"
-        (:fn-name script) f (print-args args) (empty? args))
-       (apply f args))))
-
 (defn script-fn*
   "Define an abstract script function, that can be implemented differently for
    different operating systems. Calls to functions defined by `script-fn*` are
    dispatched based on the `*script-context*` vector."
   [fn-name args]
-  `(with-meta
-     {::script-fn true
-      :fn-name ~(keyword (name fn-name))
-      :methods (atom {})}
-     {:arglists ~(list 'quote (list (vec args)))}))
+  (let [;; replace any destructuring with simple vars
+        arglist (map #(if (symbol? %) % (gensym "arg")) args)
+        ;; if we're passed vargs, then we name the vargs, so we don't
+        ;; have to interpret any destructuring in the actual vararg
+        ;; argument in args.
+        is-vargs? (some #{'&} arglist)
+        varg (when is-vargs? (gensym "varg"))
+        arglist (if is-vargs?
+                  (concat (butlast arglist) [varg])
+                  arglist)
+        fwdargs (if is-vargs?
+                  `(concat [~@(butlast (butlast arglist))] ~varg)
+                  (vec arglist))]
+    `(let [m# (with-meta
+                {::script-fn true
+                 :fn-name ~(keyword (name fn-name))
+                 :methods (atom {})}
+                {:arglists ~(list 'quote (list (vec args)))})]
+       (with-meta
+         (fn ~fn-name [~@arglist]
+           (dispatch m# ~fwdargs))
+         m#))))
 
 (defmacro script-fn
   "Define an abstract script function, that can be implemented differently for
    different operating systems. Calls to functions defined by `script-fn` are
    dispatched based on the `*script-context*` vector."
   ([[& args]]
-     (script-fn* :anonymous args))
+     (script-fn* 'anonymous args))
   ([fn-name [& args]]
      (script-fn* fn-name args)))
 
@@ -189,10 +188,8 @@
    indication whether the implementation is a match for the `*script-context*`
    passed as the function's first argument."
   [script specialisers f]
-  {:pre [(::script-fn script)]}
-  (swap! (:methods script) assoc specialisers f))
-
-;;; Dispatch mechanisms for stevedore
+  {:pre [(::script-fn (meta script))]}
+  (swap! (:methods (meta script)) assoc specialisers f))
 
 (defmacro defimpl
   "Define a script function implementation for the given `specialisers`.
@@ -213,12 +210,3 @@
   `(implement
     ~script ~specialisers
     (fn [~@args] (stevedore/script ~@body))))
-
-(defn script-fn-dispatch
-  "Optional dispatching of script functions"
-  [script-fn args ns file line]
-  (dispatch script-fn args file line))
-
-;;; Link stevedore to the dispatch mechanism
-
-(stevedore/script-fn-dispatch! script-fn-dispatch)

src/pallet/stevedore.clj

@@ -7,6 +7,7 @@
    The result of a `script` form is a string."
   (:require
    [clojure.java.io :as io]
+   [clojure.set :refer [union]]
    [clojure.string :as string]
    [clojure.tools.logging :refer [tracef]]
    [clojure.walk :as walk]
@@ -67,6 +68,27 @@
   [& forms]
   `(with-source-line-comments nil (emit-script (quasiquote ~forms))))
 
+;;; * Keyword and Operator Classes
+(def
+  ^{:doc
+    "Special forms are handled explcitly by an implementation of
+     `emit-special`."
+    :internal true}
+  special-forms
+  #{'if 'if-not 'when 'when-not 'case 'aget 'aset 'get 'defn 'return 'set!
+    'var 'defvar 'let 'local 'literally 'deref 'do 'str 'quoted 'apply
+    'file-exists? 'directory? 'symlink? 'readable? 'writeable? 'empty?
+    'not 'println 'print 'group 'pipe 'chain-or
+    'chain-and 'while 'doseq 'merge! 'assoc! 'alias})
+
+(def ^:internal operators
+  "Operators that should not be resolved."
+  #{'+ '- '/ '* '% '== '= '< '> '<= '>= '!= '<< '>> '<<< '>>> '& '| '&& '||
+    'and 'or})
+
+(def ^:internal unresolved
+  "Set of symbols that should not be resolved."
+  (union special-forms operators))
 
 ;;; Public script combiners
 ;;;
@@ -77,7 +99,6 @@
 ;;;  => (script
 ;;;       (ls)
 ;;;       (ls))
-
 (defmulti do-script
   "Concatenate multiple scripts."
   (fn [& scripts] *script-language*))
@@ -215,10 +236,12 @@
             *script-file* ~file]
     ~@body))
 
+(def ^:dynamic *apply-form-meta* true)
+
 (defn- form-meta
   [new-form form ]
   (tracef "form-meta %s %s" form (meta form))
-  (if-let [m (meta form)]
+  (if-let [m (and *apply-form-meta* (meta form))]
     (if (number? new-form)
       new-form
       `(with-meta ~new-form ~(merge {:file *file*} (meta form))))
@@ -278,6 +301,7 @@
 (defn- handle-unquote-splicing [form]
   (form-meta (list `splice (second form)) form))
 
+(def resolve-script-fns true)
 
 ;; These functions are used for an initial scan over stevedore forms
 ;; resolving escaping to Clojure and quoting symbols to stop namespace
@@ -292,27 +316,31 @@
   [inner outer form]
   (tracef "walk %s %s" form (meta form))
   (cond
-   (list? form) (outer (form-meta (apply list (map inner form)) form))
+   (list? form) (outer (with-meta
+                        (if (and resolve-script-fns
+                                 (symbol? (first form))
+                                 (not (unresolved (first form))))
+                          (list* (first form) (map inner (rest form)))
+                          (list* (map inner form)))
+                        (meta form)))
    (instance? clojure.lang.IMapEntry form) (outer (vec (map inner form)))
-   (seq? form) (outer (form-meta (doall (map inner form)) form))
-   (coll? form) (outer (form-meta (into (empty form) (map inner form)) form))
+   (seq? form) (outer (with-meta (doall (map inner form)) (meta form)))
+   (coll? form) (outer (with-meta
+                         (into (empty form) (map inner form))
+                         (meta form)))
    :else (outer form)))
 
 (declare inner-walk outer-walk)
 
-(defmacro quasiquote
-  [form]
-  (tracef "quasiquote %s %s" form (meta form))
-  (let [post-form (walk inner-walk outer-walk form)]
-    (tracef "quasiquote return %s" post-form)
-    (form-meta post-form form)))
-
 (defn- inner-walk [form]
   (tracef "inner-walk %s %s" form (meta form))
   (cond
-   (unquote? form) (form-meta (handle-unquote form) form)
+   (unquote? form) (handle-unquote form)
    (unquote-splicing? form) (handle-unquote-splicing form)
-   :else (form-meta (walk/walk inner-walk outer-walk form) form)))
+   (instance? clojure.lang.IObj form) (with-meta
+                                        (walk inner-walk outer-walk form)
+                                        (meta form))
+   :else (walk inner-walk outer-walk form)))
 
 (defn- outer-walk [form]
   (tracef "outer-walk %s %s" form (meta form))
@@ -321,14 +349,19 @@
    (seq? form)
    (do
      (tracef "outer-walk %s %s" form (meta form))
-     (form-meta (list* 'list form) form))
+     (form-meta (list* `list form) form))
    :else form))
 
+(defn quasiquote*
+  [form]
+  (tracef "quasiquote* %s %s" form (meta form))
+  (let [post-form (walk inner-walk outer-walk form)]
+    (tracef "quasiquote return %s" post-form)
+    post-form))
 
-                        ;; (let [s (first form)]
-                        ;;   (clojure.tools.logging/info "outer-walk %s" form)
-                        ;;   (if (symbol? s) (list 'quote s) s))
-                        ;; (rest form)
+(defmacro quasiquote
+  [form]
+  (quasiquote* form))
 
 ;;; High level string generation functions
 (def statement-separator "\n")
@@ -381,12 +414,6 @@
                       s)))))]
     code))
 
-
-
-
-
-
-
 ;;; Script argument helpers
 ;;; TODO eliminate the need for this to be public by supporting literal maps for
 ;;; expansion
@@ -417,29 +444,3 @@
         underscore (:underscore m)]
     (map-to-arg-string
      (dissoc m :assign :underscore) :assign assign :underscore underscore)))
-
-
-;; Dispatch functions for script functions
-
-(defn script-fn-dispatch-none
-  "Script function dispatch. This implementation does nothing."
-  [name args ns file line]
-  nil)
-
-(def ^{:doc "Script function dispatch." :dynamic true}
-  *script-fn-dispatch* script-fn-dispatch-none)
-
-(defn script-fn-dispatch!
-  "Set the script-fn dispatch function"
-  [f]
-  (alter-var-root #'*script-fn-dispatch* (fn [_] f)))
-
-(defmacro with-no-script-fn-dispatch
-  [& body]
-  `(binding [*script-fn-dispatch* script-fn-dispatch-none]
-     ~@body))
-
-(defmacro with-script-fn-dispatch
-  [f & body]
-  `(binding [*script-fn-dispatch* ~f]
-     ~@body))

src/pallet/stevedore/bash.clj

@@ -6,8 +6,7 @@
   (:use
    [pallet.stevedore.common]
    [pallet.stevedore
-    :only [emit emit-do *script-fn-dispatch* empty-splice
-           with-source-line-comments]]
+    :only [emit emit-do empty-splice special-forms with-source-line-comments]]
    [pallet.common.string :only [quoted substring underscore]]))
 
 (derive ::bash :pallet.stevedore.common/common-impl)
@@ -219,10 +218,10 @@
   (common-string/quoted (emit arg)))
 
 (defmethod emit-special [::bash 'println] [type [println & args]]
-  (str "echo " (emit args)))
+  (str "echo " (string/join " " (map emit args))))
 
 (defmethod emit-special [::bash 'print] [type [println & args]]
-  (str "echo -n " (emit args)))
+  (str "echo -n " (string/join " " (map emit args))))
 
 
 (defonce

src/pallet/stevedore/batch.clj

@@ -81,7 +81,7 @@
   (apply clojure.core/str (map emit args)))
 
 (defmethod emit-special [::batch 'println] [type [println & args]]
-  (str "echo " (emit args)))
+  (str "echo " (string/join " " (map emit args))))
 
 (defmethod emit-special [::batch 'deref]
   [type [deref expr]]