Refactored noun parsing to use conversion functions.

TODO
  + Numeric atom functions

adverb.h

@@ -2,10 +2,10 @@
 #define _ADVERB_H
 
 #define ADEF(id, f1, f2, f, l, m, r) \
-    func_def(id, ADV, f1, f2, f, NULL, NULL, l, m, r, 0)
+    fdef(id, ADV, f1, f2, f, NULL, NULL, l, m, r, 0)
 
 #define ADERV(id, df1, df2, f, l, m, r) \
-    derv_def(id, VERB, df1, df2, f, NULL, NULL, l, m, r, 0)
+    ddef(id, VERB, df1, df2, f, NULL, NULL, l, m, r, 0)
 
 MONAD(slash);
 DMONAD(insert);

anicca.c

@@ -15,17 +15,8 @@
 #include "parser.h"
 #include "util.h"
 
-
 I main(I argc, C *argv[]) {
-    C *v, str[100];
-    A x, y, z;
-
     a_init();
-    while (1) {
-        printf("   ");
-        fgets(str, 100, stdin);
-        v = strndup(str, strlen(str)-1); /* remove carriage return */
-        println(z = eval(v));
-    }
+    a_repl("   ");
     return 0;
 }

anicca.h

@@ -8,6 +8,8 @@
         }                      \
 } while(0)
 
+#define R return
+
 typedef int           I;
 typedef unsigned int  UI;
 typedef char          B;

atom.c

@@ -1,5 +1,5 @@
 #include <stdlib.h>
-
+/*
 #include "anicca.h"
 #include "noun.h"
 #include "atom.h"
@@ -28,10 +28,11 @@ ATOMFUNC(angd) {
     return 1;
 }
 
-ATOMFUNC(exp) {
-    D d = noun_dval(a);         /* TODO: it could be an integer */
-    DO(noun_ival(&b), d *= 10); /* TODO: negative exponents */
-    a->t = FLT;
+ATOMFUNC(exp) { */
+/*    D d = noun_dval(a);         */ /* TODO: it could be an integer */
+/*    DO(noun_ival(&b), d *= 10); */ /* TODO: negative exponents */
+/*    a->t = FLT;
     a->val.d = d;
     return 1;
 }
+*/

conjunction.h

@@ -2,10 +2,10 @@
 #define _CONJUNCTION_H
 
 #define CDEF(id, f1, f2, f, g, l, r, m) \
-    func_def(id, CONJ, f1, f2, f, g, NULL, l, r, m, 0)
+    fdef(id, CONJ, f1, f2, f, g, NULL, l, r, m, 0)
 
 #define CDERV(id, df1, df2, f, g, l, r, m) \
-    derv_def(id, VERB, df1, df2, f, g, NULL, l, r, m, 0)
+    ddef(id, VERB, df1, df2, f, g, NULL, l, r, m, 0)
 
 DYAD(amper);
 DMONAD(bond);

convert.c

@@ -1,18 +1,27 @@
 #include <stdlib.h>
 
 #include "anicca.h"
+#include "error.h"
 #include "memory.h"
 #include "convert.h"
 
-A convert(I t, A y) {
-    I yt = AT(y), yr = AR(y), yn = AN(y), *ys = AS(y);
-    I k = type_size(t), *iv; B *bv; D *dv;
-    A z = gen_array(t, yr, yn, ys);
+B cbTi(I n, I *iv, B *bv) { DO(n, iv[i] = (I)bv[i]); R 1; }
+B cbTd(I n, D *dv, B *bv) { DO(n, dv[i] = (D)bv[i]); R 1; }
+B ciTd(I n, D *dv, I *iv) { DO(n, dv[i] = (D)iv[i]); R 1; }
 
-    switch(k = CNVCASE(yt, t)) {
-    case BtI: bv=BAV(y); iv=IAV(z); DO(yn, iv[i] = (I)bv[i]); break;
-    case BtD: bv=BAV(y); dv=DAV(z); DO(yn, dv[i] = (D)bv[i]); break;
-    case ItD: iv=IAV(y); dv=DAV(z); DO(yn, dv[i] = (D)iv[i]); break;
+B aconv(I cv, I n, VP z, VP y) {
+    B *bv; I *iv; D *dv;
+    switch(cv) {
+    case BtI: bv=(B*)y; iv=(I*)z; cbTi(n,iv,bv); break;
+    case BtD: bv=(B*)y; dv=(D*)z; cbTd(n,dv,bv); break;
+    case ItD: iv=(I*)y; dv=(D*)z; ciTd(n,dv,iv); break;
     }
-    return z;
+    R 1;
+}
+
+A conv(I t, A y) {
+    I yt = AT(y), yr = AR(y), yn = AN(y), *ys = AS(y);
+    A z = ga(t, yr, yn, ys);
+    ASSERT(aconv(CNVCASE(yt,t),yn,AV(z),AV(y)),ERDOM);
+    R z;
 }

convert.h

@@ -16,6 +16,20 @@
 #define ItZ CNVCASE(INT, CMPX)
 #define DtZ CNVCASE(FLT, CMPX)
 
-A convert(I t, A y);
+/*
+  Atomic conversions
+   c(Argument)T(Result)
+     input:
+       n: number of elements.
+       v1: result.
+       v2: argument.
+     output: error code.
+*/
+B cbTi(I n, I *iv, B *bv);
+B cbTd(I n, D *dv, B *bv);
+B ciTd(I n, D *dv, I *iv);
+
+B aconv(I cv, I n, VP z, VP y);
+A conv(I t, A y);
 
 #endif

function.c

@@ -20,18 +20,16 @@ DDYAD(df2) {
 
 DMONAD(dhk) {
     V *v = VAV(y);
-    return derv_def(CHOOK, VERB, hook, hook2, y, self, NULL, VLR(v), VMR(v), \
-                    VRR(v), 0);
+    return ddef(CHOOK,VERB,hook,hook2,y,self,NULL,VLR(v),VMR(v),VRR(v),0);
 }
 
 DDYAD(dfrk) {
     V *v = VAV(x);
-    return derv_def(CFORK, VERB, forrk, forrk2, x, y, self, VLR(v), VMR(v), \
-                    VRR(v), 0);
+    return ddef(CFORK,VERB,forrk,forrk2,x,y,self,VLR(v),VMR(v),VRR(v),0);
 }
 
 /*
-  ado: Execute a dyadic scalar function on elements of the arguments.
+  ado: Execute a dyadic atomic function on elements of the arguments.
     input:
       b:  xr <= yr
       m:  minimum number of elements.
@@ -65,8 +63,8 @@ VO ado(I b, I m, I n, I k, I zk, C *zv, C *xv, C *yv, SF f2) {
 */
 A sex1(A y, I zt, SF f1) {
     I yt = AT(y), yr = AR(y), yn = AN(y), *ys = AS(y);
-    I zk = type_size(zt), k = type_size(yt);
-    A z = gen_array(zt, yr, yn, ys);
+    I zk = ts(zt), k = ts(yt);
+    A z = ga(zt, yr, yn, ys);
     C *yv = CAV(y), *zv = CAV(z);
     zv -= zk; yv -= k;
     DO(yn, f1(zv+=zk,  yv+=k));
@@ -86,16 +84,16 @@ A sex1(A y, I zt, SF f1) {
 A sex2(A x, A y, I zt, SF f2) {
     I xt = AT(x), yt = AT(y), *xs = AS(x), *ys = AS(y);
     I xn = AN(x), yn = AN(y), xr = AR(x), yr = AR(y);
-    I zk = type_size(zt), k = type_size(xt);
+    I zk = ts(zt), k = ts(xt);
     I b = xr <= yr, m = b ? xn : yn, n = m ? (b ? yn : xn)/m : 0;
-    A z = gen_array(zt, b ? yr : xr, m*n, b ? ys : xs);
+    A z = ga(zt, b ? yr : xr, m*n, b ? ys : xs);
     C *xv = CAV(x), *yv = CAV(y), *zv = CAV(z);
     ado(b, m, n, k, zk, zv, xv, yv, f2);
     return z;
 }
 
-A func_def(UC id, I t, AF1 f1, AF2 f2, A f, A g, A h, I lr, I mr, I rr, I inv) {
-    A z = gen_array(t, 0, 1, NULL);
+A fdef(UC id, I t, AF1 f1, AF2 f2, A f, A g, A h, I lr, I mr, I rr, I inv) {
+    A z = ga(t, 0, 1, NULL);
     V *v = VAV(z);
     VF1(v) = f1; VF2(v) = f2;
     VDF1(v) = NULL; VDF2(v) = NULL;
@@ -106,8 +104,8 @@ A func_def(UC id, I t, AF1 f1, AF2 f2, A f, A g, A h, I lr, I mr, I rr, I inv) {
     return z;
 }
 
-A derv_def(UC id, I t, AF2 df1, AF3 df2, A f, A g, A h, I lr, I mr, I rr, I inv) {
-    A z = func_def(id, t, NULL, NULL, f, g, h, lr, mr, rr, inv);
+A ddef(UC id, I t, AF2 df1, AF3 df2, A f, A g, A h, I lr, I mr, I rr, I inv) {
+    A z = fdef(id, t, NULL, NULL, f, g, h, lr, mr, rr, inv);
     V *v = VAV(z);
     VDF1(v) = df1; VDF2(v) = df2;
     return z;

function.h

@@ -34,7 +34,7 @@ typedef struct _verb {
     V *v = VAV(self); A f = VF(v), g = VG(v), h = VH(v), z;
 
 #define VDEF(id, f1, f2, l, m, r, i) \
-    func_def(id, VERB, f1, f2, NULL, NULL, NULL. l, m, r, i)
+    fdef(id, VERB, f1, f2, NULL, NULL, NULL. l, m, r, i)
 
 DMONAD(df1);
 DDYAD(df2);
@@ -44,7 +44,7 @@ DDYAD(dfrk);
 static VO ado(I b, I m, I n, I k, I zk, C *zv, C *xv, C *yv, SF f2);
 A sex1(A y, I zt, SF f1);
 A sex2(A x, A y, I zt, SF f2);
-A func_def(UC id, I t, AF1 f1, AF2 f2, A f, A g, A h, I lr, I mr, I rr, I inv);
-A derv_def(UC id, I t, AF2 df1, AF3 df2, A f, A g, A h, I lr, I mr, I rr, I inv);
+A fdef(UC id, I t, AF1 f1, AF2 f2, A f, A g, A h, I lr, I mr, I rr, I inv);
+A ddef(UC id, I t, AF2 df1, AF3 df2, A f, A g, A h, I lr, I mr, I rr, I inv);
 
 #endif

lexer.c

@@ -20,56 +20,9 @@
   input: Length of string, Pointer to string.
   output: Array of type string with length (n-2).
 */
-A parse_literal(I n, C *s) {
-    A z = gen_array(CHAR, 1, n-=2, NULL);  C *v = CAV(z);
-    if (n > 0) { s++; strncpy(v, s, n); }
-    return z;
-}
-
-#define NCOL 3
-#define NROW 5
-
-/* Noun Transition Table */
-static ST noun[NROW][NCOL] = {
-    /*SS*/ {{SM,ES},{SS,EO},{SX,EN}},
-    /*SX*/ {{SM,EW},{SN,EW},{SA,EO}},
-    /*SA*/ {{SM,EW},{SN,EW},{SA,EO}},
-    /*SN*/ {{SM,ES},{SS,EO},{SX,EN}},
-    /*SM*/ {{SS,ES},{SS,ES},{SS,ES}}
-           /*  CX      CS      CA  */
-};
-
-/*
-  noun_start
-  input:  Length of noun, String of noun.
-  output: Array of size 2n, in the form:
-    [start index token 1, length token 1, start index token 2,
-    length token 2, ..., start index token n, length token n].
-*/
-A noun_index(I n, C *s) {
-    C e, t, st = SS;
-    I i, m = 1+n, j = 0, k = 0, *v;
-    ST pr;
-    A z = gen_array(INT, 1, m, NULL);
-    v = IAV(z);
-
-    DO(n,
-       t = nountype[s[i]];
-       pr = noun[st][t];
-       e = pr.effect;
-       st = pr.new;
-
-       switch (e) {
-       case EO: break;
-       case EN: j = i; break;
-       case EW: v[k++] = j; v[k++] = i-j; break;
-       case ES: goto end_noun; break;
-       }
-    );
-  end_noun:    
-    resize_array(z, INT, k);
-    AN(z) = k;
-    return z;
+static A parse_literal(I n, C *s) {
+    A z = gstr(n-=2, s++);
+    R z;
 }
 
 #define DCOL 9
@@ -96,11 +49,11 @@ static ST dfa[DROW][DCOL] = {
     [start index token 1, length token 1, start index token 2,
     length token 2, ..., start index token n, length token n].
 */
-MONAD(token_index) {
+static MONAD(token_index) {
     C e, sn, t, s = SS, vec = 0, *str = CAV(y);
     I i, jv, j = 0, k = 0, n = AN(y), *v;
     ST pr;
-    A z = gen_array(INT, 1, n+n, NULL);
+    A z = ga(INT, 1, n+n, NULL);
     v = IAV(z);
 
     DO(n,
@@ -112,20 +65,18 @@ MONAD(token_index) {
        switch (e) {
        case EO: break;
        case EN: { j = i; break; }
-       case EW: { v[k++] = j; v[k++] = i-j; j = i; break; }
+       case EW: { v[k++] = j; v[k++] = i-j; j = i;  break; }
        case EY: { v[k++] = j; v[k++] = i-j; j = -1; break; }
        case EV: {
            if (!vec) { v[k++] = j; v[k] = i-j; jv = j; }
            else      { v[k] = i-jv; }
-           j = i;
-           vec = 1;
+           j = i; vec = 1;
            break;
        }
        case EZ: {
            if (!vec) { v[k++] = j; v[k] = i-j; jv = j; }
            else      { v[k] = i-jv; }
-           j = -1;
-           vec = 1;
+           j = -1; vec = 1;
            break;
        }
        case ES: goto end; break;
@@ -135,51 +86,39 @@ MONAD(token_index) {
        s = sn;
     );
   end:
-    resize_array(z, INT, k);
+    ra(z, INT, k);
     AN(z) = k;
-    return z;
+    R z;
 }
 
 /*
   tokens
   input:
-    x: Output of token_index.
     y: Boxed string to be tokenized.
   output: Array of boxed tokens.
 */
-DYAD(tokens) {
-    C c, vn, *s, *str = CAV(y);
-    I j, ws, wl, t, n = AN(x)/2, *indx = IAV(x);
-    A v, z = gen_array(BOX, 1, n+5, NULL), *av = AAV(z);
-    *av++ = mark;
+MONAD(tokens) {
+    C c, vn, *str=CAV(y), *s;
+    A  x=token_index(y), z, v, *av;
+    I n=AN(x)/2, *indx=IAV(x), j, ws, wl, t;
 
-    DO(n,
-       j = i+i;
-       ws = indx[j];
-       wl = indx[j+1];
-       s = &str[ws];
-       c = *s;
-       t = chartype[c];
-       vn = verb_name(wl, s);
-       v = primitive_lookup(vn);
+    z = ga(BOX, 1, n+5, NULL); av = AAV(z); *av++ = mark;
+
+    DO(n, j=i+i; ws=indx[j]; wl=indx[j+1];
+       s=&str[ws]; c=*s;  t=chartype[c];
+       vn=verb_name(wl,s); v=primitive_lookup(vn);
 
        if (AT(v)&MARK) {
            switch (t) {
            case CS:
-           case C9: {
-               *av++ = parse_noun(wl, s);
-               break;
-           }
-           case CQ: {
-               *av++ = parse_literal(wl, s);
-               break;
-           }
+           case C9: { *av++ = parse_noun(wl, s);    break; }
+           case CQ: { *av++ = parse_literal(wl, s); break; }
            default: break; /* error */
            }
        }
        else { *av++ = v; }
     );
 
     DO(4, *av++ = mark);
-    return z;
+    R z;
 }

lexer.h

@@ -29,10 +29,8 @@ typedef struct _state {
     C effect;
 } ST;
 
-A parse_literal(I n, C *s);
-A parse_verb(I n, C *s);
-A noun_index(I n, C *s);
-MONAD(token_index);
-DYAD(tokens);
+static A parse_literal(I n, C *s);
+static MONAD(token_index);
+MONAD(tokens);
 
 #endif