From a76b8a11da5e6bbc8a46466e12d113c2558dd20e Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 24 Mar 2018 20:27:07 -0700
Subject: compiler: specially compile (call ...) forms.

* share/txr/stdlib/compiler.tl (compiler comp-fun-form): Add a
caseq form to handle certain top-level functions specially.
Add a case for the call function, handled by comp-call.
(compiler comp-call): New method.
---
 share/txr/stdlib/compiler.tl | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index d95254bb..798514f7 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -653,7 +653,19 @@
     (((fbind env.(lookup-fun sym)))
      me.(comp-call-impl oreg env 'call fbind.loc args))
     (((fidx me.(get-fidx sym)))
-     me.(comp-call-impl oreg env 'gcall fidx args))))
+     (caseq sym
+       (call me.(comp-call oreg env args))
+       (t me.(comp-call-impl oreg env 'gcall fidx args))))))
+
+(defmeth compiler comp-call (me oreg env args)
+  (tree-bind (fform . fargs) args
+    (let* ((ffrag me.(compile oreg env fform))
+           (cfrag me.(comp-call-impl oreg env 'call ffrag.oreg fargs)))
+      (new (frag cfrag.oreg
+                 (append ffrag.code
+                         cfrag.code)
+                 (uni ffrag.fvars cfrag.fvars)
+                 (uni ffrag.ffuns cfrag.ffuns))))))
 
 (defmeth compiler comp-call-impl (me oreg env opcode freg args)
   (let* ((sugg-oregs (mapcar (ret me.(alloc-treg)) args))
-- 
cgit v1.2.3