diff --git a/jolt-core/jolt/analyzer.clj b/jolt-core/jolt/analyzer.clj index 0f11042..d5d016d 100644 --- a/jolt-core/jolt/analyzer.clj +++ b/jolt-core/jolt/analyzer.clj @@ -22,12 +22,13 @@ form-literal? form-elements form-vec-items form-map-pairs form-special? compile-ns form-macro? form-expand-1 resolve-global - form-sym-meta host-intern!]])) + form-sym-meta host-intern! form-syntax-quote-lower]])) (declare analyze) (def ^:private handled - #{"quote" "if" "do" "def" "fn*" "let*" "loop*" "recur" "throw" "try"}) + #{"quote" "if" "do" "def" "fn*" "let*" "loop*" "recur" "throw" "try" + "syntax-quote"}) (defn- uncompilable [why] (throw (str "jolt/uncompilable: " why))) @@ -159,6 +160,9 @@ :args (mapv #(analyze ctx % env) (rest items))}) "try" (analyze-try ctx items env) "fn*" (analyze-fn ctx items env) + ;; Lower the backtick to construction code (zero runtime cost), then analyze + ;; it — the macroexpand/compile-time step, per read -> macroexpand -> compile. + "syntax-quote" (analyze ctx (form-syntax-quote-lower ctx (second items)) env) (uncompilable (str "special form " op)))) (defn- analyze-symbol [ctx form env] diff --git a/src/jolt/core.janet b/src/jolt/core.janet index c77601e..a02a2b7 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -124,6 +124,26 @@ items) c)) +# Syntax-quote form builders. The syntax-quote lowering (evaluator) emits calls to +# these so a `(...)/`[...] body is plain compilable code instead of an interpreted +# special form. A list FORM is a Janet array, a vector FORM a tuple (the reader's +# representation), so these build those types. Each concat part is either a 1-elem +# wrap (__sq1, a non-spliced item) or a spliced seq (~@), flattened in order. +(defn core-sq1 [x] @[x]) + +(defn core-sqcat [& parts] + (def r @[]) + (each p parts (each x (realize-for-iteration p) (array/push r x))) + r) + +(defn core-sqvec [& parts] + (def r @[]) + (each p parts (each x (realize-for-iteration p) (array/push r x))) + (tuple/slice r)) + +# Map builder: parts are alternating k v (no splicing in map syntax-quote). +(defn core-sqmap [& parts] (kvs->map (array ;parts))) + # ============================================================ # Predicates # ============================================================ @@ -3289,6 +3309,10 @@ "cons" core-cons "seq" core-seq "vec" core-vec + "__sq1" core-sq1 + "__sqcat" core-sqcat + "__sqvec" core-sqvec + "__sqmap" core-sqmap "into" core-into "merge" core-merge "merge-with" core-merge-with diff --git a/src/jolt/evaluator.janet b/src/jolt/evaluator.janet index e6869cd..b35e08b 100644 --- a/src/jolt/evaluator.janet +++ b/src/jolt/evaluator.janet @@ -163,6 +163,49 @@ (array/push kvs (syntax-quote* ctx bindings (get form k) gsmap))) (struct ;kvs)) form)) +# Syntax-quote LOWERING: instead of evaluating a `(...) form to a value (what +# syntax-quote* does), produce equivalent CONSTRUCTION CODE so a backtick body is +# plain compilable code (read -> macroexpand -> compile, zero runtime cost). +# Mirrors syntax-quote*/sq-symbol exactly; the canonical algorithm is +# tools.reader's syntax-quote*/expand-list. List forms build via __sqcat (-> array), +# vectors via __sqvec (-> tuple), maps via __sqmap; symbols become (quote resolved); +# ~ leaves the expr in place, ~@ passes the seq straight to __sqcat for splicing. +(defn- sqsym* [nm] {:jolt/type :symbol :ns nil :name nm}) + +(var syntax-quote-lower nil) + +(defn- sq-lower-part [ctx item gsmap] + (if (and (array? item) (> (length item) 0) (sym-name? (first item) "unquote-splicing")) + (in item 1) + @[(sqsym* "__sq1") (syntax-quote-lower ctx item gsmap)])) + +(set syntax-quote-lower + (fn syntax-quote-lower [ctx form &opt gsmap] + (default gsmap @{}) + (cond + (and (array? form) (> (length form) 0) (sym-name? (first form) "unquote")) + (in form 1) + (and (array? form) (> (length form) 0) (sym-name? (first form) "unquote-splicing")) + (error "~@ used outside of a list or vector in syntax-quote") + (or (number? form) (string? form) (keyword? form) (nil? form) (= true form) (= false form)) + form + (and (struct? form) (= :symbol (form :jolt/type))) + @[(sqsym* "quote") (sq-symbol ctx form gsmap)] + (array? form) + (array/concat @[(sqsym* "__sqcat")] (map (fn [it] (sq-lower-part ctx it gsmap)) form)) + (tuple? form) + (array/concat @[(sqsym* "__sqvec")] (map (fn [it] (sq-lower-part ctx it gsmap)) form)) + # tagged structs (sets/chars): syntax-quote* returns them as-is (no recursion) + (and (struct? form) (get form :jolt/type)) + @[(sqsym* "quote") form] + (struct? form) + (do (var parts @[(sqsym* "__sqmap")]) + (each k (keys form) + (array/push parts (syntax-quote-lower ctx k gsmap)) + (array/push parts (syntax-quote-lower ctx (get form k) gsmap))) + parts) + @[(sqsym* "quote") form]))) + (defn resolve-var [ctx bindings sym-s] (let [name (sym-s :name) ns (sym-s :ns)] @@ -621,6 +664,10 @@ nil)) (match name "quote" (in form 1) + # Interpreter builds the form directly (self-contained, no core dependency). + # The COMPILE path instead lowers syntax-quote to construction code (via + # syntax-quote-lower) so a backtick body is compilable; the two are kept in + # sync and cross-checked by conformance (interpret vs compile modes). "syntax-quote" (syntax-quote* ctx bindings (in form 1)) "unquote" (error "Unquote not valid outside of syntax-quote") "unquote-splicing" (error "Unquote-splicing not valid outside of syntax-quote") diff --git a/src/jolt/host_iface.janet b/src/jolt/host_iface.janet index cb4a333..0c2733b 100644 --- a/src/jolt/host_iface.janet +++ b/src/jolt/host_iface.janet @@ -143,6 +143,11 @@ # Form predicates use `form-*` names (not list?/vector?/map?/set?/char?) so the # analyzer can refer them unqualified without the bootstrap's core-renames # intercepting them as the value-level predicates. +# Lower a syntax-quote's inner form to construction code (so the analyzer can +# compile it). The portable analyzer calls this and analyzes the result. +(defn h-syntax-quote-lower [ctx inner] + (syntax-quote-lower ctx inner)) + (def- exports {"form-sym?" h-sym? "form-sym-name" h-sym-name "form-sym-ns" h-sym-ns "form-sym-meta" h-sym-meta @@ -152,6 +157,7 @@ "form-map-pairs" h-map-pairs "form-set-items" h-set-items "form-special?" h-special? "compile-ns" h-current-ns "form-macro?" h-macro? "form-expand-1" h-expand-1 "resolve-global" h-resolve-global + "form-syntax-quote-lower" h-syntax-quote-lower "host-intern!" h-intern!}) (defn install! [ctx]