From 28e7bb9d9da1992af672b012c2fb0514cd369f93 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sat, 24 Mar 2018 18:16:32 -0700 Subject: compiler: implement fun special form * share/txr/stdlib/compiler.tl (compiler compile): Route fun to comp-fun. (compiler comp-fun): New method. --- share/txr/stdlib/compiler.tl | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 36e2746b..f36be47b 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -168,6 +168,7 @@ ((let let*) me.(comp-let oreg env form)) ((sys:fbind sys:lbind) me.(comp-fbind oreg env form)) (lambda me.(comp-lambda oreg env form)) + (fun me.(comp-fun oreg env form)) (sys:for-op me.(comp-for oreg env form)) (sys:each-op me.(compile oreg env (expand-each form env))) (progn me.(comp-progn oreg env (cdr form))) @@ -572,6 +573,13 @@ (uni [reduce-left uni ifrags nil .ffuns] bfrag.ffuns)))))))))) +(defmeth compiler comp-fun (me oreg env form) + (mac-param-bind form (op sym) form + (iflet ((fbin env.(lookup-fun sym))) + (new (frag fbin.loc nil nil (list sym))) + (let ((dreg me.(get-dreg sym))) + (new (frag oreg ^((getf ,oreg ,dreg)) nil (list sym))))))) + (defmeth compiler comp-progn (me oreg env args) (let* (ffuns fvars (lead-forms (butlastn 1 args)) -- cgit v1.2.3