compile (set! *var* val)
The analyzer punted set! as uncompilable. Add it as a special form: (set! sym val) on a var emits jolt-var-set, which updates the innermost thread binding (or the root when unbound), returning val. A local target (deftype mutable field) or an interop (.-field) target stays uncompilable for now. Also defines *warn-on-reflection* (false) so set! on it resolves. SCI load 186 -> 196/218.
This commit is contained in:
parent
86aa89c832
commit
e6ee17b055
6 changed files with 53 additions and 36 deletions
|
|
@ -12,3 +12,7 @@
|
||||||
|
|
||||||
;; *unchecked-math* — jolt does no unchecked-math elision; the var reads false.
|
;; *unchecked-math* — jolt does no unchecked-math elision; the var reads false.
|
||||||
(def-var! "clojure.core" "*unchecked-math*" #f)
|
(def-var! "clojure.core" "*unchecked-math*" #f)
|
||||||
|
|
||||||
|
;; *warn-on-reflection* — jolt has no reflection, so the var reads false; (set!
|
||||||
|
;; *warn-on-reflection* …) resolves and updates it (a no-op effect).
|
||||||
|
(def-var! "clojure.core" "*warn-on-reflection*" #f)
|
||||||
|
|
|
||||||
|
|
@ -1,11 +1,11 @@
|
||||||
;; run-sci.ss — SCI conformance: load borkdude/sci's own source (vendor/sci) through
|
;; run-sci.ss — SCI conformance: load borkdude/sci's own source (vendor/sci) through
|
||||||
;; joltc and require its forms to compile+eval. A real-world Clojure-compatibility
|
;; joltc and require its forms to compile+eval. A real-world Clojure-compatibility
|
||||||
;; stress test. Pure Chez, no Janet. Floor-gated like the corpus: a regression below
|
;; stress test. Pure Chez, no Janet. Floor-gated like the corpus: a regression below
|
||||||
;; the floor (or the count today, 186/218) fails. Raise the floor as host gaps close
|
;; the floor (or the count today, 196/218) fails. Raise the floor as host gaps close
|
||||||
;; (the tail is genuine gaps — set! on vars, some macro/def shapes).
|
;; (the tail is genuine gaps — set! on vars, some macro/def shapes).
|
||||||
;;
|
;;
|
||||||
;; chez --script host/chez/run-sci.ss
|
;; chez --script host/chez/run-sci.ss
|
||||||
;; JOLT_SCI_FLOOR=N override the floor (default 186)
|
;; JOLT_SCI_FLOOR=N override the floor (default 196)
|
||||||
;; SCI_VERBOSE=1 print each failing form's error
|
;; SCI_VERBOSE=1 print each failing form's error
|
||||||
(import (chezscheme))
|
(import (chezscheme))
|
||||||
|
|
||||||
|
|
@ -74,7 +74,7 @@
|
||||||
load-order)
|
load-order)
|
||||||
|
|
||||||
(printf "\nSCI load: ~a/~a forms ok (~a fail)\n" total-ok (+ total-ok total-fail) total-fail)
|
(printf "\nSCI load: ~a/~a forms ok (~a fail)\n" total-ok (+ total-ok total-fail) total-fail)
|
||||||
(define floor (let ((s (getenv "JOLT_SCI_FLOOR"))) (if s (string->number s) 186)))
|
(define floor (let ((s (getenv "JOLT_SCI_FLOOR"))) (if s (string->number s) 196)))
|
||||||
(when (< total-ok floor)
|
(when (< total-ok floor)
|
||||||
(printf "REGRESSION: ~a forms loaded < floor ~a\n" total-ok floor))
|
(printf "REGRESSION: ~a forms loaded < floor ~a\n" total-ok floor))
|
||||||
(flush-output-port)
|
(flush-output-port)
|
||||||
|
|
|
||||||
File diff suppressed because one or more lines are too long
|
|
@ -34,7 +34,7 @@
|
||||||
|
|
||||||
(def ^:private handled
|
(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" "var" "letfn"})
|
"syntax-quote" "var" "letfn" "set!"})
|
||||||
|
|
||||||
(defn- uncompilable [why]
|
(defn- uncompilable [why]
|
||||||
(throw (str "jolt/uncompilable: " why)))
|
(throw (str "jolt/uncompilable: " why)))
|
||||||
|
|
@ -323,6 +323,16 @@
|
||||||
(if (= :var (:kind r))
|
(if (= :var (:kind r))
|
||||||
(the-var (:ns r) (:name r))
|
(the-var (:ns r) (:name r))
|
||||||
(uncompilable (str "var of non-var " (form-sym-name sym)))))
|
(uncompilable (str "var of non-var " (form-sym-name sym)))))
|
||||||
|
;; (set! *var* val): set the var's innermost thread binding, else its root
|
||||||
|
;; (jolt-var-set). A local target is a deftype mutable field — not yet
|
||||||
|
;; supported (jolt binds fields immutably); an interop (.-field) target too.
|
||||||
|
"set!" (let [target (nth items 1)]
|
||||||
|
(when-not (form-sym? target) (uncompilable "set! of a non-symbol target"))
|
||||||
|
(when (local? env (form-sym-name target)) (uncompilable "set! of a local"))
|
||||||
|
(let [r (resolve-global ctx target)]
|
||||||
|
(when-not (= :var (:kind r)) (uncompilable "set! of a non-var"))
|
||||||
|
{:op :set-var :the-var (the-var (:ns r) (:name r))
|
||||||
|
:val (analyze ctx (nth items 2) env)}))
|
||||||
(uncompilable (str "special form " op))))
|
(uncompilable (str "special form " op))))
|
||||||
|
|
||||||
;; Host interop method call (jolt-0kf5). `(.method target arg*)` — a head that
|
;; Host interop method call (jolt-0kf5). `(.method target arg*)` — a head that
|
||||||
|
|
|
||||||
|
|
@ -377,6 +377,8 @@
|
||||||
"` (no core on Chez yet)") {}))
|
"` (no core on Chez yet)") {}))
|
||||||
:else (str "(var-deref " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")))
|
:else (str "(var-deref " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")))
|
||||||
:the-var (str "(jolt-var " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")
|
:the-var (str "(jolt-var " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) ")")
|
||||||
|
;; (set! *var* val) -> set the var's innermost binding (else root); returns val.
|
||||||
|
:set-var (str "(jolt-var-set " (emit (:the-var node)) " " (emit (:val node)) ")")
|
||||||
:host (throw (ex-info (str "emit: unsupported host ref `" (:name node) "`") {}))
|
:host (throw (ex-info (str "emit: unsupported host ref `" (:name node) "`") {}))
|
||||||
:host-static (str "(host-static-ref " (chez-str-lit (:class node)) " "
|
:host-static (str "(host-static-ref " (chez-str-lit (:class node)) " "
|
||||||
(chez-str-lit (:member node)) ")")
|
(chez-str-lit (:member node)) ")")
|
||||||
|
|
|
||||||
|
|
@ -96,6 +96,7 @@
|
||||||
(= op :do) (assoc node :statements (mapv f (get node :statements))
|
(= op :do) (assoc node :statements (mapv f (get node :statements))
|
||||||
:ret (f (get node :ret)))
|
:ret (f (get node :ret)))
|
||||||
(= op :throw) (assoc node :expr (f (get node :expr)))
|
(= op :throw) (assoc node :expr (f (get node :expr)))
|
||||||
|
(= op :set-var) (assoc node :val (f (get node :val)))
|
||||||
(= op :invoke) (assoc node :fn (f (get node :fn))
|
(= op :invoke) (assoc node :fn (f (get node :fn))
|
||||||
:args (mapv f (get node :args)))
|
:args (mapv f (get node :args)))
|
||||||
(= op :vector) (assoc node :items (mapv f (get node :items)))
|
(= op :vector) (assoc node :items (mapv f (get node :items)))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue