Allow primitives to take a continuation argument

Also stubbed out the command-line-args function as such.

cgen.scm

@@ -529,6 +529,7 @@
     ((eq? p 'string-length) "integer_type")
     ((eq? p 'substring) "string_type")
     ((eq? p 'apply)  "object")
+    ((eq? p 'command-line-arguments) "object")
     (else #f)))
 
 ;; Determine if primitive creates a C variable
@@ -545,7 +546,19 @@
              make-vector list->vector
              symbol->string number->string 
              string-length substring
-             + - * / apply cons length vector-length cell))))
+             + - * / apply 
+             command-line-arguments
+             cons length vector-length cell))))
+
+;; Pass continuation as the function's first parameter?
+(define (prim:cont? exp)
+  (and (prim? exp)
+       (member exp '(apply command-line-arguments))))
+;; TODO: this is a hack, right answer is to include information about
+;;  how many args each primitive is supposed to take
+(define (prim:cont-has-args? exp)
+  (and (prim? exp)
+       (member exp '(apply))))
 
 ;; Pass an integer arg count as the function's first parameter?
 (define (prim:arg-count? exp)
@@ -560,16 +573,16 @@
 ;; c-compile-prim : prim-exp -> string -> string
 (define (c-compile-prim p cont)
   (let* ((c-func (prim->c-func p))
-         ;; Following closure defs are only used for apply, to
+         ;; Following closure defs are only used for prim:cont? to
          ;; create a new closure for the continuation, if needed.
          ;;
-         ;; Apply is different in that it takes a continuation so that it can
+         ;; Each prim:cont? function is different in that it takes a continuation so that it can
          ;; allocate arbitrary data as needed using alloca, and then call into
          ;; the cont so allocations can remain on stack until GC.
          (closure-sym (mangle (gensym 'c)))
          (closure-def
            (cond
-             ((and (eq? p 'apply)
+             ((and (prim:cont? p)
                    (> (string-length cont) (string-length "__lambda_"))
                    (equal? (substring cont 0 9) "__lambda_"))
               (string-append 
@@ -581,7 +594,7 @@
             (lambda (type)
               (let ((cv-name (mangle (gensym 'c))))
                 (c-code/vars 
-                  (string-append (if (eq? p 'apply) "" "&") cv-name)
+                  (string-append (if (prim:cont? p) "" "&") cv-name)
                   (list
                     (string-append 
                       ;; Define closure if necessary (apply only)
@@ -595,14 +608,22 @@
                       ;; Emit closure as first arg, if necessary (apply only)
                       (cond
                        (closure-def
-                        (string-append "&" closure-sym ", "))
-                       ((eq? p 'apply) 
-                        (string-append cont ", "))
+                        (string-append "&" closure-sym 
+                          (if (prim:cont-has-args? p) ", " "")))
+                       ((prim:cont? p) 
+                        (string-append cont
+                          (if (prim:cont-has-args? p) ", " "")))
                        (else "")))))))))
     (cond
      ((prim/c-var-assign p)
       (c-var-assign (prim/c-var-assign p)))
      ((prim/cvar? p)
+        ;;
+        ;; TODO: look at functions that would actually fall into this
+        ;; branch, I think they are just the macro's like string->list ??
+        ;; may be able to remove this using prim:cont? and simplify
+        ;; the logic
+        ;;
         (let ((cv-name (mangle (gensym 'c))))
            (c-code/vars 
             (if (prim:allocates-object? p)

runtime.c

@@ -51,7 +51,8 @@ int gc_num_ans;
 jmp_buf jmp_main; /* Where to jump to. */
 
 object Cyc_global_variables = nil;
-object Cyc_command_line_arguments = nil;
+int _cyc_argc = 0;
+char **_cyc_argv = NULL;
 
 static symbol_type __EOF = {eof_tag, "", nil}; // symbol_type in lieu of custom type
 const object Cyc_EOF = &__EOF;
@@ -892,9 +893,12 @@ string_type Cyc_substring(object str, object start, object end) {
   }
 }
 
-object Cyc_command_line_arguments() {
-  Cyc_rt_raise_msg("not implemented yet");
-  return boolean_f;
+object Cyc_command_line_arguments(object cont) {
+  //Cyc_rt_raise_msg("not implemented yet");
+  //return boolean_f;
+  make_string(s, "TODO");
+  make_cons(l, &s, nil);
+  return_funcall1(cont, &l);
 }
 
 integer_type Cyc_system(object cmd) {
@@ -1313,7 +1317,7 @@ void _cyc_string_91ref(object cont, object args) {
     object c = Cyc_string_ref(car(args), cadr(args));
     return_funcall1(cont, c); }
 void _command_91line_91arguments(object cont, object args) {
-    object cmdline = Cyc_command_line_arguments();
+    object cmdline = Cyc_command_line_arguments(cont);
     return_funcall1(cont, cmdline); }
 void _cyc_system(object cont, object args) {
     integer_type i = Cyc_system(car(args));

runtime.h

@@ -56,7 +56,8 @@ object cell_get(object cell);
 /* Prototypes for Lisp built-in functions. */
 
 extern object Cyc_global_variables;
-extern object Cyc_command_line_arguments;
+int _cyc_argc;
+char **_cyc_argv;
 object Cyc_get_global_variables();
 object Cyc_get_cvar(object var);
 object Cyc_set_cvar(object var, object value);
@@ -104,7 +105,7 @@ string_type Cyc_string_append_va_list(int argc, object str1, va_list ap);
 integer_type Cyc_string_length(object str);
 string_type Cyc_substring(object str, object start, object end);
 object Cyc_string_ref(object str, object k);
-object Cyc_command_line_arguments();
+object Cyc_command_line_arguments(object cont);
 integer_type Cyc_system(object cmd);
 integer_type Cyc_char2integer(object chr);
 object Cyc_integer2char(object n);

test2.scm

@@ -8,6 +8,8 @@
     (loop (- i 1))))
 
 
+(write (command-line-arguments))
+
 (write (when (lambda () #t) 'true))
 (write (when (lambda () #f) 'false))