Merge pull request #27 from billhails/car-cdr

car and cdr and prefix operators for them

docs/TODO.md

@@ -0,0 +1,32 @@
+# TODO
+
+* over-application i.e. `fn (a) { fn (b) { a + b } }(2, 3)`
+* tuples - can use vec type to implement.
+   * BUT - fn args are not tuples, that might interfere with currying.
+* unpacking function return values (tuples only)
+* print function
+   * type awareness
+   * needs thought,
+   * would be nice to be able to describe how types should print.
+* don't convert `if` to `lambda` - it's too inefficient.
+* remove old `cons` from ANF and bytecodes.
+* numbers:
+   * arbitrary size integers
+   * rationals: 1/3
+   * irrationals: sqrt(2)
+   * complex numbers
+* UTF8 and `wchar_t`
+* first class environments
+* libraries
+   * probably use file system layout
+   * env var to specify the root location(s)
+   * better preable/postamble handling
+* propagate file and line numbers into all error reporting.
+   * much better error reporting.
+* error recovery.
+* command-line arguments for libraries etc.
+   * verbose output for gc statistics at end of run etc.
+* fail on non-exhaustive pattern match (optional).
+   * some sort of `//@-allow-non-exhaustive` inline directive?
+* error function
+* remove hard-coded assumptions about type sizes in bytecodes

fn/caddr.fn

@@ -0,0 +1,4 @@
+let
+    x = [1, 2, 3, 4];
+in
+    <>>x

fn/prec.fn

@@ -0,0 +1 @@
+2 + 2 * 3

fn/print.fn

@@ -0,0 +1 @@
+print("Hello, World!")

src/common.h

@@ -26,7 +26,7 @@
 // #define DEBUG_RUN_TESTS 1
 // #define TEST_STACK
 // #define DEBUG_STACK
-#define DEBUG_STEP
+// #define DEBUG_STEP
 // #define DEBUG_SLOW_STEP
 #define DEBUG_STRESS_GC
 // #define DEBUG_LOG_GC
@@ -46,7 +46,7 @@
 // #define DEBUG_LEAK
 // #define DEBUG_ANF
 // #define DEBUG_ALLOC
-#define SAFETY_CHECKS
+// #define SAFETY_CHECKS
 
 void cant_happen(const char *message, ...);
 void can_happen(const char *message, ...);

src/parser.y

@@ -210,6 +210,7 @@ static AstUnpack *newStringUnpack(char *str) {
 %nonassoc '='
 %nonassoc ':'
 %right CONS APPEND
+%left CAR CDR
 %left '+' '-'
 %left '*' '/' '%'
 %right '^'
@@ -423,6 +424,8 @@ expression : binop                      { $$ = newAstExpression(AST_EXPRESSION_T
 
 unop : '-' expression %prec NEG   { $$ = unOpToFunCall(negSymbol(), $2); }
      | NOT expression %prec NOT   { $$ = unOpToFunCall(notSymbol(), $2); }
+     | LT expression %prec CAR    { $$ = unOpToFunCall(carSymbol(), $2); }
+     | GT expression %prec CDR    { $$ = unOpToFunCall(cdrSymbol(), $2); }
      | HERE expression            { $$ = unOpToFunCall(hereSymbol(), $2); }
      ;
 

src/preamble.fn

@@ -14,4 +14,14 @@ let
         (x, _ @ t) { member(x, t) }
     }
 
+    fn car {
+        ([]) { [] }
+        (h @ _) { h }
+    }
+
+    fn cdr {
+        ([]) { [] }
+        (_ @ t) { t }
+    }
+
 in {

src/step.c

@@ -176,14 +176,8 @@ static int _vecCmp(Vec *a, Vec *b) {
     if (a->size == 0 || b->size == 0) {
         cant_happen("empty vecs in _vecCmp()");
     }
-    if (a->values[0].type != VALUE_TYPE_INTEGER || b->values[0].type != VALUE_TYPE_INTEGER) {
-        cant_happen("expected integer vec tags in _vecCmp()");
-    }
 #endif
-    if (a->values[0].val.z != b->values[0].val.z) {
-        return a->values[0].val.z < b->values[0].val.z ? -1 : 1;
-    }
-    for (int i = 1; i < a->size; ++i) {
+    for (int i = 0; i < a->size; ++i) {
         int cmp = _cmp(a->values[i], b->values[i]);
         if (cmp != 0) return cmp;
     }

src/symbols.c

@@ -285,3 +285,19 @@ HashSymbol *envSymbol() {
     return res;
 }
 
+HashSymbol *carSymbol() {
+    static HashSymbol *res = NULL;
+    if (res == NULL) {
+        res = newSymbol("car");
+    }
+    return res;
+}
+
+HashSymbol *cdrSymbol() {
+    static HashSymbol *res = NULL;
+    if (res == NULL) {
+        res = newSymbol("cdr");
+    }
+    return res;
+}
+

src/symbols.h

@@ -53,5 +53,7 @@ HashSymbol *intSymbol();
 HashSymbol *charSymbol();
 HashSymbol *boolSymbol();
 HashSymbol *envSymbol();
+HashSymbol *carSymbol();
+HashSymbol *cdrSymbol();
 
 #endif