klisp

commit bbfb9b6f1f22f2af5afe7c6c939939ee3c1034af
parent 442a16a91a254c68b02a09122ffcb0075b70aaa1
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Fri, 25 Nov 2011 12:42:39 -0300

Added make-list to the ground environment. Refactored the TODO a little.

Diffstat:
M
TODO
 | 
90
++++++++++++++++++++++++++++++++++++++++----------------------------------------
M
src/kgpairs_lists.c
 | 
38
++++++++++++++++++++++++++++++++++++--

2 files changed, 81 insertions(+), 47 deletions(-)
diff --git a/TODO b/TODO
@@ -1,5 +1,3 @@
-r7rs branch:
-
 * refactor:
 ** double check combiner names to be verbs 
    (e.g. add get- where appropriate)
@@ -7,52 +5,54 @@ r7rs branch:
    ones that are used in more than one place to kghelpers.h
 ** create knumber.h knumber.c and move there kfinitep, kintegerp, etc
    from kgnumbers.
+** use some convention for ground operative underlaying function names
+   maybe add "kgop_"
+** use a better convention for continuation underlaying function names
 * fix:
-** current-jiffy
-** jiffies-per-second
+** current-jiffy (r7rs)
+** jiffies-per-second (r7rs)
 * operatives: 
-** $when
-** $unless
-** $string-for-each
-** $vector-for-each
-** $bytevector-for-each 
-** $case
-** $case-lambda
-** $case-vau
-** $named-let
-** $do
+** $when (r7rs)
+** $unless (r7rs)
+** $string-for-each (r7rs)
+** $vector-for-each (r7rs)
+** $bytevector-for-each (r7rs)
+** $case (r7rs)
+** $case-lambda (r7rs)
+** $case-vau (r7rs)
+** $named-let (r7rs)
+** $do (r7rs)
 * applicatives: 
-** reverse
-** make-list
-** list-copy
-** list-set!
-** vector-map
-** bytevector-map
-** char-foldcase
-** string-map
-** string-downcase
-** string-foldcase
-** string-upcase
-** vector->string
-** string->vector
-** vector-fill
-** vector-copy!
-** vector-copy-partial
-** vector-copy-partial!
-** read-line
-** number->string
-** string->number
-** define-record-type
+** reverse (r7rs)
+** list-copy (r7rs)
+** list-set! (r7rs)
+** vector-map (r7rs)
+** bytevector-map (r7rs)
+** char-foldcase (r7rs)
+** string-map (r7rs)
+** string-downcase (r7rs)
+** string-foldcase (r7rs)
+** string-upcase (r7rs)
+** vector->string (r7rs)
+** string->vector (r7rs)
+** vector-fill (r7rs)
+** vector-copy! (r7rs)
+** vector-copy-partial (r7rs)
+** vector-copy-partial! (r7rs)
+** read-line (r7rs)
+** number->string (r7rs)
+** string->number (r7rs)
+** define-record-type (r7rs)
 * reader
-** symbol escapes
-** string escapes
-** char escapes
+** symbol escapes (r7rs)
+** string escapes (r7rs)
+** char escapes (r7rs)
 * other
-** optional argument to member?
-** optional argument to assoc
-** some simplified error guarding
-** restarts
-** add restart support to the repl/interpreter
-** simple modules (something inspired in r7rs)
-** add modules support to the interpreter
+** optional argument to member? (r7rs)
+** optional argument to assoc (r7rs)
+** some simplified error guarding (r7rs)
+** restarts (r7rs)
+** add restart support to the repl/interpreter (r7rs)
+** simple modules (something inspired in r7rs) (r7rs)
+** add modules support to the interpreter (r7rs)
 
diff --git a/src/kgpairs_lists.c b/src/kgpairs_lists.c
@@ -46,7 +46,6 @@ void cons(klisp_State *K)
     kapply_cc(K, new_pair);
 }
 
-
 /* 5.2.1 list */
 void list(klisp_State *K)
 {
@@ -61,6 +60,40 @@ void list(klisp_State *K)
     kapply_cc(K, ptree);
 }
 
+/* 5.2.? make-list */
+void make_list(klisp_State *K)
+{
+    TValue *xparams = K->next_xparams;
+    TValue ptree = K->next_value;
+    TValue denv = K->next_env;
+    klisp_assert(ttisenvironment(K->next_env));
+
+    UNUSED(xparams);
+    UNUSED(denv);
+    
+    bind_al1tp(K, ptree, "exact integer", keintegerp, tv_s, fill);
+
+    if (!get_opt_tpar(K, fill, "any", anytype))
+        fill = KINERT;
+
+    if (knegativep(tv_s)) {
+        klispE_throw_simple(K, "negative list length");
+        return;
+    } else if (!ttisfixint(tv_s)) {
+        klispE_throw_simple(K, "list length is too big");
+        return;
+    }
+    TValue tail = KNIL;
+    int i = ivalue(tv_s); 
+    krooted_vars_push(K, &tail);
+    while(i-- > 0) {
+	tail = kcons(K, fill, tail);
+    }
+    krooted_vars_pop(K);
+
+    kapply_cc(K, tail);
+}
+
 /* 5.2.2 list* */
 void listS(klisp_State *K)
 {
@@ -114,7 +147,6 @@ void listS(klisp_State *K)
 
 /* 5.4.1 car, cdr */
 /* 5.4.2 caar, cadr, ... cddddr */
-
 void c_ad_r(klisp_State *K)
 {
     TValue *xparams = K->next_xparams;
@@ -1166,6 +1198,8 @@ void kinit_pairs_lists_ground_env(klisp_State *K)
 		    C_AD_R_PARAM(4, 0x1110));
     add_applicative(K, ground_env, "cddddr", c_ad_r, 2, symbol,
 		    C_AD_R_PARAM(4, 0x1111));
+    /* 5.?.? make-list */
+    add_applicative(K, ground_env, "make-list", make_list, 0);
     /* 5.7.1 get-list-metrics */
     add_applicative(K, ground_env, "get-list-metrics", get_list_metrics, 0);
     /* 5.7.2 list-tail */