Added autogen functions

cgen.scm

@@ -1048,33 +1048,36 @@
     (emit "}")
     (emit *c-main-function*)))
 
-; Unused -
+;; Automatically generate blocks of code for the compiler
-;;; Echo file to stdout
+;; TODO: need a compiler option to call this from cmd line
-;(define (emit-fp fp)
+(define (autogen)
-;    (let ((l (read-line fp)))
+  (let ((fp (open-output-file "tmp.txt")))
-;        (if (eof-object? l)
+    (autogen:defprimitives fp)
-;            (close-port fp)
+    (autogen:primitive-procedures fp)
-;            (begin 
+    (close-output-port fp)))
-;                (display l) 
+
-;                (newline)
+(define (autogen:defprimitives fp)
-;                (emit-fp fp)))))
+  (for-each
-;
+    (lambda (p)
-;(define (read-runtime fp)
+      (display
-;  (letrec* 
+        (string-append 
-;    ((break "/** SCHEME CODE ENTRY POINT **/")
+          "defprimitive(" 
-;     (read-fp (lambda (header footer on-header?)
+          (mangle p)
-;       (let ((l (read-line fp)))
+          "); /* "
-;         (cond
+          (symbol->string p)
-;           ((eof-object? l)
+          " */\n")
-;             (close-port fp)
+        fp))
-;             (cons (reverse header) (reverse footer)))
+    *primitives*))
-;           (else 
+
-;             (cond
+;; List of primitive procedures
-;               ((equal? l break)
+(define (autogen:primitive-procedures fp)
-;                 (read-fp header footer #f))
+  (pp ;; CHICKEN pretty-print
-;               (else
+    (cons 
-;                 (if on-header?
+      'list
-;                   (read-fp (cons l header) footer on-header?)
+      (map
-;                   (read-fp header (cons l footer) on-header?))))))))))
+        (lambda (p)
-;
+          `(list (quote ,p) ,p))
-;   (read-fp (list) (list) #t)))
+         *primitives*))
+    fp))
+
+

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))))