Lisp Interpreter

Revision 1:a2955606adef, committed 2016-05-21

Comitter:

ohneta

Date:

Sat May 21 22:26:40 2016 +0000

Parent:

0:e9a7a38d9ad3

Commit message:

??commit

Changed in this revision

diff -r e9a7a38d9ad3 -r a2955606adef malisp.cpp
--- a/malisp.cpp	Sun Apr 17 11:59:13 2016 +0000
+++ b/malisp.cpp	Sat May 21 22:26:40 2016 +0000
@@ -162,8 +162,8 @@
     init("add1",  ADD1);
     init("sub1",  SUB1);
     init("quot",  QUOTIENT);
-    TRU = cons(init("t",T), NULL);
-    init("numberp",NUMBERP);
+    TRU = cons(init("t", T), NULL);
+    init("numberp", NUMBERP);
     rplact(TRU, SATOM);
     init("null",  NUL);
     init("funcall",FUNCALL);
@@ -171,6 +171,7 @@
     // for mbed functions
     init("info", FINFO);
     init("freemem", FFREEMEM);
+
     init("wait", FWAIT);
     init("dout", FDOUT);
     init("din",  FDIN);
@@ -183,10 +184,9 @@
 
 LIST *init(char *name, int t)
 {
-    LIST *p;
+    LIST *p = install(name, false);
+    rplact(p, t);
 
-    p = install(name, 1);
-    rplact(p, t);
     return p;
 }
 
@@ -233,24 +233,26 @@
 // isp_print - walks along the list structure printing atoms
 void lisp_print(LIST *p)
 {
-    if (p != NULL) {
-        if (type(p) == RATOM) {
-            pc.printf("%f ", p->u.num);
-        } else if (type(p) == IATOM) {
-            pc.printf("%d ", (int) p->u.num);
-        } else if (type(p) == SATOM) {
-            pc.printf("%s ", getname(car(p)));
-        } else if (type(car(p)) == LST) {
-            pc.printf("%c", '(');
-            lisp_print(car(p));
-            pc.printf("%c", ')');
-            lisp_print(cdr(p));
-        } else if (type(p) == LST) {
-            lisp_print(car(p));
-            lisp_print(cdr(p));
-        } else {
-            pc.printf("******** can't print it out *******\n");
-        }
+    if (p == NULL) {
+        return;
+    }
+
+    if (type(p) == RATOM) {
+        pc.printf("%f ", p->u.num);
+    } else if (type(p) == IATOM) {
+        pc.printf("%d ", (int) p->u.num);
+    } else if (type(p) == SATOM) {
+        pc.printf("%s ", getname(car(p)));
+    } else if (type(car(p)) == LST) {
+        pc.printf("%c", '(');
+        lisp_print(car(p));
+        pc.printf("%c", ')');
+        lisp_print(cdr(p));
+    } else if (type(p) == LST) {
+        lisp_print(car(p));
+        lisp_print(cdr(p));
+    } else {
+        pc.printf("******** can't print it out *******\n");
     }
 }
 
@@ -414,14 +416,6 @@
         // mbed expand
         case FINFO:
         {
-/*
-pc.printf("alist --\n");
-            work_garbageCollect(g_alist);
-pc.printf("oblist --\n");
-            work_garbageCollect(g_oblist);
-*/
-//pc.printf("alist --\n");
-//debug(g_alist);
 pc.printf("\noblist --\n");
 debug(g_oblist);
 
@@ -438,9 +432,11 @@
         case FWAIT:
         {
             LIST * p = mbed_wait(eval(car(cdr(x)), alist));
+/*
             if (p != NULL) {
                 p->gcbit = GARBAGE;
             }
+*/
             return p;
         }
         case FDOUT:
@@ -636,21 +632,23 @@
     return ((p == NULL) ? NULL : car(p));
 }
 
-LIST *install(char *name, int nameConstKind = 0)
+/**
+ * nameをalistに加える
+ *
+ * @param char *name alistに加える名前
+ * @param bool nameCopyFlag nameをコピーするか否か。 true=コピーする、1=コピーしない(nameがconstな文字列)
+ */
+LIST *install(char *name, bool nameCopyFlag = true)
 {
-    LIST *p;
+    LIST *p = cons(NULL, NULL);
 
-    p = cons(NULL, NULL);
-#if 0
-    strcpy(p->u.pname = (char *)emalloc(strlen(name) + 1), name);
-#else
-if (nameConstKind == 0) {    
-    p->u.pname = (char *)emalloc(strlen(name) + 1);
-    strcpy(p->u.pname, name);
-} else {
-    p->u.pname = name;
-}
-#endif
+    if (nameCopyFlag) {
+        p->u.pname = (char *)emalloc(strlen(name) + 1);
+        strcpy(p->u.pname, name);
+    } else {
+        p->u.pname = name;
+    }
+
     rplact(p, VARI);
     g_alist = cons(p, g_alist);
 
@@ -691,29 +689,32 @@
 {
     LIST *p;
 
-    char inbuf[120];
+    char inbuf[120];    // トークン　１つ分のバッファ
     char *s = inbuf;
     LIST *idptr;
 
-    int c = getc_mine(fd);
-    *s = c;
-    s++;
-    if (c != '\'') {
-        while(1) {
-            c = getc_mine(fd);
-            if (!isalnum(c)) {
-                ungetc_mine(c, fd);
-                break;
+    // トークンを取得する
+    {
+        int c = getc_mine(fd);
+        *s = c;
+        s++;
+        if (c != '\'') {
+            while(1) {
+                c = getc_mine(fd);
+                if (!isalnum(c)) {
+                    ungetc_mine(c, fd);
+                    break;
+                }
+                *s = c;
+                s++;
             }
-            *s = c;
-            s++;
         }
+        *s = '\0';
     }
-    *s = '\0';
 
     if ((idptr = lookup(g_oblist, inbuf)) == NULL) {    // not a LISP function
         if ((idptr = lookup(g_alist, inbuf)) == NULL) { // id not declared yet
-            idptr = install(inbuf, 0);                     // install it in g_alist (alist)
+            idptr = install(inbuf, true);               // install it in g_alist (alist)
         }
     }
     p = cons(idptr, NULL);
@@ -810,16 +811,6 @@
 {
     LIST *x = new_malisp();
 
-/*
-// for debug
-{
-    static int num = 0;
-    x->gcbit = (num << 16) | x->gcbit;
-pc.printf("cons-num(%08x): %d\n", x->gcbit, num);
-
-    num++;
-}
-*/
     rplaca(x, p);
     rplacd(x, q);
     rplact(x, LST);
@@ -833,7 +824,9 @@
         if (x == y) {
             return TRU;
         }
-    } else if (type(x) == SATOM && type(y) == SATOM && car(x) == car(y)) {
+    } else if ( (type(x) == SATOM) &&
+                (type(y) == SATOM) &&
+                (car(x) == car(y))  ) {
         return TRU;
     }
 
@@ -842,12 +835,28 @@
 
 LIST *atom(LIST *x)
 {
+#if 0
     int typ;
 
     if (x == NULL || (typ = type(x)) == IATOM || typ == RATOM || typ == SATOM) {
         return TRU;
     }
-
+#else
+    if (x == NULL) {
+        return TRU;
+    }
+    
+    int typ = type(x);
+    if (typ == IATOM) {
+         return TRU;
+    }
+    if (typ == RATOM) {
+         return TRU;
+    }
+    if (typ == SATOM) {
+         return TRU;
+    }
+#endif
     return NULL;
 }
 
@@ -958,8 +967,8 @@
             pc.printf(" : ");
         }
 
-        pc.printf("%d : ", (p->gcbit >> 16) & 0xff);    // num
-        pc.printf("%d \n", (p->gcbit & 0xff));          // bit (USED/RUNNING)
+        //pc.printf("%d : ", (p->gcbit >> 16) & 0xff);    // num
+        //pc.printf("%d \n", (p->gcbit & 0xff));          // bit (USED/RUNNING)
         
         p = cdr(p);
         cnt++;

diff -r e9a7a38d9ad3 -r a2955606adef malisp.h
--- a/malisp.h	Sun Apr 17 11:59:13 2016 +0000
+++ b/malisp.h	Sat May 21 22:26:40 2016 +0000
@@ -18,15 +18,15 @@
 
 
 // token types
-#define IATOM   6
-#define RATOM   7
-#define SATOM   8
-#define FUNC    9
-#define LST     10
-#define VARI    11
-#define QUOTE   12
-#define NILL    13
-#define T       14
+#define IATOM   6       // 整数ATOM
+#define RATOM   7       // 実数ATOM (float)
+#define SATOM   8       // 文字列ATOM
+#define FUNC    9       // 関数
+#define LST     10      // リスト
+#define VARI    11      // 変数
+#define QUOTE   12      // クオート
+#define NILL    13      // nil
+#define T       14      // t
 #define COND    15
 #define DEFUN   16
 #define FCAR    17
@@ -91,17 +91,16 @@
 
 
 typedef struct LIST {
-  //uint32_t    cons_num;
-  
-  //char      gcbit;
-  uint32_t  gcbit;
-  int32_t   htype;
-  union {
-    float num;
-    char  *pname;
-  } u;
-  struct LIST  *left;
-  struct LIST  *right;
+
+    uint32_t  gcbit;
+
+    int32_t   htype;
+    union {
+        float num;
+        char  *pname;
+    } u;
+    struct LIST  *left;
+    struct LIST  *right;
 } LIST;
 
 
@@ -125,6 +124,7 @@
 
 void initialize();
 LIST *init(char *name, int t);
+
 LIST *makelist();
 void lisp_print(LIST *p);
 LIST *eval(LIST *x, LIST *alist);
@@ -138,7 +138,8 @@
 int advance();
 LIST *lookup(LIST *head, char *name);
 //LIST *install(char *name);
-LIST *install(char *name, int nameConstKind);
+//LIST *install(char *name, int nameConstKind);
+LIST *install(char *name, bool nameCopyFlag);
 
 LIST *getnum();
 LIST *getid();