96 lines
3.6 KiB
Plaintext
96 lines
3.6 KiB
Plaintext
;; Function values, and specifically the ones with no environment. Nothing
|
|
;; here captures — fn-capture.flan is the other half, and fn-escape.flan is a
|
|
;; capturing value outliving the frame that made it.
|
|
;;
|
|
;; Every signature below says (Fn ...), which is the wide one: it admits a
|
|
;; capturing value and so pays for a two-word value and a widening thunk where
|
|
;; a name is handed to it. Written as (CFn ...) these would pay neither, and
|
|
;; fn-cfn.flan is where that is spelled out — the spellings are kept apart
|
|
;; here so that the two programs cover the two conventions between them.
|
|
;;
|
|
;; This is a Lisp-1 — one top-level namespace, enforced — so a bare function
|
|
;; name *is* the function and there is no #' to write.
|
|
|
|
(defn double [x i32] i32 (* x 2))
|
|
(defn negate [x i32] i32 (- 0 x))
|
|
(defn square [x i32] i32 (* x x))
|
|
|
|
;; The shape map/filter/reduce want: the function arrives as a parameter, is
|
|
;; called, and is never stored.
|
|
(defn each [xs [i32] f (Fn [i32] i32)] ()
|
|
(dotimes [i (length xs)]
|
|
(set (at xs i) (f (at xs i)))))
|
|
|
|
(defn fold [xs [i32] f (Fn [i32] i32)] i32
|
|
(let [t 0]
|
|
(dotimes [i (length xs)]
|
|
(set t (+ t (f (at xs i)))))
|
|
t))
|
|
|
|
;; A comparator, which is the other half of what was blocked: a sort that is
|
|
;; told the order rather than having it written in. Insertion sort, because the
|
|
;; point here is the parameter and not the algorithm.
|
|
(defn insertion-by [xs [i32] before? (Fn [i32 i32] bool)] ()
|
|
(dotimes [i (length xs)]
|
|
(let [j i]
|
|
(while (and (> j 0) (before? (at xs j) (at xs (- j 1))))
|
|
(swap xs j (- j 1))
|
|
(set j (- j 1))))))
|
|
|
|
(defn ascending [a i32 b i32] bool (< a b))
|
|
(defn descending [a i32 b i32] bool (> a b))
|
|
|
|
;; Returning one. A function value is a link-time constant with no environment,
|
|
;; so handing it back up is no different from handing it down.
|
|
(defn pick [up bool] (Fn [i32 i32] bool)
|
|
(if up ascending descending))
|
|
|
|
;; A function value calling another, and the transfer channel crossing an
|
|
;; indirect call: a callee reached by pointer signals exactly as one reached by
|
|
;; name, and the handler is established across the call.
|
|
(defstruct TooBig [n i32])
|
|
|
|
(defn checked [x i32] i32
|
|
(when (> x 100) (signal (TooBig {.n x})))
|
|
x)
|
|
|
|
(defonce seen i32)
|
|
|
|
;; A handler-bind and an fn literal in *one* function, which is the case that
|
|
;; would catch the two lifted-function name sequences sharing a counter: both
|
|
;; are lifted out of [handles] and both are numbered within it.
|
|
(defn handles [] ()
|
|
(handler-bind [(TooBig [c] (set seen (+ seen (.n c))))]
|
|
(let [xs [5 200 7 300]]
|
|
(println (fold (slice xs 0 4) checked))
|
|
(println (fold (slice xs 0 4) (fn [x] (min x 10))))))
|
|
(print "seen ") (print seen) (println ""))
|
|
|
|
(defn main [] i32
|
|
(let [xs [1 2 3 4]]
|
|
;; A name in value position, passed down.
|
|
(each (slice xs 0 4) double)
|
|
(print (at xs 0)) (print " ") (print (at xs 3)) (println "")
|
|
;; 2 + 4 + 6 + 8 negated
|
|
(println (fold (slice xs 0 4) negate))
|
|
;; An fn literal, whose parameter types come from the position it is in.
|
|
(println (fold (slice xs 0 4) (fn [x] (+ x 1))))
|
|
;; A let binding of function type, called by the name it is bound to.
|
|
(let [f square]
|
|
(println (f 9))))
|
|
|
|
;; A comparator, and the same slice sorted both ways.
|
|
(let [ys [3 1 4 1 5 9 2 6]
|
|
s (slice ys 0 8)]
|
|
(insertion-by s ascending)
|
|
(print (at s 0)) (print " ") (print (at s 7)) (println "")
|
|
(insertion-by s descending)
|
|
(print (at s 0)) (print " ") (print (at s 7)) (println "")
|
|
;; A returned function value, and a computed head calling it.
|
|
(insertion-by s (pick true))
|
|
(print (at s 0)) (println "")
|
|
(println ((pick false) 1 2)))
|
|
|
|
(handles)
|
|
0)
|