56 lines
2.1 KiB
Plaintext
56 lines
2.1 KiB
Plaintext
;; A (CFn ...) in the places that zero-initialise: a struct field, a fixed
|
|
;; array's element and a global. A table of bare code addresses is what the
|
|
;; narrow function type is for, and the zero is the only objection there ever
|
|
;; was — a zeroed CFn is a null address. So a call through one tests it first
|
|
;; and signals NullCall rather than jumping to nothing.
|
|
;;
|
|
;; With no argument the empty calls are answered and the program carries on;
|
|
;; with "1" nothing answers and it dies, with the site and the type.
|
|
|
|
(defn double [x i32] i32 (* x 2))
|
|
(defn negate [x i32] i32 (- 0 x))
|
|
|
|
(defstruct Ops [name str run (CFn [i32] i32)])
|
|
|
|
(defonce table [3 (CFn [i32] i32)])
|
|
(defonce hook (CFn [i32] i32))
|
|
(defonce evaluated i32 0)
|
|
(defonce caught i32 0)
|
|
(defonce seen str "")
|
|
|
|
(defn arg [x i32] i32
|
|
(set evaluated (+ evaluated 1))
|
|
x)
|
|
|
|
(defn try-call [f (CFn [i32] i32) x i32] ()
|
|
(restart-case
|
|
(do (print (f (arg x))) (println ""))
|
|
(continue [] (println "empty"))))
|
|
|
|
(defn main [args [str]] i32
|
|
(set (at table 0) double)
|
|
(set (at table 2) negate)
|
|
(let [ops (Ops {.name "half-built"})]
|
|
(if (> (length args) 1)
|
|
;; Unanswered: the process dies at the call.
|
|
(do (print ((at table 1) 5)) (println "") 0)
|
|
(do
|
|
(handler-bind
|
|
[(NullCall [c]
|
|
(set caught (+ caught 1))
|
|
(set seen (.type c))
|
|
(invoke-restart 'continue))]
|
|
(dotimes [i 3] (try-call (at table i) 7)) ; 14, empty, -7
|
|
(try-call (.run ops) 1) ; empty
|
|
(try-call hook 2) ; empty
|
|
(set hook double)
|
|
(try-call hook 2)) ; 4
|
|
;; The argument of a call that is not made is never evaluated.
|
|
(print evaluated) (println "") ; 3
|
|
(print caught) (println "") ; 3
|
|
(println seen) ; (CFn [i32] i32)
|
|
;; And a filled field calls as any CFn does.
|
|
(let [full (Ops {.name "full" .run negate})]
|
|
(print ((.run full) 9)) (println "")) ; -9
|
|
0))))
|