From a4fcdf0e9ec514c71549792459edd4f0f4ecb349 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Tue, 24 Feb 2015 12:47:30 -0500
Subject: [PATCH] Added autogen functions

---
 cgen.scm  | 63 +++++++++++++++++++++++++++++--------------------------
 trans.scm |  6 ++++--
 2 files changed, 37 insertions(+), 32 deletions(-)

diff --git a/cgen.scm b/cgen.scm
index 40dbc27e..b93993db 100644
--- a/cgen.scm
+++ b/cgen.scm
@@ -1048,33 +1048,36 @@
     (emit "}")
     (emit *c-main-function*)))
 
-; Unused -
-;;; Echo file to stdout
-;(define (emit-fp fp)
-;    (let ((l (read-line fp)))
-;        (if (eof-object? l)
-;            (close-port fp)
-;            (begin 
-;                (display l) 
-;                (newline)
-;                (emit-fp fp)))))
-;
-;(define (read-runtime fp)
-;  (letrec* 
-;    ((break "/** SCHEME CODE ENTRY POINT **/")
-;     (read-fp (lambda (header footer on-header?)
-;       (let ((l (read-line fp)))
-;         (cond
-;           ((eof-object? l)
-;             (close-port fp)
-;             (cons (reverse header) (reverse footer)))
-;           (else 
-;             (cond
-;               ((equal? l break)
-;                 (read-fp header footer #f))
-;               (else
-;                 (if on-header?
-;                   (read-fp (cons l header) footer on-header?)
-;                   (read-fp header (cons l footer) on-header?))))))))))
-;
-;   (read-fp (list) (list) #t)))
+;; Automatically generate blocks of code for the compiler
+;; TODO: need a compiler option to call this from cmd line
+(define (autogen)
+  (let ((fp (open-output-file "tmp.txt")))
+    (autogen:defprimitives fp)
+    (autogen:primitive-procedures fp)
+    (close-output-port fp)))
+
+(define (autogen:defprimitives fp)
+  (for-each
+    (lambda (p)
+      (display
+        (string-append 
+          "defprimitive(" 
+          (mangle p)
+          "); /* "
+          (symbol->string p)
+          " */\n")
+        fp))
+    *primitives*))
+
+;; List of primitive procedures
+(define (autogen:primitive-procedures fp)
+  (pp ;; CHICKEN pretty-print
+    (cons 
+      'list
+      (map
+        (lambda (p)
+          `(list (quote ,p) ,p))
+         *primitives*))
+    fp))
+
+
diff --git a/trans.scm b/trans.scm
index 192f9025..0fab3109 100644
--- a/trans.scm
+++ b/trans.scm
@@ -497,7 +497,9 @@
   
 ; prim? : exp -> boolean
 (define (prim? exp)
-  (member exp '(
+  (member exp *primitives*))
+
+(define *primitives* '(
      Cyc-global-vars
      Cyc-get-cvar
      Cyc-set-cvar!
@@ -559,7 +561,7 @@
      read-char
      peek-char
      write
-     display)))
+     display))
 
 (define (prim-call? exp)
   (and (list? exp) (prim? (car exp))))