Commits

Anonymous committed abd86f1

Add failing test case. Add debugging in mignon's eval().

Comments (0)

Files changed (6)

impl/mignon/eval.c

     printf("}\n");
 }
 
+static void debug(const char *msg)
+{
+    //printf("%s\n", msg);
+    msg = msg;
+}
+
 struct value *eval(struct value *sexp, struct env *env)
 {
     struct value *cadr = atom("cadr");
         switch (sexp->type) {
             case V_ATOM:
             {
+                debug("V_ATOM");
+                debug(((struct atom *)sexp)->string);
                 struct atom *name = (struct atom *)sexp;
                 struct value *value = lookup(env, name);
                 if (value == NULL) {
             }
             case V_CONS:
             {
+                debug("V_CONS");
                 struct value *h = head(sexp);
                 struct value *t = tail(sexp);
                 struct value *bound = lookup(env, (struct atom *)h);
                 if (bound != NULL) {
-                    sexp = cons(bound, t);
+                    debug("*(bound)");
+                    debug(((struct atom *)h)->string);
+                    sexp = cons(bound, t); /* pair of a lambda and a list */
                     done = 0; /* "tail call" */
                 } else if (h == cadr) {
+                    debug("*cadr");
                     struct value *k = eval(head(t), env);
                     return head(tail(k));
                 } else if (h == car) {
+                    debug("*car");
                     struct value *k = eval(head(t), env);
                     return head(k);
                 } else if (h == cdr) {
+                    debug("*cdr");
                     struct value *k = eval(head(t), env);
                     return tail(k);
                 } else if (h == cond) {
+                    debug("*cond");
                     struct value *branch = head(t);
                     /* this will error out with car(nil) if no 'else' in cond */
                     while (done) {
                         }
                     }
                 } else if (h == cons_) {
+                    debug("*cons");
                     struct value *j = eval(head(t), env);
                     struct value *k = eval(head(tail(t)), env);
                     return cons(j, k);
                 } else if (h == equalp) {
+                    debug("*equalp");
                     struct value *j = eval(head(t), env);
                     struct value *k = eval(head(tail(t)), env);
                     if (equal(j, k)) {
                         return falsehood;
                     }
                 } else if (h == lambda_) {
+                    debug("*lambda");
                     return lambda(env, head(t), head(tail(t)));
                 } else if (h == let) {
+                    debug("*let*");
                     struct value *pairs = head(t);
                     struct value *body = head(tail(t));
 
                         struct value *name = head(pair);
                         struct value *value = eval(head(tail(pair)), env);
                         /* TODO: check that head(pair) is an atom! */
+                        debug("binding");
+                        debug(((struct atom *)name)->string);
                         env = bind(env, (struct atom *)name, value);
                         pairs = tail(pairs);
                     }
                     sexp = body;
                     done = 0; /* "tail call" */
                 } else if (h == listp) {
+                    debug("*list?");
                     struct value *k = eval(head(t), env);
                     while (k->type == V_CONS) {
                         k = tail(k);
                         return falsehood;
                     }
                 } else if (h == nullp) {
+                    debug("*null?");
                     struct value *k = eval(head(t), env);
                     if (k == nil) {
                         return truth;
                         return falsehood;
                     }
                 } else if (h == quote) {
+                    debug("*quote");
                     if (t == nil)
                         return t;
                     return head(t);
                 } else if (h->type == V_LAMBDA) {
+                    debug("*(lambda)");
                     struct lambda *l = (struct lambda *)h;
                     struct value *formals = l->formals;
-                    env = l->env;
+                    env = l->env; /* WHAAA? */
                     while (t->type == V_CONS) {
                         struct value *formal = head(formals);
                         struct value *value = eval(head(t), env);
                     sexp = l->body;
                     done = 0; /* "tail call" */       
                 } else {
+                    debug("*(inner sexp)*");
                     struct value *k = eval(h, env);
                     struct value *m = cons(eval(k, env), t);
                     return eval(m, env);
             }
             case V_LAMBDA:
             {
+                debug("V_LAMBDA\n");
                 return sexp;
             }
         }

impl/mignon/main.c

             struct estate *estate = push_estate(NULL, env, state->result);
             estate = eval_resumable(estate);
             dump(estate->result);
-            */            
+            */
             dump(eval(state->result, env));
             printf("\n");
             done = 1;
 # - if the expression file (second argument) contains anything other than
 #   Pixley, things will crash and burn
 
+if [ ! "${DEBUG}x" = "x" ]; then
+    less $2
+fi
+
 impl/mignon/mignon `cat $2` 2>&1
 if [ "${FINAL_SCHEME_IMPL}x" = "x" ]; then
     FINAL_SCHEME_IMPL=${SCHEME_IMPL}
 fi
+
+if [ ! "${DEBUG_TOWER}x" = "x" ]; then
+    less next.scm
+fi
+
 SCHEME_IMPL=${FINAL_SCHEME_IMPL} ${SCRIPTDIR}/scheme-adapter.sh /dev/null next.scm
 
 ### Clean up ###

src/tests.markdown

     |     (f (lambda (x) (cons x a)))) f) (quote oh))
     = (oh hi)
 
+You can call a function with a bound name as its argument.
+
+    | (let* ((interpret
+    |         (lambda (program)
+    |           (let* ((interpreter (quote z)))
+    |             (cons interpreter program))))
+    |        (sexp (quote (cdr (quote (one two three))))))
+    |   (interpret sexp))
+    = (z cdr (quote (one two three)))
+
 Functions can take functions.
 
     | (let*
 #echo "Testing Pixley programs on Pixley interpreter on [mignon]..."
 #cat >config.markdown <<EOF
 #    -> Functionality "Interpret Pixley Program" is implemented by shell command
-#    -> "SCHEME_IMPL=miniscm FINAL_SCHEME_IMPL=mignon script/tower.sh src/pixley.pix %(test-file)"
+#    -> "SCHEME_IMPL=${SCHEME_IMPL} FINAL_SCHEME_IMPL=mignon script/tower.sh src/pixley.pix %(test-file)"
 #EOF
 #falderal test config.markdown src/tests.markdown