Fixed exponent bug.

 - Exponent had an integer result for integer arguments, should be a float.
   to deal with negative exponents.
 - Added macros to simplify noun parsing.

anicca.c

@@ -16,7 +16,6 @@
 #include "util.h"
 
 I main(I argc, C *argv[]) {
-    A y, z;
     a_init();
     a_repl("   ");
     R 0;

anicca.h

@@ -83,7 +83,9 @@ typedef A(*AF3)(A, A, A);
 #define DMONAD(name) A name(A y, A self)
 #define DDYAD(name)  A name(A x, A y, A self)
 
-A zero; A one; A zone;
+A zero; A one;
+A ten;
+A zone;
 A mark;
 A lpar; A rpar;
 

noun.c

@@ -55,60 +55,40 @@ static A noun_index(I n, C *s) {
     ra(z, INT, k); AN(z) = k; R z;
 }
 
-NPARSE(base) { C *s;
-    parse_pieul(n,sp,y); s=*sp;
-    if (*s=='b') { parse_pieul(n,sp,y); }
+NPARSE(base) { NPROLOG(pieul);
+    if (*e=='b') { ; }
     R 1;
 }
 
-NPARSE(pieul) {C *s=*sp, *e; I k; A p, q, x;
-    parse_cmpx(n,sp,y); e=*sp;
-    if (*e=='p')      { parse_cmpx(n,sp,y); }
-    else if (*e=='x') {
-        e++; p=*y; *y=sbool(0); k=n-(I)(e-s); *sp=e;
-        ASSERT(parse_cmpx(k,sp,y),ERILLNUM);
-        q=*y; *y=times(p,expntl(q));
-    }
+NPARSE(pieul) { NPROLOG(cmpx);
+    if (*e=='p')      { ; }
+    else if (*e=='x') { NBODY(cmpx,times(p,expntl(q))); }
     R 1;
 }
 
-NPARSE(cmpx) { C *s=*sp, *e; I k; A p, q, x;
-    parse_exp(n,sp,y); e=*sp;
+NPARSE(cmpx) { NPROLOG(exp);
     if (*e=='a') {
-        if (*e=='d')      { parse_exp(n,sp,y); }
-        else if (*e=='r') { parse_exp(n,sp,y); }
-    }
-    else if (*e=='j') {
-        e++; p=*y; *y=sbool(0); k=n-(I)(e-s); *sp=e;
-        ASSERT(parse_exp(n,sp,y),ERILLNUM);
-        q=*y; *y=complex(p,q);
+        if (*e=='d')      { NBODY(exp,complex(p,q)); }
+        else if (*e=='r') { NBODY(exp,complex(p,q));  }
     }
+    else if (*e=='j') { NBODY(exp,complex(p,q)); }
     R 1;
 }
 
-NPARSE(exp) { C *s=*sp, *e; I k; A p, q, x;
-    parse_rat(n,sp,y); e=*sp;
-    if (*e=='e') {
-        e++; p=*y; *y=sbool(0); k=n-(I)(e-s); *sp=e;
-        ASSERT(parse_rat(k,sp,y),ERILLNUM);
-        q=*y; *y=times(p,power(sint(10),q));
-    }
+NPARSE(exp) { NPROLOG(rat);
+    if (*e=='e') { NBODY(rat,times(p,power(ten,q))); }
     R 1;
 }
 
-NPARSE(rat) { C *s=*sp;
-    parse_num(n,sp,y);
-    if (*s=='r') { parse_num(n,sp,y); }
+NPARSE(rat) { NPROLOG(num);
+    if (*e=='r') { ; }
     R 1;
 }
 
-NPARSE(num) {
-    C c=**sp, *s=*sp, *d=memchr(s,'.',n), *e;
-    I si=1, iv; D dv; A w = *y;
-    if (c==CUNDS) { si=-1; s++; }
+NPARSE(num) { C c=**sp, *s=*sp, *d=memchr(s,'.',n), *e; A w = *y;
     if (n==1&&(c==CZERO||c==CONE)) { *BAV(w)=c-CZERO; e=s+1; }
-    else if (d) { w=conv(FLT,w); dv=a_strtod(n,s,&e); *DAV(w)=si*dv; }
-    else        { w=conv(INT,w); iv=a_strtoi(n,s,&e); *IAV(w)=si*iv; }
+    else if (d) { w=conv(FLT,w); *DAV(w)=a_strtod(n,s,&e); }
+    else        { w=conv(INT,w); *IAV(w)=a_strtoi(n,s,&e); }
     *y=w; *sp=e; R 1;
 }
 

noun.h

@@ -3,6 +3,17 @@
 
 #define NPARSE(name) static B parse_ ## name(I n, C **sp, A *y)
 
+#define NPROLOG(name)             \
+    C *s=*sp, *e; I k; A p, q;    \
+    parse_ ## name(n,sp,y); e=*sp
+
+#define NBODY(name,func) do {                \
+    e++; p=*y; *y=sbool(0);                  \
+    k=n-(I)(e-s); *sp=e;                     \
+    ASSERT(parse_ ## name(k,sp,y),ERILLNUM); \
+    q=*y, *y=(func);                         \
+} while (0)
+
 static A noun_index(I n, C *s);
 NPARSE(atom);
 NPARSE(base);

parser.c

@@ -7,14 +7,14 @@
 #include "function.h"
 #include "parser.h"
 
-ACTION(monad)  { R df1(stack[e], stack[b]);              }
-ACTION(dyad)   { R df2(stack[b], stack[e], stack[b+1]);  }
-ACTION(adverb) { R df1(stack[b], stack[e]);              }
-ACTION(conjun) { R df2(stack[b], stack[e], stack[b+1]);  }
-ACTION(fork)   { R dfrk(stack[b],stack[b+1], stack[e]);  }
-ACTION(bident) { R dhk(stack[b], stack[e]);              }
-ACTION(is)     { A z; R z;                               }
-ACTION(paren)  { R stack[b+1];                           }
+ACTION(monad)  { R df1(stack[e],  stack[b]);               }
+ACTION(dyad)   { R df2(stack[b],  stack[e],   stack[b+1]); }
+ACTION(adverb) { R df1(stack[b],  stack[e]);               }
+ACTION(conjun) { R df2(stack[b],  stack[e],   stack[b+1]); }
+ACTION(fork)   { R dfrk(stack[b], stack[b+1], stack[e]);   }
+ACTION(bident) { R dhk(stack[b],  stack[e]);               }
+ACTION(is)     { A z; R z;                                 }
+ACTION(paren)  { R stack[b+1];                             }
 
 #define CASES 9
 

primitive.c

@@ -134,7 +134,7 @@ static P primitives[NPRIM+1] = {
     /* 52  }  125 */ {VERB, NULL,       NULL,    0, 0, 0, 0},
     /* 53  ~  126 */ {ADV,  tilde,      NULL,    0, 0, 0, 0},
     /* 54  !. 1   */ {CONJ, NULL,       NULL,    0, 0, 0, 0},
-    /* 55  ". 2   */ {VERB, NULL,       NULL,    0, 0, 0, 0},
+    /* 55  ". 2   */ {VERB, execute,    NULL,    0, 0, 0, 0},
     /* 56  #. 3   */ {VERB, NULL,       NULL,    0, 0, 0, 0},
     /* 57  $. 4   */ {VERB, NULL,       NULL,    0, 0, 0, 0},
     /* 58  %. 5   */ {VERB, NULL,       NULL,    0, 0, 0, 0},

util.c

@@ -3,6 +3,7 @@
 #include <string.h>
 
 #include "anicca.h"
+#include "char.h"
 #include "memory.h"
 #include "function.h"
 #include "verb.h"
@@ -55,23 +56,23 @@ VO println(A y) {
 }
 
 VO a_init(VO) {
-    zero=sbool(0); one=sbool(1); zone=scmpx(0,1);
+    zero=sbool(0); one=sbool(1);
+    ten=sint(10);
+    zone=scmpx(0,1);
     mark = ga(MARK, 0, 0, NULL);
     lpar = ga(LPAR, 0, 0, NULL);
     rpar = ga(RPAR, 0, 0, NULL);
 }
 
-I a_strtoi(I n, C *s, C **e) { I v=0, i;
-    for (i=0;isdigit(*s)&&(i<n);i++) { v=(10*v)+(*s++-'0'); }
-    *e=s; R v;
-}
+I a_strtoi(I n, C *s, C **e) {  R (I)a_strtod(n,s,e); }
 
-D a_strtod(I n, C *s, C**e) {
-    C *d=memchr(s,'.',n); I k=d-s, m=n-(k+1); D p=1, a, b, v;
-    a=(D)a_strtoi(k,s,e); s=*e;
+D a_strtod(I n, C *s, C**e) { I si=1; D v, p;
+    if (*s==CUNDS) { si=-1; s++; }
+    for (v=0;isdigit(*s);) { v=(10*v)+(*s++-'0'); }
     if (*s=='.') { s++; }
-    b=(D)a_strtoi(m,s,e);
-    DO(m, p*=10); v = (a + b/(D)p); R v;
+    for (p=1;isdigit(*s);) { v=(10*v)+(*s++-'0'); p*=10; }
+    *e=s;
+    R si*(v/p);
 }
 
 A eval(const C *str) {

util.h

@@ -5,16 +5,6 @@
 #define MAX(a,b) ((a>b) ? a : b)
 #define ABS(a)   ((a<0) ? -(a) : a)
 
-/* switch-case on numeric types */
-#define NUMERIC_SWITCH(t, b, i, d, z) { \
-        switch (t) {                    \
-        case BOOL: { b; }               \
-        case INT:  { i; }               \
-        case FLT:  { d; }               \
-        case CMPX: { z; }               \
-        }                               \
-}
-
 /* switch-case on noun types */
 #define NOUN_SWITCH(type, bool, ch, i, flt, cmpx, box, mark, lpar, rpar, def) \
     switch (type) {                                                           \

verb-atomic.c

@@ -11,22 +11,21 @@
 #include "util.h"
 
 static UC vaindx[256] = {
-    /*0*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
-    /*1*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
-    /*2*/ 0,0,0,0,0,1,0,0,0,0,2,3,0,4,0,0, /* !"#$%&'()*+,-./*/
-    /*3*/ 0,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0, /*0123456789:;<=>?*/
-    /*4*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /*@ABCDEFGHIJKLMNO*/
-    /*5*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,6,0, /*PQRSTUVWXYZ[\]^_*/
-    /*6*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /*`abcdefghijklmno*/
-    /*7*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /*pqrstuvwxyz{|}~ */
-    /*8*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
-    /*9*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
-    /*a*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
-    /*b*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
-    /*c*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
-    /*d*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
-    /*e*/ 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
-         /*0  1  2  3  4  5  6  7  8  9  a  b  c  d  e  f*/
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+    0,0,0,0,0,1,0,0,0,0,2,3,0,4,0,0, /* !"#$%&'()*+,-./*/
+    0,0,0,0,0,0,0,0,0,0,0,0,5,0,0,0, /*0123456789:;<=>?*/
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /*@ABCDEFGHIJKLMNO*/
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,6,0, /*PQRSTUVWXYZ[\]^_*/
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /*`abcdefghijklmno*/
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, /*pqrstuvwxyz{|}~ */
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
+    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
 };
 
 #define NVA 7
@@ -50,7 +49,7 @@ static VA verbatm[NVA] = {
     {{ {blthan,  VAB|VRB}, {ilthan,  VAI|VRB}, {dlthan,  VAD|VRB},
        {dlthan,  VAD|VRD}, {dlthan,  VAD|VRD}, {dlthan,  VAZ|VRZ}  }},
 
-    {{ {bpower,  VAB|VRB}, {ipower,  VAI|VRI}, {dpower,  VAD|VRD},
+    {{ {bpower,  VAB|VRB}, {ipower,  VAI|VRD}, {dpower,  VAD|VRD},
        {dpower,  VAD|VRD}, {dlthan,  VAD|VRD}, {dlthan,  VAZ|VRZ}  }}
 };
 

verb-scalar2.c

@@ -45,7 +45,7 @@ SF2(dgthan, B, D, *x > *y)
 /*SF2(jplus, Z, Z, zplus(x,y))*/
 
 SF2(bpower, B, B, *x >= *y)
-SF2(ipower, I, I, (I)pow(*x,*y))
+SF2(ipower, D, I, pow((D)*x,(D)*y))
 SF2(dpower, D, D, pow(*x,*y))
 
 SF2(bresidue, B, B, *x % *y)

verb-scalar2.h

@@ -31,7 +31,7 @@ DECL_SF2(ilthan, B, I);
 DECL_SF2(dlthan, B, D);
 
 DECL_SF2(bpower, B, B);
-DECL_SF2(ipower, I, I);
+DECL_SF2(ipower, D, I);
 DECL_SF2(dpower, D, D);
 
 #endif

verb.c

@@ -7,12 +7,14 @@
 #include "char.h"
 #include "error.h"
 #include "memory.h"
+#include "util.h"
 #include "convert.h"
 #include "function.h"
-#include "verb.h"
+#include "lexer.h"
+#include "parser.h"
 #include "verb-scalar1.h"
 #include "verb-atomic.h"
-#include "util.h"
+#include "verb.h"
 
 MONAD(fact) { MONAD_PROLOG;
     I temp, r;
@@ -146,4 +148,6 @@ DYAD(complex) { A z = plus(x,imaginary(y)); R z; }
 
 DYAD(residue) { A z; R z; }
 
+MONAD(execute) { A z = parse(tokens(y)); R z; }
+
 MONAD(tail) { A z; R z; }

verb.h

@@ -42,6 +42,7 @@ MONAD(iota);
 MONAD(imaginary);
 DYAD(complex);
 DYAD(residue);
+MONAD(execute);
 MONAD(tail);
 
 #endif