aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ast.c92
-rw-r--r--src/ast.h6
-rw-r--r--src/id_table.c69
-rw-r--r--src/id_table.h29
-rw-r--r--src/inpla.l16
-rw-r--r--src/inpla.y432
-rw-r--r--src/linenoise/.gitignore3
-rw-r--r--src/name_table.c2
-rw-r--r--src/name_table.h2
9 files changed, 486 insertions, 165 deletions
diff --git a/src/ast.c b/src/ast.c
index ca46600..738b4a7 100644
--- a/src/ast.c
+++ b/src/ast.c
@@ -36,7 +36,7 @@ char *recordSymbol(SymbolTable *table, char *name) {
// The `name' has existed already,
// and table->sym[i] is used instead of that,
// so starduped memory for the `name' should be freed here.
- free(name);
+ // free(name);
return table->sym[i];
}
@@ -150,6 +150,7 @@ void ast_recordConst(char *name, int val) {
}
+
Ast *ast_makeAST(AST_ID id, Ast *left, Ast *right) {
Ast *ptr;
if ((id == AST_AGENT) && (right == NULL)) {
@@ -252,7 +253,7 @@ void puts_ast(Ast *p) {
"(*L)", "(*R)",
// extension
- "TUPLE",
+ "TUPLE", "PPAIR",
"INT", "LD", "ADD", "SUB", "MUL", "DIV", "MOD",
"LT", "LE", "EQ", "NE", "UNM",
"CONS", "NIL", "OPCONS",
@@ -276,6 +277,11 @@ void puts_ast(Ast *p) {
puts_ast(p->right);
printf(")");
break;
+ case AST_PPAIR:
+ printf("PPAIR(");
+ puts_ast(p->right);
+ printf(")");
+ break;
case AST_NIL:
printf("NIL");
break;
@@ -295,6 +301,88 @@ void puts_ast(Ast *p) {
}
+Ast *ast_unfoldABR(Ast *left, char *sym, Ast *paramlist) {
+ // input:
+ // left << (AST_AGENT, sym, paramlist)
+
+ // output:
+ // p1,p2,...,pn << (AST_AGENT, sym, params @ [param])
+ // ==> (AST_CNCT left right)
+ // where left = (AST_AGENT sym, p1,p2,...,pn,params)
+ // right = (AST_NAME param)
+
+ if (!strcmp(sym, "Append")) {
+ // paramlist: [a,b] => [b,a]
+ if (paramlist->right != NULL) {
+ Ast *tmp = paramlist->left; // tmp for a
+ paramlist->left = paramlist->right->left; // a := b
+ paramlist->right->left = tmp; // b := a
+ }
+ } else if (!strcmp(sym, "Merger")) {
+ // left << Merger(paramlist) ==> Merger(left) ~ (paramlist)
+ Ast *agent_left = ast_makeAST(AST_AGENT, ast_makeSymbol("Merger"), left);
+ Ast *agent_right = ast_makeTuple(paramlist);
+ Ast *cnct = ast_makeAST(AST_CNCT, agent_left, agent_right);
+ return cnct;
+ }
+
+ //puts_ast(left);puts("");
+ //puts_ast(paramlist);puts("");
+
+ Ast *params, *param, *at;
+
+ // paramlist: (AST_LIST elem next)
+ if (paramlist->right == NULL) {
+ // [x] => [], x
+ param = paramlist->left;
+ params = NULL;
+ } else {
+ params = param = NULL;
+
+ // params@[param] => params, param
+ at = paramlist;
+ while (at->right != NULL) {
+ if (at->right->right == NULL) {
+ param = at->right->left; // compoment
+ at->right = NULL; // break the list chain
+ params = paramlist; // params is the list whose last is just broken
+ break;
+ }
+ at = at->right;
+ }
+ }
+
+ // puts_ast(params);puts("");
+ // puts_ast(param);puts("");
+
+
+ // make left as left@params
+ at = left;
+ while (at != NULL) {
+ if (at->right == NULL) {
+ at->right = params;
+ break;
+ }
+ at = at->right;
+ }
+ // puts_ast(left);puts("");
+
+
+ Ast *agent_left = ast_makeAST(AST_AGENT, ast_makeSymbol(sym), left);
+ Ast *agent_right = param;
+ Ast *cnct = ast_makeAST(AST_CNCT, agent_left, agent_right);
+
+ //puts_ast(agent_left);puts("");
+ //puts_ast(agent_right);puts("");
+
+ //exit(1);
+ return cnct;
+
+}
+
+
+
+
Ast *ast_remove_tuple1(Ast *p) {
if (p==NULL) return p;
diff --git a/src/ast.h b/src/ast.h
index 0acc5bb..8bd667a 100644
--- a/src/ast.h
+++ b/src/ast.h
@@ -13,8 +13,8 @@ typedef enum {
// annotation
AST_ANNOTATION_L, AST_ANNOTATION_R,
- // builtin tuble
- AST_TUPLE,
+ // builtin tuple
+ AST_TUPLE, AST_PPAIR,
// operation
AST_INT, AST_LD, AST_PLUS, AST_SUB, AST_MUL, AST_DIV, AST_MOD,
@@ -50,7 +50,7 @@ void puts_ast(Ast *p);
Ast *ast_paramToCons(Ast *ast);
void ast_recordConst(char *name, int val);
Ast *ast_remove_tuple1(Ast *p);
-
+Ast *ast_unfoldABR(Ast *left, char *sym, Ast *paramlist);
#define ast_makeCons(x1,x2) ast_makeAST(AST_LIST,x1,x2)
#define ast_makeList1(x1) ast_makeAST(AST_LIST,x1,NULL)
diff --git a/src/id_table.c b/src/id_table.c
index b7b267b..cbcee78 100644
--- a/src/id_table.c
+++ b/src/id_table.c
@@ -35,10 +35,19 @@ void IdTable_init() {
IdTable[ID_CONS].arity = 2;
IdTable[ID_INTAGENT].arity = 1;
+ IdTable[ID_APPEND].arity = 2;
+ IdTable[ID_MERGER].arity = 1;
+ IdTable[ID_MERGER_P].arity = 1;
IdTable[ID_ADD].arity = 2;
IdTable[ID_ADD2].arity = 2;
- // IdTable[ID_APPEND].arity = 2;
- // IdTable[ID_APPEND2].arity = 2;
+ IdTable[ID_SUB].arity = 2;
+ IdTable[ID_SUB2].arity = 2;
+ IdTable[ID_MUL].arity = 2;
+ IdTable[ID_MUL2].arity = 2;
+ IdTable[ID_DIV].arity = 2;
+ IdTable[ID_DIV2].arity = 2;
+ IdTable[ID_MOD].arity = 2;
+ IdTable[ID_MOD2].arity = 2;
IdTable[ID_INT].name = "int";
IdTable[ID_TUPLE0].name = "Tuple0";
@@ -51,10 +60,19 @@ void IdTable_init() {
IdTable[ID_CONS].name = "Cons";
IdTable[ID_INTAGENT].name = "Int";
- IdTable[ID_ADD].name = "Add";
- IdTable[ID_ADD2].name = "Add2";
IdTable[ID_APPEND].name = "Append";
- IdTable[ID_APPEND2].name = "Append2";
+ IdTable[ID_MERGER].name = "Merger";
+ IdTable[ID_MERGER_P].name = "_MergerP";
+ IdTable[ID_ADD].name = "Add";
+ IdTable[ID_ADD2].name = "_Add";
+ IdTable[ID_SUB].name = "Sub";
+ IdTable[ID_SUB2].name = "_Sub";
+ IdTable[ID_MUL].name = "Mul";
+ IdTable[ID_MUL2].name = "_Mul";
+ IdTable[ID_DIV].name = "Div";
+ IdTable[ID_DIV2].name = "_Div";
+ IdTable[ID_MOD].name = "Mod";
+ IdTable[ID_MOD2].name = "_Mod";
}
@@ -67,16 +85,22 @@ int IdTable_getid_builtin_funcAgent(Ast *agent) {
return -1;
}
- if (strcmp((char *)agent->left->sym, "Add2") == 0) {
- id = ID_ADD2;
- } else if (strcmp((char *)agent->left->sym, "Add") == 0) {
+ if (strcmp((char *)agent->left->sym, "Add") == 0) {
id = ID_ADD;
+ } else if (strcmp((char *)agent->left->sym, "Sub") == 0) {
+ id = ID_SUB;
+ } else if (strcmp((char *)agent->left->sym, "Mul") == 0) {
+ id = ID_MUL;
+ } else if (strcmp((char *)agent->left->sym, "Div") == 0) {
+ id = ID_DIV;
+ } else if (strcmp((char *)agent->left->sym, "Mod") == 0) {
+ id = ID_MOD;
} else if (strcmp((char *)agent->left->sym, "Append") == 0) {
id = ID_APPEND;
- } else if (strcmp((char *)agent->left->sym, "Append2") == 0) {
- id = ID_APPEND2;
} else if (strcmp((char *)agent->left->sym, "Int") == 0) {
id = ID_INTAGENT;
+ } else if (strcmp((char *)agent->left->sym, "Merger") == 0) {
+ id = ID_MERGER;
}
return id;
@@ -100,7 +124,8 @@ int IdTable_is_builtin_rule(Ast *agentL, Ast *agentR) {
int idL = IdTable_getid_builtin_funcAgent(agentL);
if (agentR->id == AST_INT) {
- if ((idL == ID_ADD) || (idL == ID_ADD2)) {
+ if ((idL == ID_ADD) || (idL == ID_SUB) || (idL == ID_MUL)
+ || (idL == ID_DIV) || (idL == ID_MOD)) {
return 1;
}
return 0;
@@ -112,6 +137,16 @@ int IdTable_is_builtin_rule(Ast *agentL, Ast *agentR) {
}
return 0;
}
+
+ if (idL == ID_MERGER) {
+ if ((agentR->id == AST_TUPLE) && (agentR->intval == 2)) {
+ // Merger >< Tuple2
+ return 1;
+ }
+ return 0;
+ }
+
+
return 0;
}
@@ -133,7 +168,7 @@ void IdTable_set_arity(int id, int arity)
if ((IdTable[id].arity == -1) || (IdTable[id].arity == arity)) {
IdTable[id].arity = arity;
} else {
- printf("Warning: The agent '%s' has been already defined as whose arity is %d, but now redefined as the arity is %d.\n",
+ printf("Warning: The agent '%s' has been already defined as whose arity is %d, but now used as the arity is %d.\n",
IdTable[id].name, IdTable[id].arity, arity);
IdTable[id].arity = arity;
}
@@ -162,10 +197,12 @@ int IdTable_new_agentid() {
int IdTable_new_gnameid() {
NextGnameId++;
- if (NextAgentId > IDTABLE_SIZE) {
- printf("ERROR: The number of agents exceeded the size of names in SYMTABLE (%d)\n",
- ID_NAME);
+ if (NextGnameId < IDTABLE_SIZE) {
+ return(NextGnameId);
+ } else {
+
+ printf("ERROR: The total number of agents and names exceeded the size of names in IDTABLE (%d)\n",
+ IDTABLE_SIZE);
exit(-1);
}
- return(NextGnameId);
}
diff --git a/src/id_table.h b/src/id_table.h
index 8dbdeef..7567b70 100644
--- a/src/id_table.h
+++ b/src/id_table.h
@@ -26,17 +26,28 @@
#define ID_CONS 8
#define IS_LISTID(id) ((id == ID_NIL) && (id == ID_CONS))
-#define ID_INTAGENT 9
-
-#define START_ID_OF_BUILTIN_AGENT 10
-#define ID_ADD 10
-#define ID_ADD2 11
-#define ID_APPEND 12
-#define ID_APPEND2 13
-#define END_ID_OF_BUILTIN_AGENT 13
+#define ID_INTAGENT 10 // This is an experimental dummy agent
+ // to show the use effect of Int agent.
+
+
+#define START_ID_OF_BUILTIN_AGENT 15
+#define ID_APPEND 15
+#define ID_MERGER 16
+#define ID_MERGER_P 17
+#define ID_ADD 18
+#define ID_ADD2 19
+#define ID_SUB 20
+#define ID_SUB2 21
+#define ID_MUL 22
+#define ID_MUL2 23
+#define ID_DIV 24
+#define ID_DIV2 25
+#define ID_MOD 26
+#define ID_MOD2 27
+#define END_ID_OF_BUILTIN_AGENT 27
-#define START_ID_OF_AGENT 20
+#define START_ID_OF_AGENT END_ID_OF_BUILTIN_AGENT+1
//#define NUM_AGENTS 1024
#define END_ID_OF_AGENT 255
#define NUM_AGENTS END_ID_OF_AGENT+1 // 256
diff --git a/src/inpla.l b/src/inpla.l
index f5b386d..85bf522 100644
--- a/src/inpla.l
+++ b/src/inpla.l
@@ -6,7 +6,6 @@
#undef YY_INPUT
#define YY_INPUT(buf,result,max_size) result = mygetinput(buf, max_size);
-// lineno de kubetu?
static int mygetinput(char *buf, int size) {
char *line;
if (feof(yyin)) return YY_NULL;
@@ -23,6 +22,7 @@ static int mygetinput(char *buf, int size) {
return len;
}
+ linenoiseSetMultiLine(1);
if (yylineno == 1) {
line = linenoise(">>> ");
} else {
@@ -30,8 +30,10 @@ static int mygetinput(char *buf, int size) {
}
if(!line) return YY_NULL;
if(strlen(line) > size-2){
- fprintf(stderr,"input line too long\n"); return YY_NULL; }
- sprintf(buf,"%s\n",line);
+ fprintf(stderr,"input line too long\n");
+ return YY_NULL;
+ }
+ sprintf(buf, "%s\n", line);
linenoiseHistoryAdd(line);
linenoiseHistorySave(".inpla.history.txt");
free(line);
@@ -101,7 +103,7 @@ char *Parse_closeStringBuffer() {
<INITIAL>"/" return (DIV);
<INITIAL>"%" return (MOD);
<INITIAL>"_" return (ANY);
-<INITIAL>"?" return (QUE);
+<INITIAL>"<<" return (ABR);
<INITIAL>"int" return(INT);
@@ -132,7 +134,7 @@ char *Parse_closeStringBuffer() {
<INITIAL>"*R" return(ANNOTATE_R);
<INITIAL>[a-z][a-zA-Z0-9_'\.]* { yylval.chval = strdup(yytext);
return (NAME);}
-<INITIAL>[_A-Z][a-zA-Z0-9_'\.]* { yylval.chval = strdup(yytext);
+<INITIAL>[A-Z][a-zA-Z0-9_'\.]* { yylval.chval = strdup(yytext);
return (AGENT);}
<INITIAL>[0-9]+ { yylval.intval = atoi(yytext);
return (INT_LITERAL);}
@@ -143,8 +145,8 @@ char *Parse_closeStringBuffer() {
<COM_STATE>\n ;
<COM_STATE>"*/" BEGIN INITIAL; //comment
-<INITIAL>\r\n {}
-<INITIAL>[\n|\r] {}
+<INITIAL>\r\n ;
+<INITIAL>[\n|\r] ;
<INITIAL>[ \t]+ ;
<INITIAL><<EOF>> {return END_OF_FILE;}
<INITIAL>\" {
diff --git a/src/inpla.y b/src/inpla.y
index ff65f39..1545b81 100644
--- a/src/inpla.y
+++ b/src/inpla.y
@@ -6,9 +6,9 @@
#include <unistd.h>
#include <errno.h>
#include <sched.h>
-
-#include "linenoise/linenoise.h"
+#include "linenoise/linenoise.h"
+
#include "ast.h"
#include "id_table.h"
#include "name_table.h"
@@ -48,8 +48,8 @@ int ActiveThreadNum=0;
//#define YYDEBUG 1
-#define VERSION "0.4.2"
-#define BUILT_DATE "16 Oct. 2021"
+#define VERSION "0.5.0"
+#define BUILT_DATE "28 Oct. 2021"
extern FILE *yyin;
@@ -186,7 +186,7 @@ void eat_to_newline(void)
%token <chval> NAME AGENT
%token <intval> INT_LITERAL
%token <chval> STRING_LITERAL
-%token LP RP LC RC LB RB COMMA CROSS DELIMITER QUE
+%token LP RP LC RC LB RB COMMA CROSS DELIMITER ABR
%token COLON
%token TO CNCT
@@ -441,7 +441,7 @@ val_declare
agent_cons
: LB astterm PIPE astterm RB
-{$$ = ast_makeAST(AST_OPCONS, NULL, ast_makeList2($2, $4)); }
+{ $$ = ast_makeAST(AST_OPCONS, NULL, ast_makeList2($2, $4)); }
;
agent_list
@@ -464,8 +464,8 @@ agentterm
;
-astparam :
-LP RP { $$ = NULL; }
+astparam
+: LP RP { $$ = NULL; }
| LP astparams RP { $$ = $2; }
;
@@ -476,8 +476,16 @@ astparams
ap
: astterm CNCT astterm { $$ = ast_makeAST(AST_CNCT, $1, $3); }
+//
+| astparams ABR AGENT LP astparams RP
+{ $$ = ast_unfoldABR($1, $3, $5); }
+//
+| astparams ABR NAME LP astparams RP
+{ $$ = ast_unfoldABR($1, $3, $5); }
;
+
+
aplist
: ap { $$ = ast_makeList1($1); }
| aplist COMMA ap { $$ = ast_addLast($1, $3); }
@@ -747,7 +755,7 @@ VALUE myallocAgent(Heap *hp) {
}
-static inline
+//static inline
VALUE myallocName(Heap *hp) {
#ifdef MALLOC
@@ -1033,7 +1041,8 @@ char *Pretty_Name(VALUE a) {
#endif
-#define PUTS_ELEMENTS_NUM 12
+//#define PUTS_ELEMENTS_NUM 12
+#define PUTS_ELEMENTS_NUM 30
static int Puts_list_element=0;
@@ -1044,7 +1053,7 @@ void puts_term(VALUE ptr) {
printf("%d", FIX2INT(ptr));
return;
} else if (BASIC(ptr) == NULL) {
- printf("[NULL]");
+ printf("<NULL>");
return;
}
@@ -1124,7 +1133,7 @@ void puts_term(VALUE ptr) {
}
}
-
+
} else {
// Agent
int i, arity;
@@ -1230,7 +1239,8 @@ void free_names_ast(Ast *ast) {
while (param != NULL) {
char *sym = param->left->sym;
- flush_name_port0(NameTable_get_heap(sym));
+ VALUE heap = NameTable_get_heap(sym);
+ flush_name_port0(heap);
param = ast_getTail(param);
}
}
@@ -2663,6 +2673,7 @@ int CompileTermFromAst(Ast *ptr, int target) {
return result;
break;
+
case AST_CONS:
if (target == -1) {
result = CmEnv_newreg();
@@ -2730,7 +2741,7 @@ int CompileTermFromAst(Ast *ptr, int target) {
break;
*/
-
+
case AST_TUPLE:
arity = ptr->intval;
@@ -3765,10 +3776,15 @@ void makeRule(Ast *ast) {
// 単純に ruleAgentL、ruleAgentR を入れ替えれば良いわけではない。
if (idL > idR) {
- // 標準では Append(xs, r) >< [y|ys] なので
+ // Generally the order should be as Append(xs,r) >< y:ys,
+ // so idL should be greater than idR.
+
+ // JAPANESE: 標準では Append(xs, r) >< [y|ys] なので
// idL の方が大きくなって欲しい
- // annotation が (*L) なら左側、(*R) なら右側を指すものとする
+
+ // (*L) is interpreted as the left-hand side agent, (*R) is the right one.
+ // JAPANESE: annotation が (*L) なら左側、(*R) なら右側を指すものとする
setAnnotateLR(VM_OFFSET_ANNOTATE_L, VM_OFFSET_ANNOTATE_R);
} else {
@@ -3781,8 +3797,11 @@ void makeRule(Ast *ast) {
idTmp = idL;
idL = idR;
idR = idTmp;
-
- // aplist 内の (*L) (*R) はそのままにしておき、
+
+ // Keep the occurrence (*L) and (*R) in aplist,
+ // change the interpretation of (*L) as (*R), vice versa.
+
+ // JAPANESE: aplist 内の (*L) (*R) はそのままにしておき、
// annotation が (*L) なら右側、(*R) なら左側を指すものとする
setAnnotateLR(VM_OFFSET_ANNOTATE_R, VM_OFFSET_ANNOTATE_L);
}
@@ -3790,7 +3809,8 @@ void makeRule(Ast *ast) {
{
int arity;
- // code の先頭2つは idL、idR の arity を格納する
+ // IMPORTANT:
+ // The first two codes store arities of idL and idR.
if (idL == ID_INT) {
arity = 0;
} else {
@@ -3816,14 +3836,14 @@ void makeRule(Ast *ast) {
if (idL == ID_INT) {
setMetaL_asIntName(ruleL);
- CmEnv.annotateL = ANNOTATE_AS_INT_AGENT; // FreeL 出力を防ぐ
+ CmEnv.annotateL = ANNOTATE_AS_INT_AGENT; // to prevent putting FreeL out
} else {
setMetaL(ruleL);
}
if (idR == ID_INT) {
setMetaR_asIntName(ruleR);
- CmEnv.annotateR = ANNOTATE_AS_INT_AGENT; // FreeR 出力を防ぐ
+ CmEnv.annotateR = ANNOTATE_AS_INT_AGENT; // to prevent putting FreeR out
} else {
setMetaR(ruleR);
}
@@ -3833,7 +3853,6 @@ void makeRule(Ast *ast) {
- //code_size = CompileGuardBodiesFromAST(guard_bodies, code, code_size);
code_size += CompileIfSentenceFromAST(if_sentence, code, code_size);
if (code_size < 0)
return;
@@ -6317,12 +6336,14 @@ loop_a2IsFixnum:
getRuleCodeInt(a1, &code);
- if (code == NULL) {
-
+ if (code == NULL) {
// built-in
switch (BASIC(a1)->id) {
case ID_ADD:
{
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
BASIC(a1)->id = ID_ADD2;
VALUE a1port1 = AGENT(a1)->port[1];
AGENT(a1)->port[1] = a2;
@@ -6331,14 +6352,118 @@ loop_a2IsFixnum:
}
case ID_ADD2:
{
- int m = FIX2INT(AGENT(a1)->port[1]);
- int n = FIX2INT(a2);
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
+ // r << Add(m,n)
+ int n = FIX2INT(AGENT(a1)->port[1]);
+ int m = FIX2INT(a2);
a2 = INT2FIX(m+n);
VALUE a1port0 = AGENT(a1)->port[0];
freeAgent(a1);
a1 = a1port0;
goto loop;
}
+ case ID_SUB:
+ {
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
+ BASIC(a1)->id = ID_SUB2;
+ VALUE a1port1 = AGENT(a1)->port[1];
+ AGENT(a1)->port[1] = a2;
+ a2 = a1port1;
+ goto loop;
+ }
+ case ID_SUB2:
+ {
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
+ // r << Sub(m,n)
+ int n = FIX2INT(AGENT(a1)->port[1]);
+ int m = FIX2INT(a2);
+ a2 = INT2FIX(m-n);
+ VALUE a1port0 = AGENT(a1)->port[0];
+ freeAgent(a1);
+ a1 = a1port0;
+ goto loop;
+ }
+ case ID_MUL:
+ {
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
+ BASIC(a1)->id = ID_MUL2;
+ VALUE a1port1 = AGENT(a1)->port[1];
+ AGENT(a1)->port[1] = a2;
+ a2 = a1port1;
+ goto loop;
+ }
+ case ID_MUL2:
+ {
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
+ // r << Mult(m,n)
+ int n = FIX2INT(AGENT(a1)->port[1]);
+ int m = FIX2INT(a2);
+ a2 = INT2FIX(m*n);
+ VALUE a1port0 = AGENT(a1)->port[0];
+ freeAgent(a1);
+ a1 = a1port0;
+ goto loop;
+ }
+ case ID_DIV:
+ {
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
+ BASIC(a1)->id = ID_DIV2;
+ VALUE a1port1 = AGENT(a1)->port[1];
+ AGENT(a1)->port[1] = a2;
+ a2 = a1port1;
+ goto loop;
+ }
+ case ID_DIV2:
+ {
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
+ // r << DIV(m,n)
+ int n = FIX2INT(AGENT(a1)->port[1]);
+ int m = FIX2INT(a2);
+ a2 = INT2FIX(m/n);
+ VALUE a1port0 = AGENT(a1)->port[0];
+ freeAgent(a1);
+ a1 = a1port0;
+ goto loop;
+ }
+ case ID_MOD:
+ {
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
+ BASIC(a1)->id = ID_MOD2;
+ VALUE a1port1 = AGENT(a1)->port[1];
+ AGENT(a1)->port[1] = a2;
+ a2 = a1port1;
+ goto loop;
+ }
+ case ID_MOD2:
+ {
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
+ // r << MOD(m,n)
+ int n = FIX2INT(AGENT(a1)->port[1]);
+ int m = FIX2INT(a2);
+ a2 = INT2FIX(m%n);
+ VALUE a1port0 = AGENT(a1)->port[0];
+ freeAgent(a1);
+ a1 = a1port0;
+ goto loop;
+ }
}
@@ -6435,98 +6560,10 @@ loop_a2IsAgent:
// a1 が fixnum
if (IS_FIXNUM(a1)) {
// fixnum >< agent
-
- void **code = NULL;
-
- getRuleCodeInt(a2, &code);
-
- if (code == NULL) {
-
-
- // built-in
- VALUE tmp = a1;
- a1 = a2;
- a2 = tmp;
- switch (BASIC(a1)->id) {
-
- case ID_ADD:
- {
- BASIC(a1)->id = ID_ADD2;
- VALUE a1port1 = AGENT(a1)->port[1];
- AGENT(a1)->port[1] = a2;
- a2 = a1port1;
- goto loop;
- }
- case ID_ADD2:
- {
- int m = FIX2INT(AGENT(a1)->port[1]);
- int n = FIX2INT(a2);
- a2 = INT2FIX(m+n);
- VALUE a1port0 = AGENT(a1)->port[0];
- freeAgent(a1);
- a1 = a1port0;
- goto loop;
- }
-
- }
-
-
-
-
- printf("Runtime Error: There is no interaction rule for the following pair:\n ");
- puts_term(a1);
- printf("~");
- puts_term(a2);
- puts("");
-
- if (yyin != stdin) exit(-1);
-
-#ifndef THREAD
- mark_and_sweep();
- return;
-#else
- printf("Retrieve is not supported in the multi-threaded version.\n");
- exit(-1);
-#endif
- }
-
- int i;
- unsigned long arity;
- arity = (unsigned long)code[0];
-
- switch(arity) {
- case 0:
- break;
-
- case 1:
- vm->agentReg[VM_OFFSET_META_R(0)] = AGENT(a2)->port[0];
- break;
-
- case 2:
- vm->agentReg[VM_OFFSET_META_R(0)] = AGENT(a2)->port[0];
- vm->agentReg[VM_OFFSET_META_R(1)] = AGENT(a2)->port[1];
- break;
-
- case 3:
- vm->agentReg[VM_OFFSET_META_R(0)] = AGENT(a2)->port[0];
- vm->agentReg[VM_OFFSET_META_R(1)] = AGENT(a2)->port[1];
- vm->agentReg[VM_OFFSET_META_R(2)] = AGENT(a2)->port[2];
- break;
-
- default:
- for (i=0; i<arity; i++) {
- vm->agentReg[VM_OFFSET_META_R(i)] = AGENT(a2)->port[i];
- }
- }
-
- vm->agentReg[VM_OFFSET_ANNOTATE_L] = a2;
- vm->agentReg[VM_OFFSET_ANNOTATE_R] = a1;
-
-#ifdef COUNT_INTERACTION
- vm->NumberOfInteraction++;
-#endif
- ExecCode(1, vm, &code[2]);
- return;
+ VALUE tmp = a1;
+ a1 = a2;
+ a2 = tmp;
+ goto loop_a2IsFixnum;
}
// a1 が agent
@@ -6561,7 +6598,7 @@ loop_a2IsAgent:
if (result == 0) {
- if (BASIC(a2)->id <= ID_CONS) {
+ if (BASIC(a2)->id < START_ID_OF_BUILTIN_AGENT) {
// built-in
switch (BASIC(a1)->id) {
@@ -6569,6 +6606,9 @@ loop_a2IsAgent:
case ID_TUPLE0:
if (BASIC(a2)->id == ID_TUPLE0) {
// [] ~ [] --> nothing
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
freeAgent(a1);
freeAgent(a2);
return;
@@ -6580,6 +6620,9 @@ loop_a2IsAgent:
case ID_TUPLE2:
if (BASIC(a2)->id == ID_TUPLE2) {
// (x1,x2) ~ (y1,y2) --> x1~y1, x2~y2
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
VALUE a1p1 = AGENT(a1)->port[1];
VALUE a2p1 = AGENT(a2)->port[1];
PUSH(vm, a1p1, a2p1);
@@ -6596,6 +6639,9 @@ loop_a2IsAgent:
case ID_TUPLE3:
if (BASIC(a2)->id == ID_TUPLE3) {
// (x1,x2,x3) ~ (y1,y2,y3) --> x1~y1, x2~y2, x3~y3
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
PUSH(vm, AGENT(a1)->port[2], AGENT(a2)->port[2]);
PUSH(vm, AGENT(a1)->port[1], AGENT(a2)->port[1]);
@@ -6612,6 +6658,9 @@ loop_a2IsAgent:
case ID_TUPLE4:
if (BASIC(a2)->id == ID_TUPLE4) {
// (x1,x2,x3) ~ (y1,y2,y3) --> x1~y1, x2~y2, x3~y3
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
PUSH(vm, AGENT(a1)->port[3], AGENT(a2)->port[3]);
PUSH(vm, AGENT(a1)->port[2], AGENT(a2)->port[2]);
PUSH(vm, AGENT(a1)->port[1], AGENT(a2)->port[1]);
@@ -6629,6 +6678,9 @@ loop_a2IsAgent:
case ID_TUPLE5:
if (BASIC(a2)->id == ID_TUPLE5) {
// (x1,x2,x3) ~ (y1,y2,y3) --> x1~y1, x2~y2, x3~y3
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
PUSH(vm, AGENT(a1)->port[4], AGENT(a2)->port[4]);
PUSH(vm, AGENT(a1)->port[3], AGENT(a2)->port[3]);
PUSH(vm, AGENT(a1)->port[2], AGENT(a2)->port[2]);
@@ -6647,6 +6699,9 @@ loop_a2IsAgent:
case ID_NIL:
if (BASIC(a2)->id == ID_NIL) {
// [] ~ [] --> nothing
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
freeAgent(a1);
freeAgent(a2);
return;
@@ -6658,6 +6713,9 @@ loop_a2IsAgent:
case ID_CONS:
if (BASIC(a2)->id == ID_CONS) {
// a:b ~ c:d --> a~c, b~d
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
VALUE a1p1 = AGENT(a1)->port[1];
VALUE a2p1 = AGENT(a2)->port[1];
PUSH(vm, a1p1, a2p1);
@@ -6679,6 +6737,9 @@ loop_a2IsAgent:
case ID_NIL:
{
// App(r,a) >< [] => r~a;
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
VALUE a1p0 = AGENT(a1)->port[0];
VALUE a1p1 = AGENT(a1)->port[1];
freeAgent(a1);
@@ -6691,6 +6752,9 @@ loop_a2IsAgent:
case ID_CONS:
{
// App(r,a) >< [x|xs] => r~(*R)[x|w], (*L)App(w,a)~xs;
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
VALUE a1p0 = AGENT(a1)->port[0];
VALUE a2p1 = AGENT(a2)->port[1];
VALUE w = makeName(vm);
@@ -6708,7 +6772,118 @@ loop_a2IsAgent:
break; // end ID_APPEND
-
+ case ID_MERGER:
+ switch (BASIC(a2)->id) {
+ case ID_TUPLE2:
+ {
+ // MG(r) ~ (a|b) => *MGp(*r)~a, *MGp(*r)~b
+#ifdef COUNT_INTERACTION
+ vm->NumberOfInteraction++;
+#endif
+ BASIC(a1)->id = ID_MERGER_P;
+ AGENT(a1)->port[1] = (VALUE)NULL;
+ AGENT(a1)->port[2] = (VALUE)NULL;
+ PUSH(vm, a1, AGENT(a2)->port[1]);
+ PUSH(vm, a1, AGENT(a2)->port[0]);
+ freeAgent(a2);
+ return;
+
+
+ }
+ }
+ break; // end ID_MG
+
+ case ID_MERGER_P:
+ switch (BASIC(a2)->id) {
+ case ID_NIL:
+ // *MGP(r)~[]
+#ifndef THREAD
+ if (AGENT(a1)->port[1] == (VALUE)NULL) {
+ AGENT(a1)->port[1] = a2;
+ return;
+ } else {
+ VALUE a1p0 = AGENT(a1)->port[0];
+ freeAgent(AGENT(a1)->port[1]);
+ freeAgent(a1);
+ a1 = a1p0;
+ goto loop;
+ }
+#else
+ if (AGENT(a1)->port[2] == (VALUE)NULL) {
+ if (!(__sync_bool_compare_and_swap(&(AGENT(a1)->port[2]),
+ NULL, a2))) {
+ // something exists already
+ goto loop;
+
+ } else {
+ return;
+ }
+ } else if ((AGENT(a1)->port[2] != (VALUE)NULL) &&
+ (BASIC(AGENT(a1)->port[2])->id == ID_NIL)) {
+
+ VALUE a1p0 = AGENT(a1)->port[0];
+ freeAgent(AGENT(a1)->port[2]);
+ freeAgent(a1);
+ a1 = a1p0;
+ goto loop;
+ } else {
+ goto loop;
+ }
+
+#endif
+ case ID_CONS:
+ // *MGP(r)~x:xs => r~x:w, *MGP(w)~xs;
+ {
+#ifndef THREAD
+ VALUE a1p0 = AGENT(a1)->port[0];
+
+ VALUE w = makeName(vm);
+ AGENT(a1)->port[0] = w;
+ PUSH(vm, a1, AGENT(a2)->port[1]);
+
+ AGENT(a2)->port[1] = w;
+ a1 = a1p0;
+ goto loop;
+#else
+ if (AGENT(a1)->port[1] == (VALUE)NULL) {
+ if (!(__sync_bool_compare_and_swap(&(AGENT(a1)->port[1]),
+ NULL,
+ a2))) {
+ goto loop;
+ }
+
+ VALUE a1p0 = AGENT(a1)->port[0];
+
+ VALUE w = makeName(vm);
+ AGENT(a1)->port[0] = w;
+ PUSH(vm, a1, AGENT(a2)->port[1]);
+
+ AGENT(a2)->port[1] = w;
+
+ AGENT(a1)->port[1] = (VALUE)NULL; // free the lock
+
+ a1 = a1p0;
+
+ goto loop;
+
+ } else if ((AGENT(a1)->port[2] != (VALUE)NULL) &&
+ (BASIC(AGENT(a1)->port[2])->id == ID_NIL)) {
+ freeAgent(AGENT(a1)->port[2]);
+ VALUE a1p0 = AGENT(a1)->port[0];
+ freeAgent(a1);
+ a1 = a1p0;
+ goto loop;
+
+ } else {
+ goto loop;
+ }
+
+
+#endif
+ }
+
+ }
+ break; // end ID_MERGER_P
}
}
@@ -6919,14 +7094,18 @@ void WHNFInfo_push_equation(VALUE t1, VALUE t2) {
void WHNF_execution_loop() {
VALUE t1, t2;
+
while (PopEQStack(&VM, &t1, &t2)) {
+
+ puts_term(t1); printf("~"); puts_term(t2); puts("");
- if ((NameTable_ckech_if_term_has_gname(t1) == 1) ||
- (NameTable_ckech_if_term_has_gname(t2) == 1)) {
-
+ if ((NameTable_check_if_term_has_gname(t1) == 1) ||
+ (NameTable_check_if_term_has_gname(t2) == 1)) {
+
eval_equation(&VM, t1, t2);
} else {
+
WHNFInfo_push_equation(t1, t2);
}
}
@@ -7401,6 +7580,7 @@ int main(int argc, char *argv[])
case '-':
case 'h':
case '?':
+ printf("Inpla version %s\n", VERSION);
puts("Usage: inpla [options]\n");
puts("Options:");
printf(" -f <filename> Set input file name (Defalut: STDIN)\n");
@@ -7420,7 +7600,7 @@ int main(int argc, char *argv[])
MaxThreadNum);
#else
- printf(" -w Enable Weak Head Normal Form strategy (Default: false)\n"
+ printf(" -w Enable Weak Reduction strategy (Default: false)\n"
);
@@ -7524,7 +7704,7 @@ int main(int argc, char *argv[])
#ifndef THREAD
if (WHNFinfo.enabled) {
- printf("Inpla %s (WHNF) : Interaction nets as a programming language",
+ printf("Inpla %s (Weak Strategy) : Interaction nets as a programming language",
VERSION);
printf(" [%s]\n", BUILT_DATE);
} else {
@@ -7578,7 +7758,7 @@ int main(int argc, char *argv[])
linenoiseHistoryLoad(".inpla.history.txt");
-
+
// the main loop of parsing and execution
while(1) {
diff --git a/src/linenoise/.gitignore b/src/linenoise/.gitignore
new file mode 100644
index 0000000..7ab7825
--- /dev/null
+++ b/src/linenoise/.gitignore
@@ -0,0 +1,3 @@
+linenoise_example
+*.dSYM
+history.txt
diff --git a/src/name_table.c b/src/name_table.c
index f3fae27..3634dd0 100644
--- a/src/name_table.c
+++ b/src/name_table.c
@@ -418,7 +418,7 @@ void NameTable_free_all() {
}
-int NameTable_ckech_if_term_has_gname(VALUE term) {
+int NameTable_check_if_term_has_gname(VALUE term) {
int i;
NameList *at;
VALUE ptr;
diff --git a/src/name_table.h b/src/name_table.h
index 588c34d..1ba31a5 100644
--- a/src/name_table.h
+++ b/src/name_table.h
@@ -45,7 +45,7 @@ IDTYPE NameTable_get_set_id(char *key);
void NameTable_puts_all();
void NameTable_free_all();
-int NameTable_ckech_if_term_has_gname(VALUE term);
+int NameTable_check_if_term_has_gname(VALUE term);
int term_has_keynode(VALUE keynode, VALUE term);
int keynode_exists_in_another_term(VALUE keynode, VALUE *connected_from);
generated by cgit v1.2.3 (git 2.39.1) at 2026-11-10 16:31:37 +0000