diff --git a/src/runtime/c/Makefile.am b/src/runtime/c/Makefile.am
index b0cc5ddd1..f30a909ee 100644
--- a/src/runtime/c/Makefile.am
+++ b/src/runtime/c/Makefile.am
@@ -1,10 +1,10 @@
LDADD = libgu.la
-lib_LTLIBRARIES = libgu.la libpgf.la
+lib_LTLIBRARIES = libgu.la libpgf.la libteyjus.la
pkgconfigdir = $(libdir)/pkgconfig
-pkgconfig_DATA = libgu.pc libpgf.pc
+pkgconfig_DATA = libgu.pc libpgf.pc libteyjus.pc
configincludedir = $(libdir)/libgu/include
@@ -80,6 +80,23 @@ libgu_la_SOURCES = \
gu/variant.c \
gu/yaml.c
+libteyjus_la_SOURCES = \
+ teyjus/simulator/abstmachine.c \
+ teyjus/simulator/dataformats.c \
+ teyjus/simulator/hnorm.c \
+ teyjus/simulator/hnormlocal.c \
+ teyjus/simulator/hopu.c \
+ teyjus/simulator/io-datastructures.c \
+ teyjus/simulator/mcstring.c \
+ teyjus/simulator/printterm.c \
+ teyjus/simulator/simdispatch.c \
+ teyjus/simulator/siminit.c \
+ teyjus/simulator/siminstr.c \
+ teyjus/simulator/siminstrlocal.c \
+ teyjus/simulator/simulator.c \
+ teyjus/simulator/trail.c \
+ teyjus/simulator/types.c
+
libpgf_la_SOURCES = \
pgf/data.c \
pgf/data.h \
@@ -95,7 +112,7 @@ libpgf_la_SOURCES = \
pgf/reader.c \
pgf/linearize.c \
pgf/printer.c
-
+
bin_PROGRAMS = \
utils/pgf2yaml \
utils/pgf-print \
@@ -118,4 +135,5 @@ EXTRA_DIST = \
Doxyfile \
DoxygenLayout.xml \
libgu.pc.in \
+ libteyjus.pc.in \
libpgf.pc.in
diff --git a/src/runtime/c/configure.ac b/src/runtime/c/configure.ac
index 81bc610c9..2a8f5e0ec 100644
--- a/src/runtime/c/configure.ac
+++ b/src/runtime/c/configure.ac
@@ -56,6 +56,7 @@ DX_INIT_DOXYGEN(libpgf)
AC_CONFIG_FILES([Makefile
libgu.pc
libpgf.pc
+ libteyjus.pc
])
AC_OUTPUT
diff --git a/src/runtime/c/teyjus/loader/searchtab.h b/src/runtime/c/teyjus/loader/searchtab.h
new file mode 100644
index 000000000..6559443e1
--- /dev/null
+++ b/src/runtime/c/teyjus/loader/searchtab.h
@@ -0,0 +1,44 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+#ifndef _SEARCHTAB_H_
+#define _SEARCHTAB_H_
+
+#include "../system/memory.h"
+
+#define SEARCHTAB_FCF_SEQNSEARCH 0
+#define SEARCHTAB_FCF_HASHSEARCH 1
+
+extern WordPtr LD_SEARCHTAB_LoadHashTab(MEM_GmtEnt* ent, int* size);
+
+extern WordPtr LD_SEARCHTAB_LoadSeqSTab(MEM_GmtEnt* ent, int* size);
+
+/**
+\brief Find code function for hash tables.
+\return The address of the code corresponding to the given index. Return address for values not in the table is undefined.
+**/
+extern CSpacePtr LD_SEARCHTAB_HashSrch(int constInd, int STabSize, MemPtr STabAddr);
+
+/**
+\brief Find code function for sequential search tables.
+\return The address of the code corresponding to the given index. Return address for values not in the table is undefined.
+ **/
+extern CSpacePtr LD_SEARCHTAB_SeqnSrch(int constInd, int STabSize, MemPtr STabAddr);
+
+#endif //_SEARCHTAB_H_
diff --git a/src/runtime/c/teyjus/simulator/abstmachine.c b/src/runtime/c/teyjus/simulator/abstmachine.c
new file mode 100644
index 000000000..a1b4da273
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/abstmachine.c
@@ -0,0 +1,617 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+/****************************************************************************/
+/* */
+/* File abstmachine.c. This file defines the various registers, */
+/* data areas and record types and their operations relevant to the */
+/* abstract machine. */
+/* */
+/****************************************************************************/
+#ifndef ABSTMACHINE_C
+#define ABSTMACHINE_C
+
+#include "mctypes.h"
+#include "mcstring.h"
+#include "dataformats.h"
+#include "abstmachine.h"
+#include "instraccess.h"
+#include "../system/error.h"
+#include "../system/memory.h"
+
+/****************************************************************************/
+/* ABSTRACT MACHINE REGISTERS (AND FLAGS) */
+/****************************************************************************/
+AM_DataType AM_regs[AM_NUM_OF_REG];//argument regs/temp variable
+//data register access: return the address of the ith register
+AM_DataTypePtr AM_reg(int i) { return (AM_regs + i); }
+
+MemPtr AM_hreg; //heap top
+MemPtr AM_hbreg; //heap backtrack point
+MemPtr AM_ereg; //current environment
+MemPtr AM_breg; //last choice point
+MemPtr AM_b0reg; //cut point
+MemPtr AM_ireg; //impl pt reg, defining prog context
+MemPtr AM_cireg; //impl pt for current clause
+MemPtr AM_cereg; //closure environment
+MemPtr AM_tosreg; //top of stack impl or choice pt.
+MemPtr AM_trreg; //trail top
+MemPtr AM_pdlTop; //top of pdl
+MemPtr AM_pdlBot; //(moving) bottom of pdl
+MemPtr AM_typespdlBot; //(moving) bottom of types pdl
+
+DF_TermPtr AM_sreg; //"structure" pointer
+DF_TypePtr AM_tysreg; //type structure pointer
+
+CSpacePtr AM_preg; //program pointer
+CSpacePtr AM_cpreg; //continuation pointer
+
+Flag AM_bndFlag; //does binding of free var (term) occur?
+Flag AM_writeFlag; //in write mode?
+Flag AM_tyWriteFlag; //in ty write mode?
+Flag AM_ocFlag; //occurs check?
+
+Flag AM_consFlag; //cons?
+Flag AM_rigFlag; //rigid?
+
+//The size of AM_numAbs is decided by that of relevant fields in term
+//representations which can be found in dataformats.c
+TwoBytes AM_numAbs; //number of abstractions in hnf
+//The size of AM_numArgs is decided by that of relevant fields in term
+//representations which can be found in dataformats.c
+TwoBytes AM_numArgs; //number of arguments in hnf
+
+DF_TermPtr AM_head; //head of a hnf
+DF_TermPtr AM_argVec; //argument vector of a hnf
+
+DF_TermPtr AM_vbbreg; //variable being bound for occ
+DF_TypePtr AM_tyvbbreg; //type var being bound for occ
+
+//The size of AM_adjreg is decided by that of relevant fields in term
+//representations which can be found in dataformats.c
+TwoBytes AM_adjreg; //univ count of variable being bound
+TwoBytes AM_ucreg; //universe count register
+
+DF_DisPairPtr AM_llreg; //ptr to the live list
+
+/****************************************************************************/
+/* STACK, HEAP, TRAIL AND PDL RELATED STUFF */
+/****************************************************************************/
+
+MemPtr AM_heapBeg, //beginning of the heap
+ AM_heapEnd, //end of the heap
+ AM_stackBeg, //beginning of the trail
+ AM_stackEnd, //end of the trail
+ AM_trailBeg, //beginning of the trail
+ AM_trailEnd, //end of the trail
+ AM_pdlBeg, //beginning of pdl
+ AM_pdlEnd, //end of pdl
+ AM_fstCP; //the first choice point
+
+/****************************************************************************/
+/* CODE PLACED IN THE HEAP BY THE SYSTEM */
+/****************************************************************************/
+CSpacePtr AM_failCode;
+CSpacePtr AM_andCode;
+CSpacePtr AM_orCode;
+CSpacePtr AM_allCode;
+CSpacePtr AM_solveCode;
+CSpacePtr AM_builtinCode;
+CSpacePtr AM_eqCode;
+CSpacePtr AM_stopCode;
+CSpacePtr AM_haltCode;
+CSpacePtr AM_notCode1;
+CSpacePtr AM_notCode2;
+CSpacePtr AM_proceedCode;
+
+
+Boolean AM_isFailInstr(CSpacePtr cptr) { return (cptr == AM_failCode); }
+/****************************************************************************/
+/* VITUAL MACHINE MEMORY OPERATIONS */
+/****************************************************************************/
+//is the given addr referring to a register?
+Boolean AM_regAddr(MemPtr p)
+{
+ //TODO:
+ // AM_reg lacked conversion to MemPtr; why is a function getting
+ // converted in this way?
+ return ((((MemPtr)AM_reg) <= p) && (p < (MemPtr)((MemPtr)AM_reg + AM_NUM_OF_REG)));
+}
+//is the given addr on stack?
+Boolean AM_stackAddr(MemPtr p) { return (p > AM_hreg); }
+//is the given addr not on heap?
+Boolean AM_nHeapAddr(MemPtr p) { return ((p > AM_hreg) || (AM_heapBeg > p));}
+
+ //is the "first" impl/impt record?
+Boolean AM_botIP(MemPtr p) { return (p == AM_stackBeg); }
+//is the "first" choice point"?
+Boolean AM_botCP() { return (AM_breg == AM_fstCP); }
+//no env record left on the stack?
+Boolean AM_noEnv() { return (AM_ereg == AM_stackBeg); }
+
+
+MemPtr AM_findtos(int i)
+{
+ return ((AM_tosreg > AM_ereg) ? AM_tosreg :
+ (MemPtr)(((AM_DataTypePtr)(AM_ereg + 2)) + i));
+}
+MemPtr AM_findtosEnv()
+{
+ return ((AM_tosreg > AM_ereg) ? AM_tosreg :
+ (MemPtr)(((AM_DataTypePtr)(AM_ereg + 2))+INSACC_CALL_I1(AM_cpreg)));
+
+}
+//set AM_tosreg to the top imp or choice pt
+void AM_settosreg()
+{
+ if (AM_ireg > AM_breg) AM_tosreg = AM_ireg + AM_IMP_FIX_SIZE;
+ else AM_tosreg = AM_breg + 1;
+}
+
+
+/***************************************************************************/
+/* ENVIRONMENT RECORD OPERATIONS */
+/***************************************************************************/
+//environment record creation function
+MemPtr AM_mkEnv(MemPtr ep) //create the fixed part of env rec
+{
+ *((MemPtr *)(ep - 3)) = AM_cireg; //CI field
+ *((MemPtr *)(ep - 2)) = AM_ereg; //CE field
+ *((int *)(ep - 1)) = AM_ucreg; //UC field
+ *((CSpacePtr *)ep) = AM_cpreg; //CP field
+ return (ep - 1);
+}
+MemPtr AM_mkEnvWOUC(MemPtr ep) //ct fixed part of env without uc
+{
+ *((MemPtr *)(ep - 3)) = AM_cireg; //CI field
+ *((MemPtr *)(ep - 2)) = AM_ereg; //CE field
+ *((CSpacePtr *)ep) = AM_cpreg; //CP field
+ return (ep - 1);
+}
+
+//environment record access functions (current top-level env record)
+//the env continuation point
+CSpacePtr AM_envCP() { return *((CSpacePtr *)(AM_ereg + 1));}
+//the uc value
+int AM_envUC() { return *((int *)AM_ereg); }
+//continuation point
+MemPtr AM_envCE() { return *((MemPtr *)(AM_ereg - 1)); }
+//impl point
+MemPtr AM_envCI(MemPtr ep) { return *((MemPtr *)(AM_ereg - 2)); }
+//the nth var fd
+AM_DataTypePtr AM_envVar(int n)
+{
+ return (AM_DataTypePtr)(((AM_DataTypePtr)AM_ereg) + n);
+}
+//is p an address in the current env?
+Boolean AM_inCurEnv(MemPtr p) { return (p > AM_ereg); }
+
+//access functions for clause environment
+AM_DataTypePtr AM_cenvVar(int n) //the nth var fd in clause env
+{
+ return (AM_DataTypePtr)(((AM_DataTypePtr)AM_cereg) + n);
+}
+
+/****************************************************************************/
+/* CHOICE POINT OPERATIONS */
+/****************************************************************************/
+//choice point creation functions
+void AM_mkCP(MemPtr cp, CSpacePtr label, int n) //create a choice pt
+{
+ *((MemPtr *)cp) = AM_hreg; //heap point
+ *((CSpacePtr *)(cp - 1)) = label; //next clause ptr
+ *((MemPtr *)(cp - 2)) = AM_trreg; //trail point
+ *((DF_DisPairPtr *)(cp - 3)) = AM_llreg; //live list
+ *((MemPtr *)(cp - 4)) = AM_b0reg; //cut point
+ *((MemPtr *)(cp - 5)) = AM_breg; //previous choice pt
+ *((MemPtr *)(cp - 6)) = AM_cireg; //clause context
+ *((MemPtr *)(cp - 7)) = AM_ireg; //program context
+ *((CSpacePtr *)(cp - 8)) = AM_cpreg; //cont. code ptr
+ *((MemPtr *)(cp - 9)) = AM_ereg; //cont. env ptr
+ *((TwoBytes *)(cp - 10)) = AM_ucreg; //universe count
+
+ for (; n > 0; n--) //save reg(1) to reg(n)
+ *(((AM_DataTypePtr)(cp - 10)) - n) = *AM_reg(n);
+}
+void AM_saveStateCP(MemPtr cp, CSpacePtr label)
+{
+ *((MemPtr *)cp) = AM_hreg; //heap point
+ *((CSpacePtr *)(cp - 1)) = label; //next clause ptr
+ *((MemPtr *)(cp - 2)) = AM_trreg; //trail point
+ *((DF_DisPairPtr *)(cp - 3)) = AM_llreg; //live list
+ *((MemPtr *)(cp - 4)) = AM_b0reg; //cut point
+ *((MemPtr *)(cp - 5)) = AM_breg; //previous choice pt
+ *((MemPtr *)(cp - 6)) = AM_cireg; //clause context
+ *((MemPtr *)(cp - 7)) = AM_ireg; //program context
+ *((CSpacePtr *)(cp - 8)) = AM_cpreg; //cont. code ptr
+ *((MemPtr *)(cp - 9)) = AM_ereg; //cont. env ptr
+ *((TwoBytes *)(cp - 10)) = AM_ucreg; //universe count
+}
+//set the next clause field in the current top choice point
+void AM_setNClCP(CSpacePtr ncl)
+{
+ *((CSpacePtr *)(AM_breg - 1)) = ncl;
+}
+
+
+//restore function
+//restore all components of a choice point except the trail top and the
+//backtrack point registers
+void AM_restoreRegs(int n)
+{
+ for (; n > 0; n--)
+ AM_regs[n] = *(((AM_DataTypePtr)(AM_breg - 10)) - n);
+
+ AM_hreg = *((MemPtr *)AM_breg);
+ AM_llreg = *((DF_DisPairPtr *)(AM_breg - 3));
+ AM_b0reg = *((MemPtr *)(AM_breg - 4));
+ AM_cireg = *((MemPtr *)(AM_breg - 6));
+ AM_ireg = *((MemPtr *)(AM_breg - 7));
+ AM_cpreg = *((CSpacePtr *)(AM_breg - 8));
+ AM_ereg = *((MemPtr *)(AM_breg - 9));
+ AM_ucreg = *((TwoBytes *)(AM_breg - 10));
+}
+//restore all components of a choice point except the trail top, the backtrack
+//point and the clause context registers
+void AM_restoreRegsWoCI(int n)
+{
+ for (; n > 0; n--)
+ AM_regs[n] = *(((AM_DataTypePtr)(AM_breg - 10)) - n);
+
+ AM_hreg = *((MemPtr *)AM_breg);
+ AM_llreg = *((DF_DisPairPtr *)(AM_breg - 3));
+ AM_b0reg = *((MemPtr *)(AM_breg - 4));
+ AM_ireg = *((MemPtr *)(AM_breg - 7));
+ AM_cpreg = *((CSpacePtr *)(AM_breg - 8));
+ AM_ereg = *((MemPtr *)(AM_breg - 9));
+ AM_ucreg = *((TwoBytes *)(AM_breg - 10));
+}
+
+//access functions
+MemPtr AM_cpH() { return *((MemPtr *)(AM_breg)); }
+CSpacePtr AM_cpNCL() { return *((CSpacePtr *)(AM_breg - 1)); }
+MemPtr AM_cpTR() { return *((MemPtr *)(AM_breg - 2)); }
+MemPtr AM_cpB() { return *((MemPtr *)(AM_breg - 5)); }
+MemPtr AM_cpCI() { return *((MemPtr *)(AM_breg - 6)); }
+
+AM_DataTypePtr AM_cpArg(MemPtr cp, int n) //addr of nth arg in a given cp
+{
+ return ((AM_DataTypePtr)(cp - 10)) - n;
+}
+
+/***************************************************************************/
+/* IMPLICATION/IMPORT RECORD OPERATIONS */
+/***************************************************************************/
+/* The tags for distinguishing implication and import records */
+typedef enum
+{
+ AM_IMPTAG_IMPLICATION, //implication record
+ AM_IMPTAG_IMPTWOLOCAL, //import record without locals
+ AM_IMPTAG_IMPTWLOCAL //import record with locals
+} AM_ImpTag;
+
+//finding code for a predicate in the program context given by the value of
+//the AM_ireg.
+void AM_findCode(int constInd, CSpacePtr *clPtr, MemPtr *iptr)
+{
+ CSpacePtr myclPtr = NULL;
+ MemPtr myiptr = AM_ireg;
+ int size;
+ while (!AM_botIP(myiptr)) {
+ if ((size = AM_impPSTS(myiptr)) &&
+ (myclPtr = (*(AM_impFC(myiptr)))(constInd,size,AM_impPST(myiptr))))
+ break;
+ else myiptr = AM_impPIP(myiptr);
+ }
+ *clPtr = myclPtr;
+ *iptr = myiptr;
+}
+//creating the fixed part of a new implication/import record
+void AM_mkImplRec(MemPtr ip, MemPtr sTab, int sTabSize, MEM_FindCodeFnPtr fnPtr)
+{
+ *((MemPtr *)ip) = AM_ereg; //CE: clause env
+ *(ip+1) = (Mem)AM_IMPTAG_IMPLICATION; //tag
+ *((MemPtr *)(ip+2)) = sTab; //PST: search table addr
+ *((MEM_FindCodeFnPtr *)(ip+3)) = fnPtr; //FC: find code fn ptr
+ *((MemPtr *)(ip+4)) = AM_ireg; //PIP: previous ip addr
+ *((int *)(ip+5)) = sTabSize; //PSTS: search table size
+}
+
+//creating the fixed part of a new import record with local consts
+void AM_mkImptRecWL(MemPtr ip, int npreds, MemPtr sTab, int sTabSize,
+ MEM_FindCodeFnPtr fnPtr)
+{
+ *((int *)ip) = npreds; //NPred: # preds
+ *(ip+1) = (Mem)AM_IMPTAG_IMPTWLOCAL; //tag
+ *((MemPtr *)(ip+2)) = sTab; //PST: search table addr
+ *((MEM_FindCodeFnPtr *)(ip+3)) = fnPtr; //FC: find code fn ptr
+ *((MemPtr *)(ip+4)) = AM_ireg; //PIP: previous ip addr
+ *((int *)(ip+5)) = sTabSize; //PSTS: search table size
+}
+//creating the fixed part of a new import record without local consts
+void AM_mkImptRecWOL(MemPtr ip, int npreds, MemPtr sTab, int sTabSize,
+ MEM_FindCodeFnPtr fnPtr)
+{
+ *((int *)ip) = npreds; //NPred: # preds
+ *(ip+1) = (Mem)AM_IMPTAG_IMPTWOLOCAL;//tag
+ *((MemPtr *)(ip+2)) = sTab; //PST: search table addr
+ *((MEM_FindCodeFnPtr *)(ip+3)) = fnPtr; //FC: find code fn ptr
+ *((MemPtr *)(ip+4)) = AM_ireg; //PIP: previous ip addr
+ *((int *)(ip+5)) = sTabSize; //PSTS: search table size
+}
+
+//creating a dummy import point
+void AM_mkDummyImptRec(MemPtr ip)
+{
+ *((int *)ip) = 0;
+ *(ip+1) = (Mem)AM_IMPTAG_IMPTWOLOCAL;
+}
+
+
+/*initializing the next clause table in an implication/import record.*/
+void AM_mkImpNCLTab(MemPtr ip, MemPtr linkTab, int size)
+{
+ int constInd;
+ CSpacePtr clausePtr;
+ MemPtr iptr;
+ MemPtr nextCl = AM_impNCL(ip, size);//the first entry in the NCL table
+ size--;
+ for (; size >= 0; size--) {
+ constInd = MEM_implIthLT(linkTab, size);
+ AM_findCode(constInd, &clausePtr, &iptr);
+ if (clausePtr) { //if found
+ *((CSpacePtr *)nextCl) = clausePtr;
+ *((MemPtr *)(nextCl+1))= iptr;
+ } else { //not found
+ *((CSpacePtr *)nextCl) = AM_failCode;
+ *((MemPtr *)(nextCl+1))= NULL;
+ }
+ nextCl += AM_NCLT_ENTRY_SIZE;
+ } //for loop
+}
+//initializing the backchained vector in an import record
+void AM_initBCKVector(MemPtr ip, int nclTabSize, int nSegs)
+{
+ MemPtr bcVecPtr = ip - nclTabSize - (AM_BCKV_ENTRY_SIZE * nSegs);
+ for (; (nSegs > 0); nSegs--){
+ *((int *)bcVecPtr) = 0;
+ *((MemPtr *)(bcVecPtr+1)) = AM_breg;
+ bcVecPtr += AM_BCKV_ENTRY_SIZE;
+ }
+}
+//set back chained number in a given back chained field
+void AM_setBCKNo(MemPtr bck, int n) { *((int *)bck) = n; }
+//set most recent cp in a given back chained field
+void AM_setBCKMRCP(MemPtr bck, MemPtr mrcp) { *((MemPtr *)(bck+1)) = mrcp; }
+//initializing the universe indices in the symbol table entries for constants
+//local to a module
+void AM_initLocs(int nlocs, MemPtr locTab)
+{
+ nlocs--;
+ for (; nlocs >= 0; nlocs--)
+ AM_setCstUnivCount(MEM_impIthLCT(locTab, nlocs), AM_ucreg);
+}
+
+//implication/import record access functions
+//the ith entry of next clause tab
+MemPtr AM_impNCL(MemPtr ip, int i) {return (ip - AM_NCLT_ENTRY_SIZE * i);}
+//code in a next clause field
+CSpacePtr AM_impNCLCode(MemPtr ncl) {return *((CSpacePtr *)ncl); }
+//ip in a next clause field
+MemPtr AM_impNCLIP(MemPtr ncl) {return *((MemPtr *)(ncl+1)); }
+//the ith entry of back chained vec
+MemPtr AM_cimpBCK(int i)
+{ return (AM_cireg-AM_NCLT_ENTRY_SIZE*AM_cimpNPreds()-AM_BCKV_ENTRY_SIZE*i); }
+//back chain num in a bck field
+int AM_impBCKNo(MemPtr bck) {return *((int *)bck); }
+//most recent cp is a bck field
+MemPtr AM_impBCKMRCP(MemPtr bck) {return *((MemPtr *)(bck+1)); }
+//clause env of in imp rec referred to by cireg
+MemPtr AM_cimpCE() {return *((MemPtr *)AM_cireg); }
+//# preds of impt rec
+int AM_cimpNPreds() {return *((int *)AM_cireg); }
+ //search table addr
+MemPtr AM_impPST(MemPtr ip) {return *((MemPtr *)(ip + 2)); }
+//find code function pointer
+MEM_FindCodeFnPtr AM_impFC(MemPtr ip) {return *((MEM_FindCodeFnPtr *)(ip + 3));}
+//PIP in given imp point
+MemPtr AM_impPIP(MemPtr ip) {return *((MemPtr *)(ip + 4)); }
+//previous ip in the current top imp point
+MemPtr AM_curimpPIP() {return *((MemPtr *)(AM_ireg + 4)); }
+//search table size
+int AM_impPSTS(MemPtr ip) {return *((int *)(ip + 5)); }
+
+
+Boolean AM_isImptWL(MemPtr ip) { //is an imp rec a import rec w local
+ return ((AM_ImpTag)(*(ip+1)) == AM_IMPTAG_IMPTWLOCAL);
+}
+Boolean AM_isImptWOL(MemPtr ip){ //is an imp rec a import rec wo local
+ return ((AM_ImpTag)(*(ip+1)) == AM_IMPTAG_IMPTWOLOCAL);
+}
+Boolean AM_isImpl(MemPtr ip){ //is an imp rec a implication rec
+ return ((AM_ImpTag)(*(ip+1)) == AM_IMPTAG_IMPLICATION);
+}
+Boolean AM_isImpt(MemPtr ip){ //is an imp rec a import rec
+ return ((AM_ImpTag)(*(ip+1)) != AM_IMPTAG_IMPLICATION);
+}
+
+Boolean AM_isImplCI(){ //is rec referred to by CI impl?
+ return ((AM_ImpTag)(*(AM_cireg+1)) == AM_IMPTAG_IMPLICATION);
+}
+Boolean AM_isCurImptWL(){ //is rec referred to by I impt with loc?
+ return ((AM_ImpTag)(*(AM_ireg+1)) == AM_IMPTAG_IMPTWLOCAL);
+}
+
+/***************************************************************************/
+/* LIVE LIST OPERATIONS */
+/***************************************************************************/
+//live list is empty?
+Boolean AM_empLiveList() { return (AM_llreg == DF_EMPTY_DIS_SET);}
+
+//live list not empty?
+Boolean AM_nempLiveList(){ return (AM_llreg != DF_EMPTY_DIS_SET);}
+
+//add a dis pair to the live list when not knowning it is empty or not
+void AM_addDisPair(DF_TermPtr tPtr1, DF_TermPtr tPtr2)
+{
+ MemPtr nhtop = AM_hreg + DF_DISPAIR_SIZE;
+ AM_heapError(nhtop);
+ DF_mkDisPair(AM_hreg, AM_llreg, tPtr1, tPtr2);
+ AM_llreg = (DF_DisPairPtr)AM_hreg;
+ AM_hreg = nhtop;
+}
+
+/***************************************************************************/
+/* PDL OPERATIONS */
+/***************************************************************************/
+//pop (term/type) PDL
+MemPtr AM_popPDL() { return (MemPtr)(*(--AM_pdlTop)); }
+//push (term/type) PDL
+void AM_pushPDL(MemPtr addr) { (*AM_pdlTop++) = (Mem)addr; }
+//is empty PDL?
+Boolean AM_emptyPDL() { return (AM_pdlTop == AM_pdlBot); }
+//is not empty PDL?
+Boolean AM_nemptyPDL() { return (AM_pdlTop > AM_pdlBot); }
+//initialize PDL
+void AM_initPDL() { AM_pdlTop = AM_pdlBot = AM_pdlBeg; }
+//is empty type PDL?
+Boolean AM_emptyTypesPDL() { return (AM_pdlTop == AM_typespdlBot); }
+//is not empty type PDL?
+Boolean AM_nemptyTypesPDL() { return (AM_pdlTop > AM_typespdlBot); }
+//initialize type PDL
+void AM_initTypesPDL() { AM_typespdlBot = AM_pdlTop; }
+//recover type PDL to the status before type unification
+void AM_resetTypesPDL() { AM_pdlTop = AM_typespdlBot; }
+
+
+/****************************************************************************/
+/* RUN-TIME SYMBOL TABLES */
+/****************************************************************************/
+MEM_KstPtr AM_kstBase; //starting addr of the kind symbol table
+MEM_TstPtr AM_tstBase; //starting addr of the type skel table
+MEM_CstPtr AM_cstBase; //starting addr of the const symbol table
+
+/* Kind symbol table */
+char* AM_kstName(int n) //name of a type constructor in a given entry
+{
+ return MCSTR_toCString(
+ DF_strDataValue(((MEM_KstPtr)(((MemPtr)AM_kstBase)
+ + n*MEM_KST_ENTRY_SIZE)) -> name));
+}
+
+int AM_kstArity(int n) //arity of a type constructor in a given entry
+{
+ return ((MEM_KstPtr)(((MemPtr)AM_kstBase) + n*MEM_KST_ENTRY_SIZE)) -> arity;
+}
+
+/* Type skeleton table */
+DF_TypePtr AM_tstSkel(int n) //type skeleton in a given entry
+{
+ return (DF_TypePtr)(((MemPtr)AM_tstBase) + n*MEM_TST_ENTRY_SIZE);
+}
+
+/* Constant symbol table */
+char* AM_cstName(int n) //name of a constant in a given entry
+{
+ DF_StrDataPtr nameData = ((MEM_CstPtr)(((MemPtr)AM_cstBase) +
+ n * MEM_CST_ENTRY_SIZE)) -> name;
+ if (nameData) return MCSTR_toCString(DF_strDataValue(nameData));
+ else return NULL;
+ //return MCSTR_toCString(
+ // DF_strDataValue(((MEM_CstPtr)(((MemPtr)AM_cstBase) +
+ // n*MEM_CST_ENTRY_SIZE)) -> name));
+}
+
+int AM_cstTyEnvSize(int n) //type environment size
+{
+ return ((MEM_CstPtr)(((MemPtr)AM_cstBase)+n*MEM_CST_ENTRY_SIZE))->
+ typeEnvSize;
+}
+int AM_cstNeeded(int n) //neededness info
+{
+ return ((MEM_CstPtr)(((MemPtr)AM_cstBase)+n*MEM_CST_ENTRY_SIZE))->
+ neededness;
+
+}
+int AM_cstUnivCount(int n) //universe count
+{
+ return ((MEM_CstPtr)(((MemPtr)AM_cstBase)+n*MEM_CST_ENTRY_SIZE))->univCount;
+}
+int AM_cstPrecedence(int n) //precedence
+{
+ return ((MEM_CstPtr)(((MemPtr)AM_cstBase)+n*MEM_CST_ENTRY_SIZE))->
+ precedence;
+}
+int AM_cstFixity(int n) //fixity
+{
+ return ((MEM_CstPtr)(((MemPtr)AM_cstBase)+n*MEM_CST_ENTRY_SIZE))->fixity;
+}
+int AM_cstTySkelInd(int n) //type skeleton index
+{
+ return ((MEM_CstPtr)(((MemPtr)AM_cstBase)+n*MEM_CST_ENTRY_SIZE))->
+ tskTabIndex;
+}
+
+void AM_setCstUnivCount(int n, int uc) //set universe count
+{
+ ((MEM_CstPtr)(((MemPtr)AM_cstBase)+n*MEM_CST_ENTRY_SIZE))->univCount = uc;
+}
+
+/****************************************************************************
+ * OVERFLOW ERROR FUNCTIONS *
+ ****************************************************************************/
+void AM_heapError(MemPtr p) //heap overflow
+{
+ if (AM_heapEnd < p) EM_error(SIM_ERROR_HEAP_OVERFL);
+}
+void AM_stackError(MemPtr p) //stack overflow
+{
+ if (AM_stackEnd < p) EM_error(SIM_ERROR_STACK_OVERFL);
+}
+void AM_pdlError(int n) //pdl overflow for n cells
+{
+ if (AM_pdlEnd < (AM_pdlTop + n)) EM_error(SIM_ERROR_PDL_OVERFL);
+}
+void AM_trailError(int n) //trail overflow for n cells
+{
+ if (AM_trailEnd < (AM_trreg + n))
+ EM_error(SIM_ERROR_TRAIL_OVERFL);
+}
+
+
+/****************************************************************************
+ * MISCELLANEOUS OTHER ERRORS *
+ ****************************************************************************/
+void AM_embedError(int n) //violation of max number of lambda embeddings
+{
+ if (n > DF_MAX_BV_IND)
+ EM_error(SIM_ERROR_TOO_MANY_ABSTRACTIONS, DF_MAX_BV_IND);
+}
+void AM_arityError(int n) // violation of max number of arity in applications
+{
+ if (n > DF_TM_MAX_ARITY) EM_error(SIM_ERROR_TOO_MANY_ARGUMENTS,
+ DF_TM_MAX_ARITY);
+}
+void AM_ucError(int n) //violation of maximum of universe count
+{
+ if (n == DF_MAX_UNIVIND) EM_error(SIM_ERROR_TOO_MANY_UNIV_QUANTS);
+}
+
+#endif //ABSTMACHINE_C
diff --git a/src/runtime/c/teyjus/simulator/abstmachine.h b/src/runtime/c/teyjus/simulator/abstmachine.h
new file mode 100644
index 000000000..c43fdb4f7
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/abstmachine.h
@@ -0,0 +1,346 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+/****************************************************************************/
+/* */
+/* File abstmachine.h. This header file defines the various registers, */
+/* data areas and record types relevant to the abstract machine. */
+/* */
+/****************************************************************************/
+#ifndef ABSTMACHINE_H
+#define ABSTMACHINE_H
+
+#include
+#include
+#include "mctypes.h"
+#include "dataformats.h"
+#include "../system/memory.h"
+#include "../system/error.h"
+
+/***************************######********************************************
+ * ERROR INFORMATION
+ *********************************######**************************************/
+
+#define SIM_NUM_ERROR_MESSAGES 13
+enum
+{
+ SIM_ERROR = SIM_FIRST_ERR_INDEX,
+ SIM_ERROR_TOO_MANY_ABSTRACTIONS,
+ SIM_ERROR_TOO_MANY_ARGUMENTS,
+ SIM_ERROR_TOO_MANY_UNIV_QUANTS,
+ SIM_ERROR_HEAP_TOO_BIG,
+ SIM_ERROR_HEAP_TOO_SMALL,
+ SIM_ERROR_CANNOT_ALLOCATE_HEAP,
+ SIM_ERROR_CANNOT_ALLOCATE_HEAP_MESSAGE,
+ SIM_ERROR_CANNOT_ALLOCATE_HEAP_SUGGESTION,
+ SIM_ERROR_TRAIL_OVERFL,
+ SIM_ERROR_HEAP_OVERFL,
+ SIM_ERROR_STACK_OVERFL,
+ SIM_ERROR_PDL_OVERFL,
+};
+
+typedef union //the type of data: (atomic) term or type
+{
+ DF_Term term;
+ DF_Type type;
+} AM_DataType;
+
+typedef AM_DataType *AM_DataTypePtr;
+
+//#define AM_DATA_SIZE (int)ceil((double)sizeof(AM_DataType)/WORD_SIZE)
+#define AM_DATA_SIZE 2
+
+/****************************************************************************/
+/* ABSTRACT MACHINE REGISTERS (AND FLAGS) */
+/****************************************************************************/
+
+typedef enum {OFF = 0, ON = 1} AM_FlagTypes; //FLAG type
+typedef Byte Flag;
+
+
+/*There are 255 argument registers numbered 1 through 255; Reg_0 is never
+ used. (agree with instruction format)*/
+#define AM_NUM_OF_REG 256
+extern AM_DataType AM_regs[AM_NUM_OF_REG];//argument regs/temp variables
+
+//data register access: return the address of the ith register
+AM_DataTypePtr AM_reg(int i);
+
+extern MemPtr AM_hreg; //heap top
+extern MemPtr AM_hbreg; //heap backtrack point
+extern MemPtr AM_ereg; //current environment
+extern MemPtr AM_breg; //last choice point
+extern MemPtr AM_b0reg; //cut point
+extern MemPtr AM_ireg; //impl pt reg, defining prog context
+extern MemPtr AM_cireg; //impl pt for current clause
+extern MemPtr AM_cereg; //closure environment
+extern MemPtr AM_tosreg; //top of stack impl or choice pt.
+extern MemPtr AM_trreg; //trail top
+extern MemPtr AM_pdlTop; //top of pdl
+extern MemPtr AM_pdlBot; //(moving) bottom of pdl
+extern MemPtr AM_typespdlBot; //(moving) bottom of types pdl
+
+extern DF_TermPtr AM_sreg; //"structure" pointer
+extern DF_TypePtr AM_tysreg; //type structure pointer
+
+extern CSpacePtr AM_preg; //program pointer
+extern CSpacePtr AM_cpreg; //continuation pointer
+
+extern DF_DisPairPtr AM_llreg; //ptr to the live list
+
+extern Flag AM_bndFlag; //does binding on fv (term) occur?
+extern Flag AM_writeFlag; //in write mode?
+extern Flag AM_tyWriteFlag; //in ty write mode?
+extern Flag AM_ocFlag; //occurs check?
+
+extern Flag AM_consFlag; //cons?
+extern Flag AM_rigFlag; //rigid?
+
+extern TwoBytes AM_numAbs; //number of abstractions in hnf
+extern TwoBytes AM_numArgs; //number of arguments in hnf
+
+extern DF_TermPtr AM_head; //head of a hnf
+extern DF_TermPtr AM_argVec; //argument vector of a hnf
+
+extern DF_TermPtr AM_vbbreg; //variable being bound for occ
+extern DF_TypePtr AM_tyvbbreg; //type var being bound for occ
+extern TwoBytes AM_adjreg; //univ count of variable being bound
+
+extern TwoBytes AM_ucreg; //universe count register
+
+/****************************************************************************/
+/* STACK, HEAP, TRAIL AND PDL RELATED STUFF */
+/****************************************************************************/
+extern MemPtr AM_heapBeg, //beginning of the heap
+ AM_heapEnd, //end of the heap
+ AM_stackBeg, //beginning of the stack
+ AM_stackEnd, //end of the stack
+ AM_trailBeg, //beginning of the trail
+ AM_trailEnd, //end of the trail
+ AM_pdlBeg, //beginning of pdl
+ AM_pdlEnd, //end of pdl
+ AM_fstCP; //the first choice point
+
+
+/****************************************************************************/
+/* CODE PLACED IN THE HEAP BY THE SYSTEM */
+/****************************************************************************/
+extern CSpacePtr AM_failCode;
+extern CSpacePtr AM_andCode;
+extern CSpacePtr AM_orCode;
+extern CSpacePtr AM_allCode;
+extern CSpacePtr AM_solveCode;
+extern CSpacePtr AM_builtinCode;
+extern CSpacePtr AM_eqCode;
+extern CSpacePtr AM_stopCode;
+extern CSpacePtr AM_haltCode;
+extern CSpacePtr AM_notCode1;
+extern CSpacePtr AM_notCode2;
+extern CSpacePtr AM_proceedCode;
+
+
+Boolean AM_isFailInstr(CSpacePtr cptr);
+/****************************************************************************/
+/* VITUAL MACHINE MEMORY OPERATIONS */
+/****************************************************************************/
+Boolean AM_regAddr(MemPtr p); //is the given addr referring to a register?
+Boolean AM_stackAddr(MemPtr p); //is the given addr on stack?
+Boolean AM_nHeapAddr(MemPtr p); //is the given addr on heap?
+
+Boolean AM_botIP(MemPtr p); //is the "first" impl/impt record?
+Boolean AM_botCP(); //is the "first" choice point?
+Boolean AM_noEnv(); //no env record left on the stack?
+
+MemPtr AM_findtos(int i);
+MemPtr AM_findtosEnv();
+void AM_settosreg(); //set AM_tosreg to the top imp or choice pt
+
+/***************************************************************************/
+/* ENVIRONMENT RECORD OPERATIONS */
+/***************************************************************************/
+#define AM_ENV_FIX_SIZE 4 //size of the fix part of env rec
+
+//environment record creation function
+MemPtr AM_mkEnv(MemPtr ep); //create the fixed part of env rec
+MemPtr AM_mkEnvWOUC(MemPtr ep); //ct fixed part of env without uc
+
+//environment record access functions (current top env record)
+AM_DataTypePtr AM_envVar(int n); //the nth var fd
+int AM_envUC(); //the env universe count
+CSpacePtr AM_envCP(); //the env continuation point
+MemPtr AM_envCE(); //continuation point
+MemPtr AM_envCI(); //impl point
+Boolean AM_inCurEnv(MemPtr p); //is p an addr in the curr env?
+
+//access functions for clause environment
+AM_DataTypePtr AM_cenvVar(int n); //the nth var fd in clause env
+
+/****************************************************************************/
+/* CHOICE POINT OPERATIONS */
+/****************************************************************************/
+#define AM_CP_FIX_SIZE 11 //size of the fix part of choice point
+
+//choice point creation functions
+void AM_mkCP(MemPtr cp, CSpacePtr label, int n); //create a choice pt
+void AM_saveStateCP(MemPtr cp, CSpacePtr label);
+void AM_setNClCP(CSpacePtr ncl); //set the ncl fd in top ch pt
+
+//restore functions
+//restore all components of a choice point except the trail top and the
+//backtrack point registers
+void AM_restoreRegs(int n);
+//restore all components of a choice point except the trail top, the backtrack
+//point and the clause context registers
+void AM_restoreRegsWoCI(int n);
+//access functions
+MemPtr AM_cpH();
+CSpacePtr AM_cpNCL();
+MemPtr AM_cpTR();
+MemPtr AM_cpB();
+MemPtr AM_cpCI();
+
+AM_DataTypePtr AM_cpArg(MemPtr cp, int n); //addr of nth arg in a given cp
+
+/***************************************************************************/
+/* IMPLICATION/IMPORT RECORD OPERATIONS */
+/***************************************************************************/
+#define AM_IMP_FIX_SIZE 6 //size of the fix part of impl/impt rec
+#define AM_DUMMY_IMPT_REC_SIZE 2 //size of a dummy impt rec
+#define AM_NCLT_ENTRY_SIZE 2 //size of each entry in next clause tab
+#define AM_BCKV_ENTRY_SIZE 2 //size of ent. in back chained vector
+
+
+//finding code for a predicate in the program context given by the value of
+//the AM_ireg.
+void AM_findCode(int constInd, CSpacePtr *clPtr, MemPtr *iptr);
+
+//creating the fixed part of a new implication record
+void AM_mkImplRec(MemPtr ip,MemPtr sTab,int sTabSize, MEM_FindCodeFnPtr fnPtr);
+//creating the fixed part of a new import record with local consts
+void AM_mkImptRecWL(MemPtr ip, int npreds, MemPtr sTab, int sTabSize,
+ MEM_FindCodeFnPtr fnPtr);
+//creating the fixed part of a new import record without local consts
+void AM_mkImptRecWOL(MemPtr ip, int npreds, MemPtr sTab, int sTabSize,
+ MEM_FindCodeFnPtr fnPtr);
+//creating a dummy import point
+void AM_mkDummyImptRec(MemPtr ip);
+
+//initializing the next clause table in an implication/import record.
+void AM_mkImpNCLTab(MemPtr ip, MemPtr linkTab, int size);
+//initializing the backchained vector in an import record
+void AM_initBCKVector(MemPtr ip, int nclTabSize, int noSegs);
+//set back chained number in a given back chained field
+void AM_setBCKNo(MemPtr bck, int n);
+//set most recent cp in a given back chained field
+void AM_setBCKMRCP(MemPtr bck, MemPtr cp);
+//initializing the universe indices in the symbol table entries for constants
+//local to a module
+void AM_initLocs(int nlocs, MemPtr locTab);
+
+//implication/import record access functions
+MemPtr AM_impNCL(MemPtr ip, int i); //the ith entry of next clause tab
+CSpacePtr AM_impNCLCode(MemPtr ncl); //code in a next clause field
+MemPtr AM_impNCLIP(MemPtr ncl); //ip in a next clause field
+MemPtr AM_cimpBCK(int i); //the ith entry of back chained vec in CI
+int AM_impBCKNo(MemPtr bck); //back chain num in a bck field
+MemPtr AM_impBCKMRCP(MemPtr bck); //most recent cp is a bck field
+MemPtr AM_cimpCE(); //clause env of impl rec in CI
+int AM_cimpNPreds(); //# preds of impt rec in CI
+MemPtr AM_impPST(MemPtr ip); //search table field addr
+MEM_FindCodeFnPtr AM_impFC(MemPtr ip); //find code function field addr
+MemPtr AM_impPIP(MemPtr ip); //PIP in given imp point
+MemPtr AM_curimpPIP(); //PIP in the current top imp point
+int AM_impPSTS(MemPtr ip); //search table size field
+
+Boolean AM_isImptWL(MemPtr ip); //is an imp rec a import rec w local
+Boolean AM_isImptWOL(MemPtr ip); //is an imp rec a import rec wo local
+Boolean AM_isImpl(MemPtr ip); //is an imp rec a implication rec
+Boolean AM_isImpt(MemPtr ip); //is an imp rec a import rec
+
+Boolean AM_isImplCI(); //is rec referred to by CI impl?
+Boolean AM_isCurImptWL(); //is rec referred to by I impt with loc?
+
+
+/***************************************************************************/
+/* LIVE LIST OPERATIONS */
+/***************************************************************************/
+Boolean AM_empLiveList(); //live list is empty?
+Boolean AM_nempLiveList(); //live list not empty?
+
+//add a dpair to the beginning of live list
+void AM_addDisPair(DF_TermPtr tPtr1, DF_TermPtr tPtr2);
+
+/***************************************************************************/
+/* PDL OPERATIONS */
+/***************************************************************************/
+MemPtr AM_popPDL(); //pop (term/type) PDL
+void AM_pushPDL(MemPtr); //push (term/type) PDL
+
+Boolean AM_emptyPDL(); //is empty PDL?
+Boolean AM_nemptyPDL(); //is not empty PDL?
+void AM_initPDL(); //initialize PDL
+
+Boolean AM_emptyTypesPDL(); //is empty type PDL?
+Boolean AM_nemptyTypesPDL(); //is not empty type PDL?
+void AM_initTypesPDL(); //initialize type PDL
+void AM_resetTypesPDL(); //reset PDL to that before ty unif
+
+/****************************************************************************/
+/* RUN-TIME SYMBOL TABLES */
+/****************************************************************************/
+extern MEM_KstPtr AM_kstBase; //starting addr of the kind symbol table
+extern MEM_TstPtr AM_tstBase; //starting addr of the type skel table
+extern MEM_CstPtr AM_cstBase; //starting addr of the const symbol table
+
+/* Kind symbol table */
+char* AM_kstName(int n); //name of a type constructor in a given entry
+int AM_kstArity(int n); //arity of a type constructor in a given entry
+
+/* Type skeleton table */
+DF_TypePtr AM_tstSkel(int n); //type skeleton in a given entry
+
+/* Constant symbol table */
+char* AM_cstName(int n); //name of a constant in a given entry
+int AM_cstTyEnvSize(int n); //type environment size
+int AM_cstNeeded(int n); //neededness info
+int AM_cstUnivCount(int n); //universe count
+int AM_cstPrecedence(int n); //precedence
+int AM_cstFixity(int n); //fixity
+int AM_cstTySkelInd(int n); //type skeleton index
+
+void AM_setCstUnivCount(int n, int uc); //set universe count
+/****************************************************************************
+ * OVERFLOW ERROR FUNCTIONS *
+ ****************************************************************************/
+void AM_heapError(MemPtr); //heap overflow
+void AM_stackError(MemPtr); //stack overflow
+void AM_pdlError(int); //pdl stack overflow for n cells
+void AM_trailError(int); //trail overflow for n cells
+
+
+/****************************************************************************
+ * MISCELLANEOUS OTHER ERRORS *
+ ****************************************************************************/
+void AM_embedError(int); // violation of max number of lambda embeddings
+void AM_arityError(int); // violation of max number of arity in applications
+void AM_ucError(int); // violation of maximum of universe count
+
+
+#endif //ABSTMACHINE_H
diff --git a/src/runtime/c/teyjus/simulator/dataformats.c b/src/runtime/c/teyjus/simulator/dataformats.c
new file mode 100644
index 000000000..ecc1ce5c0
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/dataformats.c
@@ -0,0 +1,711 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************/
+/* */
+/* File dataformat.c. */
+/* The header file identifies the low-level representation of data objects */
+/* that are manipulated by the machine, through various structure types. */
+/****************************************************************************/
+#ifndef DATAFORMATS_C
+#define DATAFORMATS_C
+
+#include
+#include
+#include "dataformats.h"
+#include "mctypes.h"
+#include "mcstring.h"
+
+/********************************************************************/
+/* */
+/* TYPE REPRESENTATION */
+/* */
+/********************************************************************/
+
+/* Types of relevant fields in type representations. */
+typedef TwoBytes DF_KstTabInd; //kind symbol table index
+typedef TwoBytes DF_StrTypeArity; //arity of type structure
+typedef TwoBytes DF_SkelInd; //offset of variables in type skeletons
+
+
+/* Structure definitions of each type category. */
+typedef struct //type sort
+{
+ DF_Tag tag;
+ DF_KstTabInd kindTabIndex;
+} DF_SortType;
+
+typedef struct //type reference
+{
+ DF_Tag tag;
+ DF_TypePtr target;
+} DF_RefType;
+
+typedef struct //variables in type skeletons
+{
+ DF_Tag tag;
+ DF_SkelInd offset;
+} DF_SkVarType;
+
+typedef struct //type arrows
+{
+ DF_Tag tag;
+ DF_TypePtr args;
+} DF_ArrowType;
+
+typedef struct //type functors
+{
+ DF_Tag tag;
+ DF_StrTypeArity arity;
+ DF_KstTabInd kindTabIndex;
+} DF_FuncType;
+
+typedef struct //type structures
+{
+ DF_Tag tag;
+ DF_FuncType *funcAndArgs;
+} DF_StrType;
+
+/******************************************************************/
+/* Interface functions */
+/******************************************************************/
+
+/* TYPE DEREFERENCE */
+DF_TypePtr DF_typeDeref(DF_TypePtr tyPtr)
+{
+ DF_Type ty = *tyPtr;
+ while ((ty.tag.categoryTag == DF_TY_TAG_REF)){
+ DF_TypePtr target = (DF_TypePtr)(ty.dummy);
+ if (tyPtr == target) return tyPtr;
+ tyPtr = target;
+ ty = *tyPtr;
+ }
+ return tyPtr;
+}
+
+/* TYPE RECOGNITION */
+
+Boolean DF_isSortType(DF_TypePtr tyPtr)
+{ return (tyPtr->tag.categoryTag == DF_TY_TAG_SORT); }
+Boolean DF_isRefType(DF_TypePtr tyPtr)
+{ return (tyPtr->tag.categoryTag == DF_TY_TAG_REF); }
+Boolean DF_isSkelVarType(DF_TypePtr tyPtr)
+{ return (tyPtr->tag.categoryTag == DF_TY_TAG_SKVAR);}
+Boolean DF_isArrowType(DF_TypePtr tyPtr)
+{ return (tyPtr->tag.categoryTag == DF_TY_TAG_ARROW);}
+Boolean DF_isStrType(DF_TypePtr tyPtr)
+{ return (tyPtr->tag.categoryTag == DF_TY_TAG_STR); }
+Boolean DF_isFreeVarType(DF_TypePtr tyPtr)
+{ return ((tyPtr->tag.categoryTag == DF_TY_TAG_REF)
+ && ((DF_RefType*)tyPtr)->target == tyPtr); }
+
+
+/* TYPE DECOMPOSITION */
+int DF_typeTag(DF_TypePtr tyPtr) //generic type
+{
+ return tyPtr->tag.categoryTag;
+}
+int DF_typeKindTabIndex(DF_TypePtr tyPtr) //sorts
+{
+ return ((DF_SortType*)tyPtr) -> kindTabIndex;
+}
+int DF_typeSkelVarIndex(DF_TypePtr tyPtr) //skel var
+{
+ return ((DF_SkVarType*)tyPtr) -> offset;
+}
+DF_TypePtr DF_typeRefTarget(DF_TypePtr tyPtr) //reference
+{
+ return ((DF_RefType*)tyPtr) -> target;
+}
+DF_TypePtr DF_typeArrowArgs(DF_TypePtr tyPtr) //arrows
+{
+ return ((DF_ArrowType*)tyPtr) -> args;
+}
+DF_TypePtr DF_typeStrFuncAndArgs(DF_TypePtr tyPtr) //structures
+{
+ return (DF_TypePtr)(((DF_StrType*)tyPtr)->funcAndArgs);
+}
+int DF_typeStrFuncInd(DF_TypePtr tyPtr)
+{//Note tyPtr must refer to funcAndArgs field
+ return ((DF_FuncType*)tyPtr)->kindTabIndex;
+}
+int DF_typeStrFuncArity(DF_TypePtr tyPtr)
+{//Note tyPtr must refer to funcAndArgs field
+ return ((DF_FuncType*)tyPtr)->arity;
+}
+DF_TypePtr DF_typeStrArgs(DF_TypePtr tyPtr)
+{//Note tyPtr must refer to funcAndArgs field
+ return (DF_TypePtr)(((MemPtr)tyPtr) + DF_TY_ATOMIC_SIZE);
+}
+
+/* TYPE CONSTRUCTION */
+void DF_copyAtomicType(DF_TypePtr src, MemPtr dest)
+{
+ *((DF_TypePtr)dest) = *src;
+}
+void DF_mkSortType(MemPtr loc, int ind)
+{
+ ((DF_SortType*)loc)->tag.categoryTag = DF_TY_TAG_SORT;
+ ((DF_SortType*)loc)->kindTabIndex = ind;
+}
+void DF_mkRefType(MemPtr loc, DF_TypePtr target)
+{
+ ((DF_RefType*)loc)->tag.categoryTag = DF_TY_TAG_REF;
+ ((DF_RefType*)loc)->target = target;
+}
+void DF_mkFreeVarType(MemPtr loc)
+{
+ ((DF_RefType*)loc)->tag.categoryTag = DF_TY_TAG_REF;
+ ((DF_RefType*)loc)->target = (DF_TypePtr)loc;
+}
+void DF_mkSkelVarType(MemPtr loc, int offset)
+{
+ ((DF_SkVarType*)loc)->tag.categoryTag = DF_TY_TAG_SKVAR;
+ ((DF_SkVarType*)loc)->offset = offset;
+}
+void DF_mkArrowType(MemPtr loc, DF_TypePtr args)
+{
+ ((DF_ArrowType*)loc)->tag.categoryTag = DF_TY_TAG_ARROW;
+ ((DF_ArrowType*)loc)->args = args;
+}
+void DF_mkStrType(MemPtr loc, DF_TypePtr funcAndArgs)
+{
+ ((DF_StrType*)loc)->tag.categoryTag = DF_TY_TAG_STR;
+ ((DF_StrType*)loc)->funcAndArgs = (DF_FuncType*)funcAndArgs;
+}
+void DF_mkStrFuncType(MemPtr loc, int ind, int n)
+{
+ ((DF_FuncType*)loc)->tag.categoryTag = DF_TY_TAG_FUNC;
+ ((DF_FuncType*)loc)->kindTabIndex = ind;
+ ((DF_FuncType*)loc)->arity = n;
+}
+
+/********************************************************************/
+/* */
+/* TERM REPRESENTATION */
+/* */
+/********************************************************************/
+
+/* types of relevant fields in term representions */
+typedef TwoBytes DF_UnivInd; //universe count
+typedef TwoBytes DF_CstTabInd; //constant symbol table index
+typedef TwoBytes DF_Arity; //application arity
+typedef TwoBytes DF_DBInd; //de Bruijn ind, embed level and num of lams
+typedef WordPtr DF_StreamTabInd;
+
+typedef struct //logic variables
+{
+ DF_Tag tag;
+ DF_UnivInd univCount;
+} DF_VarTerm;
+
+typedef struct //de Bruijn indices
+{
+ DF_Tag tag;
+ DF_DBInd index;
+} DF_BVTerm;
+
+typedef struct { //name and universe count field for constants
+ DF_UnivInd univCount;
+ DF_CstTabInd symTabIndex;
+} DF_NameAndUC;
+
+typedef struct { //constant without type association
+ DF_Tag tag;
+ Boolean withType;
+ union {
+ unsigned int value;
+ DF_NameAndUC nameAndUC;
+ } data;
+} DF_ConstTerm;
+
+typedef struct { //constant with type association
+ DF_Tag tag;
+ Boolean withType;
+ union {
+ unsigned int value;
+ DF_NameAndUC nameAndUC;
+ } data;
+ DF_TypePtr typeEnv;
+} DF_TConstTerm;
+
+typedef struct //integers
+{
+ DF_Tag tag;
+ long int value;
+} DF_IntTerm;
+
+typedef struct //floats
+{
+ DF_Tag tag;
+ float value;
+} DF_FloatTerm;
+
+typedef struct //string
+{
+ DF_Tag tag;
+ DF_StrDataPtr value;
+} DF_StrTerm;
+
+typedef struct //stream
+{
+ DF_Tag tag;
+ DF_StreamTabInd index;
+} DF_StreamTerm;
+
+typedef struct //empty list
+{
+ DF_Tag tag;
+} DF_NilTerm;
+
+typedef struct //reference
+{
+ DF_Tag tag;
+ DF_TermPtr target;
+} DF_RefTerm;
+
+typedef struct //list cons
+{
+ DF_Tag tag;
+ DF_TermPtr args;
+} DF_ConsTerm;
+
+typedef struct //abstractions
+{
+ DF_Tag tag;
+ DF_DBInd numOfLams;
+ DF_TermPtr body;
+} DF_LamTerm;
+
+typedef struct //applications
+{
+ DF_Tag tag;
+ DF_Arity arity;
+ DF_TermPtr functor;
+ DF_TermPtr args;
+} DF_AppTerm;
+
+typedef struct //suspensions
+{
+ DF_Tag tag;
+ DF_DBInd ol;
+ DF_DBInd nl;
+ DF_TermPtr termSkel;
+ DF_EnvPtr envList;
+} DF_SuspTerm;
+
+
+//environment items
+typedef struct //dummy environment item
+{
+ //Boolean isDummy;
+ DF_Tag tag;
+ DF_DBInd embedLevel;
+ DF_EnvPtr rest;
+} DF_DummyEnv;
+
+typedef struct //pair environment item
+{
+ //Boolean isDummy;
+ DF_Tag tag;
+ DF_DBInd embedLevel;
+ DF_EnvPtr rest;
+ DF_TermPtr term;
+} DF_PairEnv;
+
+
+/******************************************************************/
+/* Interface functions */
+/******************************************************************/
+
+/* DEREFERENCE */
+DF_TermPtr DF_termDeref(DF_TermPtr tmPtr)
+{
+ while (DF_isRef(tmPtr)) tmPtr = ((DF_RefTerm*)tmPtr)->target;
+ return tmPtr;
+}
+
+/* TERM RECOGNITION */
+//note ref is neither atomic nor complex
+Boolean DF_isAtomic(DF_TermPtr tmPtr)
+{ return (tmPtr -> tag.categoryTag < DF_TM_TAG_REF); }
+Boolean DF_isNAtomic(DF_TermPtr tmPtr)
+{ return (tmPtr -> tag.categoryTag > DF_TM_TAG_REF); }
+Boolean DF_isFV(DF_TermPtr tmPtr)
+{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_VAR); }
+Boolean DF_isConst(DF_TermPtr tmPtr)
+{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_CONST); }
+/*assume the tmPtr is known to be a constant */
+Boolean DF_isTConst(DF_TermPtr tmPtr)
+{ return ((DF_ConstTerm*)tmPtr) -> withType; }
+Boolean DF_isInt(DF_TermPtr tmPtr)
+{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_INT); }
+Boolean DF_isFloat(DF_TermPtr tmPtr)
+{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_FLOAT); }
+Boolean DF_isNil(DF_TermPtr tmPtr)
+{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_NIL); }
+Boolean DF_isStr(DF_TermPtr tmPtr)
+{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_STR); }
+Boolean DF_isBV(DF_TermPtr tmPtr)
+{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_BVAR); }
+Boolean DF_isStream(DF_TermPtr tmPtr)
+{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_STREAM);}
+Boolean DF_isRef(DF_TermPtr tmPtr)
+{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_REF); }
+Boolean DF_isCons(DF_TermPtr tmPtr)
+{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_CONS); }
+Boolean DF_isLam(DF_TermPtr tmPtr)
+{ return (tmPtr -> tag.categoryTag == DF_TM_TAG_LAM); }
+Boolean DF_isApp(DF_TermPtr tmPtr)
+{ return (tmPtr-> tag.categoryTag == DF_TM_TAG_APP); }
+Boolean DF_isSusp(DF_TermPtr tmPtr)
+{ return (tmPtr-> tag.categoryTag == DF_TM_TAG_SUSP); }
+Boolean DF_isEmpEnv(DF_EnvPtr envPtr)
+{ return (envPtr == DF_EMPTY_ENV); }
+Boolean DF_isDummyEnv(DF_EnvPtr envPtr)
+{ return envPtr -> tag.categoryTag == DF_ENV_TAG_DUMMY; }
+
+
+/* TERM DECOMPOSITION */
+int DF_termTag(DF_TermPtr tmPtr) // tag
+{
+ return tmPtr -> tag.categoryTag;
+}
+//unbound variables
+int DF_fvUnivCount(DF_TermPtr tmPtr) //universe count
+{
+ return ((DF_VarTerm*)tmPtr)->univCount;
+}
+//constant (w/oc type associations)
+int DF_constUnivCount(DF_TermPtr tmPtr) //universe count
+{
+ return ((DF_ConstTerm*)tmPtr)->data.nameAndUC.univCount;
+}
+int DF_constTabIndex(DF_TermPtr tmPtr) //table index
+{
+ return ((DF_ConstTerm*)tmPtr)->data.nameAndUC.symTabIndex;
+}
+//constants with type associations
+DF_TypePtr DF_constType(DF_TermPtr tmPtr) //type env
+{
+ return ((DF_TConstTerm*)tmPtr)->typeEnv;
+}
+//integer
+long DF_intValue(DF_TermPtr tmPtr) //integer value
+{
+ return ((DF_IntTerm*)tmPtr)->value;
+}
+//float
+float DF_floatValue(DF_TermPtr tmPtr) //float value
+{
+ return ((DF_FloatTerm*)tmPtr)->value;
+}
+//string
+MCSTR_Str DF_strValue(DF_TermPtr tmPtr) //string value
+{
+ return (MCSTR_Str)(((MemPtr)(((DF_StrTerm*)tmPtr)->value))
+ + DF_STRDATA_HEAD_SIZE);
+}
+DF_StrDataPtr DF_strData(DF_TermPtr tmPtr) //string data field
+{
+ return ((DF_StrTerm*)tmPtr)->value;
+}
+MCSTR_Str DF_strDataValue(DF_StrDataPtr tmPtr) //acc str value from data fd
+{
+ return (MCSTR_Str)(((MemPtr)tmPtr) + DF_STRDATA_HEAD_SIZE);
+}
+
+//stream TEMP
+WordPtr DF_streamTabIndex(DF_TermPtr tmPtr) //stream table index
+{
+ return ((DF_StreamTerm*)tmPtr)->index;
+}
+//de Bruijn index
+int DF_bvIndex(DF_TermPtr tmPtr) //de Bruijn index
+{
+ return ((DF_BVTerm*)tmPtr)->index;
+}
+//reference
+DF_TermPtr DF_refTarget(DF_TermPtr tmPtr) //target
+{
+ return ((DF_RefTerm*)tmPtr)->target;
+}
+//list cons
+DF_TermPtr DF_consArgs(DF_TermPtr tmPtr) //arg vector
+{
+ return ((DF_ConsTerm*)tmPtr)->args;
+}
+//abstraction
+int DF_lamNumAbs(DF_TermPtr tmPtr) //embedding level
+{
+ return ((DF_LamTerm*)tmPtr)->numOfLams;
+}
+DF_TermPtr DF_lamBody(DF_TermPtr tmPtr) //abstraction body
+{
+ return ((DF_LamTerm*)tmPtr)->body;
+}
+//application
+int DF_appArity(DF_TermPtr tmPtr) //arity
+{
+ return ((DF_AppTerm*)tmPtr)->arity;
+}
+DF_TermPtr DF_appFunc(DF_TermPtr tmPtr) //functor
+{
+ return ((DF_AppTerm*)tmPtr)->functor;
+}
+DF_TermPtr DF_appArgs(DF_TermPtr tmPtr) //arg vector
+{
+ return ((DF_AppTerm*)tmPtr)->args;
+}
+//suspension
+int DF_suspOL(DF_TermPtr tmPtr) //ol
+{
+ return ((DF_SuspTerm*)tmPtr)->ol;
+}
+int DF_suspNL(DF_TermPtr tmPtr) //nl
+{
+ return ((DF_SuspTerm*)tmPtr)->nl;
+}
+DF_TermPtr DF_suspTermSkel(DF_TermPtr tmPtr) //term skeleton
+{
+ return ((DF_SuspTerm*)tmPtr)->termSkel;
+}
+DF_EnvPtr DF_suspEnv(DF_TermPtr tmPtr) //environment list
+{
+ return ((DF_SuspTerm*)tmPtr)->envList;
+}
+
+//environment item (dummy/pair)
+DF_EnvPtr DF_envListRest(DF_EnvPtr envPtr) //next env item
+{
+ return envPtr->rest;
+}
+DF_EnvPtr DF_envListNth(DF_EnvPtr envPtr, int n) //nth item
+{
+ int i;
+ for (i=n; (i!=1); i--) envPtr = envPtr -> rest;
+ return envPtr;
+}
+int DF_envIndex(DF_EnvPtr envPtr) //l in @l or (t,l)
+{
+ return envPtr -> embedLevel;
+}
+//pair environment item
+DF_TermPtr DF_envPairTerm(DF_EnvPtr envPtr) //t in (t,l)
+{
+ return ((DF_PairEnv*)envPtr) -> term;
+}
+
+/* TERM CONSTRUCTION */
+void DF_copyAtomic(DF_TermPtr src, MemPtr dest) //copy atomic
+{
+ *((DF_TermPtr)dest) = *src;
+}
+void DF_copyApp(DF_TermPtr src, MemPtr dest) //copy application
+{
+ *((DF_AppTerm*)dest) = *((DF_AppTerm*)src);
+}
+void DF_copySusp(DF_TermPtr src, MemPtr dest) //copy suspension
+{
+ *((DF_SuspTerm*)dest) = *((DF_SuspTerm*)src);
+}
+void DF_mkVar(MemPtr loc, int uc) //unbound variable
+{
+ ((DF_VarTerm*)loc) -> tag.categoryTag = DF_TM_TAG_VAR;
+ ((DF_VarTerm*)loc) -> univCount = uc;
+}
+void DF_mkBV(MemPtr loc, int ind) //de Bruijn index
+{
+ ((DF_BVTerm*)loc) -> tag.categoryTag = DF_TM_TAG_BVAR;
+ ((DF_BVTerm*)loc) -> index = ind;
+}
+void DF_mkConst(MemPtr loc, int uc, int ind) //const
+{
+ ((DF_ConstTerm*)loc) -> tag.categoryTag = DF_TM_TAG_CONST;
+ ((DF_ConstTerm*)loc) -> withType = FALSE;
+ (((DF_ConstTerm*)loc) -> data).nameAndUC.univCount = uc;
+ (((DF_ConstTerm*)loc) -> data).nameAndUC.symTabIndex = ind;
+}
+void DF_mkTConst(MemPtr loc, int uc, int ind, DF_TypePtr typeEnv)
+ //const with type association
+{
+ ((DF_TConstTerm*)loc) -> tag.categoryTag = DF_TM_TAG_CONST;
+ ((DF_TConstTerm*)loc) -> withType = TRUE;
+ (((DF_TConstTerm*)loc) -> data).nameAndUC.univCount = uc;
+ (((DF_TConstTerm*)loc) -> data).nameAndUC.symTabIndex = ind;
+ ((DF_TConstTerm*)loc) -> typeEnv = typeEnv;
+}
+void DF_mkInt(MemPtr loc, long value) //int
+{
+ ((DF_IntTerm*)loc) -> tag.categoryTag = DF_TM_TAG_INT;
+ ((DF_IntTerm*)loc) -> value = value;
+}
+void DF_mkFloat(MemPtr loc, float value) //float
+{
+ ((DF_FloatTerm*)loc) -> tag.categoryTag = DF_TM_TAG_FLOAT;
+ ((DF_FloatTerm*)loc) -> value = value;
+}
+void DF_mkStr(MemPtr loc, DF_StrDataPtr data) //string
+{
+ ((DF_StrTerm*)loc) -> tag.categoryTag = DF_TM_TAG_STR;
+ ((DF_StrTerm*)loc) -> value = data;
+}
+void DF_mkStrDataHead(MemPtr loc) //string data head
+{
+ ((DF_StrDataPtr)loc) -> tag.categoryTag = DF_TM_TAG_STRBODY;
+}
+
+void DF_mkStream(MemPtr loc, WordPtr ind) //stream
+{
+ ((DF_StreamTerm*)loc) -> tag.categoryTag = DF_TM_TAG_STREAM;
+ ((DF_StreamTerm*)loc) -> index = ind;
+}
+void DF_setStreamInd(DF_TermPtr tm, WordPtr ind) //update stream ind
+{
+ ((DF_StreamTerm*)tm) -> index = ind;
+}
+void DF_mkNil(MemPtr loc) //nil
+{
+ ((DF_NilTerm*)loc) -> tag.categoryTag = DF_TM_TAG_NIL;
+}
+void DF_mkRef(MemPtr loc, DF_TermPtr target) //reference
+{
+ ((DF_RefTerm*)loc) -> tag.categoryTag = DF_TM_TAG_REF;
+ ((DF_RefTerm*)loc) -> target = target;
+}
+void DF_mkCons(MemPtr loc, DF_TermPtr args) //cons
+{
+ ((DF_ConsTerm*)loc) -> tag.categoryTag = DF_TM_TAG_CONS;
+ ((DF_ConsTerm*)loc) -> args = args;
+}
+void DF_mkLam(MemPtr loc, int n, DF_TermPtr body) //abstraction
+{
+ ((DF_LamTerm*)loc) -> tag.categoryTag = DF_TM_TAG_LAM;
+ ((DF_LamTerm*)loc) -> numOfLams = n;
+ ((DF_LamTerm*)loc) -> body = body;
+}
+void DF_mkApp(MemPtr loc, int n, DF_TermPtr func, DF_TermPtr args)
+{ //application
+ ((DF_AppTerm*)loc) -> tag.categoryTag = DF_TM_TAG_APP;
+ ((DF_AppTerm*)loc) -> arity = n;
+ ((DF_AppTerm*)loc) -> functor = func;
+ ((DF_AppTerm*)loc) -> args = args;
+}
+void DF_mkSusp(MemPtr loc, int ol, int nl, DF_TermPtr tmPtr, DF_EnvPtr env)
+ //suspension
+{
+ ((DF_SuspTerm*)loc) -> tag.categoryTag = DF_TM_TAG_SUSP;
+ ((DF_SuspTerm*)loc) -> ol = ol;
+ ((DF_SuspTerm*)loc) -> nl = nl;
+ ((DF_SuspTerm*)loc) -> termSkel = tmPtr;
+ ((DF_SuspTerm*)loc) -> envList = env;
+}
+
+void DF_mkDummyEnv(MemPtr loc, int l, DF_EnvPtr rest) //@l env item
+{
+ ((DF_DummyEnv*)loc) -> tag.categoryTag = DF_ENV_TAG_DUMMY;
+ ((DF_DummyEnv*)loc) -> embedLevel = l;
+ ((DF_DummyEnv*)loc) -> rest = rest;
+}
+void DF_mkPairEnv(MemPtr loc, int l, DF_TermPtr t, DF_EnvPtr rest)
+{
+ // (t, l) env item
+ ((DF_PairEnv*)loc) -> tag.categoryTag = DF_ENV_TAG_PAIR;
+ ((DF_PairEnv*)loc) -> embedLevel = l;
+ ((DF_PairEnv*)loc) -> rest = rest;
+ ((DF_PairEnv*)loc) -> term = t;
+}
+
+
+/* TERM MODIFICATION */
+void DF_modVarUC(DF_TermPtr vPtr, int uc)
+{
+ ((DF_VarTerm*)vPtr) -> univCount = uc;
+}
+
+
+/* (NON_TRIVIAL) TERM COMPARISON */
+Boolean DF_sameConsts(DF_TermPtr const1, DF_TermPtr const2) //same constant?
+{
+ return (((DF_ConstTerm*)const1)->data.value ==
+ ((DF_ConstTerm*)const2)->data.value);
+}
+Boolean DF_sameStrs(DF_TermPtr str1, DF_TermPtr str2) //same string?
+{
+ if (str1 == str2) return TRUE;
+ else if (((DF_StrTerm*)str1)->value ==
+ ((DF_StrTerm*)str2)->value) return TRUE; //compare data fd addr
+ //compare literals
+ return MCSTR_sameStrs(
+ (MCSTR_Str)(((MemPtr)(((DF_StrTerm*)str1)->value)) +
+ DF_STRDATA_HEAD_SIZE),
+ (MCSTR_Str)(((MemPtr)(((DF_StrTerm*)str2)->value)) +
+ DF_STRDATA_HEAD_SIZE));
+
+}
+Boolean DF_sameStrData(DF_TermPtr tmPtr, DF_StrDataPtr strData)
+{
+ if (((DF_StrTerm*)tmPtr) -> value == strData) return TRUE; //compare addr
+ return MCSTR_sameStrs(
+ (MCSTR_Str)(((MemPtr)(((DF_StrTerm*)tmPtr)->value)) +
+ DF_STRDATA_HEAD_SIZE),
+ (MCSTR_Str)(((MemPtr)strData) + DF_STRDATA_HEAD_SIZE));
+}
+
+/********************************************************************/
+/* */
+/* DISAGREEMENT SET REPRESENTATION */
+/* */
+/* A double linked list */
+/********************************************************************/
+
+//create a new node at the given location
+void DF_mkDisPair(MemPtr loc, DF_DisPairPtr next, DF_TermPtr first,
+ DF_TermPtr second)
+{
+ ((DF_DisPairPtr)(loc)) -> tag.categoryTag = DF_DISPAIR;
+ ((DF_DisPairPtr)(loc)) -> next = next;
+ ((DF_DisPairPtr)(loc)) -> firstTerm = first;
+ ((DF_DisPairPtr)(loc)) -> secondTerm = second;
+}
+
+//decomposition
+DF_DisPairPtr DF_disPairNext(DF_DisPairPtr disPtr){return disPtr -> next; }
+DF_TermPtr DF_disPairFirstTerm(DF_DisPairPtr disPtr)
+{
+ return disPtr -> firstTerm;
+}
+DF_TermPtr DF_disPairSecondTerm(DF_DisPairPtr disPtr)
+{
+ return disPtr -> secondTerm;
+}
+
+//whether a given disagreement set is empty
+Boolean DF_isEmpDisSet(DF_DisPairPtr disPtr)
+{
+ return (disPtr == DF_EMPTY_DIS_SET);
+}
+
+Boolean DF_isNEmpDisSet(DF_DisPairPtr disPtr)
+{
+ return (disPtr != DF_EMPTY_DIS_SET);
+}
+
+
+#endif //DATAFORMATS_C
diff --git a/src/runtime/c/teyjus/simulator/dataformats.h b/src/runtime/c/teyjus/simulator/dataformats.h
new file mode 100644
index 000000000..3905cd8c2
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/dataformats.h
@@ -0,0 +1,417 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************/
+/* */
+/* File dataformat.h. */
+/* The header file identifies the low-level representation of data objects */
+/* that are manipulated by the machine, through various structure types. */
+/****************************************************************************/
+#ifndef DATAFORMATS_H
+#define DATAFORMATS_H
+
+#include // to be removed
+#include
+//#include
+#include "mctypes.h"
+#include "mcstring.h"
+
+/********************************************************************/
+/* DATA TAG FIELD IN TYPES AND TERMS */
+/********************************************************************/
+
+/* The first byte is assumed to contain a type or term category tag,
+ and the second is to be used for marking in garbage collection */
+typedef struct
+{
+ Byte categoryTag;
+ Byte mark; //to be used in garbage collection
+} DF_Tag;
+
+/* The tags of heap items */
+typedef enum
+{
+ //type categories
+ DF_TY_TAG_SORT = 0, //sort
+ DF_TY_TAG_REF, //reference
+ DF_TY_TAG_SKVAR, //skeleton variable
+ DF_TY_TAG_ARROW, //type arrow
+ DF_TY_TAG_STR, //type structure
+ DF_TY_TAG_FUNC, //functor of type structure
+
+ //term categories
+ DF_TM_TAG_VAR = 6, // existential variables
+ DF_TM_TAG_CONST, // constants
+ DF_TM_TAG_INT, // integers
+ DF_TM_TAG_FLOAT, // floats
+ DF_TM_TAG_NIL, // empty lists
+ DF_TM_TAG_STR, // strings
+ DF_TM_TAG_STREAM, // streams
+ DF_TM_TAG_BVAR, // lambda bound variables (de Bruijn index)
+ // -- atoms above
+ DF_TM_TAG_REF, // references
+ // -- complex terms below
+ DF_TM_TAG_CONS, // list constructors
+ DF_TM_TAG_LAM, // abstractions
+ DF_TM_TAG_APP, // applications
+ DF_TM_TAG_SUSP, // suspensions
+
+ DF_TM_TAG_STRBODY = 19, // string body
+
+ //suspension environment items
+ DF_ENV_TAG_DUMMY = 20, //dummy environment
+ DF_ENV_TAG_PAIR, //pair environment
+
+ //disagreement pair
+ DF_DISPAIR = 22
+} DF_HeapDataCategory;
+
+
+/********************************************************************/
+/* */
+/* TYPE REPRESENTATION */
+/* */
+/********************************************************************/
+
+/********************************************************************/
+/* Only generic types are visible from outside. */
+/* The "public" information for each specific type category is their*/
+/* sizes. Their structure declarations are hidden in dataformat.c. */
+/* Construction, recognization and decomposition of types should be */
+/* performed through interface functions with declarations present */
+/* in this file. */
+/********************************************************************/
+
+/*
+//type categories
+enum DF_TypeCategory
+{
+ DF_TY_TAG_SORT, //sort
+ DF_TY_TAG_REF, //reference
+ DF_TY_TAG_SKVAR, //skeleton variable
+ DF_TY_TAG_ARROW, //type arrow
+ DF_TY_TAG_STR //type structure
+};
+*/
+
+//generic type (head) for every category
+typedef struct
+{
+ DF_Tag tag; /* the common field for every type (head); can
+ be any one of enum TypeCategory.
+ rely on struct alignment */
+ Word dummy; /* a place holder which enforces the size of the
+ generic term to be 2 words. */
+} DF_Type;
+
+typedef DF_Type *DF_TypePtr; //type pointer
+
+//sizes of different type items
+#define DF_TY_ATOMIC_SIZE 2 //atomic size
+
+//attributes of special type constructors
+#define DF_TY_ARROW_ARITY 2 //arity of type arrow
+
+
+/******************************************************************/
+/* Interface functions */
+/******************************************************************/
+
+/* TYPE DEREFERENCE */
+DF_TypePtr DF_typeDeref(DF_TypePtr);
+
+/* TYPE RECOGNITION */
+Boolean DF_isSortType(DF_TypePtr); // is sort?
+Boolean DF_isRefType(DF_TypePtr); // is reference? (including free var)
+Boolean DF_isFreeVarType(DF_TypePtr); // is free var?
+Boolean DF_isSkelVarType(DF_TypePtr); // is skeleton var?
+Boolean DF_isArrowType(DF_TypePtr); // is type arrow?
+Boolean DF_isStrType(DF_TypePtr); // is type structure?
+
+/* TYPE DECOMPOSITION */
+int DF_typeTag(DF_TypePtr); //generic type
+int DF_typeKindTabIndex(DF_TypePtr); //sorts
+int DF_typeSkelVarIndex(DF_TypePtr); //skel var
+DF_TypePtr DF_typeRefTarget(DF_TypePtr); //reference
+DF_TypePtr DF_typeArrowArgs(DF_TypePtr); //arrows
+DF_TypePtr DF_typeStrFuncAndArgs(DF_TypePtr); //structures
+int DF_typeStrFuncInd(DF_TypePtr);
+int DF_typeStrFuncArity(DF_TypePtr);
+DF_TypePtr DF_typeStrArgs(DF_TypePtr);
+
+/* TYPE CONSTRUCTION */
+void DF_copyAtomicType(DF_TypePtr src, MemPtr dest);
+void DF_mkSortType(MemPtr loc, int ind);
+void DF_mkRefType(MemPtr loc, DF_TypePtr target);
+void DF_mkFreeVarType(MemPtr loc);
+void DF_mkSkelVarType(MemPtr loc, int offset);
+void DF_mkArrowType(MemPtr loc, DF_TypePtr args);
+void DF_mkStrType(MemPtr loc, DF_TypePtr funcAndArgs);
+void DF_mkStrFuncType(MemPtr loc, int ind, int n);
+
+
+/********************************************************************/
+/* */
+/* TERM REPRESENTATION */
+/* */
+/********************************************************************/
+
+/********************************************************************/
+/* Only generic terms (environment items) are visible from outside. */
+/* The "public" information for each specific term category is their*/
+/* sizes. Their structure declarations are hidden in dataformat.c. */
+/* Construction, recognization and decomposition of terms should be */
+/* performed through interface functions with declarations present */
+/* in this file. */
+/********************************************************************/
+
+/*
+//term categories
+enum DF_TermCategory
+{
+ DF_TM_TAG_VAR, // existential variables
+ DF_TM_TAG_CONST, // constants
+ DF_TM_TAG_INT, // integers
+ DF_TM_TAG_FLOAT, // floats
+ DF_TM_TAG_NIL, // empty lists
+ DF_TM_TAG_STR, // strings
+ DF_TM_TAG_STREAM, // streams
+ DF_TM_TAG_BVAR, // lambda bound variables (de Bruijn index)
+ // -- atoms above
+ DF_TM_TAG_REF, // references
+ // -- complex terms below
+ DF_TM_TAG_CONS, // list constructors
+ DF_TM_TAG_LAM, // abstractions
+ DF_TM_TAG_APP, // applications
+ DF_TM_TAG_SUSP // suspensions
+};
+*/
+
+// a generic term (head) for every category
+typedef struct
+{
+ DF_Tag tag; /* the common field for every term (head); can
+ be any one of enum TermCategory.
+ rely on struct alignment */
+ Word dummy; /* a place holder which enforces the size of the
+ generic term to be 2 words. */
+} DF_Term;
+
+typedef DF_Term *DF_TermPtr; //term pointer
+
+//sizes of different term items
+#define DF_TM_ATOMIC_SIZE 2 // atomic size
+#define DF_TM_TCONST_SIZE 3 // type associated constant (config set)
+#define DF_TM_APP_SIZE 3 // application head
+#define DF_TM_LAM_SIZE 2 // abstraction
+#define DF_TM_CONS_SIZE 2 // cons
+#define DF_TM_SUSP_SIZE 4 // suspension (config set)
+
+// attributes of some special constants
+#define DF_CONS_ARITY 2 //arity of cons
+
+// head of string body (a tag word should be followed by encoding of literals)
+typedef union
+{
+ DF_Tag tag;
+ Word dummy;
+} DF_StrData;
+
+typedef DF_StrData *DF_StrDataPtr;
+
+//#define DF_STRDATA_HEAD_SIZE (int)ceil((double)sizeof(DF_StrData)/WORD_SIZE)
+#define DF_STRDATA_HEAD_SIZE 2
+
+//a generic environment item in suspension
+typedef struct DF_env
+{
+ //Boolean isDummy;
+ DF_Tag tag;
+ TwoBytes embedLevel;
+ struct DF_env *rest; //the tail of the list
+} DF_Env;
+
+typedef DF_Env *DF_EnvPtr;
+
+// empty environment list
+#define DF_EMPTY_ENV NULL
+
+//sizes of different environment items
+#define DF_ENV_DUMMY_SIZE 2 // dummy environment item
+#define DF_ENV_PAIR_SIZE 3 // pair environment item
+
+//limits (to be set by configuration)
+#define DF_MAX_BV_IND USHRT_MAX //max db ind (embedding level)
+#define DF_TM_MAX_ARITY USHRT_MAX //max arity
+#define DF_MAX_UNIVIND USHRT_MAX //max universe index
+
+
+/******************************************************************/
+/* Interface functions */
+/******************************************************************/
+
+/* DEREFERENCE */
+DF_TermPtr DF_termDeref(DF_TermPtr); // term dereference
+
+/* TERM RECOGNITION */
+Boolean DF_isAtomic(DF_TermPtr); //note ref is neither atomic nor complex
+Boolean DF_isNAtomic(DF_TermPtr);
+Boolean DF_isFV(DF_TermPtr); // is unbound variable?
+Boolean DF_isConst(DF_TermPtr); // is constant (typed and untyped)?
+Boolean DF_isTConst(DF_TermPtr); // is a type associated constant?
+ // Note we assume the arg is known to be const
+Boolean DF_isInt(DF_TermPtr); // is integer?
+Boolean DF_isFloat(DF_TermPtr); // is float?
+Boolean DF_isNil(DF_TermPtr); // is list nil?
+Boolean DF_isStr(DF_TermPtr); // is string?
+Boolean DF_isBV(DF_TermPtr); // is de Bruijn index?
+Boolean DF_isStream(DF_TermPtr); // is stream?
+Boolean DF_isRef(DF_TermPtr); // is reference?
+Boolean DF_isCons(DF_TermPtr); // is list cons?
+Boolean DF_isLam(DF_TermPtr); // is abstraction?
+Boolean DF_isApp(DF_TermPtr); // is application?
+Boolean DF_isSusp(DF_TermPtr); // is suspension?
+
+Boolean DF_isEmpEnv(DF_EnvPtr); // is empty environment?
+Boolean DF_isDummyEnv(DF_EnvPtr);// is dummy environment item?
+
+/* TERM DECOMPOSITION */
+//generic term
+int DF_termTag(DF_TermPtr); // term category tag
+//unbound variable
+int DF_fvUnivCount(DF_TermPtr); // universe count
+//constants (w/oc type associations)
+int DF_constUnivCount(DF_TermPtr); // universe index
+int DF_constTabIndex(DF_TermPtr); // symbol table index
+//constants with type associations
+DF_TypePtr DF_constType(DF_TermPtr); // type environment
+//integer
+long DF_intValue(DF_TermPtr); // integer value (long)
+//float
+float DF_floatValue(DF_TermPtr); // float value
+//string
+MCSTR_Str DF_strValue(DF_TermPtr); // string value
+DF_StrDataPtr DF_strData(DF_TermPtr tmPtr); // string data field
+MCSTR_Str DF_strDataValue(DF_StrDataPtr tmPtr); //acc str value from data fd
+//stream
+WordPtr DF_streamTabIndex(DF_TermPtr); // stream table index
+//de Bruijn indices
+int DF_bvIndex(DF_TermPtr); // de Bruijn index
+//reference
+DF_TermPtr DF_refTarget(DF_TermPtr); // target
+//list cons
+DF_TermPtr DF_consArgs(DF_TermPtr); // arg vector
+//abstractions
+int DF_lamNumAbs(DF_TermPtr); // embedding level
+DF_TermPtr DF_lamBody(DF_TermPtr); // lambda body
+//application
+int DF_appArity(DF_TermPtr); // arity
+DF_TermPtr DF_appFunc(DF_TermPtr); // functor
+DF_TermPtr DF_appArgs(DF_TermPtr); // arg vector
+//suspension
+int DF_suspOL(DF_TermPtr); // ol
+int DF_suspNL(DF_TermPtr); // nl
+DF_TermPtr DF_suspTermSkel(DF_TermPtr); // term skel
+DF_EnvPtr DF_suspEnv(DF_TermPtr); // environment list
+
+//environment item (dummy/pair)
+DF_EnvPtr DF_envListRest(DF_EnvPtr); // next env item
+DF_EnvPtr DF_envListNth(DF_EnvPtr, int); // the nth item
+int DF_envIndex(DF_EnvPtr); // l in @l or (t,l)
+//pair environment item
+DF_TermPtr DF_envPairTerm(DF_EnvPtr); // t in (t,l)
+
+
+/* TERM CONSTRUCTION */
+void DF_copyAtomic(DF_TermPtr src, MemPtr dest); //copy atomic
+void DF_copyApp(DF_TermPtr src, MemPtr dest); //copy application
+void DF_copySusp(DF_TermPtr src, MemPtr dest); //copy suspension
+void DF_mkVar(MemPtr loc, int uc); //unbound variable
+void DF_mkBV(MemPtr loc, int ind); //de Bruijn index
+void DF_mkConst(MemPtr loc, int uc, int ind); //const
+void DF_mkTConst(MemPtr loc, int uc, int ind, DF_TypePtr typeEnv);
+ //const with type association
+void DF_mkInt(MemPtr loc, long value); //int
+void DF_mkFloat(MemPtr loc, float value); //float
+void DF_mkStr(MemPtr loc, DF_StrDataPtr data); //string
+void DF_mkStrDataHead(MemPtr loc); //string data head
+void DF_mkStream(MemPtr loc, WordPtr ind); //stream
+void DF_setStreamInd(DF_TermPtr tm, WordPtr ind); //update index of a stream
+void DF_mkNil(MemPtr loc); //nil
+void DF_mkRef(MemPtr loc, DF_TermPtr target); //reference
+void DF_mkCons(MemPtr loc, DF_TermPtr args); //cons
+void DF_mkLam(MemPtr loc, int n, DF_TermPtr body); //abstraction
+void DF_mkApp(MemPtr loc, int n, DF_TermPtr func, DF_TermPtr args);
+ //application
+void DF_mkSusp(MemPtr loc, int ol, int nl, DF_TermPtr tp, DF_EnvPtr env);
+ //suspension
+void DF_mkDummyEnv(MemPtr loc, int l, DF_EnvPtr rest); //@l env item
+void DF_mkPairEnv(MemPtr loc, int l, DF_TermPtr t, DF_EnvPtr rest);
+ // (t, l) env item
+
+/* TERM MODIFICATION */
+void DF_modVarUC(DF_TermPtr vPtr, int uc);
+
+/* (NON_TRIVIAL) TERM COMPARISON */
+Boolean DF_sameConsts(DF_TermPtr const1, DF_TermPtr const2); //same const?
+Boolean DF_sameStrs(DF_TermPtr str1, DF_TermPtr str2); //same string?
+Boolean DF_sameStrData(DF_TermPtr tmPtr, DF_StrDataPtr strData); //same str?
+
+/********************************************************************/
+/* */
+/* DISAGREEMENT SET REPRESENTATION */
+/* */
+/* Linked list */
+/********************************************************************/
+
+typedef struct DF_disPair //each node in the disagreement set
+{
+ DF_Tag tag;
+ struct DF_disPair *next;
+ DF_TermPtr firstTerm;
+ DF_TermPtr secondTerm;
+} DF_DisPair;
+
+typedef DF_DisPair *DF_DisPairPtr; //pointer to a disagreement pair
+
+//note this arithmatic should in reality be performed in configuration
+#define DF_DISPAIR_SIZE (int)ceil((double)sizeof(DF_DisPair)/WORD_SIZE)
+
+#define DF_EMPTY_DIS_SET NULL //empty disagreement set
+
+/******************************************************************/
+/* Interface functions */
+/******************************************************************/
+
+//create a new node at the given location
+void DF_mkDisPair(MemPtr loc, DF_DisPairPtr next, DF_TermPtr first,
+ DF_TermPtr second);
+
+//decomposition
+DF_DisPairPtr DF_disPairNext(DF_DisPairPtr disPtr);
+DF_TermPtr DF_disPairFirstTerm(DF_DisPairPtr disPtr);
+DF_TermPtr DF_disPairSecondTerm(DF_DisPairPtr disPtr);
+
+//whether a given disagreement set is empty
+Boolean DF_isEmpDisSet(DF_DisPairPtr disPtr);
+Boolean DF_isNEmpDisSet(DF_DisPairPtr disPtr);
+
+#endif //DATAFORMATS_H
+
+
diff --git a/src/runtime/c/teyjus/simulator/hnorm.c b/src/runtime/c/teyjus/simulator/hnorm.c
new file mode 100644
index 000000000..7f84087cb
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/hnorm.c
@@ -0,0 +1,1128 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************/
+/* */
+/* File hnorm.c. */
+/* This file contains the head normalization routines. */
+/* These procedures are based on the suspension calculus, and the reduction */
+/* strategy with lazy reduction, lazy substitution and lazy heap */
+/* commitment is chosen. A SML realization of this process is described in */
+/* paper "Choices in Representation and Reduction Strategies for Lambda */
+/* Terms in Intersional Contexts". */
+/****************************************************************************/
+
+#ifndef HNORM_C
+#define HNORM_C
+
+#include
+#include "dataformats.h"
+#include "mctypes.h"
+#include "hnorm.h"
+#include "hnormlocal.h"
+#include "abstmachine.h"
+#include "../system/error.h"
+
+//for debugging: to be removed
+#include
+#include "printterm.h"
+#include "../system/stream.h"
+
+/*****************************************************************************/
+/* a global(to file hnorm.c) encoding of the explicit suspension environment*/
+/* and simple checking and updating functions on this environment */
+/*****************************************************************************/
+/* environment of the implicit suspension, which is initialized to empty*/
+static int ol, nl;
+static DF_EnvPtr envlist;
+
+/* clean the environment to empty */
+static void HN_setEmptyEnv() { ol = 0; nl = 0; envlist = DF_EMPTY_ENV; }
+/* set the environment according to given values */
+static void HN_setEnv(int o, int n, DF_EnvPtr e)
+{ ol = o; nl = n; envlist = e; }
+/* is an empty environment? */
+static Boolean HN_isEmptyEnv() { return ((ol == 0) && (nl == 0)); }
+
+/****************************************************************************/
+/* Functions for creating (modifying) the environment list in the suspension*/
+/* environment defined by ol, nl and envlist according to their current */
+/* values. */
+/****************************************************************************/
+
+/* Add n (n > 0) dummy environment items to the front of the current
+ environment list: @(nl+n-1) :: ... :: @nl :: envlist.
+ New dummy env items are created on the current heap top.
+*/
+static DF_EnvPtr HN_addNDummyEnv(int n)
+{
+ int i;
+ DF_EnvPtr last = envlist, current;
+
+ AM_heapError(AM_hreg + n * DF_ENV_DUMMY_SIZE);
+ for (i = 0; i < n; i++){
+ current = (DF_EnvPtr)AM_hreg;
+ DF_mkDummyEnv(AM_hreg, nl+i, last);
+ AM_hreg += DF_ENV_DUMMY_SIZE;
+ last = current;
+ }
+ return current;
+}
+
+/* Add n (n > 0) pair environment items to the front of the current
+ environment list as the following:
+ ([|an,myol,mynl,myenv|],nl):: ... ::([|ai,myol,mynl,myenv|],nl)::envlist,
+ where ai is the ith argument in the vector referred to by argvec.
+ Note if ai is an atomic term, the suspension over it is eagerly evaluated.
+ */
+static DF_EnvPtr HN_addNPair(DF_TermPtr argvec, int myol, int mynl,
+ DF_EnvPtr myenv, int n)
+{
+ int i;
+ DF_EnvPtr last = envlist, current;
+ MemPtr myEnvlist = AM_hreg;
+ MemPtr newhtop = AM_hreg + n * DF_ENV_PAIR_SIZE;
+
+ AM_heapError(newhtop);
+ AM_hreg = newhtop; //spare space for n pair env items
+ for (i = 1; i<= n; i++) {
+ current = (DF_EnvPtr)myEnvlist;
+ DF_mkPairEnv(myEnvlist, nl, HNL_suspAsEnv(argvec,myol,mynl,myenv),
+ last);
+ myEnvlist += DF_ENV_PAIR_SIZE;
+ last = current;
+ argvec = (DF_TermPtr)(((MemPtr)argvec) + DF_TM_ATOMIC_SIZE);
+ }
+ return current;
+}
+
+/* A specialized version of HN_addNPair when the incoming environment is
+ empty.
+ Now, n (n > 0) pair environment items are added to the front of the
+ current environment list as the following:
+ (an,0) :: ... :: (a1,0) :: envlist, where ai is the ith argument in the
+ vector referred to by argvec.
+ */
+static DF_EnvPtr HN_addNPairEmpEnv(DF_TermPtr argvec, int n)
+{
+ int i;
+ DF_EnvPtr last = envlist, current;
+ AM_heapError(AM_hreg + n * DF_ENV_PAIR_SIZE);
+ for (i = 1; i <= n; i++) {
+ current = (DF_EnvPtr)AM_hreg;
+ DF_mkPairEnv(AM_hreg, 0, argvec, last);
+ AM_hreg += DF_ENV_PAIR_SIZE;
+ last = current;
+ argvec = (DF_TermPtr)(((MemPtr)argvec) + DF_TM_ATOMIC_SIZE);
+ }
+ return current;
+}
+
+/****************************************************************************/
+/* A function for pushing suspension over n abstractions following the rule */
+/* [|lam(n,body), ol, nl, envlist|] */
+/* -> lam(n, [|body, ol+n, nl+n, @(nl+n-1) :: ... :: @nl :: envlist |] */
+/* The result is committed on the current top of heap. */
+/* The top-level (implicit) suspension is given by the global variable */
+/* ol, nl, and envlist. */
+/* This function is used in HN_hnormSusp, HN_hnormSuspOCC and HN_lnormSusp. */
+/****************************************************************************/
+static DF_TermPtr HN_pushSuspOverLam(DF_TermPtr lamPtr)
+{
+ DF_TermPtr rtPtr; //term pointer to be returned
+ DF_TermPtr suspPtr; //explicit susp as the lam body in the result
+ int numabs =DF_lamNumAbs(lamPtr);
+ int newol = ol + numabs, newnl = nl + numabs;
+ MemPtr newhtop = AM_hreg+ DF_TM_SUSP_SIZE+ numabs*DF_TM_ATOMIC_SIZE;
+ DF_EnvPtr newenv;
+
+ AM_embedError(newol);
+ AM_embedError(newnl);
+ AM_heapError(newhtop);
+ newenv = HN_addNDummyEnv(numabs);
+ suspPtr = HNL_suspAsEnv(DF_lamBody(lamPtr), newol, newnl, newenv);
+ rtPtr = (DF_TermPtr)AM_hreg; //create lam over the susp
+ DF_mkLam(AM_hreg, numabs, suspPtr);
+ AM_hreg = newhtop;
+
+ return rtPtr;
+}
+
+/****************************************************************************/
+/* functions for (weak) head normalizing terms of known categories */
+/*--------------------------------------------------------------------------*/
+/* General comments: */
+/* An implicit suspension is given by the global variables ol, nl and */
+/* envlist together with the first argument tmPtr to the sub-functions: */
+/* [|tmPtr, ol, nl, envlist|] */
+/* The suspension environment could be empty in which case the term */
+/* being normalized is tmPtr itself. */
+/* The second argument of the sub-functions whnf is a flag indicating */
+/* whether a head normal form or a weak head normal form is being */
+/* computed. */
+/****************************************************************************/
+static DF_TermPtr HN_hnormDispatch(DF_TermPtr tmPtr, Boolean whnf);
+
+/* (weak) head normalize bound variable or implicit suspension with
+ bound variable as term skeleton. */
+static DF_TermPtr HN_hnormBV(DF_TermPtr bvPtr, Boolean whnf)
+{
+
+ DF_TermPtr rtPtr; //term pointer to be returned
+ if (HN_isEmptyEnv()){ //[|#i, 0, 0, nil|] -> #i
+ rtPtr = bvPtr;
+ HNL_setRegsRig(bvPtr);
+ } else { //non-empty env
+ int dbind = DF_bvIndex(bvPtr);
+
+ if (dbind > ol) { //[|#i,ol,nl,e|] -> #i-ol+nl
+ int newind = dbind - ol + nl;
+
+ AM_embedError(newind);
+ rtPtr =(DF_TermPtr)AM_hreg;
+ HNL_pushBV(newind);
+ HNL_setRegsRig(rtPtr);
+ HN_setEmptyEnv();
+ } else { // i <= ol
+ DF_EnvPtr envitem = DF_envListNth(envlist, dbind);
+ int nladj = nl-DF_envIndex(envitem);
+
+ if (DF_isDummyEnv(envitem)){ //[|#i,ol,nl,..@l..|]->#(nl-l)
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushBV(nladj);
+ HNL_setRegsRig(rtPtr);
+ HN_setEmptyEnv();
+ } else { //pair env [|#i,ol,nl,..(s,l)..|] -> [|s,0,(nl-l),nil|]
+ DF_TermPtr tmPtr = DF_termDeref(DF_envPairTerm(envitem));
+ if ((nladj != 0) && (DF_isSusp(tmPtr))) {//combine susp
+ int newnl = DF_suspNL(tmPtr)+nladj;
+ AM_embedError(newnl);
+ HN_setEnv(DF_suspOL(tmPtr), newnl, DF_suspEnv(tmPtr));
+ rtPtr = HN_hnormDispatch(DF_suspTermSkel(tmPtr), whnf);
+ } else {
+ HN_setEnv(0, nladj, DF_EMPTY_ENV);
+ rtPtr = HN_hnormDispatch(tmPtr, whnf);
+ }
+ } //pair env
+ } // i<= ol
+ } //non-empty env
+
+ return rtPtr;
+}
+
+
+/* (weak) head normalize an abstraction or implicit suspension with term
+ skeleton as an abstraction.
+ If an implicit suspension is weak head normalized, the suspension itself
+ is returned. The descendant of this suspension over its abstraction skeleton
+ is performed in the subsequent app case on a fly.
+ Note that this is the only case that hnorm termniates with a non-empty
+ environment.
+*/
+static DF_TermPtr HN_hnormLam(DF_TermPtr lamPtr, Boolean whnf)
+{
+ DF_TermPtr rtPtr; //term pointer to be returned
+
+ if (whnf) return rtPtr = lamPtr; //weak hn
+ else { //whnf = FALSE
+ int numabs = DF_lamNumAbs(lamPtr);
+ DF_TermPtr newbody;
+
+ if (HN_isEmptyEnv()){
+ newbody = HN_hnormDispatch(DF_lamBody(lamPtr), FALSE);
+ rtPtr = lamPtr; //body must have been adjusted in place
+ } else { // non-empty env
+ //[|lam(n,t),ol,nl,e|] ->lam(n,[|t,ol+n,nl+n,@nl+n-1...::@nl::e|]
+ int newol = ol+numabs, newnl = nl+numabs;
+
+ AM_embedError(newol);
+ AM_embedError(newnl);
+ HN_setEnv(newol, newnl, HN_addNDummyEnv(numabs));
+ newbody = HN_hnormDispatch(DF_lamBody(lamPtr), FALSE);
+ /* create a new lam on the result of hn the lam body */
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushLam(newbody, numabs);
+ } // non-empty env
+ AM_numAbs += numabs;
+ } //whnf == FALSE
+ return rtPtr;
+}
+
+/* (weak) head normalize cons or implicit suspension over cons */
+static DF_TermPtr HN_hnormCons(DF_TermPtr consPtr, Boolean whnf)
+{
+ DF_TermPtr argvec = DF_consArgs(consPtr),
+ rtPtr; //term pointer to be returned
+ if (HN_isEmptyEnv()){
+ AM_argVec = argvec;
+ AM_numArgs = DF_CONS_ARITY;
+ rtPtr = consPtr;
+ } else {
+ Boolean changed = HNL_makeConsArgvec(argvec, ol, nl, envlist);
+ if (changed){ //new argvec is built because of pushing susp
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushCons(AM_argVec);
+ } else rtPtr = consPtr;
+ HN_setEmptyEnv();
+ }
+ HNL_setRegsCons(rtPtr);
+ return rtPtr;
+}
+
+/* (weak) head normalize application or implicit suspension over
+ application. The old application term is destructively changed into
+ a reference to its head normal form or its weak head normal form if
+ the weak heap normal form is not an implicit suspension (in which
+ case the term skeleton must be an abstraction.).
+*/
+static DF_TermPtr HN_hnormApp(DF_TermPtr appPtr, Boolean whnf)
+{
+ DF_TermPtr funPtr = DF_appFunc(appPtr), argvec = DF_appArgs(appPtr),
+ rtPtr; // term pointer to be returned
+ DF_TermPtr oldFunPtr = funPtr;
+ int arity = DF_appArity(appPtr);
+ Boolean emptyTopEnv = HN_isEmptyEnv();
+ int myol, mynl; //for book keeping the implicit suspension env
+ DF_EnvPtr myenvlist; //for book keeping the implicit suspension env
+ int myarity = arity; //book keeping the arity before contraction
+
+ if (!emptyTopEnv) { //book keeping the current environment
+ myol = ol; mynl = nl; myenvlist = envlist;
+ }
+ funPtr = HN_hnormDispatch(funPtr, TRUE); //whf of the function
+ while ((arity > 0) && (DF_isLam(funPtr))) {
+ //perform contraction on top-level redexes while you can
+ DF_TermPtr lamBody = DF_lamBody(funPtr); //abs body
+ int numAbsInFun = DF_lamNumAbs(funPtr);
+ int numContract = ((arity<=numAbsInFun) ? arity : numAbsInFun);
+ DF_EnvPtr newenv;
+ int newol = ol + numContract;
+
+ AM_embedError(newol);
+ if (emptyTopEnv) newenv = HN_addNPairEmpEnv(argvec, numContract);
+ else newenv = HN_addNPair(argvec, myol, mynl, myenvlist, numContract);
+ HN_setEnv(newol, nl, newenv);
+
+ if (arity == numAbsInFun){
+ funPtr = HN_hnormDispatch(lamBody, whnf);
+ arity = 0;
+ } else if (arity > numAbsInFun) {
+ funPtr = HN_hnormDispatch(lamBody, TRUE);
+ argvec=(DF_TermPtr)(((MemPtr)argvec)+numAbsInFun*DF_TM_ATOMIC_SIZE);
+ arity -= numAbsInFun;
+ } else { //arity < numabsInFun
+ DF_TermPtr newBody = (DF_TermPtr)AM_hreg;
+ HNL_pushLam(lamBody, (numAbsInFun-arity));
+ funPtr = HN_hnormDispatch(newBody, whnf);
+ arity = 0;
+ }
+ }// while ((arity >0) && (DF_IsLam(fun)))
+
+ //update or create application
+ if (arity == 0) { //app disappears
+ rtPtr = funPtr;
+ if (emptyTopEnv && HN_isEmptyEnv()) HNL_updateToRef(appPtr, funPtr);
+ } else { //app persists; Note: now HN_isEmptyEnv must be TRUE
+ Boolean changed;
+ if (emptyTopEnv) changed = HNL_makeArgvecEmpEnv(argvec, arity);
+ else changed = HNL_makeArgvec(argvec,arity,myol,mynl,myenvlist);
+
+ if ((!changed) && (arity == myarity) && (funPtr == oldFunPtr)) {
+ rtPtr = appPtr;
+ } else {// create new app and in place update the old if empty top env
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushApp(AM_head, AM_argVec, AM_numArgs);
+ if (emptyTopEnv) HNL_updateToRef(appPtr, rtPtr);
+ }
+ }
+ return rtPtr;
+}
+
+/* (weak) head normalize (explicit) suspension or implicit suspension
+ with a suspension term skeletion. The explicit suspension is destructivly
+ changed to its head normal form or weak head normal form in case
+ that the whn is not an implicit susp itself (in which case the term
+ skeleton must be an abstraction).
+*/
+static DF_TermPtr HN_hnormSusp(DF_TermPtr suspPtr, Boolean whnf)
+{
+ DF_TermPtr rtPtr; //term pointer to be returned
+ int myol, mynl ; // for book keeping the env of implicit susp
+ DF_EnvPtr myenvlist;
+ Boolean emptyTopEnv = HN_isEmptyEnv();
+
+ if (!emptyTopEnv){
+ myol = ol; mynl = nl; myenvlist = envlist;
+ }
+ //first (weak) head normalize the explicit susp
+ HN_setEnv(DF_suspOL(suspPtr), DF_suspNL(suspPtr), DF_suspEnv(suspPtr));
+ rtPtr = HN_hnormDispatch(DF_suspTermSkel(suspPtr), whnf);
+ if (emptyTopEnv) {
+ if (HN_isEmptyEnv()) {
+ HNL_updateToRef(suspPtr, rtPtr);
+ }
+ } else { // ! emptyTopEnv
+ if (HN_isEmptyEnv()) HNL_updateToRef(suspPtr, rtPtr);
+ else rtPtr = HN_pushSuspOverLam(rtPtr);
+ //(weak) head norm the top-level (imp) susp
+ HN_setEnv(myol, mynl, myenvlist);
+ /* note that AM_numabs, AM_numargs and AM_argvec have to be
+ re-initialized, because the (w)hnf of the inner suspension
+ is to be traversed again. */
+ HNL_initRegs();
+ rtPtr = HN_hnormDispatch(rtPtr, whnf);
+ }
+ return rtPtr;
+}
+
+/****************************************************************************/
+/* Dispatching on various term categories. */
+/****************************************************************************/
+static DF_TermPtr HN_hnormDispatch(DF_TermPtr tmPtr, Boolean whnf)
+{
+ restart:
+ switch (DF_termTag(tmPtr)){
+ case DF_TM_TAG_VAR:
+ {
+ if (!HN_isEmptyEnv()) HN_setEmptyEnv();
+ HNL_setRegsFlex(tmPtr);
+ return tmPtr;
+ }
+ case DF_TM_TAG_CONST:
+ case DF_TM_TAG_INT:
+ case DF_TM_TAG_FLOAT:
+ case DF_TM_TAG_NIL:
+ case DF_TM_TAG_STR:
+ case DF_TM_TAG_STREAM:
+ {
+ if (!HN_isEmptyEnv()) HN_setEmptyEnv();
+ HNL_setRegsRig(tmPtr);
+ return tmPtr;
+ }
+ case DF_TM_TAG_BVAR: { return HN_hnormBV(tmPtr, whnf); }
+ case DF_TM_TAG_CONS: { return HN_hnormCons(tmPtr, whnf); }
+ case DF_TM_TAG_LAM: { return HN_hnormLam(tmPtr, whnf); }
+ case DF_TM_TAG_APP: { return HN_hnormApp(tmPtr, whnf); }
+ case DF_TM_TAG_SUSP: { return HN_hnormSusp(tmPtr, whnf); }
+ case DF_TM_TAG_REF: { tmPtr = DF_termDeref(tmPtr); goto restart;}
+ }
+
+ //Impossible to reach this point.
+ return NULL;
+}
+
+/****************************************************************************/
+/* the interface routine for head normalization */
+/****************************************************************************/
+void HN_hnorm(DF_TermPtr tmPtr)
+{
+ HN_setEmptyEnv();
+ HNL_initRegs();
+ HN_hnormDispatch(DF_termDeref(tmPtr), FALSE);
+}
+
+
+/****************************************************************************/
+/* HEAD (WEAK HEAD) NORMALIZATION WITH OCCURS CHECK */
+/*--------------------------------------------------------------------------*/
+/* General comments: */
+/* Checkings are added when the (dereference of) term to be normlized is */
+/* an application or a cons. If the term is an application, checking is */
+/* made on whether the application is currently referred */
+/* to by register AM_vbbreg, and this checking is added in the APP case */
+/* of the dispatch function. If the term is a cons, checking is made on */
+/* whether its argument vector is currently referred to by the register */
+/* AM_vbbreg, and this checking is added in sub-function HN_hnormConsOcc. */
+/****************************************************************************/
+static DF_TermPtr HN_hnormDispatchOcc(DF_TermPtr tmPtr, Boolean whnf);
+
+/****************************************************************************/
+/* functions for (weak) head normalizing terms with occurs-check */
+/* of known categories */
+/****************************************************************************/
+
+/* (weak) head normalize bound variable or implicit suspension with
+ bound variable as term skeleton. */
+static DF_TermPtr HN_hnormBVOcc(DF_TermPtr bvPtr, Boolean whnf)
+{
+ DF_TermPtr rtPtr; //term pointer to be returned
+ if (HN_isEmptyEnv()){ //[|#i, 0, 0, nil|] -> #i
+ rtPtr = bvPtr;
+ HNL_setRegsRig(bvPtr);
+ } else { //non-empty env
+ int dbind = DF_bvIndex(bvPtr);
+
+ if (dbind > ol) { //[|#i,ol,nl,e|] -> #i-ol+nl
+ int newind = dbind - ol + nl;
+
+ AM_embedError(newind);
+ rtPtr =(DF_TermPtr)AM_hreg;
+ HNL_pushBV(newind);
+ HNL_setRegsRig(rtPtr);
+ HN_setEmptyEnv();
+ } else { // i <= ol
+ DF_EnvPtr envitem = DF_envListNth(envlist, dbind);
+ int nladj = nl-DF_envIndex(envitem);
+
+ if (DF_isDummyEnv(envitem)){ //[|#i,ol,nl,..@l..|]->#(nl-l)
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushBV(nladj);
+ HNL_setRegsRig(rtPtr);
+ HN_setEmptyEnv();
+ } else { //pair env [|#i,ol,nl,..(s,l)..|] -> [|s,0,(nl-l),nil|]
+ DF_TermPtr tmPtr = DF_termDeref(DF_envPairTerm(envitem));
+ if ((nladj != 0) && (DF_isSusp(tmPtr))) {//combine susp
+ int newnl = DF_suspNL(tmPtr)+nladj;
+ AM_embedError(newnl);
+ HN_setEnv(DF_suspOL(tmPtr), newnl, DF_suspEnv(tmPtr));
+ rtPtr = HN_hnormDispatchOcc(DF_suspTermSkel(tmPtr), whnf);
+ } else {
+ HN_setEnv(0, nladj, DF_EMPTY_ENV);
+ rtPtr = HN_hnormDispatchOcc(tmPtr, whnf);
+ }
+ } //pair env
+ } // i<= ol
+ } //non-empty env
+ return rtPtr;
+}
+
+/* (weak) head normalize an abstraction or implicit suspension with term
+ skeleton as an abstraction. */
+static DF_TermPtr HN_hnormLamOcc(DF_TermPtr lamPtr, Boolean whnf)
+{
+ DF_TermPtr rtPtr; //term pointer to be returned
+
+ if (whnf) return rtPtr = lamPtr; //weak hn
+ else { //whnf = FALSE
+ int numabs = DF_lamNumAbs(lamPtr);
+ DF_TermPtr newbody;
+
+ if (HN_isEmptyEnv()){
+ newbody = HN_hnormDispatchOcc(DF_lamBody(lamPtr), FALSE);
+ rtPtr = lamPtr; //body must have been adjusted in place
+ } else { // non-empty env
+ //[|lam(n,t),ol,nl,e|] ->lam(n,[|t,ol+n,nl+n,@nl+n-1...::@nl::e|]
+ int newol = ol+numabs, newnl = nl+numabs;
+
+ AM_embedError(newol);
+ AM_embedError(newnl);
+ HN_setEnv(newol, newnl, HN_addNDummyEnv(numabs));
+ newbody = HN_hnormDispatchOcc(DF_lamBody(lamPtr), FALSE);
+ /* create a new lam on the result of hn the lam body */
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushLam(newbody, numabs);
+ } // non-empty env
+ AM_numAbs += numabs;
+ } //whnf == FALSE
+ return rtPtr;
+}
+
+/* (weak) head normalize cons or implicit suspension over cons.
+ Note checking on whether the argument vector of the cons term is referred to
+ by the register AM_vbbreg is made.
+*/
+static DF_TermPtr HN_hnormConsOcc(DF_TermPtr consPtr, Boolean whnf)
+{
+ DF_TermPtr argvec = DF_consArgs(consPtr),
+ rtPtr; //term pointer to be returned
+ if (AM_vbbreg == argvec) EM_THROW(EM_FAIL);
+ if (HN_isEmptyEnv()){
+ AM_argVec = argvec;
+ AM_numArgs = DF_CONS_ARITY;
+ rtPtr = consPtr;
+ } else {
+ Boolean changed = HNL_makeConsArgvec(argvec, ol, nl, envlist);
+ if (changed){ //new argvec is built because of pushing susp
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushCons(AM_argVec);
+ } else rtPtr = consPtr;
+ HN_setEmptyEnv();
+ }
+ HNL_setRegsCons(rtPtr);
+ return rtPtr;
+}
+
+/* (weak) head normalize application or implicit suspension over
+ application.
+*/
+static DF_TermPtr HN_hnormAppOcc(DF_TermPtr appPtr, Boolean whnf)
+{
+ DF_TermPtr funPtr = DF_appFunc(appPtr), argvec = DF_appArgs(appPtr),
+ rtPtr; // term pointer to be returned
+ DF_TermPtr oldFunPtr = funPtr;
+ int arity = DF_appArity(appPtr);
+ Boolean emptyTopEnv = HN_isEmptyEnv();
+ int myol, mynl; //for book keeping the implicit suspension env
+ DF_EnvPtr myenvlist; //for book keeping the implicit suspension env
+ int myarity = arity; //book keeping the arity before contraction
+
+ if (!emptyTopEnv) { //book keeping the current environment
+ myol = ol; mynl = nl; myenvlist = envlist;
+ }
+ funPtr = HN_hnormDispatchOcc(funPtr, TRUE); //whf of the function
+ while ((arity > 0) && (DF_isLam(funPtr))) {
+ //perform contraction on top-level redexes while you can
+ DF_TermPtr lamBody = DF_lamBody(funPtr); //abs body
+ int numAbsInFun = DF_lamNumAbs(funPtr);
+ int numContract = ((arity<=numAbsInFun) ? arity : numAbsInFun);
+ DF_EnvPtr newenv;
+ int newol = ol + numContract;
+
+ AM_embedError(newol);
+ if (emptyTopEnv) newenv = HN_addNPairEmpEnv(argvec, numContract);
+ else newenv = HN_addNPair(argvec, myol, mynl, myenvlist, numContract);
+ HN_setEnv(newol, nl, newenv);
+
+ if (arity == numAbsInFun){
+ funPtr = HN_hnormDispatchOcc(lamBody, whnf);
+ arity = 0;
+ } else if (arity > numAbsInFun) {
+ funPtr = HN_hnormDispatchOcc(lamBody, TRUE);
+ argvec=(DF_TermPtr)(((MemPtr)argvec)+numAbsInFun*DF_TM_ATOMIC_SIZE);
+ arity -= numAbsInFun;
+ } else { //arity < numabsInFun
+ DF_TermPtr newBody = (DF_TermPtr)AM_hreg;
+ HNL_pushLam(lamBody, (numAbsInFun-arity));
+ funPtr = HN_hnormDispatchOcc(newBody, whnf);
+ arity = 0;
+ }
+ }// while ((arity >0) && (DF_IsLam(fun)))
+
+ //update or create application
+ if (arity == 0) { //app disappears
+ rtPtr = funPtr;
+ if (emptyTopEnv && HN_isEmptyEnv()) HNL_updateToRef(appPtr, funPtr);
+ } else { //app persists; Note: now HN_isEmptyEnv must be TRUE
+ Boolean changed;
+ if (emptyTopEnv) changed = HNL_makeArgvecEmpEnv(argvec, arity);
+ else changed = HNL_makeArgvec(argvec,arity,myol,mynl,myenvlist);
+
+ if ((!changed) && (arity == myarity) && (oldFunPtr == funPtr)) {
+ rtPtr = appPtr;
+ } else {// create new app and in place update the old if empty top env
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushApp(AM_head, AM_argVec, AM_numArgs);
+ if (emptyTopEnv) HNL_updateToRef(appPtr, rtPtr);
+ }
+ }
+ return rtPtr;
+}
+
+/* (weak) head normalize (explicit) suspension or implicit suspension
+ with a suspension term skeletion.
+*/
+static DF_TermPtr HN_hnormSuspOcc(DF_TermPtr suspPtr, Boolean whnf)
+{
+ DF_TermPtr rtPtr; //term pointer to be returned
+ int myol, mynl ; // for book keeping the env of implicit susp
+ DF_EnvPtr myenvlist;
+ Boolean emptyTopEnv = HN_isEmptyEnv();
+
+ if (!emptyTopEnv){
+ myol = ol; mynl = nl; myenvlist = envlist;
+ }
+ //first (weak) head normalize the explicit susp
+ HN_setEnv(DF_suspOL(suspPtr), DF_suspNL(suspPtr), DF_suspEnv(suspPtr));
+ rtPtr = HN_hnormDispatchOcc(DF_suspTermSkel(suspPtr), whnf);
+
+ if (emptyTopEnv) {
+ if (HN_isEmptyEnv()) HNL_updateToRef(suspPtr, rtPtr);
+ } else { // ! emptyTopEnv
+ if (HN_isEmptyEnv()) HNL_updateToRef(suspPtr, rtPtr);
+ else rtPtr = HN_pushSuspOverLam(rtPtr);
+ //(weak) head norm the top-level (imp) susp
+ HN_setEnv(myol, mynl, myenvlist);
+ /* note that AM_numabs, AM_numargs and AM_argvec have to be
+ re-initialized, because the (w)hnf of the inner suspension
+ is to be traversed again. */
+ HNL_initRegs();
+ rtPtr = HN_hnormDispatchOcc(rtPtr, whnf);
+ }
+ return rtPtr;
+}
+
+/****************************************************************************/
+/* Dispatching on various term categories. */
+/****************************************************************************/
+static DF_TermPtr HN_hnormDispatchOcc(DF_TermPtr tmPtr, Boolean whnf)
+{
+ restart_hnormOcc:
+ switch (DF_termTag(tmPtr)){
+ case DF_TM_TAG_VAR:
+ {
+ if (!HN_isEmptyEnv()) HN_setEmptyEnv();
+ HNL_setRegsFlex(tmPtr);
+ return tmPtr;
+ }
+ case DF_TM_TAG_CONST:
+ case DF_TM_TAG_INT:
+ case DF_TM_TAG_FLOAT:
+ case DF_TM_TAG_NIL:
+ case DF_TM_TAG_STR:
+ case DF_TM_TAG_STREAM:
+ {
+ if (!HN_isEmptyEnv()) HN_setEmptyEnv();
+ HNL_setRegsRig(tmPtr);
+ return tmPtr;
+ }
+ case DF_TM_TAG_BVAR: { return HN_hnormBVOcc(tmPtr, whnf); }
+ case DF_TM_TAG_CONS: { return HN_hnormConsOcc(tmPtr, whnf); }
+ case DF_TM_TAG_LAM: { return HN_hnormLamOcc(tmPtr, whnf); }
+ case DF_TM_TAG_APP: {
+ if (AM_vbbreg == tmPtr) EM_THROW(EM_FAIL);
+ return HN_hnormAppOcc(tmPtr, whnf); }
+ case DF_TM_TAG_SUSP: { return HN_hnormSuspOcc(tmPtr, whnf); }
+ case DF_TM_TAG_REF: {tmPtr=DF_termDeref(tmPtr); goto restart_hnormOcc;}
+ }
+
+ //Impossible to reach this point.
+ return NULL;
+}
+
+/****************************************************************************/
+/* the interface routine for head normalization */
+/****************************************************************************/
+void HN_hnormOcc(DF_TermPtr tmPtr)
+{
+ HN_setEmptyEnv();
+ HNL_initRegs();
+ tmPtr = HN_hnormDispatchOcc(DF_termDeref(tmPtr), FALSE);
+}
+
+
+/****************************************************************************/
+/* FULL NORMALIZATION */
+/****************************************************************************/
+static DF_TermPtr HN_lnormDispatch(DF_TermPtr, Boolean whnf);
+
+/****************************************************************************/
+/* Functions for creating argument vectors in full normalization */
+/*--------------------------------------------------------------------------*/
+/* General comments: */
+/* This is the counter part of HNL_makeArgvec functions (hnormlocal.c) */
+/* in the full normalization process for arranging arguments of */
+/* applications (cons) when their "heads" are in (head) normal forms. */
+/* Nested applications are unfolded. */
+/* The difference is that HN_lnormDispatch is invoked on each argument */
+/* to fully normalize it. */
+/****************************************************************************/
+
+/* Fully normalize (implicit) suspensions [| ai, myol, mynl, myenv |],
+ where ai's are those in the vector referred to by argvec with size arity,
+ and myol, mynl, myenv are given by other parameters.
+ Note that a new argument vector is always created.
+*/
+static void HN_lnormArgvec(DF_TermPtr argvec, int arity, int myol, int mynl,
+ DF_EnvPtr myenv)
+{
+ int i;
+ //book keeping relevant regs.
+ DF_TermPtr head = AM_head, myArgvec = AM_argVec;
+ int numAbs = AM_numAbs, numArgs = AM_numArgs;
+ Flag rigFlag = AM_rigFlag, consFlag = AM_consFlag;
+
+ MemPtr newArgvec = AM_hreg; //new argvec
+ MemPtr newhtop = newArgvec + arity * DF_TM_ATOMIC_SIZE;
+ AM_heapError(newhtop);
+ AM_hreg = newhtop; //arrange heap top for creating terms in norm args
+
+ for (i = 1; i <= arity; i++){
+ HN_setEnv(myol, mynl, myenv); //imp susp environment
+ HNL_initRegs();
+ DF_mkRef(newArgvec, HN_lnormDispatch(argvec, FALSE));
+ newArgvec += DF_TM_ATOMIC_SIZE;
+ argvec = (DF_TermPtr)(((MemPtr)argvec)+DF_TM_ATOMIC_SIZE);
+ }
+ //reset registers
+ AM_head = head; AM_argVec = myArgvec;
+ AM_numAbs = numAbs; AM_numArgs = numArgs;
+ AM_rigFlag = rigFlag; AM_consFlag = consFlag;
+}
+
+/* A specialized version of HN_lnormArgvec when the implicit suspension
+ over each argument in the vector is known to be empty.
+ Note that upon the return of HN_lnormDispatch, the argument has been
+ destructively updated to its normal form, which means the old argument
+ vector is always used.
+*/
+static void HN_lnormArgvecEmpEnv(DF_TermPtr argvec, int arity)
+{
+ int i;
+ //book keeping relevant regs.
+ DF_TermPtr head = AM_head, myArgvec = AM_argVec;
+ int numAbs = AM_numAbs, numArgs = AM_numArgs;
+ Flag rigFlag = AM_rigFlag, consFlag = AM_consFlag;
+
+ for (i = 1; i <= arity; i++){
+ HNL_initRegs();
+ HN_lnormDispatch(argvec, FALSE);
+ argvec = (DF_TermPtr)(((MemPtr)argvec) + DF_TM_ATOMIC_SIZE);
+ }
+ //reset registers
+ AM_head = head; AM_argVec = myArgvec;
+ AM_numAbs = numAbs; AM_numArgs = numArgs;
+ AM_rigFlag = rigFlag; AM_consFlag = consFlag;
+}
+
+/* Create an argument vector for applications within a non-empty environment.
+ Actions are carried out in two steps:
+ First, nested applications are unfolded if arising. Second, the (implicit)
+ suspensions formed by each argument and given parameters are fully
+ normalized.
+ Note that a new argument vector is always created.
+*/
+static Boolean HN_makeArgvecLnorm(DF_TermPtr argvec, int arity, int myol,
+ int mynl, DF_EnvPtr myenv)
+{
+ DF_TermPtr newArgvec = (DF_TermPtr)AM_hreg; //new argvec
+ int newArity;
+
+ if (AM_numArgs != 0){ //unfold nested app first
+ MemPtr newhtop = AM_hreg + AM_numArgs * DF_TM_ATOMIC_SIZE;
+ AM_heapError(newhtop);
+ newArity = arity + AM_numArgs;
+ AM_arityError(newArity);
+ HNL_copyArgs(AM_argVec, AM_numArgs); //layout inner args
+ } else newArity = arity;
+
+ //fully normalize arguments
+ HN_lnormArgvec(argvec, arity, myol, mynl, myenv);
+ AM_argVec = newArgvec;
+ AM_numArgs = newArity;
+ return TRUE;
+}
+
+/* A specilized version of HN_makeArgvecLnorm when the enclosing environment
+ is known to be empty. Note that new argument vecoter is created
+ if nested applications were unfolded. Otherwise, the old is used.
+ Boolean values TRUE or FALSE is returned to inidicate which situation it is.
+*/
+static Boolean HN_makeArgvecEmpEnvLnorm(DF_TermPtr argvec, int arity)
+{
+ HN_lnormArgvecEmpEnv(argvec, arity); //lnorm arguments
+
+ if (AM_numArgs != 0){ //unfold nested app
+ int newArity = arity + AM_numArgs;
+ DF_TermPtr newArgvec = (DF_TermPtr)AM_hreg; //new argument vector
+ AM_arityError(newArity);
+ AM_heapError(((MemPtr)newArgvec + newArity * DF_TM_ATOMIC_SIZE));
+
+ HNL_copyArgs(AM_argVec, AM_numArgs);
+ HNL_copyArgs(argvec, arity);
+
+ AM_argVec = newArgvec;
+ AM_numArgs = newArity;
+ return TRUE;
+ } else {
+ AM_argVec = argvec;
+ AM_numArgs = arity;
+ return FALSE;
+ }
+}
+
+/****************************************************************************/
+/* functions for fully normalizing terms of known categories */
+/*--------------------------------------------------------------------------*/
+/* General comments: */
+/* */
+/* An implicit suspension is given by the global variables ol, nl and */
+/* envlist together with the first argument tmPtr to the sub-functions: */
+/* [|tmPtr, ol, nl, envlist|] */
+/* The suspension environment could be empty in which case the term */
+/* being normalized is tmPtr itself. */
+/* The second argument of the sub-functions whnf is a flag indicating */
+/* whether a head normal form or a weak head normal form is being */
+/* computed. */
+/****************************************************************************/
+
+/* Fully normalize or weak head normalize bound variable or implicit
+ suspension with bound variable as term skeleton.
+ The actions carried out are the same as the counter part in the head
+ normalization proceee, except that HN_lnormDispatch is invoked as opposed
+ to HN_hnormDispatch when necessary.
+*/
+static DF_TermPtr HN_lnormBV(DF_TermPtr bvPtr, Boolean whnf)
+{
+ DF_TermPtr rtPtr; //term pointer to be returned
+ if (HN_isEmptyEnv()){ //[|#i, 0, 0, nil|] -> #i
+ rtPtr = bvPtr;
+ HNL_setRegsRig(bvPtr);
+ } else { //non-empty env
+ int dbind = DF_bvIndex(bvPtr);
+
+ if (dbind > ol) { //[|#i,ol,nl,e|] -> #i-ol+nl
+ int newind = dbind - ol + nl;
+
+ AM_embedError(newind);
+ rtPtr =(DF_TermPtr)AM_hreg;
+ HNL_pushBV(newind);
+ HNL_setRegsRig(rtPtr);
+ HN_setEmptyEnv();
+ } else { // i <= ol
+ DF_EnvPtr envitem = DF_envListNth(envlist, dbind);
+ int nladj = nl-DF_envIndex(envitem);
+
+ if (DF_isDummyEnv(envitem)){ //[|#i,ol,nl,..@l..|]->#(nl-l)
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushBV(nladj);
+ HNL_setRegsRig(rtPtr);
+ HN_setEmptyEnv();
+ } else { //pair env [|#i,ol,nl,..(s,l)..|] -> [|s,0,(nl-l),nil|]
+ DF_TermPtr tmPtr = DF_termDeref(DF_envPairTerm(envitem));
+ if ((nladj != 0) && (DF_isSusp(tmPtr))) {//combine susp
+ int newnl = DF_suspNL(tmPtr)+nladj;
+ AM_embedError(newnl);
+ HN_setEnv(DF_suspOL(tmPtr), newnl, DF_suspEnv(tmPtr));
+ rtPtr = HN_lnormDispatch(DF_suspTermSkel(tmPtr), whnf);
+ } else {
+ HN_setEnv(0, nladj, DF_EMPTY_ENV);
+ rtPtr = HN_lnormDispatch(tmPtr, whnf);
+ }
+ } //pair env
+ } // i<= ol
+ } //non-empty env
+ return rtPtr;
+}
+
+/* Fully normalize or weak head normalize abstractions or implicit suspension
+ with abstractions as term skeletons.
+ The actions carried out are the same as the counter part in the head
+ normalization process, except that HN_lnormDispatch is invoked as opposed
+ to HN_hnormDispatch when necessary.
+*/
+static DF_TermPtr HN_lnormLam(DF_TermPtr lamPtr, Boolean whnf)
+{
+ DF_TermPtr rtPtr; //term pointer to be returned
+ if (whnf) return rtPtr = lamPtr; //weak hn
+ else { //whnf = FALSE
+ int numabs = DF_lamNumAbs(lamPtr);
+ DF_TermPtr newbody;
+
+ if (HN_isEmptyEnv()){
+ newbody = HN_lnormDispatch(DF_lamBody(lamPtr), FALSE);
+ rtPtr = lamPtr; //body must have been adjusted in place
+ } else { // non-empty env
+ //[|lam(n,t),ol,nl,e|] ->lam(n,[|t,ol+n,nl+n,@nl+n-1...::@nl::e|]
+ int newol = ol+numabs, newnl = nl+numabs;
+
+ AM_embedError(newol);
+ AM_embedError(newnl);
+ HN_setEnv(newol, newnl, HN_addNDummyEnv(numabs));
+ newbody = HN_lnormDispatch(DF_lamBody(lamPtr), FALSE);
+ /* create a new lam on the result of hn the lam body */
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushLam(newbody, numabs);
+ } // non-empty env
+ AM_numAbs += numabs;
+ } //whnf == FALSE
+ return rtPtr;
+}
+
+/* Fully normalize or weak head normalize cons or implicit suspension over
+ cons. The difference from HN_hnormCons is that the arguments of the cons
+ are fully normalized.
+*/
+static DF_TermPtr HN_lnormCons(DF_TermPtr consPtr, Boolean whnf)
+{
+ DF_TermPtr argvec = DF_consArgs(consPtr),
+ rtPtr; //term pointer to be returned
+ if (HN_isEmptyEnv()){
+ HN_lnormArgvecEmpEnv(argvec, DF_CONS_ARITY);
+ AM_argVec = argvec;
+ AM_numArgs = DF_CONS_ARITY;
+ rtPtr = consPtr;
+ } else {
+ DF_TermPtr newArgvec = (DF_TermPtr)AM_hreg; //new argument vector
+ HN_lnormArgvec(argvec, DF_CONS_ARITY, ol, nl, envlist);
+ AM_argVec = newArgvec;
+ AM_numArgs = DF_CONS_ARITY;
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushCons(AM_argVec);
+ HN_setEmptyEnv();
+ }
+ HNL_setRegsCons(rtPtr);
+ return rtPtr;
+}
+
+/* Fully normalize or weak head normalize application or implicit suspension
+ over application. The actions carried out here is the same as those in
+ HN_hnormApp except that HN_lnormDispatch is invoked as HN_hnormDispatch, and
+ in making argument vectors makeArgvecLnorm functions are used to fully
+ normalize the arguments.
+*/
+static DF_TermPtr HN_lnormApp(DF_TermPtr appPtr, Boolean whnf)
+{
+ DF_TermPtr funPtr = DF_appFunc(appPtr), argvec = DF_appArgs(appPtr),
+ rtPtr; // term pointer to be returned
+ DF_TermPtr oldFunPtr = funPtr;
+ int arity = DF_appArity(appPtr);
+ Boolean emptyTopEnv = HN_isEmptyEnv();
+ int myol, mynl; //for book keeping the implicit suspension env
+ DF_EnvPtr myenvlist; //for book keeping the implicit suspension env
+ int myarity = arity; //book keeping the arity before contraction
+
+ if (!emptyTopEnv) { //book keeping the current environment
+ myol = ol; mynl = nl; myenvlist = envlist;
+ }
+ funPtr = HN_lnormDispatch(funPtr, TRUE); //whf of the function
+ while ((arity > 0) && (DF_isLam(funPtr))) {
+ //perform contraction on top-level redexes while you can
+ DF_TermPtr lamBody = DF_lamBody(funPtr); //abs body
+ int numAbsInFun = DF_lamNumAbs(funPtr);
+ int numContract = ((arity<=numAbsInFun) ? arity : numAbsInFun);
+ DF_EnvPtr newenv;
+ int newol = ol + numContract;
+
+ AM_embedError(newol);
+ if (emptyTopEnv) newenv = HN_addNPairEmpEnv(argvec, numContract);
+ else newenv = HN_addNPair(argvec, myol, mynl, myenvlist, numContract);
+ HN_setEnv(newol, nl, newenv);
+
+ if (arity == numAbsInFun){
+ funPtr = HN_lnormDispatch(lamBody, whnf);
+ arity = 0;
+ } else if (arity > numAbsInFun) {
+ funPtr = HN_lnormDispatch(lamBody, TRUE);
+ argvec=(DF_TermPtr)(((MemPtr)argvec)+numAbsInFun*DF_TM_ATOMIC_SIZE);
+ arity -= numAbsInFun;
+ } else { //arity < numabsInFun
+ DF_TermPtr newBody = (DF_TermPtr)AM_hreg;
+ HNL_pushLam(lamBody, (numAbsInFun-arity));
+ funPtr = HN_lnormDispatch(newBody, whnf);
+ arity = 0;
+ }
+ }// while ((arity >0) && (DF_IsLam(fun)))
+
+ //update or create application
+ if (arity == 0) { //app disappears
+ rtPtr = funPtr;
+ if (emptyTopEnv && HN_isEmptyEnv()) HNL_updateToRef(appPtr, funPtr);
+ } else { //app persists; Note: now HN_isEmptyEnv must be TRUE
+ Boolean changed;
+ if (emptyTopEnv) changed = HN_makeArgvecEmpEnvLnorm(argvec, arity);
+ else changed = HN_makeArgvecLnorm(argvec,arity,myol,mynl,myenvlist);
+
+ if ((!changed) && (arity == myarity) && (oldFunPtr == funPtr)) {
+ rtPtr = appPtr;
+ } else {// create new app and in place update the old if empty top env
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushApp(AM_head, AM_argVec, AM_numArgs);
+ if (emptyTopEnv) HNL_updateToRef(appPtr, rtPtr);
+ }
+ }
+ return rtPtr;
+}
+
+/* Fuuly normlize or weak head normalize (explicit) suspension or implicit
+ suspension with a suspension term skeletion. The actions are the same
+ as those in HN_hnormSusp except that HN_lnormDispatch is used as opposed
+ to HN_hnormSusp with one exception: when the environment of the top-level
+ suspension is not empty, the inner suspension is head normalized
+ (HN_hnormDispatch).
+*/
+
+static DF_TermPtr HN_lnormSusp(DF_TermPtr suspPtr, Boolean whnf)
+{
+ DF_TermPtr rtPtr; //term pointer to be returned
+ int myol, mynl; // for book keeping the env of implicit susp
+ DF_EnvPtr myenvlist;
+ Boolean emptyTopEnv = HN_isEmptyEnv();
+
+ if (!emptyTopEnv) {
+ myol = ol; mynl = nl; myenvlist = envlist;
+ }
+ HN_setEnv(DF_suspOL(suspPtr), DF_suspNL(suspPtr), DF_suspEnv(suspPtr));
+
+ if (emptyTopEnv){
+ rtPtr = HN_lnormDispatch(DF_suspTermSkel(suspPtr), whnf);
+ if (HN_isEmptyEnv()) HNL_updateToRef(suspPtr, rtPtr);
+ } else { //non-empty top-level env
+ rtPtr = HN_hnormDispatch(DF_suspTermSkel(suspPtr), whnf);
+
+ if (HN_isEmptyEnv()) HNL_updateToRef(suspPtr, rtPtr);
+ else rtPtr = HN_pushSuspOverLam(rtPtr);
+ //fully normalize top-level susp
+ HN_setEnv(myol, mynl, myenvlist);
+ /* note that AM_numabs, AM_numargs and AM_argvec have to be
+ re-initialized, because the (w)hnf of the inner suspension
+ is to be traversed again. */
+ HNL_initRegs();
+ rtPtr = HN_lnormDispatch(rtPtr, whnf);
+ }
+ return rtPtr;
+}
+
+/****************************************************************************/
+/* Dispatching on various term categories. */
+/****************************************************************************/
+static DF_TermPtr HN_lnormDispatch(DF_TermPtr tmPtr, Boolean whnf)
+{
+ restart_lnorm:
+ switch (DF_termTag(tmPtr)){
+ case DF_TM_TAG_VAR:
+ {
+ if (!HN_isEmptyEnv()) HN_setEmptyEnv();
+ HNL_setRegsFlex(tmPtr);
+ return tmPtr;
+ }
+ case DF_TM_TAG_CONST:
+ case DF_TM_TAG_INT:
+ case DF_TM_TAG_FLOAT:
+ case DF_TM_TAG_NIL:
+ case DF_TM_TAG_STR:
+ case DF_TM_TAG_STREAM:
+ {
+ if (!HN_isEmptyEnv()) HN_setEmptyEnv();
+ HNL_setRegsRig(tmPtr);
+ return tmPtr;
+ }
+ case DF_TM_TAG_BVAR: { return HN_lnormBV(tmPtr, whnf); }
+ case DF_TM_TAG_CONS: { return HN_lnormCons(tmPtr, whnf); }
+ case DF_TM_TAG_LAM: { return HN_lnormLam(tmPtr, whnf); }
+ case DF_TM_TAG_APP: { return HN_lnormApp(tmPtr, whnf); }
+ case DF_TM_TAG_SUSP: { return HN_lnormSusp(tmPtr, whnf); }
+ case DF_TM_TAG_REF: { tmPtr = DF_termDeref(tmPtr); goto restart_lnorm;}
+ }
+
+ //Impossible to reach this point.
+ return NULL;
+}
+
+/****************************************************************************/
+/* the interface routine for head normalization */
+/****************************************************************************/
+void HN_lnorm(DF_TermPtr tmPtr)
+{
+ HN_setEmptyEnv();
+ HNL_initRegs();
+ tmPtr = HN_lnormDispatch(DF_termDeref(tmPtr), FALSE);
+}
+
+#endif //HNORM_C
+
+
+
+
+
+
+
+
+
+
+
diff --git a/src/runtime/c/teyjus/simulator/hnorm.h b/src/runtime/c/teyjus/simulator/hnorm.h
new file mode 100644
index 000000000..d57a7349f
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/hnorm.h
@@ -0,0 +1,42 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+/****************************************************************************/
+/* */
+/* File hnorm.h. */
+/* This header file identifies routines defined in hnorm.c that are */
+/* exported from there. */
+/****************************************************************************/
+#ifndef HNORM_H
+#define HNORM_H
+
+#include "dataformats.h"
+
+/* head normalization of the term in the argument */
+void HN_hnorm(DF_TermPtr);
+
+/* head normalization of the term in the argument with occurs-check */
+void HN_hnormOcc(DF_TermPtr);
+
+/* full normalization of the term in the argument */
+void HN_lnorm(DF_TermPtr);
+
+
+#endif //HNORM_H
diff --git a/src/runtime/c/teyjus/simulator/hnormlocal.c b/src/runtime/c/teyjus/simulator/hnormlocal.c
new file mode 100644
index 000000000..2f55246bd
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/hnormlocal.c
@@ -0,0 +1,598 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/*****************************************************************************/
+/* */
+/* File hnormlocal.c. */
+/* This file contains the definitions of some auxiliary functionw that are */
+/* used exclusively in the (head) normalization routines. (hnorm.c) */
+/*****************************************************************************/
+
+#ifndef HNORMLOCAL_C
+#define HNORMLOCAL_C
+
+#include
+#include "abstmachine.h"
+#include "dataformats.h"
+#include "trail.h"
+
+
+/**********************************************************************/
+/* Register setting upon hnorm initiation or termination */
+/**********************************************************************/
+
+/* initialize relevant registers */
+void HNL_initRegs()
+{
+ AM_numAbs = AM_numArgs = 0;
+ AM_head = AM_argVec = NULL;
+}
+
+/* when a cons head is found */
+void HNL_setRegsCons(DF_TermPtr consPtr)
+{
+ AM_consFlag = AM_rigFlag = ON;
+ AM_head = consPtr;
+}
+
+/* when a (special) constant head is found */
+void HNL_setRegsRig(DF_TermPtr headPtr)
+{
+ AM_consFlag = OFF;
+ AM_rigFlag = ON;
+ AM_head = headPtr;
+}
+
+/* when a unbound variable head is found */
+void HNL_setRegsFlex(DF_TermPtr headPtr)
+{
+ AM_consFlag = AM_rigFlag = OFF;
+ AM_head = headPtr;
+}
+
+/************************************************************************/
+/* Term creation functions */
+/************************************************************************/
+
+/* Push de Bruijn index #ind on the current heap top */
+void HNL_pushBV(int ind)
+{
+ MemPtr newhtop = AM_hreg + DF_TM_ATOMIC_SIZE; //new heap top
+ AM_heapError(newhtop);
+ DF_mkBV(AM_hreg, ind);
+ AM_hreg = newhtop;
+}
+
+/* Push abstraction lam(n, body) on the current heap top. */
+void HNL_pushLam(DF_TermPtr bodyPtr, int n)
+{
+ MemPtr newhtop = AM_hreg + DF_TM_LAM_SIZE; //new heap top
+ AM_heapError(newhtop);
+ DF_mkLam(AM_hreg, n, bodyPtr);
+ AM_hreg = newhtop;
+}
+
+/* Push cons(argvecPtr) on the current heap top */
+void HNL_pushCons(DF_TermPtr argvecPtr)
+{
+ MemPtr newhtop = AM_hreg + DF_TM_CONS_SIZE; //new heap top
+ AM_heapError(newhtop);
+ DF_mkCons(AM_hreg, argvecPtr);
+ AM_hreg = newhtop;
+}
+
+/* Push an application on the current heap top. */
+void HNL_pushApp(DF_TermPtr funcPtr, DF_TermPtr argvecPtr, int arity)
+{
+ MemPtr newhtop = AM_hreg + DF_TM_APP_SIZE;
+ AM_heapError(newhtop);
+ DF_mkApp(AM_hreg, arity, funcPtr, argvecPtr);
+ AM_hreg = newhtop;
+}
+
+/* Push suspension [|skPtr, ol, nl, e|] on the current heap top. */
+void HNL_pushSusp(DF_TermPtr skPtr, int ol, int nl, DF_EnvPtr e)
+{
+ MemPtr newhtop = AM_hreg + DF_TM_SUSP_SIZE; //new heap top
+ AM_heapError(newhtop);
+ DF_mkSusp(AM_hreg, ol, nl, skPtr, e);
+ AM_hreg = newhtop;
+}
+
+/* Push suspension [|skPtr, ol, nl, e|] on a given location, the pointer to
+ that location is increamented as side-effect */
+void HNL_pushSuspOnLoc(DF_TermPtr skPtr, int ol, int nl, DF_EnvPtr e,
+ MemPtr *locPtr)
+{
+ MemPtr loc = *locPtr, newloc = loc + DF_TM_SUSP_SIZE;
+ AM_heapError(newloc);
+ DF_mkSusp(loc, ol, nl, skPtr, e);
+ *locPtr = newloc;
+}
+
+/* Destructively change the cell referred to by tmPtr to a reference.
+ The change is trailed if necessary. */
+void HNL_updateToRef(DF_TermPtr tmPtr, DF_TermPtr target)
+{
+ TR_trailHTerm(tmPtr);
+ DF_mkRef((MemPtr)tmPtr, target);
+}
+
+/************************************************************************/
+/* Functions for eagerly evaluating implicit renumber suspensions */
+/*----------------------------------------------------------------------*/
+/* General comments: */
+/* Renumbering suspensions [|skPtr, 0, nl, nil|] */
+/* Specifically, if skPtr is a (special) constant, de Bruijn index or a */
+/* unbound variable, the suspension is eagerly evaluated; otherwise */
+/* it is suspended. In case skPtr is another suspension, combination is */
+/* performed. */
+/************************************************************************/
+
+/* Used in HNL_BVSuspAsEnv.
+ The renumber suspension belongs to an environment list.
+ A pointer to the evaluation result is returned. New suspensions are
+ pushed on the current heap top if necessary.
+*/
+static DF_TermPtr HNL_renumberAsEnv(DF_TermPtr skPtr, int nl)
+{
+ DF_TermPtr rtPtr; //term pointer to be returned
+ restart_renumberAsEnv:
+ switch (DF_termTag(skPtr)){
+ case DF_TM_TAG_VAR:
+ case DF_TM_TAG_CONST:
+ case DF_TM_TAG_INT:
+ case DF_TM_TAG_FLOAT:
+ case DF_TM_TAG_NIL:
+ case DF_TM_TAG_STR:
+ case DF_TM_TAG_STREAM:
+ { rtPtr = skPtr; break; }
+ case DF_TM_TAG_LAM:
+ case DF_TM_TAG_CONS:
+ case DF_TM_TAG_APP: //[|skPtr, 0, nl, nil|]
+ {
+ if (nl == 0) rtPtr = skPtr;
+ else {
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushSusp(skPtr, 0, nl, DF_EMPTY_ENV);
+ }
+ break;
+ }
+ case DF_TM_TAG_SUSP: //[|[|t,ol,nl,e|],0,l,nil|] -> [|t,ol,nl+l,e|]
+ {
+ if (nl == 0) rtPtr = skPtr;
+ else {
+ DF_TermPtr myskPtr = DF_termDeref(DF_suspTermSkel(skPtr));
+ int myol = DF_suspOL(skPtr), mynl = DF_suspNL(skPtr);
+ DF_EnvPtr myenv = DF_suspEnv(skPtr);
+ int newnl = mynl+nl;
+
+ AM_embedError(newnl);
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushSusp(skPtr, myol, newnl, myenv);
+ }
+ break;
+ }
+ case DF_TM_TAG_BVAR: //[|#i, 0, nl, nil |] -> #(i+nl)
+ {
+ int newind = DF_bvIndex(skPtr)+nl;
+
+ AM_embedError(newind);
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushBV(newind);
+ break;
+ }
+ case DF_TM_TAG_REF:{skPtr=DF_termDeref(skPtr); goto restart_renumberAsEnv; }
+ }//switch
+ return rtPtr;
+}
+
+/* Used in HNL_BVSuspAsArg.
+ The renumber suspension belongs to the arguments of an application or
+ cons.
+ In case the evaluation result has an atomic size and is not a unbound
+ variable, it is committed on the heap location referred to by loc.
+ If the evaluation result is a free variable or a constant with type
+ associations, a reference to the result is created on the heap location
+ referred to by loc.
+ Otherwise, the evaluation result must be a suspension, and in this case,
+ the new suspension is created on the location referred to by (*spLocPtr),
+ (*spLocPtr) is increamented by a suspension size, and a reference to the
+ new suspension is created on the location pointed by loc. */
+static void HNL_renumberAsArg(DF_TermPtr skPtr, int nl, MemPtr loc,
+ MemPtr *spLocPtr)
+{
+ restart_renumberAsArg:
+ switch (DF_termTag(skPtr)){
+ case DF_TM_TAG_VAR: { DF_mkRef(loc, skPtr); break; }
+ case DF_TM_TAG_CONST:
+ {
+ if (DF_isTConst(skPtr)) DF_mkRef(loc, skPtr);
+ else DF_copyAtomic(skPtr, loc);
+ break;
+ }
+ case DF_TM_TAG_INT:
+ case DF_TM_TAG_FLOAT:
+ case DF_TM_TAG_NIL:
+ case DF_TM_TAG_STR:
+ case DF_TM_TAG_STREAM:
+ { DF_copyAtomic(skPtr, loc); break;}
+ case DF_TM_TAG_LAM:
+ case DF_TM_TAG_CONS:
+ case DF_TM_TAG_APP: //[|t, 0, nl, nil|]
+ {
+ if (nl == 0) DF_mkRef(loc, skPtr);
+ else {
+ DF_mkRef(loc, (DF_TermPtr)(*spLocPtr));
+ HNL_pushSuspOnLoc(skPtr, 0, nl, DF_EMPTY_ENV, spLocPtr);
+ }
+ break;
+ }
+ case DF_TM_TAG_SUSP: //[|[|t,ol,nl,e|],0,l,nil|] -> [|t,ol,nl+l,e|]
+ {
+ if (nl == 0) DF_mkRef(loc, skPtr);
+ else {
+ DF_TermPtr myskPtr = DF_termDeref(DF_suspTermSkel(skPtr));
+ int myol = DF_suspOL(skPtr), mynl = DF_suspNL(skPtr);
+ DF_EnvPtr myenv = DF_suspEnv(skPtr);
+ int newnl = mynl+nl;
+
+ AM_embedError(newnl);
+ DF_mkRef(loc, (DF_TermPtr)(*spLocPtr));
+ HNL_pushSuspOnLoc(myskPtr, myol, newnl, myenv, spLocPtr);
+ }
+ break;
+ }
+ case DF_TM_TAG_BVAR: //[|#i, 0, adj, nil |] -> #(i+adj)
+ {
+ int newind = DF_bvIndex(skPtr)+nl;
+ AM_embedError(newind);
+ DF_mkBV(loc, newind);
+ break;
+ }
+ case DF_TM_TAG_REF:{skPtr=DF_termDeref(skPtr); goto restart_renumberAsArg;}
+ }
+}
+
+
+/************************************************************************/
+/* Functions for eagerly evaluating implicit suspensions with */
+/* de Bruijn indices as term skeleton. */
+/*----------------------------------------------------------------------*/
+/* General comments: */
+/* suspension [|#ind, ol, nl, env|] */
+/* The suspension is eagerly evaluated till a non-suspension term or a */
+/* un-trivial suspension is resulted. */
+/************************************************************************/
+
+/* Used in HNL_suspAsEnv.
+ The suspension belongs to an environment list.
+ A pointer to the evaluation result is returned. If new suspensions
+ need to be created, they are pushed on the current heap top. */
+static DF_TermPtr HNL_BVSuspAsEnv(int ind, int ol, int nl, DF_EnvPtr env)
+{
+ DF_TermPtr rtPtr; //term pointer to be returned
+ if (ind > ol){ //[|#i, ol, nl, env|] -> #(i-ol+nl), where i>ol
+ int newind = ind - ol + nl;
+
+ AM_embedError(newind);
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushBV(newind);
+ } else {// ind <= ol
+ DF_EnvPtr envitem = DF_envListNth(env, ind); //ith in env
+ int nladj = nl - DF_envIndex(envitem);
+
+ if (DF_isDummyEnv(envitem)){//[|#i,ol,nl,..@l..|]->#(nl-l), where i<=ol
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushBV(nladj);
+ } else { //DF_isPairEnv(envitem)
+ DF_TermPtr tmPtr = DF_envPairTerm(envitem);
+
+ rtPtr = HNL_renumberAsEnv(tmPtr, nladj);
+ }
+ } // ind <= ol
+ return rtPtr;
+}
+
+/* Used in HNL_suspAsArg.
+ The suspension belongs to the arguments of an application or cons.
+ The pointer loc refers to the heap location where the evaluation result
+ or a reference of the evaluation result is to be created, and if new
+ suspensions need to be created, they are created on the heap location
+ referred to by *spLocPtr.
+*/
+static void HNL_BVSuspAsArg(DF_TermPtr bv, int ol, int nl, DF_EnvPtr env,
+ MemPtr loc, MemPtr *spLocPtr)
+{
+ int ind = DF_bvIndex(bv); //index of the bv
+ if (ind > ol){ //[|#i, ol, nl, env|] -> #(i-ol+nl), where i>ol
+ int newind = ind - ol + nl;
+
+ AM_embedError(newind);
+ DF_mkBV(loc, newind);
+ } else {//ind <= ol
+ DF_EnvPtr envitem = DF_envListNth(env, ind); //ith item in env
+ int nladj = nl - DF_envIndex(envitem);
+
+ if (DF_isDummyEnv(envitem)){//[|#i,ol,nl,..@l..|]->#(nl-l), where i<=ol
+ DF_mkBV(loc, nladj);
+ } else { //DF_IsPairEnv(envitem)
+ DF_TermPtr tmPtr = DF_envPairTerm(envitem);
+ HNL_renumberAsArg(tmPtr, nladj, loc, spLocPtr);
+ } //ind <= ol
+ }
+}
+
+/************************************************************************/
+/* Functions for eagerly evaluating implicit suspensions */
+/*----------------------------------------------------------------------*/
+/* General comments: */
+/* suspension [|skPtr ol, nl, env|] */
+/* The suspension is eagerly evaluated till a non-suspension term or a */
+/* un-trivial suspension is resulted. */
+/************************************************************************/
+
+/* The suspension belongs to an environment list.
+ A pointer to the evaluation result is returned. New suspensions are
+ pushed on the current heap top if necessary. */
+DF_TermPtr HNL_suspAsEnv(DF_TermPtr skPtr, int ol, int nl, DF_EnvPtr env)
+{
+ DF_TermPtr rtPtr; // term pointer to be returned
+ restart_suspAsEnv:
+ switch(DF_termTag(skPtr)){ //[|c, ol, nl, envlist|] -> c
+ case DF_TM_TAG_VAR:
+ case DF_TM_TAG_CONST:
+ case DF_TM_TAG_INT:
+ case DF_TM_TAG_FLOAT:
+ case DF_TM_TAG_NIL:
+ case DF_TM_TAG_STR:
+ case DF_TM_TAG_STREAM:
+ { rtPtr = skPtr; break; }
+ case DF_TM_TAG_LAM:
+ case DF_TM_TAG_CONS:
+ case DF_TM_TAG_SUSP:
+ case DF_TM_TAG_APP:
+ {
+ rtPtr = (DF_TermPtr)AM_hreg;
+ HNL_pushSusp(skPtr, ol, nl, env);
+ break;
+ }
+ case DF_TM_TAG_BVAR:
+ {
+ int dbind = DF_bvIndex(skPtr);
+ rtPtr = HNL_BVSuspAsEnv(dbind, ol, nl, env);
+ break;
+ }
+ case DF_TM_TAG_REF: { skPtr = DF_termDeref(skPtr); goto restart_suspAsEnv; }
+ }
+ return rtPtr;
+}
+
+/* Used in HNL_pushSuspOverArgs.
+ The suspension belongs to the arguments of an application or cons.
+ The pointer loc refers to the heap location where the evaluation result
+ or a reference of the evaluation result is to be created, and if new
+ suspensions need to be created, they are created on the heap location
+ referred to by *spLocPtr.
+ A flag CHANGED is used to indicate whether the evaluation result is different
+ from skPtr.
+*/
+static void HNL_suspAsArg(DF_TermPtr skPtr, int ol, int nl, DF_EnvPtr env,
+ MemPtr loc, MemPtr *spLocPtr, Boolean *changed)
+{
+ restart_suspAsArg:
+ switch(DF_termTag(skPtr)){
+ case DF_TM_TAG_VAR: { DF_mkRef(loc, skPtr); break; }
+ case DF_TM_TAG_CONST:
+ {
+ if (DF_isTConst(skPtr)) DF_mkRef(loc, skPtr);
+ else DF_copyAtomic(skPtr, loc);
+ break;
+ }
+ case DF_TM_TAG_INT:
+ case DF_TM_TAG_FLOAT:
+ case DF_TM_TAG_NIL:
+ case DF_TM_TAG_STR:
+ case DF_TM_TAG_STREAM:
+ {
+ DF_copyAtomic(skPtr, loc);
+ break;
+ }
+ case DF_TM_TAG_LAM:
+ case DF_TM_TAG_CONS:
+ case DF_TM_TAG_SUSP:
+ case DF_TM_TAG_APP:
+ {
+ DF_mkRef(loc, (DF_TermPtr)(*spLocPtr));
+ HNL_pushSuspOnLoc(skPtr, ol, nl, env, spLocPtr);
+ *changed = TRUE;
+ break;
+ }
+ case DF_TM_TAG_BVAR:
+ {
+
+ HNL_BVSuspAsArg(skPtr, ol, nl, env, loc, spLocPtr);
+ *changed = TRUE;
+ break;
+ }
+ case DF_TM_TAG_REF: { skPtr = DF_termDeref(skPtr); goto restart_suspAsArg; }
+ }
+}
+
+/************************************************************************/
+/* Functions for creating application argument vectors */
+/*----------------------------------------------------------------------*/
+/* Gerenal comments: */
+/* Two issues are considered here. */
+/* 1. When the application (cons) is embedded inside a non-empty */
+/* suspension, the suspension has to be propagated over their */
+/* arguments. In this process, trivial suspensions (those over atomic*/
+/* terms including de Bruijn indices) are eagerly evaluated. */
+/* 2. When the application has a function being another application */
+/* (indicated by AM_numArgs), the nested structures should be */
+/* un-folded. In particular, an argument vector with that of the */
+/* "top-level" application (possibly changed from propagating */
+/* suspensions), and that of the "inner" application has to be */
+/* created on the current top of heap. */
+/* Such functionality is realized by the following procedures. */
+/************************************************************************/
+
+/* Copy an argument vector start from argvec onto the current top of
+ heap. Needed in unfolding nested applications.
+ Note that a reference has to be made for unbound variables as opposed
+ to duplication.
+*/
+void HNL_copyArgs(DF_TermPtr argvec, int arity)
+{
+ int i;
+ for (i = 1; i <= arity; i++){
+ if (DF_isFV(argvec)) DF_mkRef(AM_hreg, argvec);
+ else DF_copyAtomic(argvec, AM_hreg);
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ argvec = (DF_TermPtr)(((MemPtr)argvec)+DF_TM_ATOMIC_SIZE);
+ }
+}
+
+
+/* Create an argument vector for applications inside an empty environment.
+ If no other application is nested in this one, the old argument vector is
+ used. Specifically, AM_argVec is set to refer the starting address of
+ the old argument vector, AM_numArgs is set to its arity, and FALSE is
+ returned to indicate no changes occur in the vector.
+ Otherwise, a new vector copied from that referred to by argvec and
+ the other referred to by AM_argVec is created on the current top of heap.
+ AM_argVec and AM_numArgs are updated correspondingly, and TRUE is
+ returned to indicate a new vector should be used for the application.
+*/
+
+Boolean HNL_makeArgvecEmpEnv(DF_TermPtr argvec, int arity)
+{
+ if (AM_numArgs == 0) { //no nested app
+ AM_argVec = argvec; //reuse the old argvec
+ AM_numArgs = arity;
+ return FALSE;
+ } else { //unfold nested app
+ DF_TermPtr newArgvec = (DF_TermPtr)AM_hreg;
+ int newArity = arity + AM_numArgs;
+ MemPtr newhtop = AM_hreg + arity * DF_TM_ATOMIC_SIZE;
+
+ AM_arityError(newArity);
+ AM_heapError(newhtop);
+ HNL_copyArgs(AM_argVec, AM_numArgs); //lay out inner argvec
+ HNL_copyArgs(argvec, arity); //lay out top-level argvec
+
+ AM_argVec = newArgvec;
+ AM_numArgs = newArity;
+ return TRUE;
+ }
+}
+
+/* Propagate a suspension environment given by (ol, nl, env) over the
+ argument vector referred to by argvec. Trivial suspensions are eagerly
+ evaluated in this process. Non-trivial ones are created on the location
+ referred to by *spLocPtr.
+ Further, a flag changed is used to indicate whether the propagating
+ result is the same as the original argument vector.
+*/
+static void HNL_pushSuspOverArgs(DF_TermPtr argvec, int arity, int ol, int nl,
+ DF_EnvPtr env, MemPtr *spLocPtr,
+ Boolean *changed)
+{
+ int i;
+ MemPtr myArgvec = AM_hreg;//AM_hreg has not been moved yet
+
+ for (i = 1; i <= arity; i++){
+ HNL_suspAsArg(argvec, ol, nl, env, myArgvec, spLocPtr, changed);
+ myArgvec = myArgvec + DF_TM_ATOMIC_SIZE;
+ argvec = (DF_TermPtr)(((MemPtr)argvec)+DF_TM_ATOMIC_SIZE);
+ }
+}
+
+/* Create an argument vector for applications inside a non-empty environment.
+ Actions are carried out in two steps:
+ First, nested applications are unfolded if arising. Second, the
+ non-empty environment is propagated over the argument vector of the (top)
+ application.
+ It is assumed that the vector will be changed in the beginning of both
+ processes, and a flag changed is used to indicate whether changes really
+ occur. The new argument vector is used and the top of heap is updated only
+ when the changed flag is TRUE upon termination. Otherwise, the old argument
+ is used. The flag changed is also returned to the caller to indicate which
+ vector is used.
+*/
+Boolean HNL_makeArgvec(DF_TermPtr argvec, int arity, int ol, int nl,
+ DF_EnvPtr env)
+{
+ Boolean changed; //flag denoting if new argvec is made or the old is reused
+ MemPtr spLocPtr; //place where susps are to be created
+ MemPtr newArgvec = AM_hreg;
+
+
+ //unfold nested app first when necessary
+ if (AM_numArgs == 0){ //no nested app
+ //assume new arg vector has to be created because of susp propagating
+ spLocPtr = newArgvec + arity * DF_TM_ATOMIC_SIZE;
+ AM_heapError(spLocPtr);
+ AM_numArgs = arity;
+ changed = FALSE; //indicating no change is made for unfolding app
+ } else { //unfold nested app
+ int newArity = arity + AM_numArgs;
+
+ AM_arityError(newArity);
+ //assume new arg vector has to be created because of susp propagating
+ spLocPtr = newArgvec + newArity * DF_TM_ATOMIC_SIZE;
+ AM_heapError(spLocPtr);
+ HNL_copyArgs(AM_argVec, AM_numArgs); //lay out inner argvec
+ AM_numArgs = newArity;
+ changed = TRUE; //indicating changes are made for unfolding app
+ }
+
+ //push susp over the argument vector of the top-level app
+ HNL_pushSuspOverArgs(argvec, arity, ol, nl, env, &spLocPtr, &changed);
+
+ if (changed) { //changes because of unfold app or propagate susp
+ AM_hreg = spLocPtr;
+ AM_argVec = (DF_TermPtr)newArgvec;
+ } else AM_argVec = argvec; //no change, reuse the old arg vector
+ return changed;
+}
+
+/* A specialized version of HNL_makeArgvec for argument vectors on cons.
+ The arity of cons is fixed, and there is no need to considering "unfolding".
+*/
+Boolean HNL_makeConsArgvec(DF_TermPtr argvec, int ol, int nl, DF_EnvPtr env)
+{
+ MemPtr spLocPtr;
+ MemPtr newArgvec = AM_hreg;
+ Boolean changed = FALSE;
+
+ spLocPtr = newArgvec + DF_CONS_ARITY * DF_TM_ATOMIC_SIZE;
+ AM_heapError(spLocPtr);
+ HNL_pushSuspOverArgs(argvec,DF_CONS_ARITY,ol,nl,env,&spLocPtr,&changed);
+
+ AM_numArgs = DF_CONS_ARITY;
+ if (changed){
+ AM_hreg = spLocPtr;
+ AM_argVec = (DF_TermPtr)newArgvec;
+ } else AM_argVec = argvec;
+
+ return changed;
+}
+
+#endif //HNORMLOCAL_C
diff --git a/src/runtime/c/teyjus/simulator/hnormlocal.h b/src/runtime/c/teyjus/simulator/hnormlocal.h
new file mode 100644
index 000000000..0a123c581
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/hnormlocal.h
@@ -0,0 +1,75 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/*****************************************************************************/
+/* */
+/* File hnormlocal.h. */
+/* This header file identifies functions that are used exclusively in the */
+/* (head) normalization routines. Thus, this file is imported only by */
+/* hnorm.c. */
+/*****************************************************************************/
+
+#ifndef HNORMLOCAL_H
+#define HNORMLOCAL_H
+
+#include "dataformats.h"
+
+/**********************************************************************/
+/* Register setting upon hnorm initiation or termination */
+/**********************************************************************/
+void HNL_initRegs(); // initialize relevant registers
+void HNL_setRegsCons(DF_TermPtr); // when a cons head is found
+void HNL_setRegsRig(DF_TermPtr); // when a (special) constant head is found
+void HNL_setRegsFlex(DF_TermPtr); // when a unbound variable head is found
+
+/************************************************************************/
+/* Term creation and destructive modification functions */
+/************************************************************************/
+/* Push de Bruijn index #ind on the current heap top. */
+void HNL_pushBV(int ind);
+/* Push abstraction lam(n, body) on the current heap top. */
+void HNL_pushLam(DF_TermPtr body, int n);
+/* Push cons on the current heap top. */
+void HNL_pushCons(DF_TermPtr argvecPtr);
+/* Push an application on the current heap top. */
+void HNL_pushApp(DF_TermPtr funcPtr, DF_TermPtr argvecPtr, int arity);
+/* Destructively change the cell referred to by tmPtr to a reference
+ The change is trailed if necessary. */
+void HNL_updateToRef(DF_TermPtr tmPtr, DF_TermPtr target);
+
+/************************************************************************/
+/* Functions for eagerly evaluating implicit suspensions */
+/************************************************************************/
+/* The suspension belongs to an environment list. */
+DF_TermPtr HNL_suspAsEnv(DF_TermPtr skPtr, int ol, int nl, DF_EnvPtr env);
+
+/************************************************************************/
+/* Functions for creating application argument vectors */
+/************************************************************************/
+/* Copy an argument vector start from argvec onto the current top of heap. */
+void HNL_copyArgs(DF_TermPtr argvec, int arity);
+/* Create an argument vector for applications inside an empty environment. */
+Boolean HNL_makeArgvecEmpEnv(DF_TermPtr argvec, int arity);
+/* Create an argument vector for applications inside a non-empty environment. */
+Boolean HNL_makeArgvec(DF_TermPtr argvec, int arity, int ol, int nl,
+ DF_EnvPtr env);
+/* A specialized version of HNL_makeArgvec for argument vectors on cons. */
+Boolean HNL_makeConsArgvec(DF_TermPtr argvec, int ol, int nl, DF_EnvPtr env);
+
+#endif //HNORMLOCAL_H
diff --git a/src/runtime/c/teyjus/simulator/hopu.c b/src/runtime/c/teyjus/simulator/hopu.c
new file mode 100644
index 000000000..505eed6df
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/hopu.c
@@ -0,0 +1,1693 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************/
+/* */
+/* File hopu.c. This file contains the main routines implementing the */
+/* interpretive part of higher-order pattern unification. */
+/* */
+/****************************************************************************/
+#ifndef HOPU_C
+#define HOPU_C
+
+#include "hopu.h"
+#include "mctypes.h"
+#include "dataformats.h"
+#include "hnorm.h"
+#include "abstmachine.h"
+#include "types.h"
+#include "trail.h"
+#include "../system/error.h"
+#include "../system/memory.h"
+
+#include
+
+/* Unify types associated with constants. */
+static void HOPU_typesUnify(DF_TypePtr tyEnv1, DF_TypePtr tyEnv2, int n)
+{
+ AM_pdlError(2*n);
+ AM_initTypesPDL();
+ TY_pushPairsToPDL((MemPtr)tyEnv1, (MemPtr)tyEnv2, n);
+ TY_typesUnify();
+}
+
+/* Return the dereference of the abstraction body of the given term. */
+DF_TermPtr HOPU_lamBody(DF_TermPtr tmPtr)
+{
+ tmPtr = DF_termDeref(tmPtr);
+ while (DF_isLam(tmPtr)) tmPtr = DF_termDeref(DF_lamBody(tmPtr));
+ return tmPtr;
+}
+
+/***************************************************************************/
+/* Globalize functions needed for HOPU_patternUnidyPair */
+/***************************************************************************/
+
+/* Globalize a rigid term. */
+/* If the term pointer is not one referring to a heap address, the atomic */
+/* content is then copied onto the current top of heap; the term pointer */
+/* is updated to the new heap term. */
+static DF_TermPtr HOPU_globalizeRigid(DF_TermPtr rPtr)
+{
+ if (AM_nHeapAddr((MemPtr)rPtr)) {//rPtr must refer to const (no type), int,
+ //float, str, (stream), nil, cons
+ MemPtr nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_copyAtomic(rPtr, AM_hreg);
+ rPtr = (DF_TermPtr)AM_hreg;
+ AM_hreg = nhreg;
+ }
+ return rPtr;
+}
+
+/* Globalize a rigid term and make a variable binding. */
+/* If the term pointer to the rigid term is not one referring to a heap */
+/* address, its atomic content is then copied into the variable to be bound*/
+/* Otherwise, the variable is made a reference to the rigid term. */
+void HOPU_globalizeCopyRigid(DF_TermPtr rPtr, DF_TermPtr vPtr)
+{
+ if (AM_nHeapAddr((MemPtr)rPtr)) //rPtr must refer to rigid atomic term
+ DF_copyAtomic(rPtr, (MemPtr)vPtr);
+ else DF_mkRef((MemPtr)vPtr, rPtr); //rPtr could also be app
+}
+
+/* Globalize a flex term. */
+/* If the term pointer is one referring to a stack address, (in which case */
+/* the flex term must be a free variable itself), the atomic content is */
+/* copied onto the current top of heap; the free variable on stack is then */
+/* bound to the new heap term, and the binding is trailed if necessary; the */
+/* term pointer is updated to the new heap term. */
+DF_TermPtr HOPU_globalizeFlex(DF_TermPtr fPtr)
+{
+ if (AM_stackAddr((MemPtr)fPtr)) {//fPtr must be a reference to var
+ MemPtr nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_copyAtomic(fPtr, AM_hreg);
+ TR_trailETerm(fPtr);
+ DF_mkRef((MemPtr)fPtr, (DF_TermPtr)AM_hreg);
+ fPtr = (DF_TermPtr)AM_hreg;
+ AM_hreg = nhreg;
+ }
+ return fPtr;
+}
+
+/***************************************************************************/
+/* Explicit eta expansion (on a rigid term) */
+/***************************************************************************/
+
+/* Eta expands a rigid term whose term pointer and decomposition are given */
+/* by arguments. The new lambda body is returned. (It is unnecessary to */
+/* create a new lambda term for the abstractions in the front of the eta */
+/* expanded form. Note that the term head and argument vector are updated */
+/* as side-effect. */
+/* Note globalization on the term head is always performed and no */
+/* specialized version of this function is provided based on the assumption*/
+/* that explicit eta-expansion is rarely needed. */
+static DF_TermPtr HOPU_etaExpand(DF_TermPtr *h, DF_TermPtr *args, int nargs,
+ int nabs)
+{
+ DF_TermPtr hPtr = *h, oldArgs = *args, rtPtr;
+ MemPtr suspLoc; //where susps are to be created
+ int newArity = nargs + nabs;
+ if (DF_isBV(hPtr)){ //lift index by nabs if the head is a bound variable
+ int ind = DF_bvIndex(hPtr) + nabs;
+ AM_embedError(ind);
+ AM_heapError(AM_hreg + DF_TM_ATOMIC_SIZE);
+ *h = hPtr =(DF_TermPtr)AM_hreg; //update head pointer
+ DF_mkBV(AM_hreg,ind);
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ } else
+ //always perform globalization; eta expansion is rarely needed
+ *h = hPtr = HOPU_globalizeRigid(hPtr);
+
+ AM_arityError(newArity);
+ AM_heapError(AM_hreg + nargs * DF_TM_SUSP_SIZE + newArity*DF_TM_ATOMIC_SIZE
+ + DF_TM_APP_SIZE);
+ suspLoc = AM_hreg;
+ AM_hreg += nargs * DF_TM_SUSP_SIZE; //allocate space for nargs suspensions
+ rtPtr = (DF_TermPtr)AM_hreg; //new application
+ DF_mkApp(AM_hreg, newArity, hPtr, (DF_TermPtr)(AM_hreg + DF_TM_APP_SIZE));
+ AM_hreg += DF_TM_APP_SIZE;
+ *args = (DF_TermPtr)AM_hreg; //update arg vector pointer
+ for (; nargs > 0; nargs--){//create suspensions over original arguments
+ DF_mkSusp(suspLoc, 0, nabs, DF_termDeref(oldArgs), DF_EMPTY_ENV);
+ DF_mkRef(AM_hreg, (DF_TermPtr)suspLoc);
+ suspLoc += DF_TM_SUSP_SIZE; AM_hreg += DF_TM_ATOMIC_SIZE;
+ oldArgs = (DF_TermPtr)(((MemPtr)oldArgs) + DF_TM_ATOMIC_SIZE);
+ }
+ for (; nabs > 0; nabs--){//create de Bruijn indices from #nabs to #1
+ DF_mkBV(AM_hreg, nabs);
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ }
+ return rtPtr;
+}
+
+/***************************************************************************/
+/* PATTERN RECOGNITION */
+/* */
+/* Auxiliary functions for recognizing LLambda pattens for flexible terms. */
+/***************************************************************************/
+/* Whether a bound variable occurs in the given arguments. */
+/* It is assumned that the given arguments can only contain bound variables*/
+/* and constants. */
+static Boolean HOPU_uniqueBV(int bvInd, DF_TermPtr args, int n)
+{
+ DF_TermPtr tPtr;
+ for ( ; n > 0 ; n-- ){
+ tPtr = DF_termDeref(args);
+ if (DF_isBV(tPtr) && (bvInd == DF_bvIndex(tPtr))) return FALSE;
+ //otherwise different bv or constant, check the next
+ args = (DF_TermPtr)(((MemPtr)args) + DF_TM_ATOMIC_SIZE);
+ }
+ return TRUE;
+}
+
+/* Whether a constant occurs in the given arguments. */
+/* It is assumned that the given arguments can only contain bound variables*/
+/* and constants. */
+/* CHANGES have to be made here if the semantics of local constants are */
+/* changed with respect to polymorphism. */
+static Boolean HOPU_uniqueConst(DF_TermPtr cPtr, DF_TermPtr args, int n)
+{
+ DF_TermPtr tPtr;
+ for ( ; n > 0 ; n--){
+ tPtr = DF_termDeref(args);
+ if (DF_isConst(tPtr) && DF_sameConsts(tPtr, cPtr)) {
+ if (DF_isTConst(tPtr)) {
+ EM_TRY {
+ HOPU_typesUnify(DF_constType(tPtr), DF_constType(cPtr),
+ AM_cstTyEnvSize(DF_constTabIndex(cPtr)));
+ } EM_CATCH {
+ if (EM_CurrentExnType == EM_FAIL) {
+ AM_resetTypesPDL();//remove tys from pdl for ty unif
+ return FALSE;
+ } else EM_RETHROW();
+ }
+ } else return FALSE;
+ } //otherwise different constant or bv, check the next
+ args = (DF_TermPtr)(((MemPtr)args) + DF_TM_ATOMIC_SIZE);
+ } //for loop
+ return TRUE;
+}
+
+/* Checking whether the argments of the head normal form given by registers*/
+/* AM_argVec, AM_numArgs and AM_numAbs are those of an eta-expanded form. */
+/* Specifically, the arguments are attempted to match de Bruijn indices */
+/* #n ... #1, where n is the current value of AM_numAbs. */
+/* It is assumed that the argument vector is not empty. */
+static Boolean HOPU_isEtaExpArgs()
+{
+ if (AM_numArgs != AM_numAbs) return FALSE;
+ else {
+ int i = AM_numAbs;
+ Boolean match = TRUE;
+ DF_TermPtr oneArg = AM_argVec;
+ DF_TermPtr head = AM_head;
+ while (match && (i > 0)){
+ HN_hnorm(oneArg);
+ if (AM_numArgs == 0)
+ match = ((AM_numArgs == 0) && DF_isBV(AM_head) &&
+ (DF_bvIndex(AM_head) == i));
+ else
+ match = (DF_isBV(AM_head) && (DF_bvIndex(AM_head)-AM_numAbs==i)
+ && HOPU_isEtaExpArgs());
+ oneArg = (DF_TermPtr)(((MemPtr)oneArg + DF_TM_ATOMIC_SIZE));
+ i--;
+ }
+ AM_head = head;
+ return match;
+ }
+}
+
+/* Checking whether the arguments of a flexible term satisfy with the */
+/* LLambda pattern with respect to the universe count of its flex head. */
+/* CHANGES have to be made here if the semantics of local constants are */
+/* changed with respect to polymorphism. */
+static Boolean HOPU_isLLambda(int uc, int nargs, DF_TermPtr args)
+{
+ if (nargs == 0) return TRUE;
+ else {
+ int i;
+ DF_TermPtr myArgs = args;
+ for (i = 0; i < nargs; i++){
+ HN_hnorm(args);
+ if (AM_numArgs == 0) {
+ if (AM_numAbs != 0) return FALSE; //abstraction
+ if (DF_isBV(AM_head)) { //bound variable
+ if (!HOPU_uniqueBV(DF_bvIndex(AM_head), myArgs, i))
+ return FALSE;
+ } else if (DF_isConst(AM_head)) { //constant
+ if (!(uc < DF_constUnivCount(AM_head) &&
+ HOPU_uniqueConst(AM_head, myArgs, i))) return FALSE;
+ } else return FALSE; //other sort of terms
+ } else { //AM_numArgs != 0
+ if (DF_isBV(AM_head)) { //bound variable head
+ int dbInd = DF_bvIndex(AM_head) - AM_numAbs; //eta-norm
+ if (dbInd > 0 && HOPU_uniqueBV(dbInd, myArgs, i) &&
+ HOPU_isEtaExpArgs()) {
+ TR_trailHTerm(args);
+ DF_mkBV((MemPtr)args, dbInd);
+ } else return FALSE;
+ } else { //!(DF_isBV(AM_head))
+ if (DF_isConst(AM_head)) { //constant head
+ if (uc < DF_constUnivCount(AM_head) &&
+ HOPU_uniqueConst(AM_head, myArgs, i) &&
+ HOPU_isEtaExpArgs()) {
+ TR_trailHTerm(args);
+ if (DF_isTConst(AM_head))
+ DF_mkRef((MemPtr)args, AM_head);
+ else DF_copyAtomic(AM_head, (MemPtr)args);
+ } else return FALSE;
+ } else return FALSE; //other sort of terms
+ } //!(DF_isBV(AM_head))
+ } //AM_numArgs != 0
+ args = (DF_TermPtr)(((MemPtr)args) + DF_TM_ATOMIC_SIZE);
+ } //for loop
+ return TRUE;
+ } //nargs != 0
+}
+
+/***************************************************************************/
+/* BINDING */
+/* */
+/* Attempt to find bindings for free variables (counter part of mksubst in */
+/* the sml pattern unfication code). */
+/***************************************************************************/
+/* A flag denoting whether new structure is created during the process of */
+/* finding substitutions. */
+Boolean HOPU_copyFlagGlb = FALSE;
+
+/* Return a non-zero index of a bound variable appears in a list of */
+/* arguments. Note the index is the position from the right and the */
+/* embedding level is taken into account. */
+static int HOPU_bvIndex(int dbInd, DF_TermPtr args, int nargs, int lev)
+{
+ int ind;
+ dbInd -= lev;
+ for (ind = nargs; ind > 0; ind--){
+ DF_TermPtr tPtr = DF_termDeref(args);
+ if (DF_isBV(tPtr) && (dbInd == DF_bvIndex(tPtr))) return (ind+lev);
+ //otherwise try the next
+ args = (DF_TermPtr)(((MemPtr)args) + DF_TM_ATOMIC_SIZE);
+ }
+ return 0; //not found
+}
+
+/* Return a non-zero index if a constant appears in a list of arguments. */
+/* Note the index is the position from the right and the embedding level */
+/* is taken into account. */
+/* CHANGES have to be made here if the semantics of local constants are */
+/* changed with respect to polymorphism. */
+static int HOPU_constIndex(DF_TermPtr cPtr, DF_TermPtr args, int nargs, int lev)
+{
+ int ind;
+ for (ind = nargs; ind > 0; ind--){
+ DF_TermPtr tPtr = DF_termDeref(args);
+ if (DF_isConst(tPtr) && DF_sameConsts(tPtr, cPtr)) {
+ if (DF_isTConst(tPtr)) {
+ Boolean found = FALSE;
+ EM_TRY {
+ HOPU_typesUnify(DF_constType(tPtr), DF_constType(cPtr),
+ AM_cstTyEnvSize(DF_constTabIndex(cPtr)));
+ found = TRUE;
+ } EM_CATCH {//remove types added for ty unif from the PDL
+ if (EM_CurrentExnType == EM_FAIL) AM_resetTypesPDL();
+ else EM_RETHROW();
+ }
+ if (found) return (ind+lev);
+ } else return (ind+lev); //cPtr does not have type associated
+ } //otherwise try the next
+ args = (DF_TermPtr)(((MemPtr)args) + DF_TM_ATOMIC_SIZE);
+ }
+ return 0; //not found
+}
+
+/***************************************************************************/
+/* BINDING FOR FLEX-FLEX */
+/* */
+/* Auxiliary functions for solving flex-flex pairs. */
+/* Non-LLambda pairs are delayed onto the disagreement list. */
+/***************************************************************************/
+
+/* Collect raising components for internal variable in the LLambda case */
+/* when it is known it has a higher universe index than the outside llambda*/
+/* variable. */
+/* It is assumned that the incoming argument vector has a size larger than */
+/* zero. */
+/* As a result of this process, segments of the argument vectors for both */
+/* variables are decided. That for the internal variable is created on the */
+/* current top of heap, while that for the outside variable, each */
+/* argument of which must be a de Bruijn index, is recorded into an integer*/
+/* array which is set by side-effect. */
+/* The number returned by this procedure is the length of both of the */
+/* argument vector segements. Raising occured when this number is non-zero.*/
+/* CHANGES have to be made here if the semantics of local constants are */
+/* changed with respect to polymorphism. */
+static int HOPU_raise(int varuc, DF_TermPtr args, int nargs, int emblev,
+ int *args11)
+{
+ int numRaised = 0; //number of args that have been raised
+ AM_heapError(AM_hreg + nargs * DF_TM_ATOMIC_SIZE);//max possible size
+ for (; nargs > 0; nargs--){
+ DF_TermPtr tmPtr = DF_termDeref(args);
+ if (DF_isConst(tmPtr) && (DF_constUnivCount(tmPtr) <= varuc)){
+ args11[numRaised] = nargs + emblev; //args11
+ if (DF_isTConst(tmPtr)) DF_mkRef(AM_hreg, tmPtr); //args21
+ else DF_copyAtomic(tmPtr, AM_hreg);
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ numRaised++;
+ }
+ args = (DF_TermPtr)(((MemPtr)args) + DF_TM_ATOMIC_SIZE);
+ }
+ return numRaised;
+}
+
+
+/* Generate the indices for items not to be pruned when the internal */
+/* variable is known to have a universe index greater than that of the */
+/* external one. */
+/* It is assumned that arg vector of the internal flex term has a size */
+/* larger than zero. */
+/* As a result of this process, segments of the argument vectors for both */
+/* variables are decided. That for the internal variable is created on the */
+/* current top of heap, while that for the outside variable, each */
+/* argument of which must be a de Bruijn index, is recorded into an integer*/
+/* array which is set by side-effect. */
+/* The number returned by this procedure is the length of both of the */
+/* argument vector segements. Pruning occured when this number is smaller */
+/* than the size of the arg vector of the internal term. */
+static int HOPU_prune(DF_TermPtr args1, int nargs1, DF_TermPtr args2,
+ int nargs2, int emblev, int *args12)
+{
+
+ int numNotPruned = 0;
+ AM_heapError(AM_hreg + nargs2 * DF_TM_ATOMIC_SIZE);//max possible size
+ for (; nargs2 > 0; nargs2--){
+ DF_TermPtr tmPtr = DF_termDeref(args2);
+ if (DF_isConst(tmPtr)) {
+ int ind = HOPU_constIndex(tmPtr, args1, nargs1, emblev);
+ if (ind > 0) {
+ args12[numNotPruned] = ind; //args12
+ DF_mkBV(AM_hreg, nargs2); //args22
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ numNotPruned ++;
+ HOPU_copyFlagGlb = TRUE;
+ } //ind == 0 the argument is pruned
+ } else {//bv
+ int ind = DF_bvIndex(tmPtr);
+ if (ind > emblev) {
+ int newind = HOPU_bvIndex(ind, args1, nargs1, emblev);
+ if (newind > 0) {
+ args12[numNotPruned] = newind; //args12
+ DF_mkBV(AM_hreg, nargs2); //args22
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ numNotPruned ++;
+ if (ind != newind) HOPU_copyFlagGlb = TRUE;
+ } //newind == 0 the argument is pruned
+ } else {//ind <= lev
+ args12[numNotPruned] = ind; //args12
+ DF_mkBV(AM_hreg, nargs2); //args22
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ numNotPruned ++;
+ }
+ } //bv
+ args2 = (DF_TermPtr)(((MemPtr)args2) + DF_TM_ATOMIC_SIZE);
+ } //for loop
+ return numNotPruned;
+}
+
+/* When the index of the internal variable is less than or equal to that */
+/* of the external one in the LLambda case, we have to raise the outside */
+/* variable over those constants in the internal list that have smaller */
+/* index and we have to prune other constants and bound variables in this */
+/* list that are not shared. */
+/* It is assumned that the arg vector of the internal flex term has a size */
+/* larger than zero. */
+/* As a result of this process, the argument vectors for both variables */
+/* are decided. That for the outside variable is created on the current */
+/* top of heap, while that for the internal variable, each argument of */
+/* which must be a de Bruijn index, is recorded into an integer array which*/
+/* is set by side-effect. */
+/* The number returned by this procedure is the length of both of the */
+/* argument vectors. Pruning occured when this number is smaller than the */
+/* size of the arg vector of the internal term. */
+/* CHANGES have to be made here if the semantics of local constants are */
+/* changed with respect to polymorphism. */
+static int HOPU_pruneAndRaise(DF_TermPtr args1, int nargs1, DF_TermPtr args2,
+ int nargs2, int emblev, int *args)
+{
+ int numNotPruned = 0;
+ AM_heapError(AM_hreg + nargs2 * DF_TM_ATOMIC_SIZE); //max possible size
+ for (; nargs2 > 0; nargs2 --){
+ DF_TermPtr tmPtr = DF_termDeref(args2);
+ if (DF_isBV(tmPtr)){
+ int ind = DF_bvIndex(tmPtr);
+ if (ind > emblev) {
+ int newind = HOPU_bvIndex(ind, args1, nargs1, emblev);
+ if (newind > 0) {
+ DF_mkBV(AM_hreg, newind); //args for outside var
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ args[numNotPruned] = nargs2; //args for internal var
+ numNotPruned ++;
+ if (ind != newind) HOPU_copyFlagGlb = TRUE;
+ } // newind == 0, the argument is prubed
+ } else { //ind <= emblev
+ DF_mkBV(AM_hreg, ind); //args for outside var
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ args[numNotPruned] = nargs2; //args for internal var
+ numNotPruned ++;
+ }
+ } else { //tmPtr is const
+ if (DF_constUnivCount(tmPtr) > AM_adjreg){
+ int ind = HOPU_constIndex(tmPtr, args1, nargs1, emblev);
+ if (ind > 0) {
+ DF_mkBV(AM_hreg, ind); //args for outside var
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ args[numNotPruned] = nargs2; //args for internal var
+ numNotPruned ++;
+ HOPU_copyFlagGlb = TRUE;
+ } //else ind = 0, the argument is pruned
+ } else { //const uc <= AM_adjreg
+ if (DF_isTConst(tmPtr)) DF_mkRef(AM_hreg, tmPtr);//args out var
+ else DF_copyAtomic(tmPtr, AM_hreg);
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ args[numNotPruned] = nargs2; //args for internal var
+ numNotPruned ++;
+ }
+ }
+ args2 = (DF_TermPtr)(((MemPtr)args2) + DF_TM_ATOMIC_SIZE);
+ } //for loop
+ return numNotPruned;
+}
+
+/* Generating the arguments of a pruning substitution for the case when */
+/* when trying to unify two flexible terms of the form */
+/* (F a1 ... an) = lam(k, (F b1 ... bm)) */
+/* The resulted argument vector is created on the current top of heap, and */
+/* the integer returned by this procedure is the length of the argument */
+/* vector resulted from pruning. Pruning takes place if this value is */
+/* smaller that nargs2. */
+/* It is assumed that the sum of n and k is the same as m. */
+/* CHANGES have to be made here if the semantics of local constants are */
+/* changed with respect to polymorphism. */
+static int HOPU_pruneSameVar(DF_TermPtr args1, int nargs1, DF_TermPtr args2,
+ int nargs2, int lev)
+{
+ if (nargs2 == 0) return 0;
+ else {
+ int numNotPruned = 0;
+ DF_TermPtr tPtr2;
+ AM_heapError(AM_hreg + nargs2 * DF_TM_ATOMIC_SIZE); //max possible size
+ nargs1 = nargs2 - nargs1; //reused nargs1
+ for (; nargs2 > nargs1; nargs2 --){
+ DF_TermPtr tPtr1 = DF_termDeref(args1);
+ tPtr2 = DF_termDeref(args2);
+ if (DF_isBV(tPtr1)){
+ int ind = DF_bvIndex(tPtr1) + lev;
+ if (DF_isBV(tPtr2) && (ind == DF_bvIndex(tPtr2))){
+ DF_mkBV(AM_hreg, nargs2); AM_hreg += DF_TM_ATOMIC_SIZE;
+ numNotPruned++;
+ if (nargs2 != ind) HOPU_copyFlagGlb = TRUE;
+ } //else this argument is pruned
+ } else {// tPtr1 is a constant
+ if (DF_isConst(tPtr2) && DF_sameConsts(tPtr1, tPtr2)){
+ if (DF_isTConst(tPtr2)) {
+ EM_TRY {
+ HOPU_typesUnify(DF_constType(tPtr1),DF_constType(tPtr2),
+ AM_cstTyEnvSize(DF_constTabIndex(tPtr1)));
+ DF_mkBV(AM_hreg, nargs2); AM_hreg += DF_TM_ATOMIC_SIZE;
+ numNotPruned++;
+ HOPU_copyFlagGlb = TRUE;
+ } EM_CATCH {//remove tys for type unif from the PDL
+ if (EM_CurrentExnType == EM_FAIL)
+ AM_resetTypesPDL();
+ else EM_RETHROW();
+ } //EM_catch
+ } else {//no type association
+ DF_mkBV(AM_hreg, nargs2); AM_hreg+=DF_TM_ATOMIC_SIZE;
+ numNotPruned++;
+ HOPU_copyFlagGlb = TRUE;
+ }
+ }//else pruned
+ } //tPtr1 is a constant
+ args1 = (DF_TermPtr)(((MemPtr)args1) + DF_TM_ATOMIC_SIZE);
+ args2 = (DF_TermPtr)(((MemPtr)args2) + DF_TM_ATOMIC_SIZE);
+ } //for (; nargs2 > nargs1; nargs2--)
+ for (; nargs2 > 0; nargs2--){
+ tPtr2 = DF_termDeref(args2);
+ if (DF_isBV(tPtr2) && (DF_bvIndex(tPtr2) == nargs2)){
+ DF_mkBV(AM_hreg, nargs2); AM_hreg += DF_TM_ATOMIC_SIZE;
+ numNotPruned++;
+ } //else pruned
+ args2 = (DF_TermPtr)(((MemPtr)args2) + DF_TM_ATOMIC_SIZE);
+ } //for (; nargs2 > 0; nargs2--)
+ return numNotPruned;
+ } //nargs2 != 0
+}
+
+/* Push a new free variable with given universe count onto the current heap */
+/* top. */
+static void HOPU_pushVarToHeap(int uc)
+{
+ MemPtr newhtop = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(newhtop);
+ DF_mkVar(AM_hreg, uc);
+ AM_hreg = newhtop;
+}
+
+/* Perform substitution to realize pruning and raising for an internal */
+/* variable in the LLambda situation when the variable has an index greater*/
+/* than that of the outside one */
+/* This procedure is also used to perform substitution for flex-flex pairs */
+/* with same variable heads in the LLambda situation. */
+static void HOPU_mkPandRSubst(DF_TermPtr hPtr, DF_TermPtr args, int nargs,
+ DF_TermPtr vPtr, int nabs)
+{
+ TR_trailTerm(vPtr); AM_bndFlag = ON;
+ if (nargs == 0) {
+ if (nabs == 0) DF_mkRef((MemPtr)vPtr, hPtr);
+ else DF_mkLam((MemPtr)vPtr, nabs, hPtr);
+ } else { //nargs > 0
+ DF_TermPtr tPtr = (DF_TermPtr)AM_hreg;
+ AM_heapError(AM_hreg + DF_TM_APP_SIZE);
+ AM_arityError(nargs);
+ DF_mkApp(AM_hreg, nargs, hPtr, args); //application body
+ AM_hreg += DF_TM_APP_SIZE;
+ AM_embedError(nabs);
+ if (nabs == 0) DF_mkRef((MemPtr)vPtr, tPtr);
+ else DF_mkLam((MemPtr)vPtr, nabs, tPtr);
+ }
+}
+
+/* Perform substitution to realize pruning and raising for an internal */
+/* variable in the LLambda situation when the variable has an index smaller*/
+/* than or equal to that of the outside one */
+/* The arguments of the substitution which should be de Bruijn indices */
+/* are given by an integer array. */
+static void HOPU_mkPrunedSubst(DF_TermPtr hPtr, int *args, int nargs,
+ DF_TermPtr vPtr, int nabs)
+{
+ AM_bndFlag = ON;
+ TR_trailTerm(vPtr);
+ if (nargs == 0) {
+ if (nabs == 0) DF_mkRef((MemPtr)vPtr, hPtr);
+ else DF_mkLam((MemPtr)vPtr, nabs, hPtr);
+ } else { //nargs > 0;
+ DF_TermPtr argvec = (DF_TermPtr)AM_hreg, appPtr;
+ int i;
+ AM_heapError(AM_hreg + DF_TM_APP_SIZE + nargs * DF_TM_ATOMIC_SIZE);
+ for (i = 0; i < nargs; i++){//commit bvs in args onto heap
+ DF_mkBV(AM_hreg, args[i]);
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ }
+ appPtr = (DF_TermPtr)AM_hreg;
+ DF_mkApp(AM_hreg, nargs, hPtr, argvec);
+ AM_hreg += DF_TM_APP_SIZE;
+ if (nabs == 0) DF_mkRef((MemPtr)vPtr, appPtr);
+ else DF_mkLam((MemPtr)vPtr, nabs, appPtr);
+ }
+}
+
+/* Generating the partial structure of a substitution to realize pruning */
+/* and raising for an outside variable in the LLambda situation when the */
+/* variable has an index smaller than that of the internal one. */
+/* The arguments of the susbsitution consists of two segments of de Burijn */
+/* indices, which are given by two integer arrays respectively. */
+static DF_TermPtr HOPU_mkPandRTerm(DF_TermPtr hPtr, int args1[], int nargs1,
+ int args2[], int nargs2)
+{
+ if ((nargs1 == 0) && (nargs2 == 0)) return hPtr;
+ else {
+ DF_TermPtr args = (DF_TermPtr)AM_hreg, rtPtr;
+ int nargs = nargs1 + nargs2; //new arity (non-zero)
+ int i;
+ AM_arityError(nargs);
+ AM_heapError(AM_hreg + DF_TM_APP_SIZE + nargs * DF_TM_ATOMIC_SIZE);
+ for (i = 0; i < nargs1 ; i++){ //commit bvs in a11 onto heap
+ DF_mkBV(AM_hreg, args1[i]);
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ }
+ for (i = 0; i < nargs2 ; i++){ //commit bvs in a12 onto heap
+ DF_mkBV(AM_hreg, args2[i]);
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ }
+ rtPtr = (DF_TermPtr)AM_hreg;
+ DF_mkApp(AM_hreg, nargs, hPtr, args);
+ AM_hreg += DF_TM_APP_SIZE;
+ return rtPtr;
+ }
+}
+
+/* Generating the partial structure of a substitution to realize pruning */
+/* and raising for an internal variable in the LLambda situation when the */
+/* variable has an index greater than or equal to that of the outside one. */
+static DF_TermPtr HOPU_mkPrunedTerm(DF_TermPtr hPtr, DF_TermPtr args, int nargs)
+{
+ if (nargs == 0) return hPtr;
+ else {
+ DF_TermPtr rtPtr = (DF_TermPtr)AM_hreg;
+ AM_heapError(AM_hreg + DF_TM_APP_SIZE);
+ DF_mkApp(AM_hreg, nargs, hPtr, args);
+ AM_hreg += DF_TM_APP_SIZE;
+ return rtPtr;
+ }
+}
+
+/* Find the (partial) structure of the substitution for a flex head of a */
+/* LLambda term corresponding to an internal flex term which is known to be */
+/* LLambda. The internal free variable is bound to a proper substitution as */
+/* side-effect.
+/* The arguments of this procedure are: */
+/* args1 : reference to the argument vector of the outside flex term */
+/* nargs1: number of arguments of the outside flex term */
+/* uc : universe count of the internal free variable */
+/* tPtr2 : refers to the dereference of ABSTRACTION BODY of the internal */
+/* flex term */
+/* fhPtr : refers to the head of the internal flex term */
+/* args2 : refers to the argument vector of the internal flex term */
+/* nargs2: number of arguments of the internal flex term */
+/* lev : the abstraction context of the internal flex term */
+/* Note that the outside free variable and its universe count are assumed to */
+/* be given by the global variables (registers) AM_vbbreg and AM_adjreg. */
+static DF_TermPtr HOPU_flexNestedLLambda(DF_TermPtr args1, int nargs1, int uc,
+ DF_TermPtr tPtr2, DF_TermPtr fhPtr, DF_TermPtr args2,
+ int nargs2, int lev)
+{
+ DF_TermPtr bnd; //(partial) binding for the outside free var
+ MemPtr oldhtop = AM_hreg;
+ DF_TermPtr heapArgs = (DF_TermPtr)AM_hreg;
+ if (AM_adjreg < uc){
+ int *args11 = NULL, *args12 = NULL; //hold args of bnd of the outside v
+ int nargs11 = 0, nargs12 = 0;
+ if (nargs1 != 0) {
+ args11 = (int*)EM_malloc(nargs1 * sizeof(int));
+ nargs11 = HOPU_raise(uc, args1, nargs1, lev, args11);
+ }
+ if (nargs2 != 0) {
+ args12 = (int*)EM_malloc(nargs2 * sizeof(int));
+ nargs12 = HOPU_prune(args1, nargs1, args2, nargs2, lev, args12);
+ }
+ if ((nargs11 == 0) && (nargs12 == nargs2)) {//neither raised nor pruned
+ AM_hreg = oldhtop; //the internal free var remains unbound
+ TR_trailTerm(fhPtr); AM_bndFlag = ON;
+ DF_modVarUC(fhPtr, AM_adjreg);
+ if (HOPU_copyFlagGlb)
+ bnd = HOPU_mkPandRTerm(fhPtr, args11, nargs11, args12, nargs12);
+ else bnd = tPtr2;
+ } else { //raised or pruned
+ DF_TermPtr newVar = (DF_TermPtr)AM_hreg;
+ HOPU_pushVarToHeap(AM_adjreg);
+ HOPU_mkPandRSubst(newVar, heapArgs, nargs11+nargs12, fhPtr, nargs2);
+ bnd = HOPU_mkPandRTerm(newVar, args11, nargs11, args12, nargs12);
+ HOPU_copyFlagGlb = TRUE;
+ }
+ if (nargs1 != 0) free(args11); if (nargs2 != 0) free(args12);
+ } else { //AM_adjreg >= uc
+ int *newargs2 = NULL;
+ int nnewargs2 = 0;
+ if (nargs2 != 0) {
+ newargs2 = (int*)EM_malloc(nargs2 * sizeof(int));
+ nnewargs2 = HOPU_pruneAndRaise(args1,nargs1,args2,nargs2,lev,
+ newargs2);
+ }
+ if (nnewargs2 == nargs2){//not pruned
+ if (HOPU_copyFlagGlb)
+ bnd = HOPU_mkPrunedTerm(fhPtr, heapArgs, nnewargs2);
+ else { AM_hreg = oldhtop; bnd = tPtr2; }
+ } else { //pruned
+ DF_TermPtr newVar = (DF_TermPtr)AM_hreg;
+ HOPU_pushVarToHeap(uc);
+ HOPU_mkPrunedSubst(newVar, newargs2, nnewargs2, fhPtr, nargs2);
+ bnd = HOPU_mkPrunedTerm(newVar, heapArgs, nnewargs2);
+ HOPU_copyFlagGlb = TRUE;
+ }
+ if (nargs2 != 0) free(newargs2);
+ } //AM_adjreg >= uc
+ return bnd;
+}
+
+/* Checking the arguments of a flex (non-LLambda) term to see whetehr a */
+/* free variable same as that currently in the AM_vbbreg register, a free */
+/* variable with higher univ count than that currently in the AM_adjreg */
+/* register, a constant with higher univ count than that currently in */
+/* AM_adjreg, or a de Bruijn index bound by abstractions over the variable */
+/* for which a substitution is being constructed occurs. */
+/* If one of the situations occurs, exception is raised. */
+static void HOPU_flexCheck(DF_TermPtr args, int nargs, int emblev)
+{
+ for (; nargs > 0; nargs --){
+ int nemblev;
+ HN_hnorm(args);
+ nemblev = emblev + AM_numAbs;
+ if (AM_rigFlag){
+ if (DF_isBV(AM_head)) {
+ if (DF_bvIndex(AM_head) > nemblev) EM_THROW(EM_FAIL);
+ } else {
+ if (DF_isConst(AM_head)&&(DF_constUnivCount(AM_head)>AM_adjreg))
+ EM_THROW(EM_FAIL);
+ } //otherwise succeeds
+ } else { //AM_rigFlag == FALSE
+ if ((AM_vbbreg == AM_head) || (DF_fvUnivCount(AM_head)>AM_adjreg))
+ EM_THROW(EM_FAIL);
+ }
+ HOPU_flexCheck(AM_argVec, AM_numArgs, nemblev);
+ args = (DF_TermPtr)(((MemPtr)args) + DF_TM_ATOMIC_SIZE);
+ }
+}
+
+/* This version of flexCheckC is needed in the compiled form of pattern */
+/* unification. The essential difference from the other version is that the */
+/* variable being bound is already partially bound to a structure. */
+/* The difference from the other procedure is the head normalization */
+/* procedure invoked is one performs the occurs checking on partially bound */
+/* variables */
+static void HOPU_flexCheckC(DF_TermPtr args, int nargs, int emblev)
+{
+ for (; nargs > 0; nargs--){
+ int nemblev;
+ HN_hnormOcc(args);
+ nemblev = emblev + AM_numAbs;
+ if (AM_rigFlag) {
+ if (DF_isBV(AM_head)) {
+ if (DF_bvIndex(AM_head) > nemblev) EM_THROW(EM_FAIL);
+ } else {
+ if (DF_isConst(AM_head)&&(DF_constUnivCount(AM_head)>AM_adjreg))
+ EM_THROW(EM_FAIL);
+ } //otherwise succeeds
+ } else //AM_rigFlag == FALSE
+ if (DF_fvUnivCount(AM_head) > AM_adjreg) EM_THROW(EM_FAIL);
+
+ HOPU_flexCheckC(AM_argVec, AM_numArgs, nemblev);
+ args = (DF_TermPtr)(((MemPtr)args)+DF_TM_ATOMIC_SIZE);
+ }
+}
+
+/* Generating a term on the top of heap which is to be added into a */
+/* disagreement pair. */
+/* The term has the following structure: */
+/* (h [|a1, 0, lev, nil|] ... [|an, 0, lev, nil|] #lev ... #1) */
+/* It is assumed that nargs and lev are not equal to zero. */
+static void HOPU_mkTermNLL(DF_TermPtr h, DF_TermPtr args, int nargs, int lev)
+{
+ int newArity = nargs + lev;
+ MemPtr newArgs = AM_hreg + DF_TM_APP_SIZE; //spare app (head) size on heap
+ AM_arityError(newArity);
+ AM_heapError(AM_hreg + nargs*DF_TM_SUSP_SIZE + newArity*DF_TM_ATOMIC_SIZE
+ + DF_TM_APP_SIZE);
+ DF_mkApp(AM_hreg, newArity, h, (DF_TermPtr)newArgs);
+ AM_hreg += (DF_TM_APP_SIZE + newArity * DF_TM_ATOMIC_SIZE);//alloc arg vec
+ for (; nargs > 0; nargs--){ //[|ai, 0, lev, nil|], for i <= nargs
+ DF_mkRef(newArgs, (DF_TermPtr)AM_hreg);
+ DF_mkSusp(AM_hreg, 0, lev, DF_termDeref(args), DF_EMPTY_ENV);
+ newArgs += DF_TM_ATOMIC_SIZE; AM_hreg += DF_TM_SUSP_SIZE;
+ args = (DF_TermPtr)(((MemPtr)args) + DF_TM_ATOMIC_SIZE);
+ }
+ for (; lev > 0; lev--){ //#i, for i <= lev
+ DF_mkBV(newArgs, lev);
+ newArgs += DF_TM_ATOMIC_SIZE;
+ }
+}
+
+/* Generating a partial subsitution for the free head of a LLambda term */
+/* corresponding to an internal flex term which is known to be non-LLambda.*/
+/* The partial substitution is of form: */
+/* (h #n ... #1) */
+/* It is assumed that n is not equal to zero. */
+static void HOPU_mkSubstNLL(DF_TermPtr h, int n)
+{
+ AM_arityError(n);
+ AM_heapError(AM_hreg + DF_TM_APP_SIZE + n * DF_TM_ATOMIC_SIZE);
+ DF_mkApp(AM_hreg, n, h, (DF_TermPtr)(AM_hreg + DF_TM_APP_SIZE));
+ AM_hreg += DF_TM_APP_SIZE;
+ for (; n > 0; n--){
+ DF_mkBV(AM_hreg, n);
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ }
+}
+
+/* Try to solve G = ...(F a1 ... an)..., where F and G are different free */
+/* variables, and (F a1 ... an) is non-LLambda. */
+/* Either G is bound to (F a1 ... an) or an exception is raised. In the */
+/* latter case, the caller of this function is responsible to add a */
+/* disagreement pair to the live list. */
+static void HOPU_bndVarNestedFlex(DF_TermPtr fhPtr, DF_TermPtr args, int nargs,
+ int lev)
+{
+ HOPU_flexCheck(args, nargs, lev);
+ if (DF_fvUnivCount(fhPtr) > AM_adjreg) {
+ TR_trailTerm(fhPtr);
+ AM_bndFlag = ON;
+ DF_modVarUC(fhPtr, AM_adjreg);
+ }
+}
+
+/* Try to find the (partial) structure of the substitution for a flex head */
+/* of a LLambda term corresponding to an internal flex term which is not */
+/* known to be LLambda. */
+/* If the internal flex term is LLambda, HOPU_flexNestedLLambda is invoked */
+/* to generate the (parital) substitution for the outside variable, and */
+/* perform proper substitutions on the internal free variable if necessary. */
+/* Otherwise, a disagreement pair is added into the live list. */
+static DF_TermPtr HOPU_flexNestedSubst(DF_TermPtr args1, int nargs1,
+ DF_TermPtr fhPtr, DF_TermPtr args2,
+ int nargs2, DF_TermPtr tmPtr, int emblev)
+{
+ DF_TermPtr bnd;
+ int varuc = DF_fvUnivCount(fhPtr);
+ if (HOPU_isLLambda(varuc, nargs2, args2)){
+ if (fhPtr == AM_vbbreg) EM_THROW(EM_FAIL); //occurs check
+ bnd = HOPU_flexNestedLLambda(args1, nargs1, varuc, tmPtr, fhPtr, args2,
+ nargs2, emblev);
+ } else {// the internal flex term is not LLambda: delay (opt possible)
+ DF_TermPtr newVar;
+ DF_TermPtr newTerm;
+ Boolean found = FALSE;
+ if ((fhPtr != AM_vbbreg) && (nargs1 == 0)) {
+ EM_TRY{
+ HOPU_bndVarNestedFlex(fhPtr, args2, nargs2, emblev);
+ bnd = tmPtr;
+ found = TRUE;
+ } EM_CATCH {if (EM_CurrentExnType != EM_FAIL) EM_RETHROW();}
+ }
+ if (!found) {
+ newVar = (DF_TermPtr)AM_hreg;
+ HOPU_pushVarToHeap(AM_adjreg);
+ HOPU_copyFlagGlb = TRUE;
+ if ((nargs1 == 0) && (emblev == 0)) {
+ bnd = newVar;
+ AM_addDisPair(bnd, tmPtr);
+ } else {
+ newTerm = (DF_TermPtr)AM_hreg;
+ HOPU_mkTermNLL(newVar, args1, nargs1, emblev);
+ AM_addDisPair(newTerm, tmPtr);
+ bnd = (DF_TermPtr)AM_hreg;
+ HOPU_mkSubstNLL(newVar, emblev + nargs1);
+ }
+ }
+ }
+ return bnd;
+}
+
+/* This version of flexNestedSubst is needed in the compiled form of pattern */
+/* unification. The essential difference from the other version is that the */
+/* variable being bound is already partially bound to a structure. */
+/* The difference from the other procedure is first the head normalization */
+/* process invokded is one performs occurs checking on partially bound */
+/* variables, and second, the "top-level" flexible term is a free variable: */
+/* so there is no need to distinguish whether the other flex term is Llambda */
+/* or not: the substitution can be found by an invocation of flexCheckC */
+DF_TermPtr HOPU_flexNestedSubstC(DF_TermPtr fhPtr, DF_TermPtr args, int nargs,
+ DF_TermPtr tmPtr, int emblev)
+{
+ DF_TermPtr bnd, newVar, newTerm;
+ int varuc;
+ Boolean found = FALSE;
+
+ EM_TRY {
+ HOPU_flexCheckC(args, nargs, emblev);
+ if (DF_fvUnivCount(fhPtr) > AM_adjreg){
+ TR_trailTerm(fhPtr);
+ AM_bndFlag = ON;
+ DF_modVarUC(fhPtr, AM_adjreg);
+ }
+ bnd = tmPtr;
+ found = TRUE;
+ } EM_CATCH { if (EM_CurrentExnType != EM_FAIL) EM_RETHROW(); }
+
+ if (!found) {
+ varuc = DF_fvUnivCount(fhPtr);
+ if (HOPU_isLLambda(varuc, nargs, args)){
+ bnd = HOPU_flexNestedLLambda(NULL, 0, varuc, tmPtr, fhPtr, args, nargs,
+ emblev);
+ } else {//otherwise delay this pair onto the live list
+ HOPU_copyFlagGlb = TRUE;
+ newVar = (DF_TermPtr)AM_hreg;
+ HOPU_pushVarToHeap(AM_adjreg);
+ if (emblev == 0) {
+ bnd = newVar;
+ AM_addDisPair(bnd, tmPtr);
+ } else {
+ newTerm = (DF_TermPtr)AM_hreg;
+ HOPU_mkTermNLL(newVar, NULL, 0, emblev);
+ AM_addDisPair(newTerm, tmPtr);
+ bnd = (DF_TermPtr)AM_hreg;
+ HOPU_mkSubstNLL(newVar, emblev);
+ }
+ }
+ }
+ return bnd;
+}
+
+/* Try to solve G = (F a1 ... an), where F and G are different free */
+/* variables, and (F a1 ... an) is non-LLambda. */
+/* Either G is bound to (F a1 ... an) or an exception is raised. In the */
+/* latter case, the caller of this function is responsible to add a */
+/* disagreement pair to the live list. */
+static void HOPU_bndVarFlex(DF_TermPtr vPtr, DF_TermPtr fPtr, DF_TermPtr fhPtr,
+ DF_TermPtr args, int nargs)
+{
+ AM_vbbreg = vPtr; AM_adjreg = DF_fvUnivCount(vPtr);
+ HOPU_flexCheck(args, nargs, 0);
+ if (DF_fvUnivCount(fhPtr) > AM_adjreg) {
+ TR_trailTerm(fPtr);
+ AM_bndFlag = ON;
+ DF_modVarUC(fhPtr, AM_adjreg);
+ }
+ TR_trailTerm(vPtr);
+ AM_bndFlag = ON;
+ DF_mkRef((MemPtr)vPtr, fPtr);
+}
+
+/* Try to solve (F a1 ... an) = lam(k, (G b1 ... bm)), where F and G are */
+/* both free variables. */
+/* The arguments are: */
+/* tPtr1 : reference to the ABSTRACTION BODY of the first flex term */
+/* h1 : reference to the flex head of the first term */
+/* nargs1: number of arguments of the first flex term */
+/* args1 : reference to the argument vector of the first flex term */
+/* tPtr2 : reference to the ABSTRACTION BODY of the second flex term */
+/* h2 : reference to the flex head of the second flex term */
+/* nargs2: number of arguments of the second flex term */
+/* args2 : reference to the argument vector of the second flex term */
+/* lev : abstraction context of the second term with respect to the */
+/* first one. */
+/* */
+/* Non-Llambda pairs could be encountered during this process, and in */
+/* this situation, the pair is delayed onto the disagreement list. */
+static void HOPU_flexMkSubst(DF_TermPtr tPtr1, DF_TermPtr h1, int nargs1,
+ DF_TermPtr args1, DF_TermPtr tPtr2, DF_TermPtr h2,
+ int nargs2, DF_TermPtr args2, int lev)
+{
+ int uc = DF_fvUnivCount(h1);
+ if (HOPU_isLLambda(uc, nargs1, args1)){ //the first term is LLambda
+ DF_TermPtr bndBody;
+ if (h1 == h2) { //same variable (comparing addresses)
+ if (HOPU_isLLambda(uc, nargs2, args2)) {//same var common uc
+ MemPtr oldhtop = AM_hreg;
+ DF_TermPtr newArgs = (DF_TermPtr)AM_hreg;
+ HOPU_copyFlagGlb = FALSE;
+ nargs1 = HOPU_pruneSameVar(args1, nargs1, args2, nargs2, lev);
+ if ((nargs1 != nargs2) || HOPU_copyFlagGlb){
+ DF_TermPtr newVar = (DF_TermPtr)AM_hreg;
+ HOPU_pushVarToHeap(uc);
+ HOPU_mkPandRSubst(newVar, newArgs, nargs1, h1, nargs2);
+ } else AM_hreg = oldhtop; //unbound
+ } else { //(F a1 ... an)[ll] = (lam(k, (F b1 ... bm)))[non-ll]
+ if (lev == 0) AM_addDisPair(tPtr1, tPtr2);
+ else {
+ MemPtr nhtop = AM_hreg + DF_TM_LAM_SIZE;
+ DF_TermPtr tmPtr = (DF_TermPtr)AM_hreg;
+ AM_heapError(AM_hreg);
+ DF_mkLam(AM_hreg, lev, tPtr2);
+ AM_hreg = nhtop;
+ AM_addDisPair(tPtr1, tmPtr);
+ } //(lev != 0)
+ } //tPtr2 not LLambda
+ } else { //different variable
+ int nabs;
+ AM_vbbreg = h1; AM_adjreg = uc; //set regs for occ
+ HOPU_copyFlagGlb = FALSE;
+ bndBody = HOPU_flexNestedSubst(args1, nargs1, h2, args2, nargs2,
+ tPtr2, lev);
+ nabs = lev + nargs1;
+ TR_trailTerm(h1); AM_bndFlag = ON;
+ if (nabs == 0) DF_mkRef((MemPtr)h1, bndBody);
+ else {
+ AM_embedError(nabs);
+ DF_mkLam((MemPtr)h1, nabs, bndBody);
+ }
+ } //different variable
+ } else { //the first term is non-LLambda
+ Boolean found = FALSE;
+ if ((nargs2 == 0) && (lev == 0) && (h1 != h2)) { // (F t1 ... tm) = G
+ EM_TRY{
+ HOPU_bndVarFlex(h2, tPtr1, h1, args1, nargs1);
+ found = TRUE;
+ } EM_CATCH {
+ if (EM_CurrentExnType != EM_FAIL) EM_RETHROW();
+ }
+ }
+ if (!found) {
+ if (lev == 0) AM_addDisPair(tPtr1, tPtr2);
+ else {
+ MemPtr nhtop = AM_hreg + DF_TM_LAM_SIZE;
+ DF_TermPtr tmPtr = (DF_TermPtr)AM_hreg;
+ AM_heapError(AM_hreg);
+ DF_mkLam(AM_hreg, lev, tPtr2);
+ AM_hreg = nhtop;
+ AM_addDisPair(tPtr1, tmPtr);
+ } //(lev != 0)
+ }
+ } //the first term is non-LLambda
+}
+
+/* The counterpart of HOPU_flexMkSubst invoked from HOPU_patternUnifyPair. */
+/* Care is taken to avoid making a reference to a stack address in binding */
+/* and creating disagreement pairs. */
+/* It is assumed that the first term (F a1 ... an) given by its */
+/* is not embedded in any abstractions. */
+static void HOPU_flexMkSubstGlb(DF_TermPtr tPtr1, DF_TermPtr h1, int nargs1,
+ DF_TermPtr args1,
+ DF_TermPtr tPtr2, DF_TermPtr h2, int nargs2,
+ DF_TermPtr args2,
+ DF_TermPtr topPtr2, int lev)
+{
+ int uc = DF_fvUnivCount(h1);
+ if (HOPU_isLLambda(uc, nargs1, args1)) { //the first term is LLambda
+ DF_TermPtr bndBody;
+ if (h1 == h2) { //same variable (comparing addresses)
+ if (HOPU_isLLambda(uc, nargs2, args2)){//same var; common uc
+ MemPtr oldhtop = AM_hreg;
+ DF_TermPtr newArgs = (DF_TermPtr)AM_hreg;
+ HOPU_copyFlagGlb = FALSE;
+ nargs1 = HOPU_pruneSameVar(args1, nargs1, args2, nargs2, lev);
+ if ((nargs1 != nargs2) || HOPU_copyFlagGlb) {
+ DF_TermPtr newVar = (DF_TermPtr)AM_hreg;
+ HOPU_pushVarToHeap(uc);
+ HOPU_mkPandRSubst(newVar, newArgs, nargs1, h1, nargs2);
+ } else AM_hreg = oldhtop; //variable remain unbound
+ } else { //(F a1 ... an)[ll] = (lam(k, (F b1 ... bm)))[non-ll]
+ //non-LLambda term must locate on the heap
+ if (nargs1 == 0) tPtr1 = HOPU_globalizeFlex(tPtr1);
+ if (lev == 0) AM_addDisPair(tPtr1, tPtr2);
+ else AM_addDisPair(tPtr1, DF_termDeref(topPtr2));
+ } //tPtr2 not LLambda
+ } else { //different variable
+ int nabs;
+ AM_vbbreg = h1; AM_adjreg = uc; //set regs for occ
+ HOPU_copyFlagGlb = FALSE;
+ bndBody = HOPU_flexNestedSubst(args1, nargs1, h2, args2, nargs2,
+ tPtr2, lev);
+ nabs = nargs1 + lev;
+ TR_trailTerm(h1); AM_bndFlag = ON;
+ if (HOPU_copyFlagGlb == FALSE)
+ bndBody = HOPU_globalizeFlex(bndBody);
+ if (nabs == 0) DF_mkRef((MemPtr)h1, bndBody);
+ else {
+ AM_embedError(nabs);
+ DF_mkLam((MemPtr)h1, nabs, bndBody);
+ }
+ }
+ } else {//the first term is non-LLambda (must locate on heap)
+ Boolean found = FALSE;
+ if ((nargs2 == 0) && (lev == 0) && (h1 != h2)) {//(F t1...tm)[nll] = G
+ EM_TRY {
+ HOPU_bndVarFlex(h2, tPtr1, h1, args1, nargs1);
+ found = TRUE;
+ } EM_CATCH {
+ if (EM_CurrentExnType == EM_FAIL)
+ tPtr2 = HOPU_globalizeFlex(tPtr2);
+ else EM_RETHROW();
+ }
+ }
+ if (!found) {
+ if (lev == 0) AM_addDisPair(tPtr1, tPtr2);
+ else AM_addDisPair(tPtr1, DF_termDeref(topPtr2));
+ }
+ } //the first term is non-LLambda
+}
+
+
+/***************************************************************************/
+/* BINDING FOR FLEX-RIGID */
+/* */
+/* Auxiliary functions for solving flex-rigid pairs. */
+/* Non-LLambda pairs are delayed onto the disagreement list. */
+/***************************************************************************/
+/* Try to find the (partial) binding of the head of a flex term correponding */
+/* to a rigid atom during the process of unifying the flex term with a */
+/* rigid one. The global variable HOPU_copyFlagGlb is used to indicate */
+/* whether a new term is created during this process. */
+/* Note it is assumed that rPtr refers to the dereference of a rigid atom */
+/* or cons. */
+static DF_TermPtr HOPU_getHead(DF_TermPtr rPtr, DF_TermPtr args, int nargs,
+ int emblev)
+{
+ DF_TermPtr rtPtr;
+ switch(DF_termTag(rPtr)){
+ case DF_TM_TAG_CONST:{
+ if (DF_constUnivCount(rPtr) > AM_adjreg){
+ MemPtr newhtop;
+ int ind = HOPU_constIndex(rPtr, args, nargs, emblev);
+ if (ind == 0) EM_THROW(EM_FAIL); //occurs-check
+ AM_embedError(ind);
+ newhtop = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(newhtop);
+ HOPU_copyFlagGlb = TRUE; //new structure is created
+ rtPtr = (DF_TermPtr)AM_hreg; //create a db on the heap top
+ DF_mkBV(AM_hreg, ind);
+ AM_hreg = newhtop;
+ } else rtPtr = rPtr; //DF_constUnivCount(rPtr <= AM_adjreg)
+ break;
+ }
+ case DF_TM_TAG_BVAR: {
+ int dbInd = DF_bvIndex(rPtr);
+ if (dbInd > emblev){
+ int ind = HOPU_bvIndex(dbInd, args, nargs, emblev);
+ if (ind == 0) EM_THROW(EM_FAIL); //occurs-check
+ AM_embedError(ind);
+ if (ind == dbInd) rtPtr = rPtr; //use the old db term
+ else { //create a db on the heap top
+ MemPtr newhtop = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(newhtop);
+ HOPU_copyFlagGlb = TRUE; //new structure is created
+ rtPtr = (DF_TermPtr)AM_hreg;
+ DF_mkBV(AM_hreg, ind);
+ AM_hreg = newhtop;
+ }
+ } else rtPtr = rPtr; //dbInd <= emlev
+ break;
+ }
+ default: { rtPtr = rPtr; break;} //other rigid head: cons,nil,int,fl,str
+ } //switch
+ return rtPtr;
+}
+
+/* Create a new cons or app term on the current heap top. */
+static void HOPU_mkConsOrApp(DF_TermPtr tmPtr, DF_TermPtr funcPtr,
+ DF_TermPtr argvec, int nargs)
+{
+ MemPtr newhtop;
+ if (DF_isCons(tmPtr)) {
+ newhtop = AM_hreg + DF_TM_CONS_SIZE;
+ AM_heapError(newhtop);
+ DF_mkCons(AM_hreg, argvec);
+ } else {// application
+ newhtop = AM_hreg + DF_TM_APP_SIZE;
+ AM_heapError(newhtop);
+ DF_mkApp(AM_hreg, nargs, funcPtr, argvec);
+ }
+ AM_hreg = newhtop;
+}
+
+/* Try to find the (partial) binding of the head of a flex term when */
+/* unifying it with a rigid term possible under abstractions. */
+/* The arguments are: */
+/* fargs: reference to the arguments of the flex term */
+/* fnargs: number of arguments of the flex term */
+/* rhPtr: reference to the rigid head */
+/* rPtr: reference to the ABSTRACTION BODY of the rigid term */
+/* rargs: reference to the arguments of the rigid term */
+/* rnargs: number of arguments of the rigid term */
+/* emblev: abstraction context of the rigid term */
+/* The global variable HOPU_copyFlagGlb is used to indicate whether new */
+/* term is created in this process. */
+/* Note that if the rigid term is app or cons, it is first assumed that */
+/* a new argument vector is to be created. However, after all the args in */
+/* the binding are calculated, a checking is made on whether this is */
+/* really necessary. If it is not, the old arg vector is used, and the new */
+/* one is abandoned. (Heap space for it is deallocated.) */
+/* It is assumed that the flexible head and its universe count are */
+/* in registers AM_vbbreg and AM_adjreg. */
+static DF_TermPtr HOPU_rigNestedSubst(DF_TermPtr fargs, int fnargs,
+ DF_TermPtr rhPtr, DF_TermPtr rPtr,
+ DF_TermPtr rargs, int rnargs, int emblev)
+{
+ rhPtr = HOPU_getHead(rhPtr, fargs, fnargs, emblev); //head of the binding
+ if (rnargs == 0) return rhPtr; //the rigid term is atomic
+ else { //the rigid term is cons or app
+ Boolean myCopyFlagHead = HOPU_copyFlagGlb, myCopyFlagArgs = FALSE;
+ int i;
+ MemPtr oldHreg = AM_hreg; //the old heap top
+ MemPtr argLoc = AM_hreg; //arg vector location
+ DF_TermPtr newArgs = (DF_TermPtr)AM_hreg; //new argument vector
+ DF_TermPtr oldArgs = rargs; //old argument vector
+ AM_heapError(AM_hreg + rnargs * DF_TM_ATOMIC_SIZE);
+ AM_hreg += rnargs * DF_TM_ATOMIC_SIZE; //allocate space for argvec
+ HOPU_copyFlagGlb = FALSE;
+ for (i = 0; i < rnargs; i++){
+ DF_TermPtr bnd;
+ int nabs;
+ MemPtr tmpHreg = AM_hreg;
+ HN_hnorm(rargs); nabs = AM_numAbs; //dereference of hnf
+ if (AM_hreg != tmpHreg) {myCopyFlagArgs = TRUE; }
+
+ if (AM_rigFlag){
+ bnd = HOPU_rigNestedSubst(fargs, fnargs, AM_head,
+ HOPU_lamBody(rargs), AM_argVec, AM_numArgs, nabs+emblev);
+ } else { //AM_rigFlag = FALSE
+ bnd = HOPU_flexNestedSubst(fargs, fnargs, AM_head, AM_argVec,
+ AM_numArgs, HOPU_lamBody(rargs), nabs+emblev);
+ }
+ if (nabs == 0) DF_mkRef(argLoc, bnd); //compact atomic??
+ else DF_mkLam(argLoc, nabs, bnd);
+ argLoc += DF_TM_ATOMIC_SIZE; //note: abs has atomic size
+ if (HOPU_copyFlagGlb) {myCopyFlagArgs=TRUE; HOPU_copyFlagGlb=FALSE;}
+ rargs = (DF_TermPtr)(((MemPtr)rargs)+DF_TM_ATOMIC_SIZE); //next arg
+ } //for loop
+ if (myCopyFlagArgs) {
+ DF_TermPtr tmPtr = (DF_TermPtr)AM_hreg; //new cons or app
+ HOPU_mkConsOrApp(rPtr, rhPtr, newArgs, rnargs);
+ HOPU_copyFlagGlb = TRUE;
+ return tmPtr;
+ } else { //myCopyFlagBody == FALSE
+ AM_hreg = oldHreg; //deallocate space for the argument vector
+ //note no new terms are created form any argument
+ if (myCopyFlagHead){
+ DF_TermPtr tmPtr = (DF_TermPtr)AM_hreg; //new cons or app
+ HOPU_mkConsOrApp(rPtr, rhPtr, oldArgs, rnargs);
+ HOPU_copyFlagGlb = TRUE;
+ return tmPtr;
+ } else return rPtr; //myCopyFlagHead==FALSE, myCopyFlagArgs==FALSE
+ }
+ }//rnargs > 0
+}
+
+/* This version of rigNestedSubstC is needed in the compiled form of pattern */
+/* unification. The essential difference from the other version is that the */
+/* variable being bound is already partially bound to a structure. */
+/* The difference from the other procedure is first the head normalization */
+/* procedure invoked is one performs the occurs checking on partially bound */
+/* variables, and second, the incoming flexible term is in fact a free */
+/* variable. */
+DF_TermPtr HOPU_rigNestedSubstC(DF_TermPtr rhPtr, DF_TermPtr rPtr,
+ DF_TermPtr rargs, int rnargs, int emblev)
+{
+ rhPtr = HOPU_getHead(rhPtr, NULL, 0, emblev);
+ if (rnargs == 0) return rhPtr;
+ else {
+ Boolean myCopyFlagHead = HOPU_copyFlagGlb, myCopyFlagArgs = FALSE;
+ int i;
+ MemPtr oldHreg = AM_hreg; //the old heap top
+ MemPtr argLoc = AM_hreg; //arg vector location
+ DF_TermPtr newArgs = (DF_TermPtr)AM_hreg; //new arg vector
+ DF_TermPtr oldArgs = rargs; //old arg vector
+ AM_heapError(AM_hreg + rnargs * DF_TM_ATOMIC_SIZE);
+ AM_hreg += rnargs * DF_TM_ATOMIC_SIZE; //alloc space for new args
+ HOPU_copyFlagGlb = FALSE;
+ for (i = 0; i < rnargs; i++) {
+ DF_TermPtr bnd;
+ int nabs;
+ MemPtr tmpHreg = AM_hreg;
+ HN_hnormOcc(rargs); nabs = AM_numAbs;
+ if (tmpHreg != AM_hreg) {myCopyFlagArgs = TRUE; }
+ if (AM_rigFlag)
+ bnd = HOPU_rigNestedSubstC(AM_head, HOPU_lamBody(rargs),
+ AM_argVec, AM_numArgs, nabs+emblev);
+ else //AM_rigFlag == FALSE
+ bnd = HOPU_flexNestedSubstC(AM_head, AM_argVec, AM_numArgs,
+ HOPU_lamBody(rargs), nabs+emblev);
+
+ if (nabs == 0) DF_mkRef(argLoc, bnd);
+ else DF_mkLam(argLoc, nabs, bnd);
+
+ argLoc += DF_TM_ATOMIC_SIZE;
+ if (HOPU_copyFlagGlb) {myCopyFlagArgs=TRUE; HOPU_copyFlagGlb=FALSE;}
+ rargs = (DF_TermPtr)(((MemPtr)rargs)+DF_TM_ATOMIC_SIZE);
+ } //for loop
+ if (myCopyFlagArgs) {
+ DF_TermPtr tmPtr = (DF_TermPtr)AM_hreg; //new cons or app
+ HOPU_mkConsOrApp(rPtr, rhPtr, newArgs, rnargs);
+ HOPU_copyFlagGlb = TRUE;
+ return tmPtr;
+ } else { //myCopyFlagArgs == FALSE
+ AM_hreg = oldHreg;//deallocate space for arg vector
+ if (myCopyFlagHead) {
+ DF_TermPtr tmPtr = (DF_TermPtr)AM_hreg;
+ HOPU_mkConsOrApp(rPtr, rhPtr, oldArgs, rnargs);
+ HOPU_copyFlagGlb = TRUE;
+ return tmPtr;
+ } else return rPtr; ////myCopyFlagHead==FALSE, myCopyFlagArgs==FALSE
+ }
+ }//rnargs > 0
+}
+
+/* Try to solve (F a1 ... an) = lam(k, (r b1 ... bm)), where r is rigid. */
+/* The arguments are: */
+/* fPtr : reference to the ABSTRACTION BODY of the flex term */
+/* fhPtr : reference to the flex head */
+/* fnargs: number of arguments of the flex term */
+/* fargs : reference to the argument vector of the flex term */
+/* rPtr : reference to the ABSTRACTION BODY of the rigid term */
+/* rhPtr : reference to the rigid head (Note it could be cons) */
+/* rnargs: number of arguments of the rigid term */
+/* rargs : reference to the argument vector of the rigid term */
+/* */
+/* Non-Llambda pairs could be encountered during this process, and in */
+/* this situation, the pair is delayed onto the disagreement list. */
+static void HOPU_rigMkSubst(DF_TermPtr fPtr, DF_TermPtr fhPtr, int fnargs,
+ DF_TermPtr fargs, DF_TermPtr rPtr, DF_TermPtr rhPtr,
+ int rnargs, DF_TermPtr rargs, int emblev)
+{
+ int uc = DF_fvUnivCount(fhPtr);
+ if (HOPU_isLLambda(uc, fnargs, fargs)){//Llambda pattern
+ DF_TermPtr bndBody; //abs body of bnd of the fv
+ int nabs;
+
+ AM_vbbreg = fhPtr; AM_adjreg = uc; //set regs for occurs check
+ HOPU_copyFlagGlb = FALSE;
+ bndBody = HOPU_rigNestedSubst(fargs, fnargs, rhPtr, rPtr,
+ rargs, rnargs, emblev);
+ nabs = emblev + fnargs; //# abs in the front of the binding
+ TR_trailTerm(fhPtr); AM_bndFlag = ON;
+ if (nabs == 0) DF_mkRef((MemPtr)fhPtr, bndBody);
+ else {
+ AM_embedError(nabs);
+ DF_mkLam((MemPtr)fhPtr, nabs, bndBody);
+ }
+ } else { //non-Llambda pattern
+ if (emblev == 0) AM_addDisPair(fPtr, rPtr);
+ else {
+ MemPtr nhtop = AM_hreg + DF_TM_LAM_SIZE;
+ DF_TermPtr tmPtr = (DF_TermPtr)AM_hreg;
+ AM_heapError(AM_hreg);
+ DF_mkLam(AM_hreg, emblev, rPtr);
+ AM_hreg = nhtop;
+ AM_addDisPair(fPtr, tmPtr);
+ } // (emblev != 0)
+ } //non-LLambda pattern
+}
+
+/* The counter part of HOPU_rigMkSubst invoked by HOPU_patternUnifyPair. */
+/* Care is taken to avoid making a reference to a register/stack address in */
+/* binding and creating disagreement pair. */
+/* It is assumed that the pair of terms are not embedded in any abstractions*/
+/* ie. (F a1 ... an) = (r b1 ... bm) */
+/* Note both fPtr and rPtr are not dereferenced. */
+static void HOPU_rigMkSubstGlb(DF_TermPtr fPtr, DF_TermPtr fhPtr, int fnargs,
+ DF_TermPtr fargs,
+ DF_TermPtr rPtr, DF_TermPtr rhPtr, int rnargs,
+ DF_TermPtr rargs)
+{
+ int uc = DF_fvUnivCount(fhPtr);
+ if (HOPU_isLLambda(uc, fnargs, fargs)) { //LLambda pattern
+ DF_TermPtr bndBody;
+ AM_vbbreg = fhPtr; AM_adjreg = uc;
+ HOPU_copyFlagGlb = FALSE;
+ bndBody = HOPU_rigNestedSubst(fargs, fnargs, rhPtr, DF_termDeref(rPtr),
+ rargs, rnargs, 0);
+ TR_trailTerm(fhPtr); AM_bndFlag = ON;
+ if (HOPU_copyFlagGlb) {//bndBody must locate on the heap
+ if (fnargs == 0) DF_mkRef((MemPtr)fhPtr, bndBody);
+ else {
+ AM_embedError(fnargs);
+ DF_mkLam((MemPtr)fhPtr, fnargs, bndBody);
+ }
+ } else { //HOPU_copyFlagGlb == FALSE
+ /* //note: rPtr is the undereferenced rigid term; in this case,
+ // it is assumed rPtr cannot be a reference to the stack.
+ // This assumption should be ensured by the fact that atomic
+ // rigid terms on stack are alway copied into registers in
+ // binding.
+ if (fnargs == 0) DF_copyAtomic(rPtr, (MemPtr)fhPtr); */
+ if (fnargs == 0) HOPU_globalizeCopyRigid(bndBody, fhPtr);
+ else {
+ bndBody = HOPU_globalizeRigid(bndBody);
+ AM_embedError(fnargs);
+ DF_mkLam((MemPtr)fhPtr, fnargs, bndBody);
+ }
+ } //HOPU_copyFlagGlb == FALSE
+ } else //non_LLambda flex (must locate on the heap)
+ AM_addDisPair(DF_termDeref(fPtr),
+ HOPU_globalizeRigid(DF_termDeref(rPtr)));
+}
+
+/***************************************************************************/
+/* TERM SIMPLIFICATION (RIGID-RIGID) */
+/* */
+/* Auxiliary functions for solving rigid-rigid pairs. */
+/***************************************************************************/
+
+/* Matching heads of two rigid terms. Eta-expansion is considered when */
+/* necessary. It is assumed that the heads have been dereferenced. */
+static void HOPU_matchHeads(DF_TermPtr hPtr1, DF_TermPtr hPtr2, int nabs)
+{
+ switch(DF_termTag(hPtr1)){
+ case DF_TM_TAG_CONST:{
+ if (!(DF_isConst(hPtr2) && (DF_sameConsts(hPtr1, hPtr2))))
+ EM_THROW(EM_FAIL);
+ if (DF_isTConst(hPtr1)){ //(first-order) unify type environments
+ HOPU_typesUnify(DF_constType(hPtr1), DF_constType(hPtr2),
+ AM_cstTyEnvSize(DF_constTabIndex(hPtr1)));
+ }
+ break;
+ }
+ case DF_TM_TAG_BVAR: {
+ if (!DF_isBV(hPtr2)) EM_THROW(EM_FAIL);
+ else {
+ int ind = DF_bvIndex(hPtr2) + nabs; //lifting for eta-expansion
+ AM_embedError(ind);
+ if (DF_bvIndex(hPtr1) != ind) EM_THROW(EM_FAIL);
+ }
+ break;
+ }
+ case DF_TM_TAG_NIL: { if (!DF_isNil(hPtr2)) EM_THROW(EM_FAIL); break;}
+ case DF_TM_TAG_INT: {
+ if (!(DF_isInt(hPtr2) && (DF_intValue(hPtr2) == DF_intValue(hPtr1))))
+ EM_THROW(EM_FAIL);
+ break;
+ }
+ case DF_TM_TAG_FLOAT:{
+ if (!(DF_isFloat(hPtr2)&&(DF_floatValue(hPtr2)==DF_floatValue(hPtr1))))
+ EM_THROW(EM_FAIL);
+ break;
+ }
+ case DF_TM_TAG_STR: {
+ if (!(DF_isStr(hPtr2) && (DF_sameStrs(hPtr1, hPtr2))))
+ EM_THROW(EM_FAIL);
+ break;
+ }
+ case DF_TM_TAG_CONS: {
+ if (!(DF_isCons(hPtr2))) EM_THROW(EM_FAIL);
+ break;
+ }
+ } //switch
+}
+
+/* Set up PDL by sub problems resulted from rigid-rigid pairs upon */
+/* successful matching of their heads. Eta-expansion is performed on-a-fly */
+/* when necessary. */
+void HOPU_setPDL(MemPtr args1, MemPtr args2, int nargs, int nabs)
+{
+ if (nabs == 0){ //no need for eta-expansion
+ AM_pdlError(nargs * 2);
+ for (; nargs > 0; nargs --){
+ AM_pushPDL(args1); args1 += DF_TM_ATOMIC_SIZE;
+ AM_pushPDL(args2); args2 += DF_TM_ATOMIC_SIZE;
+ }
+ } else { //nabs > 0 (eta-expansion)
+ AM_pdlError((nargs + nabs) * 2);
+ AM_heapError(AM_hreg + nargs*DF_TM_SUSP_SIZE + nabs*DF_TM_ATOMIC_SIZE);
+ for (; nargs > 0; nargs --){ //[|ai, 0, nabs, nil|]
+ AM_pushPDL(args1); AM_pushPDL(AM_hreg);
+ DF_mkSusp(AM_hreg, 0, nabs, DF_termDeref((DF_TermPtr)args2),
+ DF_EMPTY_ENV);
+ AM_hreg += DF_TM_SUSP_SIZE;
+ args1 += DF_TM_ATOMIC_SIZE; args2 += DF_TM_ATOMIC_SIZE;
+ }
+ for (; nabs > 0; nabs --){ // bv(i)
+ AM_pushPDL(args1); AM_pushPDL(AM_hreg);
+ DF_mkBV(AM_hreg, nabs);
+ args1 += DF_TM_ATOMIC_SIZE; AM_hreg += DF_TM_ATOMIC_SIZE;
+ }
+ }
+}
+
+/***************************************************************************/
+/* HIGHER_ORDER PATTERN UNIFICATION */
+/* */
+/* The main routines of this file. */
+/***************************************************************************/
+/* Perform higher-order pattern unification over the pairs delayed on the */
+/* PDL stack. The PDL stack is empty upon successful termination of this */
+/* procedure. */
+void HOPU_patternUnifyPDL()
+{
+ DF_TermPtr tPtr1, tPtr2, //pointers to terms to be unified
+ hPtr, //pointer to head of hnf
+ args; //arg vec of hnf
+ Flag rig, cons; //rigid flag and cons flags
+ int nabs, nargs; //binder length and # of arguments of hnf
+ while (AM_nemptyPDL()){
+ //retrieve the pair of terms on the current top of PDL
+ tPtr1 = (DF_TermPtr)AM_popPDL(); tPtr2 = (DF_TermPtr)AM_popPDL();
+ HN_hnorm(tPtr1); //hnorm tPtr1
+ hPtr = AM_head; args = AM_argVec; nabs = AM_numAbs; nargs = AM_numArgs;
+ rig = AM_rigFlag; //bookkeeping relevant info of hnf of tPtr1
+ HN_hnorm(tPtr2); //hnorm tPtr2
+ if (rig){
+ if (AM_rigFlag){// rigid - rigid
+ if (nabs > AM_numAbs) {
+ nabs = nabs - AM_numAbs; //reuse nabs
+ HOPU_matchHeads(hPtr, AM_head, nabs);
+ HOPU_setPDL((MemPtr)args,(MemPtr)AM_argVec,AM_numArgs,nabs);
+ } else { //nabs <= AM_numAbs
+ nabs = AM_numAbs - nabs; //reuse nabs
+ HOPU_matchHeads(AM_head, hPtr, nabs);
+ HOPU_setPDL((MemPtr)AM_argVec, (MemPtr)args, nargs, nabs);
+ }
+ } else { // rigid - flex
+ DF_TermPtr rigBody = HOPU_lamBody(tPtr1);
+ DF_TermPtr flexBody = HOPU_lamBody(tPtr2);
+ if (nabs < AM_numAbs) { //eta expand rigid term first
+ nabs = AM_numAbs - nabs; //reuse nabs
+ rigBody = HOPU_etaExpand(&hPtr, &args, nargs, nabs);
+ HOPU_rigMkSubst(flexBody, AM_head, AM_numArgs, AM_argVec,
+ rigBody, hPtr, (nargs+nabs), args, 0);
+ } else HOPU_rigMkSubst(flexBody,AM_head, AM_numArgs, AM_argVec,
+ rigBody,hPtr,nargs,args,nabs-AM_numAbs);
+ } // rigid-flex
+ } else { //(rig == FALSE)
+ DF_TermPtr absBody1 = HOPU_lamBody(tPtr1);
+ DF_TermPtr absBody2 = HOPU_lamBody(tPtr2);
+ if (AM_rigFlag){// flex - rigid
+ if (AM_numAbs < nabs) { //eta expand rigid term first
+ nabs = nabs - AM_numAbs; //reuse nabs
+ absBody2 = HOPU_etaExpand(&AM_head, &AM_argVec, AM_numArgs,
+ nabs);
+ HOPU_rigMkSubst(absBody1, hPtr, nargs, args, absBody2,
+ AM_head, AM_numArgs+nabs, AM_argVec, 0);
+ }else HOPU_rigMkSubst(absBody1,hPtr,nargs,args,absBody2,AM_head,
+ AM_numArgs,AM_argVec,AM_numAbs-nabs);
+ } else { // flex - flex
+ if (AM_numAbs > nabs)
+ HOPU_flexMkSubst(absBody1, hPtr, nargs, args, absBody2,
+ AM_head, AM_numArgs, AM_argVec,
+ AM_numAbs-nabs);
+ else HOPU_flexMkSubst(absBody2, AM_head, AM_numArgs, AM_argVec,
+ absBody1,hPtr,nargs,args,nabs-AM_numAbs);
+ } // flex - flex
+ } //(rig == FALSE)
+ } // while (AM_nemptyPDL())
+}
+
+/* Interpretively pattern unify first the pairs delayed on the PDL, then */
+/* those delayed on the live list, if binding occured during the first step */
+/* or previous compiled unification process. */
+/* Upon successful termination, PDL should be empty and pairs left on the */
+/* live list should be those other than LLambda. */
+void HOPU_patternUnify()
+{
+ HOPU_patternUnifyPDL(); //first solve those left from compiled unification
+ while (AM_bndFlag && AM_nempLiveList()){
+ DF_DisPairPtr dset = AM_llreg;
+ do { //move everything in live list to PDL
+ AM_pdlError(2);
+ AM_pushPDL((MemPtr)DF_disPairSecondTerm(dset));
+ AM_pushPDL((MemPtr)DF_disPairFirstTerm(dset));
+ dset = DF_disPairNext(dset);
+ } while (DF_isNEmpDisSet(dset));
+ AM_bndFlag = OFF;
+ AM_llreg = DF_EMPTY_DIS_SET;
+ HOPU_patternUnifyPDL(); //unsolvable pairs are added to live list
+ }
+}
+
+/* Interpretively pattern unify a pair of terms given as parameters. This is*/
+/* the counter part of HOPU_patterUnifyPDL that is invoked from the compiled*/
+/* part of unification. In this situation, the procedure has to be applied */
+/* to two terms as opposed to pairs delayed on the PDL stack. */
+/* */
+/* The input term pointers may dereference to register and stack addresses */
+/* Care must be taken to avoid making a reference to a register (stack) */
+/* address in binding a variable, and in making a disagreement pair. */
+
+void HOPU_patternUnifyPair(DF_TermPtr tPtr1, DF_TermPtr tPtr2)
+{
+ DF_TermPtr h1Ptr, h2Ptr, args1, args2;
+ Flag rig1, rig2, cons1, cons2;
+ int nabs1, nabs2, nargs1, nargs2;
+ MemPtr oldPdlBot = AM_pdlBot;
+
+ AM_pdlBot = AM_pdlTop;
+ HN_hnorm(tPtr1); h1Ptr = AM_head; args1 = AM_argVec;
+ nabs1 = AM_numAbs; nargs1 = AM_numArgs; rig1 = AM_rigFlag;
+ HN_hnorm(tPtr2); h2Ptr = AM_head; args2 = AM_argVec;
+ nabs2 = AM_numAbs; nargs2 = AM_numArgs; rig2 = AM_rigFlag;
+
+
+ if (rig1) {
+ if (rig2) { //rigid-rigid
+ if (nabs1 > nabs2) {
+ nabs1 = nabs1 - nabs2;
+ HOPU_matchHeads(h1Ptr, h2Ptr, nabs1);
+ HOPU_setPDL((MemPtr)args1, (MemPtr)args2, nargs2, nabs1);
+ } else {//nabs1 <= nabs2
+ nabs1 = nabs2 - nabs1;
+ HOPU_matchHeads(h2Ptr, h1Ptr, nabs1);
+ HOPU_setPDL((MemPtr)args2, (MemPtr)args1, nargs1, nabs1);
+ }
+ } else { //rigid-flex
+ if ((nabs1 == 0) && (nabs2 == 0))
+ HOPU_rigMkSubstGlb(tPtr2, h2Ptr, nargs2, args2,
+ tPtr1, h1Ptr, nargs1, args1);
+ else {
+ DF_TermPtr rigBody = HOPU_lamBody(tPtr1);
+ DF_TermPtr flexBody = HOPU_lamBody(tPtr2);
+ if (nabs1 < nabs2) {
+ nabs1 = nabs2 - nabs1;
+ rigBody = HOPU_etaExpand(&h1Ptr, &args1, nargs1, nabs1);
+ //now rigBody must locate on heap
+ HOPU_rigMkSubst(flexBody, h2Ptr, nargs2, args2, rigBody,
+ h1Ptr, nargs1+nabs1, args1, 0);
+ } else // (nabs1 >= nabs2)
+ HOPU_rigMkSubst(flexBody, h2Ptr, nargs2, args2, rigBody,
+ h1Ptr, nargs1, args1, nabs1-nabs2);
+ } // !(nabs1 == nabs2 == 0)
+ } //rigid-flex
+ } else { // rig1 = FALSE
+ if (rig2) { //flex-rigid
+ if ((nabs2 == 0) && (nabs1 == 0))
+ HOPU_rigMkSubstGlb(tPtr1, h1Ptr, nargs1, args1,
+ tPtr2, h2Ptr, nargs2, args2);
+ else { //!(nabs1 == nabs2 == 0)
+ DF_TermPtr rigBody = HOPU_lamBody(tPtr2);
+ DF_TermPtr flexBody = HOPU_lamBody(tPtr1);
+ if (nabs2 < nabs1) {
+ nabs1 = nabs2 - nabs1;
+ rigBody = HOPU_etaExpand(&h2Ptr, &args2, nargs2, nabs1);
+ //now rigBody must locate on heap
+ HOPU_rigMkSubst(flexBody, h1Ptr, nargs1, args1, rigBody,
+ h2Ptr, nargs2+nabs1, args2, 0);
+ } else //(nabs2 >= nabs1)
+ HOPU_rigMkSubst(flexBody, h1Ptr, nargs1, args1, rigBody,
+ h2Ptr, nargs2, args2, nabs2-nabs1);
+ } //!(nabs1 == nabs2 == 0)
+ } else { //flex-flex
+ if (nabs1 == 0) //nabs2 >= nabs1
+ HOPU_flexMkSubstGlb(DF_termDeref(tPtr1), h1Ptr, nargs1, args1,
+ HOPU_lamBody(tPtr2), h2Ptr, nargs2, args2,
+ tPtr2, nabs2);
+ else { //(nabs1 > 0)
+ if (nabs2 == 0) //nabs2 < nabs1
+ HOPU_flexMkSubstGlb(DF_termDeref(tPtr2),h2Ptr,nargs2,args2,
+ HOPU_lamBody(tPtr1),h1Ptr,nargs1,args1,
+ tPtr1,nabs1);
+
+ else { //nabs1 != 0 && nabs2 != 0
+ DF_TermPtr flexBody1 = HOPU_lamBody(tPtr1);
+ DF_TermPtr flexBody2 = HOPU_lamBody(tPtr2);
+ if (nabs2 > nabs1)
+ HOPU_flexMkSubst(flexBody1, h1Ptr, nargs1, args1,
+ flexBody2, h2Ptr, nargs2, args2,
+ nabs2-nabs1);
+ else //nabs2 <= nabs1
+ HOPU_flexMkSubst(flexBody2, h2Ptr, nargs2, args2,
+ flexBody1, h1Ptr, nargs1, args1,
+ nabs1-nabs2);
+ } //nabs1 != 0 && nabs2 != 0
+ } //(nabs1 > 0)
+ } //flex-flex
+ } //rig1 = FALSE
+ //solve the pairs (which must locate on heap) remaining on the PDL
+ HOPU_patternUnifyPDL();
+ AM_pdlBot = oldPdlBot;
+}
+
+#endif //HOPU_C
diff --git a/src/runtime/c/teyjus/simulator/hopu.h b/src/runtime/c/teyjus/simulator/hopu.h
new file mode 100644
index 000000000..1ea26b00c
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/hopu.h
@@ -0,0 +1,85 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************/
+/* File hopu.h. This header file defines the interface components for the */
+/* code in hopu.c that implements higher-order pattern unification. */
+/* */
+/****************************************************************************/
+#ifndef HOPU_H
+#define HOPU_H
+
+#include "mctypes.h"
+#include "dataformats.h"
+
+/* A flag denoting whether new structure is created during the process of */
+/* finding substitutions. */
+extern Boolean HOPU_copyFlagGlb;
+
+/* Return the dereference of the abstraction body of the given term. */
+DF_TermPtr HOPU_lamBody(DF_TermPtr tPtr);
+
+/* Globalize a rigid term and make a variable binding. */
+/* If the term pointer to the rigid term is not one referring to a heap */
+/* address, its atomic content is then copied into the variable to be bound*/
+/* Otherwise, the variable is made a reference to the rigid term. */
+void HOPU_globalizeCopyRigid(DF_TermPtr rPtr, DF_TermPtr vPtr);
+
+
+/* Globalize a flex term. */
+/* If the term pointer is one referring to a stack address, (in which case */
+/* the flex term must be a free variable itself), the atomic content is */
+/* copied onto the current top of heap; the free variable on stack is then */
+/* bound to the new heap term, and the binding is trailed if necessary; the */
+/* term pointer is updated to the new heap term. */
+DF_TermPtr HOPU_globalizeFlex(DF_TermPtr fPtr);
+
+/* Try to find the (partial) structure of the substitution for a flex head */
+/* of a LLambda term corresponding to an internal flex term which is not */
+/* known to be LLambda in the compiled form of pattern unification. */
+DF_TermPtr HOPU_flexNestedSubstC(DF_TermPtr fhPtr, DF_TermPtr args, int nargs,
+ DF_TermPtr tmPtr, int emblev);
+
+/* Try to find the (partial) binding of the head of a flex term when */
+/* unifying it with a rigid term possible under abstractions in the compiled*/
+/* form of pattern unification. */
+DF_TermPtr HOPU_rigNestedSubstC(DF_TermPtr rhPtr, DF_TermPtr rPtr,
+ DF_TermPtr args, int rnargs, int emblev);
+
+
+/* Interpretively pattern unify first the pairs delayed on the PDL, then */
+/* those delayed on the live list, if binding occured during the first step */
+/* or previous compiled unification process. */
+/* Upon successful termination, PDL should be empty and pairs left on the */
+/* live list should be those other than LLambda. */
+void HOPU_patternUnify();
+
+/* Interpretively pattern unify a pair of terms given as parameters. This is*/
+/* the counter part of HOPU_patterUnifyPDL that is invoked from the compiled*/
+/* part of unification. In this situation, the procedure has to be applied */
+/* to two terms as opposed to pairs delayed on the PDL stack. */
+/* */
+/* The input term pointers may dereference to register and stack addresses */
+/* Care must be taken to avoid making a reference to a register (stack) */
+/* address in binding a variable, and in making a disagreement pair. */
+void HOPU_patternUnifyPair(DF_TermPtr tPtr1, DF_TermPtr tPtr2);
+
+
+#endif //HOPU_H
+
diff --git a/src/runtime/c/teyjus/simulator/instraccess.h b/src/runtime/c/teyjus/simulator/instraccess.h
new file mode 100644
index 000000000..21d19f81e
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/instraccess.h
@@ -0,0 +1,300 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/*************************************************************************/
+/* */
+/* File instraccess.h. Micros for access instruction arguments are */
+/* defined, which depends on the instruction format. */
+/*************************************************************************/
+
+#ifndef INSTRACCESS_H
+#define INSTRACCESS_H
+
+#include "../tables/instructions.h" //to be modified
+
+#define INSACC_CALL_I1(op) (*((INSTR_OneByteInt *)((op) - INSTR_CALL_I1_LEN)))
+
+//INSTR_CAT_X
+#define INSACC_X() { AM_preg += INSTR_X_LEN; }
+
+//INSTR_CAT_RX
+#define INSACC_RX(op) {\
+ (op) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RX_R))); \
+ AM_preg += INSTR_RX_LEN; \
+}
+
+//INSTR_CAT_EX
+#define INSACC_EX(op) {\
+ (op) = AM_envVar(*((INSTR_EnvInd *)(AM_preg + INSTR_EX_E))); \
+ AM_preg += INSTR_EX_LEN; \
+}
+
+//INSTR_CAT_I1X
+#define INSACC_I1X(op) {\
+ (op) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1X_I1)); \
+ AM_preg += INSTR_I1X_LEN; \
+}
+
+//INSTR_CAT_CX
+#define INSACC_CX(op) {\
+ (op) = *((INSTR_CstIndex *)(AM_preg + INSTR_CX_C)); \
+ AM_preg += INSTR_CX_LEN; \
+}
+
+//INSTR_CAT_KX
+#define INSACC_KX(op) {\
+ (op) = *((INSTR_KstIndex *)(AM_preg + INSTR_KX_K)); \
+ AM_preg += INSTR_KX_LEN; \
+}
+
+//INSTR_CAT_IX
+#define INSACC_IX(op) {\
+ (op) = *((INSTR_Int *)(AM_preg + INSTR_IX_I)); \
+ AM_preg += INSTR_IX_LEN; \
+}
+
+//INSTR_CAT_FX
+#define INSACC_FX(op) {\
+ (op) = *((INSTR_Float *)(AM_preg + INSTR_FX_F)); \
+ AM_preg += INSTR_FX_LEN; \
+}
+
+//INSTR_CAT_SX
+#define INSACC_SX(op) {\
+ (op) = *((INSTR_Str *)(AM_preg + INSTR_SX_S)); \
+ AM_preg += INSTR_SX_LEN; \
+}
+
+//INSTR_CAT_MTX
+#define INSACC_MTX(op) {\
+ (op) = *((INSTR_ModTab *)(AM_preg + INSTR_MTX_MT)); \
+ AM_preg += INSTR_MTX_LEN; \
+}
+
+//INSTR_CAT_RRX
+#define INSACC_RRX(op1, op2) {\
+ (op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RRX_R1))); \
+ (op2) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RRX_R2))); \
+ AM_preg += INSTR_RRX_LEN; \
+}
+
+//INSTR_CAT_ERX
+#define INSACC_ERX(op1, op2) {\
+ (op1) = AM_envVar(*((INSTR_EnvInd *)(AM_preg + INSTR_ERX_E))); \
+ (op2) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_ERX_R))); \
+ AM_preg += INSTR_ERX_LEN; \
+}
+
+//INSTR_CAT_RCX
+#define INSACC_RCX(op1, op2) {\
+ (op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RCX_R))); \
+ (op2) = *((INSTR_CstIndex *)(AM_preg + INSTR_RCX_C)); \
+ AM_preg += INSTR_RCX_LEN; \
+}
+
+//INSTR_CAT_RIX
+#define INSACC_RIX(op1, op2) {\
+ (op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RIX_R))); \
+ (op2) = *((INSTR_Int *)(AM_preg + INSTR_RIX_I)); \
+ AM_preg += INSTR_RIX_LEN; \
+}
+
+//INSTR_CAT_RFX
+#define INSACC_RFX(op1, op2) {\
+ (op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RFX_R))); \
+ (op2) = *((INSTR_Float *)(AM_preg + INSTR_RFX_F)); \
+ AM_preg += INSTR_RFX_LEN; \
+}
+
+//INSTR_CAT_RSX
+#define INSACC_RSX(op1, op2) {\
+ (op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RSX_R))); \
+ (op2) = *((INSTR_Str *)(AM_preg + INSTR_RSX_S)); \
+ AM_preg += INSTR_RSX_LEN; \
+}
+
+//INSTR_CAT_RI1X
+#define INSACC_RI1X(op1, op2) {\
+ (op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RI1X_R))); \
+ (op2) = *((INSTR_OneByteInt *)(AM_preg + INSTR_RI1X_I1)); \
+ AM_preg += INSTR_RI1X_LEN; \
+}
+
+//INSTR_CAT_RCEX
+#define INSACC_RCEX(op1, op2) {\
+ (op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RCEX_R))); \
+ (op2) = AM_cenvVar(*((INSTR_ClEnvInd *)(AM_preg + INSTR_RCEX_CE))); \
+ AM_preg += INSTR_RCEX_LEN; \
+}
+
+//INSTR_CAT_ECEX
+#define INSACC_ECEX(op1, op2) {\
+ (op1) = AM_envVar(*((INSTR_EnvInd *)(AM_preg + INSTR_ECEX_E))); \
+ (op2) = AM_cenvVar(*((INSTR_ClEnvInd *)(AM_preg + INSTR_ECEX_CE))); \
+ AM_preg += INSTR_ECEX_LEN; \
+}
+
+//INSTR_CAT_CLX
+#define INSACC_CLX(op1, op2) {\
+ (op1) = *((INSTR_CstIndex *)(AM_preg + INSTR_CLX_C)); \
+ (op2) = *((INSTR_CodeLabel *)(AM_preg + INSTR_CLX_L)); \
+ AM_preg += INSTR_CLX_LEN; \
+}
+
+//INSTR_CAT_RKX
+#define INSACC_RKX(op1, op2) {\
+ (op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RKX_R))); \
+ (op2) = *((INSTR_KstIndex *)(AM_preg + INSTR_RKX_K)); \
+ AM_preg += INSTR_RKX_LEN; \
+}
+
+//INSTR_CAT_ECX
+#define INSACC_ECX(op1, op2) {\
+ (op1) = AM_envVar(*((INSTR_EnvInd *)(AM_preg + INSTR_ECX_E))); \
+ (op2) = *((INSTR_CstIndex *)(AM_preg + INSTR_ECX_C)); \
+ AM_preg += INSTR_ECX_LEN; \
+}
+
+//INSTR_CAT_I1ITX
+#define INSACC_I1ITX(op1, op2) {\
+ (op1) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1ITX_I1)); \
+ (op2) = *((INSTR_ImplTab *)(AM_preg + INSTR_I1ITX_IT)); \
+ AM_preg += INSTR_I1ITX_LEN; \
+}
+
+//INSTR_CAT_I1LX
+#define INSACC_I1LX(op1, op2) {\
+ (op1) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1LX_I1)); \
+ (op2) = *((INSTR_CodeLabel *)(AM_preg + INSTR_I1LX_L)); \
+ AM_preg += INSTR_I1LX_LEN; \
+}
+
+//INSTR_CAT_SEGLX
+#define INSACC_SEGLX(op1, op2) {\
+ (op1) = *((INSTR_ImpSegInd *)(AM_preg + INSTR_SEGLX_SEG)); \
+ (op2) = *((INSTR_CodeLabel *)(AM_preg + INSTR_SEGLX_L)); \
+ AM_preg += INSTR_SEGLX_LEN; \
+}
+
+
+//INSTR_CAT_I1NX
+#define INSACC_I1NX(op1, op2) {\
+ (op1) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1NX_I1)); \
+ (op2) = *((INSTR_NextClauseInd *)(AM_preg + INSTR_I1NX_N)); \
+ AM_preg += INSTR_I1NX_LEN; \
+}
+
+//INSTR_CAT_I1HTX
+#define INSACC_I1HTX(op1, op2) {\
+ (op1) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1HTX_I1)); \
+ (op2) = *((INSTR_HashTab *)(AM_preg + INSTR_I1HTX_HT)); \
+ AM_preg += INSTR_I1HTX_LEN; \
+}
+
+//INSTR_CAT_I1BVTX
+#define INSACC_I1BVTX(op1, op2) {\
+ (op1) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1BVTX_I1)); \
+ (op2) = *((INSTR_BranchTab *)(AM_preg + INSTR_I1BVTX_BVT)); \
+ AM_preg += INSTR_I1BVTX_LEN; \
+}
+
+//INSTR_CAT_CWPX
+#define INSACC_CWPX(op) {\
+ (op) = *((INSTR_CstIndex *)(AM_preg + INSTR_CWPX_C)); \
+ AM_preg += INSTR_CWPX_LEN; \
+}
+
+//INSTR_CAT_I1WPX
+#define INSACC_I1WPX(op) {\
+ (op) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1WPX_I1)); \
+ AM_preg += INSTR_I1WPX_LEN; \
+}
+
+//INSTR_CAT_RRI1X
+#define INSACC_RRI1X(op1, op2, op3) {\
+ (op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RRI1X_R1))); \
+ (op2) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RRI1X_R2))); \
+ (op3) = *((INSTR_OneByteInt *)(AM_preg + INSTR_RRI1X_I1)); \
+ AM_preg += INSTR_RRI1X_LEN; \
+}
+
+//INSTR_CAT_RCLX
+#define INSACC_RCLX(op1, op2, op3) {\
+ (op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RCLX_R))); \
+ (op2) = *((INSTR_CstIndex *)(AM_preg + INSTR_RCLX_C)); \
+ (op3) = *((INSTR_CodeLabel *)(AM_preg + INSTR_RCLX_L)); \
+ AM_preg += INSTR_RCLX_LEN; \
+}
+
+//INSTR_CAT_RCI1X
+#define INSACC_RCI1X(op1, op2, op3) {\
+ (op1) = AM_reg(*((INSTR_RegInd *)(AM_preg + INSTR_RCI1X_R))); \
+ (op2) = *((INSTR_CstIndex *)(AM_preg + INSTR_RCI1X_C)); \
+ (op3) = *((INSTR_OneByteInt *)(AM_preg + INSTR_RCI1X_I1)); \
+ AM_preg += INSTR_RCI1X_LEN; \
+}
+
+//INSTR_CAT_SEGI1LX
+#define INSACC_SEGI1LX(op1, op2, op3) {\
+ (op1) = *((INSTR_ImpSegInd *)(AM_preg + INSTR_SEGI1LX_SEG)); \
+ (op2) = *((INSTR_OneByteInt *)(AM_preg + INSTR_SEGI1LX_I1)); \
+ (op3) = *((INSTR_CodeLabel *)(AM_preg + INSTR_SEGI1LX_L)); \
+ AM_preg += INSTR_SEGI1LX_LEN; \
+}
+
+
+
+//specialized
+//INSTR_CAT_LX
+#define INSACC_LX() {AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_LX_L));}
+
+//INSTR_CAT_I1LX
+#define INSACC_I1LX_I1(op) {\
+ (op) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1LX_I1)); \
+}
+
+//INSTR_CAT_I1LWPX
+#define INSACC_I1LWPX_I1(op) {\
+ (op) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1LWPX_I1)); \
+}
+
+//INSACC_CAT_I1LLX
+#define INSACC_I1LLX(op1, op2) {\
+ (op1) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1LLX_I1)); \
+ (op2) = *((INSTR_CodeLabel *)(AM_preg + INSTR_I1LLX_L1)); \
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_I1LLX_L2)); \
+}
+
+//INSACC_CAT_NLLX
+#define INSACC_NLLX_N(op) {\
+ (op) = *((INSTR_NextClauseInd *)(AM_preg + INSTR_NLLX_N)); \
+}
+
+//INSTR_CAT_I1CWPX
+#define INSACC_I1CWPX_C(op) {\
+ (op) = *((INSTR_CstIndex *)(AM_preg + INSTR_I1CWPX_C)); \
+}
+
+
+//INSTR_CAT_I1I1WPX
+#define INSACC_I1I1WPX(op1) {\
+ (op1) = *((INSTR_OneByteInt *)(AM_preg + INSTR_I1I1WPX_I12)); \
+ AM_preg += INSTR_I1I1WPX_LEN; \
+}
+#endif //INSTRACCESS_H
diff --git a/src/runtime/c/teyjus/simulator/io-datastructures.c b/src/runtime/c/teyjus/simulator/io-datastructures.c
new file mode 100644
index 000000000..1647ee5b1
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/io-datastructures.c
@@ -0,0 +1,53 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************
+ * *
+ * File io-datastructures.c. *
+ * *
+ ****************************************************************************/
+#include "io-datastructures.h"
+
+/* The io free term variable table */
+IO_FreeVarInfo IO_freeVarTab[IO_MAX_FREE_VARS];
+
+/* index for the topmost cell that has been used */
+int IO_freeVarTabTop;
+
+/* initialize */
+void IO_initIO()
+{
+ IO_freeVarTabTop = 0;
+}
+
+/* check if the free term variable table is full */
+Boolean IO_freeVarTabFull(int incSize)
+{
+ return (IO_freeVarTabTop+incSize >= IO_MAX_FREE_VARS);
+}
+
+/* make an entry in the free term variable table */
+void IO_enterFreeVarTab(DF_StrDataPtr name, DF_TermPtr varLoc)
+{
+ int i = IO_freeVarTabTop++;
+
+ IO_freeVarTab[i].varName = name;
+ IO_freeVarTab[i].rigdes = varLoc;
+}
+
diff --git a/src/runtime/c/teyjus/simulator/io-datastructures.h b/src/runtime/c/teyjus/simulator/io-datastructures.h
new file mode 100644
index 000000000..217a0f04e
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/io-datastructures.h
@@ -0,0 +1,66 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+/****************************************************************************
+ * *
+ * File io-datastructures.h. *
+ * *
+ ****************************************************************************/
+
+#ifndef IODATASTRUCTURES_H
+#define IODATASTRUCTURES_H
+
+#include "mcstring.h"
+#include "dataformats.h"
+#include "mctypes.h"
+
+/*****************************************************************************
+ * A data structure for maintaining information about query term variables *
+ * and other free variables encountered in the course of displaying answers. *
+ *****************************************************************************/
+/* number of entries in the table for such variables. */
+#define IO_MAX_FREE_VARS 500
+
+/* Structure of each entry in the table; display name, and the rigid
+ designator in the form of the memory cell corresponding to the variable are
+ maintained. */
+typedef struct
+{
+ DF_StrDataPtr varName;
+ DF_TermPtr rigdes;
+} IO_FreeVarInfo;
+
+/* The table itself */
+extern IO_FreeVarInfo IO_freeVarTab[IO_MAX_FREE_VARS];
+
+/* index for the topmost cell that has been used */
+extern int IO_freeVarTabTop;
+
+/* initialize */
+void IO_initIO();
+
+/* check if the free term variable table is full */
+Boolean IO_freeVarTabFull(int incSize);
+
+/* make an entry in the free term variable table */
+void IO_enterFreeVarTab(DF_StrDataPtr name, DF_TermPtr varLoc);
+
+
+#endif //IODATASTRUCTURES_H
diff --git a/src/runtime/c/teyjus/simulator/mcstring.c b/src/runtime/c/teyjus/simulator/mcstring.c
new file mode 100644
index 000000000..aed27b5e2
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/mcstring.c
@@ -0,0 +1,116 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************/
+/* */
+/* File mcstring.c. */
+/****************************************************************************/
+#include
+#include
+#include
+#include "mcstring.h"
+#include "mctypes.h"
+
+//length of a given string; the string pointer is assumed to not be NULL
+int MCSTR_strLength(MCSTR_Str str)
+{
+ return *((int *)str);
+}
+
+//number of words needed for a string with n characters
+int MCSTR_numWords(int n)
+{
+ return ((int)ceil(((double)(n+1))/WORD_SIZE)) + 1; //with '\0' terminator
+}
+
+//from machine string to c string
+char* MCSTR_toCString(MCSTR_Str str)
+{
+ return (char*)(str + 1);
+}
+
+//to string
+void MCSTR_toString(MCSTR_Str loc, char* buf, int length)
+{
+ char* chloc = (char*)(loc + 1);
+ *((int *)loc) = length;
+ strcpy(chloc, buf);
+}
+
+//compare whether two string literals are the same
+Boolean MCSTR_sameStrs(MCSTR_Str str1, MCSTR_Str str2)
+{
+ if (strcmp((char*)(str1+1), (char*)(str2+1)) == 0) return TRUE;
+ else return FALSE;
+}
+
+/* compare strings: return < 0 if str1 < str2
+ return == 0 if str1 == str2
+ return > 0 if str1 > str2
+*/
+int MCSTR_compareStrs(MCSTR_Str str1, MCSTR_Str str2)
+{
+ return strcmp((char*)(str1+1), (char*)(str2+1));
+}
+
+//string concatenate (the new string is created at address started from loc)
+void MCSTR_concat(MCSTR_Str loc, MCSTR_Str str1, MCSTR_Str str2)
+{
+ char* chloc = (char*)(loc + 1);
+ *((int *)loc) = MCSTR_strLength(str1) + MCSTR_strLength(str2);
+ strcpy(chloc, (char*)(str1+1));
+ strcat(chloc, (char*)(str2+1));
+}
+
+//substring (the new string is created at address started from loc)
+void MCSTR_subString(MCSTR_Str loc, MCSTR_Str str, int startPos, int length)
+{
+ int i;
+ char* fromPtr = ((char*)(str + 1))+startPos;
+ char* toPtr = (char*)(loc + 1);
+
+ *((int *)loc) = (length + 1);
+ while (length > 0) {
+ *toPtr++ = *fromPtr++;
+ length--;
+ }
+ *toPtr = '\0';
+}
+
+//chr
+void MCSTR_chr(MCSTR_Str loc, int integer)
+{
+ char* chloc = (char*)(loc + 1);
+ *((int *)loc) = 1;
+ *chloc++ = (char)integer;
+ *chloc = '\0';
+}
+
+//ord
+int MCSTR_ord(MCSTR_Str str)
+{
+ return (int)(*((char*)(str + 1)));
+}
+
+//display on standard IO
+void MCSTR_printStr(MCSTR_Str str)
+{
+ printf("%s", (char*)(str+1));
+}
+
diff --git a/src/runtime/c/teyjus/simulator/mcstring.h b/src/runtime/c/teyjus/simulator/mcstring.h
new file mode 100644
index 000000000..f1004c8e9
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/mcstring.h
@@ -0,0 +1,67 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+/****************************************************************************/
+/* */
+/* File mcstring.h. The virtual machine encoding of string literals is */
+/* contained in this module. Any change of such encoding format should be */
+/* isolated here. */
+/****************************************************************************/
+
+#ifndef MCSTRING_H
+#define MCSTRING_H
+
+#include "mctypes.h"
+
+/****************************************************************************/
+/* Currently the string is encoded as one word being the length of the */
+/* string followed by a list of characters in C string encoding (which is a */
+/* sequence of chars ended with '\0'. */
+/****************************************************************************/
+typedef char MCSTR_Char;
+typedef WordPtr MCSTR_Str;
+
+//length of a given string; the string pointer is assumed to not be NULL
+int MCSTR_strLength(MCSTR_Str str);
+//number of words needed for a string with n characters
+int MCSTR_numWords(int n);
+//from machine string to c string
+char* MCSTR_toCString(MCSTR_Str str);
+//to string
+void MCSTR_toString(MCSTR_Str loc, char* buf, int length);
+
+//compare whether two string literals are the same
+Boolean MCSTR_sameStrs(MCSTR_Str str1, MCSTR_Str str2);
+//compare strings
+int MCSTR_compareStrs(MCSTR_Str str1, MCSTR_Str str2);
+//string concatenate (the new string is created at address started from loc)
+void MCSTR_concat(MCSTR_Str loc, MCSTR_Str str1, MCSTR_Str str2);
+//substring (the new string is created at address started from loc)
+void MCSTR_subString(MCSTR_Str loc, MCSTR_Str str, int startPos, int length);
+//chr
+void MCSTR_chr(MCSTR_Str loc, int integer);
+//ord
+int MCSTR_ord(MCSTR_Str str);
+
+
+//display on standard IO
+void MCSTR_printStr(MCSTR_Str str);
+
+#endif //MCSTRING_H
diff --git a/src/runtime/c/teyjus/simulator/mctypes.h b/src/runtime/c/teyjus/simulator/mctypes.h
new file mode 100644
index 000000000..b964599bc
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/mctypes.h
@@ -0,0 +1,54 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+/****************************************************************************/
+/* */
+/* */
+/* File mctypes.h. */
+/* This file contains the definitions of the low-level */
+/* data types that are used in constructing the more complex objects that */
+/* are used in data representation and in instruction formats. This file */
+/* will likely be included by most others defining the overall system. */
+/* */
+/****************************************************************************/
+#ifndef MCTYPES_H
+#define MCTYPES_H
+
+typedef unsigned char Byte; /* 8 bits */
+typedef unsigned short TwoBytes; /* 16 bits */
+
+
+typedef unsigned char Boolean; /* 8 bits: FALSE/TRUE */
+#define TRUE 1
+#define FALSE 0
+
+
+typedef unsigned long Word;
+typedef Word *WordPtr;
+
+#define WORD_SIZE sizeof(Word) /* 4: 32-bits machine */
+ /* 8 64-bits machine */
+
+typedef Word Mem; /* generic memory type */
+typedef Mem *MemPtr; /* pointer to memory */
+typedef Byte *CSpacePtr; /* code space pointer */
+typedef Byte *BytePtr;
+
+#endif //MCTYPES_H
diff --git a/src/runtime/c/teyjus/simulator/printterm.c b/src/runtime/c/teyjus/simulator/printterm.c
new file mode 100644
index 000000000..2fbe03fd2
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/printterm.c
@@ -0,0 +1,814 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************
+ * *
+ * File printterm.c. This file contains routines for printing out lambda *
+ * terms. It is assumed that these routines will be needed in two *
+ * situations: printing out answers to queries and displaying terms as *
+ * needed by invocation of builtin goals. *
+ * The difference between these two situations is in the display of *
+ * free term variables. Only when displaying answers is an attempt made to *
+ * present these using sensible names: in this case, either the name in the *
+ * query is used or a concise name is cooked up. In the other situation, *
+ * the address of the variable cell is used as the name. *
+ * *
+ * Certain assumptions are relevant to avoiding name clashes. For local *
+ * constants, the assumption is that no constant names in user *
+ * programs begin with . The use of this idea is *
+ * buried inside the routine PRINT_writeHCName. *
+ * Violation of this condition is *not* checked. For term variables, the *
+ * assumption is that bound variables do not begin with _. *
+ * *
+ ****************************************************************************/
+#include
+#include
+#include "printterm.h"
+#include "mctypes.h"
+#include "mcstring.h"
+#include "hnorm.h"
+#include "dataformats.h"
+#include "abstmachine.h"
+#include "io-datastructures.h"
+#include "builtins/builtins.h"
+#include "../system/stream.h"
+#include "../system/error.h"
+#include "../system/operators.h"
+#include "../tables/pervasives.h"
+
+//temp
+#include
+
+/* This variable records the number of query variables */
+int PRINT_numQueryVars;
+
+/* flag determining whether or not to print sensible names for free vars */
+Boolean PRINT_names = FALSE;
+
+static void PRINT_writeTerm(WordPtr outStream, DF_TermPtr tmPtr,
+ OP_FixityType infx, int inprec, OP_TermContext tc);
+
+/****************************************************************************
+ * Auxiliary routines used in this file *
+ ****************************************************************************/
+static Boolean PRINT_parenNeeded(OP_FixityType opfx, int opprec,
+ OP_TermContext context, OP_FixityType fx,
+ int prec)
+{
+ Boolean pparen = FALSE;
+ if (context == OP_LEFT_TERM) {
+ switch (fx) {
+ case OP_INFIX: case OP_INFIXR: case OP_POSTFIX:
+ if (opprec <= prec) pparen = TRUE; break;
+ case OP_INFIXL: case OP_POSTFIXL:
+ {
+ switch (opfx) {
+ case OP_PREFIX: case OP_INFIX: case OP_INFIXL: case OP_POSTFIX:
+ case OP_POSTFIXL:
+ if (opprec < prec) pparen = TRUE; break;
+ default:
+ if (opprec <= prec) pparen = TRUE; break;
+ }
+ break;
+ }
+ }
+ } else if (context == OP_RIGHT_TERM) {
+ switch (fx) {
+ case OP_INFIX: case OP_INFIXL: case OP_PREFIX:
+ if (opprec <= prec) pparen = TRUE; break;
+ case OP_INFIXR: case OP_PREFIXR:
+ {
+ switch (opfx) {
+ case OP_INFIXL: case OP_POSTFIXL:
+ if (opprec <= prec) pparen = TRUE; break;
+ default:
+ if (opprec < prec) pparen = TRUE; break;
+ }
+ }
+ }
+ }
+ return pparen;
+}
+
+/* making a name from the address of an unbound term variable */
+static long PRINT_makeNumberName(DF_TermPtr tmPtr)
+{ return (long)tmPtr - (long)AM_heapBeg; }
+
+
+/****************************************************************************
+ * Routines for printing out keywords and punctuation symbols in the course *
+ * of displaying lambda terms. These have been extracted out of the other *
+ * routines so as to make stylistic changes at a later point easier to *
+ * effect. *
+ ****************************************************************************/
+static void PRINT_writeLParen(WordPtr outStream)
+{ STREAM_printf(outStream, "("); }
+
+static void PRINT_writeRParen(WordPtr outStream)
+{ STREAM_printf(outStream, ")"); }
+
+static void PRINT_writeConsSymbol(WordPtr outStream)
+{ STREAM_printf(outStream, " :: "); }
+
+static void PRINT_writeNilSymbol(WordPtr outStream)
+{ STREAM_printf(outStream, "nil"); }
+
+static void PRINT_writeInfixLam(WordPtr outStream)
+{ STREAM_printf(outStream, "\\ "); }
+
+static void PRINT_writeLam(WordPtr outStream, int numabs)
+{ STREAM_printf(outStream, "lam(%d, ", numabs); }
+
+static void PRINT_writeSpace(WordPtr outStream, int i)
+{ while (i--) STREAM_printf(outStream, " "); }
+
+static void PRINT_writeEquals(WordPtr outStream)
+{ STREAM_printf(outStream, " = "); }
+
+static void PRINT_writeComma(WordPtr outStream)
+{ STREAM_printf(outStream, ","); }
+
+static void PRINT_writeDPairStart(WordPtr outStream)
+{ STREAM_printf(outStream, "<"); }
+
+static void PRINT_writeDPairEnd(WordPtr outStream)
+{ STREAM_printf(outStream, ">"); }
+
+/***************************************************************************
+ * Writing out terms corresponding to the builtin constants. *
+ ***************************************************************************/
+/* Writing out an integer term to a given output stream */
+static void PRINT_writeInt(WordPtr outStream, DF_TermPtr tmPtr)
+{ STREAM_printf(outStream, "%d", DF_intValue(tmPtr)); }
+
+/* Writing out a float term to a given output stream */
+static void PRINT_writeFloat(WordPtr outStream, DF_TermPtr tmPtr)
+{ STREAM_printf(outStream, "%f", DF_floatValue(tmPtr)); }
+
+/* Writing out a string term to a given output stream */
+static void PRINT_writeString(WordPtr outStream, DF_TermPtr tmPtr)
+{ STREAM_printf(outStream, "\"%s\"", MCSTR_toCString(DF_strValue(tmPtr))); }
+
+/* Writing out a stream constant to a given output stream */
+static void PRINT_writeStream(WordPtr outStream, DF_TermPtr tmPtr)
+{
+ WordPtr stream = DF_streamTabIndex(tmPtr);
+ STREAM_printf(outStream, "");
+ else STREAM_printf(outStream, "-- \"%s\">", STREAM_getName(stream));
+}
+
+/****************************************************************************
+ * Writing out a constant. Use the index into the runtime constant table *
+ * stored in the constant to get the constant name if one exists. If one *
+ * does not exist, i.e. if the constant is a local or hidden one, look for *
+ * it in a list of constants. If it is not in this list, make up a new *
+ * name. Eventually, the name consists of three parts: a generic name for *
+ * hidden constants, a part based on the runtime table index and a part *
+ * based on the universe index. *
+ ****************************************************************************/
+/* A structure for maintaining information about local constants encountered
+while printing; this structure enables the assignment of a unique integer
+to each runtime symbol table slot for such a constant. */
+typedef struct PRINT_ConstList_ *PRINT_ConstList;
+
+struct PRINT_ConstList_
+{
+ int constInd;
+ int count;
+ PRINT_ConstList next;
+};
+
+static PRINT_ConstList PRINT_clist = NULL;
+static int PRINT_lccount = 0;
+
+static void PRINT_cleanCList()
+{
+ PRINT_ConstList tmp;
+
+ PRINT_lccount = 0;
+ while (PRINT_clist){
+ tmp = PRINT_clist;
+ PRINT_clist = PRINT_clist -> next;
+ free(tmp);
+ }
+}
+
+/* writing out a hidden (local) constant name; as side effect, a note may be
+ made of a new hidden (local) constant seen during this printing. */
+static void PRINT_writeHCName(WordPtr outStream, int constInd, int uc)
+{
+ PRINT_ConstList lclist = PRINT_clist;
+ while (lclist && (lclist->constInd != constInd)) lclist = lclist->next;
+
+ if (!lclist) {
+ lclist = (PRINT_ConstList)EM_malloc(sizeof(struct PRINT_ConstList_));
+ lclist->constInd = constInd;
+ lclist->count = PRINT_lccount++;
+ lclist->next = PRINT_clist;
+ PRINT_clist = lclist;
+ }
+
+ STREAM_printf(outStream, "", lclist->count, uc);
+}
+
+/* Writing out a constant, hidden or global. */
+static void PRINT_writeConst(WordPtr outStream, DF_TermPtr tmPtr)
+{
+ int constInd = DF_constTabIndex(tmPtr);
+ char* name = AM_cstName(constInd);
+
+ if (name) STREAM_printf(outStream, "%s", name);
+ else PRINT_writeHCName(outStream, constInd, DF_constUnivCount(tmPtr));
+}
+
+/****************************************************************************
+ * Writing out a free variable. Two situations are possible, one where a *
+ * symbolic name is to be produced and the other where the `address' could *
+ * serve as the name. In the first case, if the variable is a query *
+ * variable, then its name from the query is used. Otherwise a new name is *
+ * invented that is distinct from other free term variable names; the *
+ * initial segment of the name guarantees that it will be distinct from *
+ * that of bound variables. *
+ ****************************************************************************/
+/* counter used to generate free variable name */
+static int PRINT_fvcounter = 1;
+
+/* Create a free term variable name; this starts with _ has a standard
+ string prefix and then a digit sequence */
+static DF_StrDataPtr PRINT_makeFVarName()
+{
+ int digits = 0;
+ int i = PRINT_fvcounter;
+ int length;
+ char* cname;
+ DF_StrDataPtr fvname;
+
+ while(i) { digits++; i = i/10; }
+
+ length = digits + 3;
+ cname = (char*)EM_malloc(sizeof(char)*length);
+ cname[0] = '_';
+ cname[1] = 'T';
+ cname[length-1] = '\0';
+
+ i = PRINT_fvcounter;
+ while(i) {
+ cname[digits+1] = (i%10 + '0');
+ i = i/10;
+ digits--;
+ }
+ PRINT_fvcounter++;
+
+ fvname = (DF_StrDataPtr)EM_malloc(sizeof(Word)*(MCSTR_numWords(length) +
+ DF_STRDATA_HEAD_SIZE));
+ DF_mkStrDataHead((MemPtr)fvname);
+ MCSTR_toString((MemPtr)((MemPtr)fvname + DF_STRDATA_HEAD_SIZE),
+ cname, length);
+ free(cname);
+ return fvname;
+}
+
+/* Does a made up name occur in the free term variable table? Clash can
+only occur with names in the user query */
+static Boolean PRINT_nameInFVTab(DF_StrDataPtr name)
+{
+ int i;
+ for (i = 0; i < PRINT_numQueryVars ; i++){
+ if (MCSTR_sameStrs(DF_strDataValue(name),
+ DF_strDataValue(IO_freeVarTab[i].varName)))
+ return TRUE;
+ }
+ return FALSE;
+}
+
+/* The main routine for printing out an unbound term variable */
+static void PRINT_writeFVar(WordPtr outStream, DF_TermPtr tmPtr)
+{
+ int fvind = 0;
+ DF_StrDataPtr fvname;
+
+ //PRINT_names = TRUE;
+ if (PRINT_names) {
+ IO_freeVarTab[IO_freeVarTabTop].rigdes = tmPtr;
+
+ while (tmPtr != IO_freeVarTab[fvind].rigdes) fvind++;
+
+ if (fvind == IO_freeVarTabTop) {
+ /* i.e., a free variable not seen before */
+ if (IO_freeVarTabTop == IO_MAX_FREE_VARS)
+ EM_error(BI_ERROR_TYFVAR_CAP);
+
+ while(1) {//make a name
+ fvname = PRINT_makeFVarName();
+ if (!PRINT_nameInFVTab(fvname)) break;
+ free(fvname);
+ }
+
+ IO_freeVarTab[fvind].varName = fvname;
+ IO_freeVarTabTop++;
+ }
+ STREAM_printf(outStream,
+ MCSTR_toCString(DF_strDataValue(IO_freeVarTab[fvind].varName)));
+ } else { //PRINT_names = FALSE
+ STREAM_printf(outStream, "_%ld", PRINT_makeNumberName(tmPtr));
+ }
+}
+
+/****************************************************************************
+ * Routines for writing out bound variables (in lambda abstraction and *
+ * bound variable occurrence) *
+ ****************************************************************************/
+/* prefix for bound variables */
+static char* PRINT_bvname = "W";
+
+/* a counter for determining the suffix part of bound variables */
+static int PRINT_bvcounter = 1;
+
+/* A structure for maintaining information about bound variable names */
+typedef struct PRINT_BVList_ *PRINT_BVList;
+
+struct PRINT_BVList_ {
+ DF_StrDataPtr name;
+ PRINT_BVList next; };
+
+/* the initial list of bound variable names; initialized in SIM_InitIo */
+static PRINT_BVList PRINT_bvs = NULL;
+
+static void PRINT_cleanBV(PRINT_BVList bv)
+{
+ free(bv->name);
+ free(bv);
+}
+
+/* releasing the space for bound variables; needed only in case of error
+ exit */
+static void PRINT_cleanBVList()
+{
+ PRINT_BVList tbvl;
+
+ PRINT_bvcounter = 1;
+ while (PRINT_bvs) {
+ tbvl = PRINT_bvs; PRINT_bvs = PRINT_bvs->next;
+ PRINT_cleanBV(tbvl);
+ }
+}
+
+/****************************************************************************
+ * Writing out a bound variable *
+ ****************************************************************************/
+static void PRINT_writeBVar(WordPtr outStream, DF_TermPtr tmPtr)
+{
+ int i;
+ int bvind = DF_bvIndex(tmPtr);
+ PRINT_BVList lbvs = PRINT_bvs;
+
+ for (i = bvind; ((i != 1) && lbvs) ; i--)
+ lbvs = lbvs->next;
+
+ // Is this checking and the else branch really necessary?
+ // Printing should start from top-level closed terms?
+ if (lbvs) STREAM_printf(outStream, "%s",
+ MCSTR_toCString(DF_strDataValue(lbvs->name)));
+ else STREAM_printf(outStream, "#%d", i);
+}
+
+/****************************************************************************
+ * Writing out an empty list *
+ ****************************************************************************/
+static void PRINT_writeNil(WordPtr outStream)
+{ PRINT_writeNilSymbol(outStream); }
+
+/****************************************************************************
+ * Writing out a non-empty list. *
+ ****************************************************************************/
+static void PRINT_writeCons(WordPtr outStream, DF_TermPtr tmPtr,
+ OP_FixityType fx, int prec, OP_TermContext tc)
+{
+ DF_TermPtr args = DF_consArgs(tmPtr);
+ DF_TermPtr arg;
+ OP_FixityType consfix = (OP_FixityType)AM_cstFixity(PERV_CONS_INDEX);
+ int consprec = AM_cstPrecedence(PERV_CONS_INDEX);
+ Boolean pparen = PRINT_parenNeeded(consfix, consprec, tc, fx,prec);
+
+ if (pparen) PRINT_writeLParen(outStream);
+ PRINT_writeTerm(outStream, args, consfix, consprec, OP_LEFT_TERM);
+ PRINT_writeConsSymbol(outStream);
+
+ do {
+ args++;
+ tmPtr = DF_termDeref(args);
+ if (DF_termTag(tmPtr) != DF_TM_TAG_CONS) break;
+ args = DF_consArgs(tmPtr);
+ PRINT_writeTerm(outStream, args, consfix, consprec, OP_LEFT_TERM);
+ PRINT_writeConsSymbol(outStream);
+ } while(1);
+
+ PRINT_writeTerm(outStream, tmPtr, consfix, consprec, OP_RIGHT_TERM);
+ if (pparen) PRINT_writeRParen(outStream);
+}
+
+/****************************************************************************
+ * Writing out an abstraction. *
+ ****************************************************************************/
+/* creating a bound variable name with bound variable prefix followed by the*/
+/* current bound variable counter value. */
+static DF_StrDataPtr PRINT_makeBVarName()
+{
+ int digits = 0;
+ int i = PRINT_bvcounter;
+ int length;
+ char* cname;
+ DF_StrDataPtr bvname;
+
+ while(i) { digits++; i = i/10; }
+
+ length = digits + 2;
+ cname = (char*)EM_malloc(sizeof(char)*length);
+ strcpy(cname, PRINT_bvname);
+ cname[length-1] = '\0';
+
+ i = PRINT_bvcounter;
+ while(i) {
+ cname[digits] = (i%10 + '0');
+ i = i/10;
+ digits--;
+ }
+ PRINT_bvcounter++;
+
+ bvname = (DF_StrDataPtr)EM_malloc(sizeof(Word)*(MCSTR_numWords(length) +
+ DF_STRDATA_HEAD_SIZE));
+
+ DF_mkStrDataHead((MemPtr)bvname);
+ MCSTR_toString((MemPtr)((MemPtr)bvname + DF_STRDATA_HEAD_SIZE),
+ cname, length);
+ free(cname);
+ return bvname;
+}
+
+static void PRINT_writeAbstBinders(WordPtr outStream, int nabs)
+{
+ DF_StrDataPtr bvname;
+ PRINT_BVList tmpbvs;
+
+ while(nabs > 0) {
+ nabs--;
+ while(1) {//make a bvname not in FV table
+ bvname = PRINT_makeBVarName();
+ if (!PRINT_nameInFVTab(bvname)) break;
+ free(bvname);
+ }
+
+ //record the name into the head of the current bvlist
+ tmpbvs = (PRINT_BVList)EM_malloc(sizeof(struct PRINT_BVList_));
+ tmpbvs->name = bvname;
+ tmpbvs->next = PRINT_bvs;
+ PRINT_bvs = tmpbvs;
+ //write out binder
+ STREAM_printf(outStream, "%s", MCSTR_toCString(DF_strDataValue(bvname)));
+ PRINT_writeInfixLam(outStream);
+ }
+}
+
+static void PRINT_writeAbst(WordPtr outStream, DF_TermPtr tmPtr,
+ OP_FixityType fx, int prec, OP_TermContext tc)
+{
+ int numabs = 0;
+ Boolean pparen = PRINT_parenNeeded(OP_LAM_FIXITY,OP_LAM_PREC,tc,fx,prec);
+ PRINT_BVList tmpbvs;
+ int tmpbvc = PRINT_bvcounter;
+
+ if (pparen) PRINT_writeLParen(outStream);
+ while (DF_isLam(tmPtr)){
+ numabs += DF_lamNumAbs(tmPtr);
+ tmPtr = DF_termDeref(DF_lamBody(tmPtr));
+ }
+ PRINT_writeAbstBinders(outStream, numabs);
+ PRINT_writeTerm(outStream, tmPtr, OP_LAM_FIXITY,OP_LAM_PREC,OP_RIGHT_TERM);
+ if (pparen) PRINT_writeRParen(outStream);
+
+ while (numabs > 0) {
+ numabs--;
+ tmpbvs = PRINT_bvs;
+ PRINT_bvs = PRINT_bvs->next;
+ PRINT_cleanBV(tmpbvs);
+ }
+ PRINT_bvcounter = tmpbvc;
+}
+
+/****************************************************************************
+ * WRITING OUT AN APPLICATION *
+ * *
+ * Note that it is assumed that nested application structures are flattened *
+ * during the full normalization process. *
+ ****************************************************************************/
+/* Getting the fixity and precedence for the head of an application.
+ Assume the pointer to the term head is already dereferenced. */
+static void PRINT_getHeadInfo(DF_TermPtr hdPtr, OP_FixityType *fx, int* prec)
+{
+ int cstInd;
+ switch (DF_termTag(hdPtr)) {
+ case DF_TM_TAG_CONST:
+ cstInd = DF_constTabIndex(hdPtr);
+ if (AM_cstName(cstInd)) {
+ *fx = (OP_FixityType)AM_cstFixity(cstInd);
+ *prec = AM_cstPrecedence(cstInd);
+ } else {
+ *fx = OP_NONE;
+ *prec = 0;
+ }
+ break;
+ case DF_TM_TAG_VAR:
+ *fx = OP_NONE;
+ *prec = OP_MINPREC;
+ break;
+ case DF_TM_TAG_BVAR:
+ *fx = OP_NONE;
+ *prec = OP_MINPREC;
+ break;
+ }
+}
+
+/* Writing out a term with a prefix operator as head; we use the knowledge
+that the operator must be a constant here and that the pointer to it is
+fully dereferenced */
+static void PRINT_writePrefixTerm(WordPtr outStream, DF_TermPtr head,
+ OP_FixityType opfx, int opprec,
+ OP_TermContext tc, OP_FixityType fx,int prec,
+ DF_TermPtr args)
+{
+ Boolean pparen = PRINT_parenNeeded(opfx, opprec, tc, fx, prec);
+
+ if (pparen) PRINT_writeLParen(outStream);
+ PRINT_writeConst(outStream, head);
+ PRINT_writeSpace(outStream, 1);
+ PRINT_writeTerm(outStream, args, opfx, opprec, OP_RIGHT_TERM);
+ if (pparen) PRINT_writeRParen(outStream);
+}
+
+static void PRINT_writeInfixTerm(WordPtr outStream, DF_TermPtr head,
+ OP_FixityType opfx, int opprec,
+ OP_TermContext tc, OP_FixityType fx, int prec,
+ DF_TermPtr args)
+{
+ Boolean pparen = PRINT_parenNeeded(opfx, opprec, tc, fx, prec);
+ if(pparen) PRINT_writeLParen(outStream);
+ PRINT_writeTerm(outStream, args, opfx, opprec, OP_LEFT_TERM);
+ PRINT_writeSpace(outStream, 1);
+ PRINT_writeConst(outStream, head);
+ PRINT_writeSpace(outStream, 1);
+ PRINT_writeTerm(outStream, args+1, opfx, opprec, OP_RIGHT_TERM);
+ if (pparen) PRINT_writeRParen(outStream);
+}
+
+static void PRINT_writePostfixTerm(WordPtr outStream, DF_TermPtr head,
+ OP_FixityType opfx, int opprec,
+ OP_TermContext tc,OP_FixityType fx,int prec,
+ DF_TermPtr args)
+{
+ Boolean pparen = PRINT_parenNeeded(opfx, opprec, tc, fx, prec);
+ if(pparen) PRINT_writeLParen(outStream);
+ PRINT_writeTerm(outStream, args, opfx, opprec, OP_LEFT_TERM);
+ PRINT_writeSpace(outStream, 1);
+ PRINT_writeConst(outStream, head);
+ if (pparen) PRINT_writeRParen(outStream);
+}
+
+/* Main routine for writing out an application term */
+static void PRINT_writeApp(WordPtr outStream, DF_TermPtr tmPtr,
+ OP_FixityType infx, int inprec, OP_TermContext tc)
+{
+
+ DF_TermPtr head = DF_termDeref(DF_appFunc(tmPtr));
+ DF_TermPtr args = DF_appArgs(tmPtr);
+ int arity = DF_appArity(tmPtr);
+ Boolean pparen = PRINT_parenNeeded(OP_APP_FIXITY, OP_APP_PREC, tc, infx,
+ inprec);
+ OP_FixityType fix;
+ int prec;
+
+ HN_hnorm(tmPtr);
+ PRINT_getHeadInfo(AM_head, &fix, &prec);
+
+ switch(fix){
+ case OP_PREFIX: case OP_PREFIXR:
+ if (arity == 1) {
+ pparen = FALSE;
+ PRINT_writePrefixTerm(outStream, head, fix, prec, tc, infx, inprec,
+ args);
+
+ } else {
+ if (pparen) PRINT_writeLParen(outStream);
+ PRINT_writePrefixTerm(outStream, head, fix, prec, OP_LEFT_TERM,
+ OP_APP_FIXITY, OP_APP_PREC, args);
+ }
+ arity--; args++;
+ break;
+ case OP_INFIX: case OP_INFIXL: case OP_INFIXR:
+ if (arity == 2) {
+ pparen = FALSE;
+ PRINT_writeInfixTerm(outStream, head, fix, prec, tc, infx, inprec,
+ args);
+ } else {
+ if (pparen) PRINT_writeLParen(outStream);
+ PRINT_writeInfixTerm(outStream, head, fix, prec, OP_LEFT_TERM,
+ OP_APP_FIXITY, OP_APP_PREC, args);
+ }
+ arity -= 2; args += 2;
+ break;
+ case OP_POSTFIX: case OP_POSTFIXL:
+ if (arity == 1) {
+ pparen = FALSE;
+ PRINT_writePostfixTerm(outStream, head, fix, prec, tc, infx,
+ inprec, args);
+ } else {
+ if (pparen) PRINT_writeLParen(outStream);
+ PRINT_writePostfixTerm(outStream, head, fix, prec, OP_LEFT_TERM,
+ OP_APP_FIXITY, OP_APP_PREC, args);
+ }
+ break;
+ case OP_NONE:
+ if (pparen) PRINT_writeLParen(outStream);
+ PRINT_writeTerm(outStream,head,OP_APP_FIXITY,OP_APP_PREC,OP_LEFT_TERM);
+ break;
+ } /*switch*/
+
+ /* print the arguments (if any) of the application */
+ while (arity > 0) {
+ PRINT_writeSpace(outStream, 1);
+ PRINT_writeTerm(outStream, args, OP_APP_FIXITY, OP_APP_PREC,
+ OP_RIGHT_TERM);
+ args++;
+ arity--;
+ }
+ if (pparen) PRINT_writeRParen(outStream);
+}
+
+
+/*****************************************************************************
+ * The main routine for writing out a term; this is called by the interface *
+ * routines to do the real job of printing. *
+ *****************************************************************************/
+static void PRINT_writeTerm(WordPtr outStream, DF_TermPtr tmPtr,
+ OP_FixityType infx, int inprec, OP_TermContext tc)
+{
+ tmPtr = DF_termDeref(tmPtr);
+ switch (DF_termTag(tmPtr)) {
+ case DF_TM_TAG_INT: PRINT_writeInt(outStream, tmPtr); break;
+ case DF_TM_TAG_FLOAT: PRINT_writeFloat(outStream, tmPtr); break;
+ case DF_TM_TAG_STR: PRINT_writeString(outStream, tmPtr); break;
+ case DF_TM_TAG_STREAM: PRINT_writeStream(outStream, tmPtr); break;
+ case DF_TM_TAG_CONST: PRINT_writeConst(outStream, tmPtr); break;
+ case DF_TM_TAG_VAR: PRINT_writeFVar(outStream, tmPtr); break;
+ case DF_TM_TAG_BVAR: PRINT_writeBVar(outStream, tmPtr); break;
+ case DF_TM_TAG_NIL: PRINT_writeNil(outStream); break;
+ case DF_TM_TAG_CONS:
+ PRINT_writeCons(outStream, tmPtr, infx, inprec, tc); break;
+ case DF_TM_TAG_LAM:
+ PRINT_writeAbst(outStream, tmPtr, infx, inprec, tc); break;
+ case DF_TM_TAG_APP:
+ PRINT_writeApp(outStream, tmPtr, infx, inprec, tc); break;
+ } /* switch */
+}
+
+
+/* Printing a term to a specified output stream; names will be invented for
+free variables if the boolean variable PRINT_names is set. */
+void PRINT_fPrintTerm(WordPtr outStream, DF_TermPtr tmPtr)
+{
+ HN_lnorm(tmPtr);
+ PRINT_writeTerm(outStream, tmPtr, OP_NONE, 0, OP_WHOLE_TERM);
+}
+
+/* Printing routine for debugging */
+void PRINT_printTerm(DF_TermPtr tmPtr)
+{
+ PRINT_fPrintTerm(STREAM_stdout, tmPtr);
+ STREAM_printf(STREAM_stdout, "\n");
+}
+
+/* printing an answer substitution pair */
+static void PRINT_printSubsPair(WordPtr outStream, int ind)
+{
+ DF_TermPtr tmPtr;
+ char *varName =
+ MCSTR_toCString(DF_strDataValue(IO_freeVarTab[ind].varName));
+
+ /* print the variable name if it is not an anonymous variable */
+ if (strcmp(varName, "_") != 0) {
+ STREAM_printf(outStream, varName);
+
+ /* Print the equals sign */
+ PRINT_writeEquals(outStream);
+
+ /* Print the binding of the variable */
+ tmPtr = IO_freeVarTab[ind].rigdes;
+ HN_lnorm(tmPtr);
+ PRINT_writeTerm(outStream, tmPtr, OP_NONE, 0, OP_WHOLE_TERM);
+ }
+}
+
+void PRINT_showAnswerSubs()
+{
+ int i;
+
+ PRINT_names = TRUE;
+
+ for (i = 0; i < PRINT_numQueryVars; i++) {
+ PRINT_printSubsPair(STREAM_stdout, i);
+ STREAM_printf(STREAM_stdout, "\n");
+ }
+}
+
+/* Printing a disagreement pair to a specified output stream */
+static void PRINT_printDPair(WordPtr outStream, DF_DisPairPtr dpair)
+{
+ DF_TermPtr tmPtr;
+
+ PRINT_writeDPairStart(outStream);
+
+ tmPtr = DF_disPairFirstTerm(dpair);
+ HN_lnorm(tmPtr);
+ PRINT_writeTerm(outStream, tmPtr, OP_NONE, 0, OP_WHOLE_TERM);
+
+ PRINT_writeComma(outStream);
+ PRINT_writeSpace(outStream, 1);
+
+ tmPtr = DF_disPairSecondTerm(dpair);
+ HN_lnorm(tmPtr);
+ PRINT_writeTerm(outStream, tmPtr, OP_NONE, 0, OP_WHOLE_TERM);
+
+ PRINT_writeDPairEnd(outStream);
+}
+
+void PRINT_showDisAgreeList()
+{
+ DF_DisPairPtr liveList = AM_llreg;
+
+ while (DF_isNEmpDisSet(liveList)) {
+ PRINT_printDPair(STREAM_stdout, liveList);
+ liveList = DF_disPairNext(liveList);
+ STREAM_printf(STREAM_stdout, "\n");
+ }
+}
+
+void PRINT_setQueryFreeVariables()
+{
+ PRINT_numQueryVars = IO_freeVarTabTop;
+}
+
+/* Use this function to reset the top of the free variable table
+after a read; this is logical and also needed to avoid trying
+to release print name space accidentally at some other point. */
+void PRINT_resetFreeVarTab()
+{
+ IO_freeVarTabTop = PRINT_numQueryVars;
+}
+
+
+void PRINT_resetPrintState()
+{
+ /* release space for term variables created during printing */
+ while (IO_freeVarTabTop > PRINT_numQueryVars){
+ IO_freeVarTabTop--;
+ free(IO_freeVarTab[IO_freeVarTabTop].varName);
+ }
+
+ /* reset counters used in names of anonymous term and type variables */
+ PRINT_fvcounter = 1;
+
+ /* free space for information created for local consts and reset counter */
+ PRINT_cleanCList();
+
+ /* free space for information created for bound vars and reset counter */
+ PRINT_cleanBVList();
+}
+
+Boolean PRINT_queryHasVars()
+{
+ int i = PRINT_numQueryVars - 1;
+ while (!(i < 0) &&
+ (strcmp(MCSTR_toCString(DF_strDataValue(IO_freeVarTab[i].varName)),
+ "_") == 0))
+ i--;
+
+ if (i < 0) return FALSE;
+ else return TRUE;
+
+}
diff --git a/src/runtime/c/teyjus/simulator/printterm.h b/src/runtime/c/teyjus/simulator/printterm.h
new file mode 100644
index 000000000..d6814b5ab
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/printterm.h
@@ -0,0 +1,62 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************
+ * *
+ * File printterm.h{c}. This file contains routines for printing out lambda *
+ * terms. It is assumed that these routines will be needed in two *
+ * situations: printing out answers to queries and displaying terms as *
+ * needed by invocation of builtin goals. *
+ * The difference between these two situations is in the display of *
+ * free term variables. Only when displaying answers is an attempt made to *
+ * present these using sensible names: in this case, either the name in the *
+ * query is used or a concise name is cooked up. In the other situation, *
+ * the address of the variable cell is used as the name. *
+ * *
+ * Certain assumptions are relevant to avoiding name clashes. For local *
+ * constants, the assumption is that no constant names in user *
+ * programs begin with . The use of this idea is *
+ * buried inside the routine PRINT_writeHCName. *
+ * Violation of this condition is *not* checked. For term variables, the *
+ * assumption is that bound variables do not begin with _. *
+ * *
+ ****************************************************************************/
+
+#ifndef PRINTTERM_H
+#define PRINTTERM_H
+
+#include "dataformats.h"
+#include "mctypes.h"
+
+/* set this variable to FALSE if variable names are to be displayed as
+`numbers' */
+extern Boolean PRINT_names;
+
+void PRINT_fPrintTerm(WordPtr outStream, DF_TermPtr tmPtr);
+void PRINT_showAnswerSubs();
+void PRINT_showDisAgreeList();
+
+void PRINT_resetFreeVarTab();
+void PRINT_setQueryFreeVariables();
+void PRINT_resetPrintState();
+Boolean PRINT_queryHasVars();
+
+//for debugging (display on stdout )
+void PRINT_printTerm(DF_TermPtr tmPtr);
+#endif //PRINTTERM_H
diff --git a/src/runtime/c/teyjus/simulator/simdispatch.c b/src/runtime/c/teyjus/simulator/simdispatch.c
new file mode 100644
index 000000000..4567bb092
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/simdispatch.c
@@ -0,0 +1,160 @@
+/***************************************************************************/
+/* */
+/* File simdispatch.c. The instruction dispatch table used by the */
+/* simulator is defined here as an array of function pointers, each of */
+/* which refers to a function realizing a corresponding instruction. */
+/* These functions are defined in the file ./siminstr.c. */
+/***************************************************************************/
+
+#include "../tables/instructions.h" //to be modified
+#include "siminstr.h"
+#include "simdispatch.h"
+
+SDP_InstrFunctionPtr SDP_dispatchTable[INSTR_NUM_INSTRS] = {
+ SINSTR_put_variable_t,
+ SINSTR_put_variable_p,
+ SINSTR_put_value_t,
+ SINSTR_put_value_p,
+ SINSTR_put_unsafe_value,
+ SINSTR_copy_value,
+ SINSTR_put_m_const,
+ SINSTR_put_p_const,
+ SINSTR_put_nil,
+ SINSTR_put_integer,
+ SINSTR_put_float,
+ SINSTR_put_string,
+ SINSTR_put_index,
+ SINSTR_put_app,
+ SINSTR_put_list,
+ SINSTR_put_lambda,
+ SINSTR_set_variable_t,
+ SINSTR_set_variable_te,
+ SINSTR_set_variable_p,
+ SINSTR_set_value_t,
+ SINSTR_set_value_p,
+ SINSTR_globalize_pt,
+ SINSTR_globalize_t,
+ SINSTR_set_m_const,
+ SINSTR_set_p_const,
+ SINSTR_set_nil,
+ SINSTR_set_integer,
+ SINSTR_set_float,
+ SINSTR_set_string,
+ SINSTR_set_index,
+ SINSTR_set_void,
+ SINSTR_deref,
+ SINSTR_set_lambda,
+ SINSTR_get_variable_t,
+ SINSTR_get_variable_p,
+ SINSTR_init_variable_t,
+ SINSTR_init_variable_p,
+ SINSTR_get_m_constant,
+ SINSTR_get_p_constant,
+ SINSTR_get_integer,
+ SINSTR_get_float,
+ SINSTR_get_string,
+ SINSTR_get_nil,
+ SINSTR_get_m_structure,
+ SINSTR_get_p_structure,
+ SINSTR_get_list,
+ SINSTR_unify_variable_t,
+ SINSTR_unify_variable_p,
+ SINSTR_unify_value_t,
+ SINSTR_unify_value_p,
+ SINSTR_unify_local_value_t,
+ SINSTR_unify_local_value_p,
+ SINSTR_unify_m_constant,
+ SINSTR_unify_p_constant,
+ SINSTR_unify_integer,
+ SINSTR_unify_float,
+ SINSTR_unify_string,
+ SINSTR_unify_nil,
+ SINSTR_unify_void,
+ SINSTR_put_type_variable_t,
+ SINSTR_put_type_variable_p,
+ SINSTR_put_type_value_t,
+ SINSTR_put_type_value_p,
+ SINSTR_put_type_unsafe_value,
+ SINSTR_put_type_const,
+ SINSTR_put_type_structure,
+ SINSTR_put_type_arrow,
+ SINSTR_set_type_variable_t,
+ SINSTR_set_type_variable_p,
+ SINSTR_set_type_value_t,
+ SINSTR_set_type_value_p,
+ SINSTR_set_type_local_value_t,
+ SINSTR_set_type_local_value_p,
+ SINSTR_set_type_constant,
+ SINSTR_get_type_variable_t,
+ SINSTR_get_type_variable_p,
+ SINSTR_init_type_variable_t,
+ SINSTR_init_type_variable_p,
+ SINSTR_get_type_value_t,
+ SINSTR_get_type_value_p,
+ SINSTR_get_type_constant,
+ SINSTR_get_type_structure,
+ SINSTR_get_type_arrow,
+ SINSTR_unify_type_variable_t,
+ SINSTR_unify_type_variable_p,
+ SINSTR_unify_type_value_t,
+ SINSTR_unify_type_value_p,
+ SINSTR_unify_envty_value_t,
+ SINSTR_unify_envty_value_p,
+ SINSTR_unify_type_local_value_t,
+ SINSTR_unify_type_local_value_p,
+ SINSTR_unify_envty_local_value_t,
+ SINSTR_unify_envty_local_value_p,
+ SINSTR_unify_type_constant,
+ SINSTR_pattern_unify_t,
+ SINSTR_pattern_unify_p,
+ SINSTR_finish_unify,
+ SINSTR_head_normalize_t,
+ SINSTR_head_normalize_p,
+ SINSTR_incr_universe,
+ SINSTR_decr_universe,
+ SINSTR_set_univ_tag,
+ SINSTR_tag_exists_t,
+ SINSTR_tag_exists_p,
+ SINSTR_tag_variable,
+ SINSTR_push_impl_point,
+ SINSTR_pop_impl_point,
+ SINSTR_add_imports,
+ SINSTR_remove_imports,
+ SINSTR_push_import,
+ SINSTR_pop_imports,
+ SINSTR_allocate,
+ SINSTR_deallocate,
+ SINSTR_call,
+ SINSTR_call_name,
+ SINSTR_execute,
+ SINSTR_execute_name,
+ SINSTR_proceed,
+ SINSTR_try_me_else,
+ SINSTR_retry_me_else,
+ SINSTR_trust_me,
+ SINSTR_try,
+ SINSTR_retry,
+ SINSTR_trust,
+ SINSTR_trust_ext,
+ SINSTR_try_else,
+ SINSTR_retry_else,
+ SINSTR_branch,
+ SINSTR_switch_on_term,
+ SINSTR_switch_on_constant,
+ SINSTR_switch_on_bvar,
+ SINSTR_switch_on_reg,
+ SINSTR_neck_cut,
+ SINSTR_get_level,
+ SINSTR_put_level,
+ SINSTR_cut,
+ SINSTR_call_builtin,
+ SINSTR_builtin,
+ SINSTR_stop,
+ SINSTR_halt,
+ SINSTR_fail,
+ SINSTR_create_type_variable,
+ SINSTR_execute_link_only,
+ SINSTR_call_link_only,
+ SINSTR_put_variable_te
+};
+
diff --git a/src/runtime/c/teyjus/simulator/simdispatch.h b/src/runtime/c/teyjus/simulator/simdispatch.h
new file mode 100644
index 000000000..2a5f1475c
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/simdispatch.h
@@ -0,0 +1,37 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/***************************************************************************/
+/* */
+/* File simdispatch.h. The instruction dispatch table used by the */
+/* simulator is defined here as an array of function pointers, each of */
+/* which refers to a function realizing a corresponding instruction. */
+/* These functions are defined in the file ./siminstr.c. */
+/***************************************************************************/
+#ifndef SIMDISPATCH_H
+#define SIMDISPATCH_H
+
+//the function pointer type of instructions
+typedef void (* SDP_InstrFunctionPtr)();
+
+//instruction dispatch table
+extern SDP_InstrFunctionPtr SDP_dispatchTable[];
+
+
+#endif //SIMDISPATCH_H
diff --git a/src/runtime/c/teyjus/simulator/siminit.c b/src/runtime/c/teyjus/simulator/siminit.c
new file mode 100644
index 000000000..b6de2acea
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/siminit.c
@@ -0,0 +1,275 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/**************************************************************************/
+/* */
+/* File siminit.c. */
+/**************************************************************************/
+#ifndef SIMINIT_C
+#define SIMINIT_C
+
+#include "siminit.h"
+#include "abstmachine.h"
+#include "dataformats.h"
+#include "io-datastructures.h"
+#include "builtins/builtins.h"
+#include "../tables/instructions.h"
+#include "../system/error.h"
+#include "../system/message.h"
+
+#include
+/***************************######********************************************
+ * ERROR INFORMATION
+ *********************************######**************************************/
+static MSG_Msg SIM_errorMessages[SIM_NUM_ERROR_MESSAGES] =
+{
+ { SIM_ERROR,
+ 0,
+ "Simulator: ",
+ 0, 0, 0 },
+ { SIM_ERROR_TOO_MANY_ABSTRACTIONS,
+ SIM_ERROR,
+ "Abstraction embedding depth has exceeded maximum of %d.",
+ EM_NEWLINE, EM_TOP_LEVEL, 4 },
+ { SIM_ERROR_TOO_MANY_ARGUMENTS,
+ SIM_ERROR,
+ "Application arguments has exceeded maximum of %d.",
+ EM_NEWLINE, EM_TOP_LEVEL, 4 },
+ { SIM_ERROR_TOO_MANY_UNIV_QUANTS,
+ SIM_ERROR,
+ "Too many universal quantifiers.",
+ EM_NEWLINE, EM_TOP_LEVEL, 3 },
+ { SIM_ERROR_HEAP_TOO_BIG,
+ SIM_ERROR,
+ "Specified heap size (%uK) is larger than maximum of 256Gb.",
+ EM_NEWLINE, EM_ABORT, 1 },
+ { SIM_ERROR_HEAP_TOO_SMALL,
+ SIM_ERROR,
+ "Specified heap size (%uK) is smaller than minimum of 10K.",
+ EM_NEWLINE, EM_ABORT, 1 },
+ { SIM_ERROR_CANNOT_ALLOCATE_HEAP,
+ SIM_ERROR_CANNOT_ALLOCATE_HEAP_MESSAGE,
+ "",
+ SIM_ERROR_CANNOT_ALLOCATE_HEAP_SUGGESTION, EM_ABORT, 1 },
+ { SIM_ERROR_CANNOT_ALLOCATE_HEAP_MESSAGE,
+ SIM_ERROR,
+ "Could not allocate heap of size %uK at 0x%08x using %s.",
+ EM_NEWLINE, EM_NO_EXN, 1 },
+ { SIM_ERROR_CANNOT_ALLOCATE_HEAP_SUGGESTION,
+ SIM_ERROR,
+ "Try modifying the configuration and recompiling.",
+ EM_NEWLINE, EM_NO_EXN, 1 },
+ { SIM_ERROR_TRAIL_OVERFL,
+ SIM_ERROR,
+ "Trail overflow.",
+ EM_NEWLINE, EM_TOP_LEVEL, 1 },
+ { SIM_ERROR_HEAP_OVERFL,
+ SIM_ERROR,
+ "Heap overflow.",
+ EM_NEWLINE, EM_TOP_LEVEL, 1 },
+ { SIM_ERROR_STACK_OVERFL,
+ SIM_ERROR,
+ "Stack overflow.",
+ EM_NEWLINE, EM_TOP_LEVEL, 1 },
+ { SIM_ERROR_PDL_OVERFL,
+ SIM_ERROR,
+ "PDL overflow.",
+ EM_NEWLINE, EM_TOP_LEVEL, 1 }
+};
+
+
+/*************************************************************************/
+/* SETTING UP SPECIAL CODE SEGMENTS */
+/*************************************************************************/
+static const int SINIT_initSize = 31;
+
+static void SINIT_initCode()
+{
+ MemPtr nhreg = AM_hreg + SINIT_initSize;
+ CSpacePtr myhreg = (CSpacePtr)AM_hreg;
+
+ AM_heapError(nhreg);
+
+ //builtinCode
+ AM_builtinCode = myhreg;
+ *((INSTR_OpCode*)myhreg) = builtin; //builtin ...
+ myhreg += INSTR_I1X_LEN;
+
+ //eqCode
+ AM_eqCode = myhreg;
+ *((INSTR_OpCode*)myhreg) = pattern_unify_t; //pattern_unify A1, A2
+ *((INSTR_RegInd*)(myhreg + INSTR_RRX_R1)) = 1;
+ *((INSTR_RegInd*)(myhreg + INSTR_RRX_R2)) = 2;
+ myhreg += INSTR_RRX_LEN;
+ *((INSTR_OpCode*)myhreg) = finish_unify; //finish_unify
+ myhreg += INSTR_X_LEN;
+ *((INSTR_OpCode*)myhreg) = proceed; //proceed
+ myhreg += INSTR_X_LEN;
+
+ //failCode
+ AM_failCode = myhreg;
+ *((INSTR_OpCode*)myhreg) = fail; //fail
+ myhreg += INSTR_X_LEN;
+
+ //andCode
+ *((INSTR_OneByteInt*)(myhreg + INSTR_I1LX_I1)) = 2;//"call" 2 L
+ myhreg += INSTR_I1LX_LEN;
+ AM_andCode = myhreg;
+ *((INSTR_OpCode*)myhreg) = put_value_p; //put_value Y1, A1
+ *((INSTR_EnvInd*)(myhreg + INSTR_ERX_E)) = 1;
+ *((INSTR_RegInd*)(myhreg + INSTR_ERX_R)) = 1;
+ myhreg += INSTR_ERX_LEN;
+ *((INSTR_OpCode*)myhreg) = put_level; //put_level Y2
+ *((INSTR_EnvInd*)(myhreg + INSTR_EX_E)) = 2;
+ myhreg += INSTR_EX_LEN;
+ *((INSTR_OpCode*)myhreg) = deallocate; //deallocate
+ myhreg += INSTR_X_LEN;
+
+ //solveCode
+ AM_solveCode = myhreg;
+ *((INSTR_OpCode*)myhreg) = builtin; //builtin BI_SOLVE
+ *((INSTR_OneByteInt*)(myhreg + INSTR_I1X_I1)) = BI_SOLVE;
+ myhreg += INSTR_I1X_LEN;
+
+ //proceed
+ AM_proceedCode = myhreg; //proceed
+ *((INSTR_OpCode*)myhreg) = proceed;
+ myhreg += INSTR_X_LEN;
+
+ //orCode
+ AM_orCode = myhreg;
+ *((INSTR_OpCode*)myhreg) = trust_me; //trust_me 1
+ *((INSTR_OneByteInt*)(myhreg + INSTR_I1WPX_I1)) = 1;
+ myhreg += INSTR_I1WPX_LEN;
+ *((INSTR_OpCode*)myhreg) = builtin; //builtin BI_SOLVE
+ *((INSTR_OneByteInt*)(myhreg + INSTR_I1X_I1)) = BI_SOLVE;
+ myhreg += INSTR_I1X_LEN;
+
+ //allcode
+ *((INSTR_OneByteInt*)(myhreg + INSTR_I1LX_I1)) = 0; //"call" 0 L
+ myhreg += INSTR_I1LX_LEN;
+ AM_allCode = myhreg;
+ *((INSTR_OpCode*)myhreg) = decr_universe; //decr_universe
+ myhreg += INSTR_X_LEN;
+ *((INSTR_OpCode*)myhreg) = deallocate; //deallocate
+ myhreg += INSTR_X_LEN;
+ *((INSTR_OpCode*)myhreg) = proceed; //proceed
+ myhreg += INSTR_X_LEN;
+
+ //stopCode
+ AM_stopCode = myhreg;
+ *((INSTR_OpCode*)myhreg) = stop; //stop
+ myhreg += INSTR_X_LEN;
+
+ //notCode2
+ AM_notCode2 = myhreg;
+ *((INSTR_OpCode*)myhreg) = trust_me; //trust_me 0
+ *((INSTR_OneByteInt*)(myhreg + INSTR_I1WPX_I1)) = 0;
+ myhreg += INSTR_I1WPX_LEN;
+ *((INSTR_OpCode*)myhreg) = proceed; //proceed
+ myhreg += INSTR_X_LEN;
+
+ //notCode1
+ AM_notCode1 = myhreg;
+ *((INSTR_OpCode*)myhreg) = allocate; //allocate 2
+ *((INSTR_OneByteInt*)(myhreg + INSTR_I1X_I1)) = 2;
+ myhreg += INSTR_I1X_LEN;
+ *((INSTR_OpCode*)myhreg) = get_level; //get_level Y1
+ *((INSTR_EnvInd*)(myhreg + INSTR_EX_E)) = 1;
+ myhreg += INSTR_EX_LEN;
+ *((INSTR_OpCode*)myhreg) = call_builtin; //call_builtin 1 BI_SOLVE
+ *((INSTR_OneByteInt*)(myhreg + INSTR_I1I1WPX_I11)) = 1;
+ *((INSTR_OneByteInt*)(myhreg + INSTR_I1I1WPX_I12)) = BI_SOLVE;
+ myhreg += INSTR_I1I1WPX_LEN;
+ *((INSTR_OpCode*)myhreg) = cut; //cut 1
+ *((INSTR_EnvInd*)(myhreg + INSTR_EX_E)) = 1;
+ myhreg += INSTR_EX_LEN;
+ *((INSTR_OpCode*)myhreg) = fail; //fail
+ myhreg += INSTR_X_LEN;
+
+ //haltCode
+ AM_haltCode = myhreg;
+ *((INSTR_OpCode*)myhreg) = halt; //halt
+ myhreg += INSTR_X_LEN;
+
+ AM_hreg = nhreg;
+}
+
+/*****************************************************************************
+ * THE PUBLIC ROUTINES *
+ *****************************************************************************/
+void SINIT_preInit()
+{
+ /* errors get initialized before ANYTHING */
+ MSG_addMessages(SIM_NUM_ERROR_MESSAGES, SIM_errorMessages);
+}
+
+void SINIT_simInit()
+{
+ AM_hreg = AM_heapBeg; //heap
+ AM_hbreg = AM_heapBeg;
+ AM_ereg = AM_stackBeg; //stack
+ AM_ireg = AM_stackBeg;
+ AM_cireg = AM_stackBeg;
+ AM_initPDL(); //pdl
+ AM_trreg = AM_trailBeg; //trail
+ AM_llreg = DF_EMPTY_DIS_SET; //live list
+ AM_bndFlag = OFF; //bind flag
+ AM_ucreg = 0; //uc reg
+
+ //make a dummy first mod point at the beginning of the stack
+ AM_mkDummyImptRec(AM_ireg);
+
+ /* perform initialization for the term io system */
+ IO_initIO();
+
+ /* and set up some built-in code */
+ SINIT_initCode();
+
+ /* set up the base branch register to put the heap back to this point */
+ AM_breg = AM_stackBeg + AM_DUMMY_IMPT_REC_SIZE;
+ *AM_breg = (Mem)AM_hreg;
+
+ AM_fstCP = AM_b0reg = AM_breg;
+ AM_tosreg = AM_breg + 1;
+}
+
+void SINIT_reInitSimState(Boolean inDoInitializeImports)
+{
+ AM_initPDL(); //pdl
+ AM_ereg = AM_stackBeg; //stack
+ AM_trreg = AM_trailBeg; //trail
+ AM_llreg = DF_EMPTY_DIS_SET; //live list
+ AM_ucreg = 0; //uc reg
+ AM_bndFlag = OFF; //bind flag
+ AM_breg = AM_fstCP;
+ AM_hreg = AM_cpH();
+ AM_hreg = *((MemPtr *)AM_breg);
+
+ /* initialize ireg if necessary */
+ if (inDoInitializeImports) {
+ AM_ireg = AM_stackBeg;
+ AM_tosreg = AM_breg + 1;
+ }
+
+ IO_initIO();
+}
+
+
+#endif //SIMINIT_H
diff --git a/src/runtime/c/teyjus/simulator/siminit.h b/src/runtime/c/teyjus/simulator/siminit.h
new file mode 100644
index 000000000..0dd8fa749
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/siminit.h
@@ -0,0 +1,33 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/**************************************************************************/
+/* */
+/* File siminit.h. */
+/**************************************************************************/
+#ifndef SIMINIT_H
+#define SIMINIT_H
+#include "mctypes.h"
+
+void SINIT_preInit();
+void SINIT_simInit();
+void SINIT_reInitSimState(Boolean inDoInitializeImports);
+
+
+#endif //SIMUINIT_H
diff --git a/src/runtime/c/teyjus/simulator/siminstr.c b/src/runtime/c/teyjus/simulator/siminstr.c
new file mode 100644
index 000000000..6cb78cc38
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/siminstr.c
@@ -0,0 +1,1846 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/*****************************************************************************/
+/* */
+/* File siminstr.c. The instruction set of the virtual machine. */
+/*****************************************************************************/
+#ifndef SIMINSTR_C
+#define SIMINSTR_C
+
+#include "siminstr.h"
+#include "dataformats.h"
+#include "abstmachine.h"
+#include "trail.h"
+#include "hnorm.h"
+#include "hopu.h"
+#include "types.h"
+#include "instraccess.h"
+#include "siminstrlocal.h"
+#include "builtins/builtins.h"
+#include "../system/error.h"
+#include "../tables/pervasives.h"
+#include "../tables/instructions.h"
+#include "../loader/searchtab.h"
+
+
+#include
+#include "printterm.h"
+#include "../system/stream.h"
+
+static AM_DataTypePtr regX, regA;
+static AM_DataTypePtr envY, clenvY;
+static DF_TermPtr tmPtr, func;
+static DF_TypePtr tyPtr;
+static MemPtr nhreg, ip, ep, cp;
+static MemPtr impTab;
+static MemPtr table;
+static MemPtr bckfd;
+static MemPtr nextcl;
+static int constInd, kindInd, tablInd;
+static int n, m, l, uc, numAbs;
+static int intValue;
+static float floatValue;
+static DF_StrDataPtr str;
+static CSpacePtr label, cl;
+
+/****************************************************************************/
+/* INSTRUCTIONS FOR UNIFYING AND CREATING TERMS */
+/****************************************************************************/
+
+/**************************************************************************/
+/* PUT CLASS */
+/**************************************************************************/
+void SINSTR_put_variable_t() //put_variable Xn,Ai -- R_R_X
+{
+ INSACC_RRX(regX, regA);
+ nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_mkVar(AM_hreg, AM_ucreg);
+ DF_mkRef((MemPtr)regX, (DF_TermPtr)AM_hreg);
+ *regA = *regX;
+ AM_hreg = nhreg;
+}
+
+void SINSTR_put_variable_te() //put_variable_te Xn,Ai -- R_R_X
+{
+ INSACC_RRX(regX, regA);
+ nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_mkVar(AM_hreg, AM_envUC());
+ DF_mkRef((MemPtr)regX, (DF_TermPtr)AM_hreg);
+ *regA = *regX;
+ AM_hreg = nhreg;
+}
+
+void SINSTR_put_variable_p() //put_variable Yn,Ai -- E_R_X
+{
+ INSACC_ERX(envY, regA);
+ DF_mkVar((MemPtr)envY, AM_envUC());
+ DF_mkRef((MemPtr)regA, (DF_TermPtr)envY);
+}
+
+void SINSTR_put_value_t() //put_value Xn,Ai -- R_R_X
+{
+ INSACC_RRX(regX, regA);
+ *regA = *regX;
+}
+
+void SINSTR_put_value_p() //put_value Yn,Ai -- E_R_X
+{
+ INSACC_ERX(envY, regA);
+ tmPtr = DF_termDeref((DF_TermPtr)envY);
+ if ((!AM_stackAddr((MemPtr)tmPtr)) || DF_isFV(tmPtr))
+ DF_mkRef((MemPtr)regA, tmPtr);
+ else *regA = *((AM_DataTypePtr)tmPtr); //cons or (mono) constants on stack
+}
+
+void SINSTR_put_unsafe_value() //put_unsafe_value Yn,Ai -- E_R_X
+{
+ INSACC_ERX(envY, regA);
+
+ tmPtr = DF_termDeref((DF_TermPtr)envY);
+ switch (DF_termTag(tmPtr)) {
+ case DF_TM_TAG_NIL:
+ case DF_TM_TAG_CONS:
+ case DF_TM_TAG_INT:
+ case DF_TM_TAG_FLOAT:
+ case DF_TM_TAG_STR:
+ case DF_TM_TAG_STREAM:
+ {*regA = *((AM_DataTypePtr)tmPtr); break; }
+ case DF_TM_TAG_CONST:
+ {
+ if (DF_isTConst(tmPtr)) DF_mkRef((MemPtr)regA, tmPtr);
+ else *regA = *((AM_DataTypePtr)tmPtr);
+ break;
+ }
+ case DF_TM_TAG_VAR:
+ {
+ if (AM_inCurEnv((MemPtr)tmPtr)) {
+ AM_heapError(AM_hreg + DF_TM_ATOMIC_SIZE);
+ TR_trailETerm(tmPtr);
+ DF_copyAtomic(tmPtr, AM_hreg);
+ DF_mkRef((MemPtr)tmPtr, (DF_TermPtr)AM_hreg);
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ *regA = *((AM_DataTypePtr)tmPtr);
+ } else
+ DF_mkRef((MemPtr)regA, tmPtr);
+ break;
+ }
+ default: { DF_mkRef((MemPtr)regA, tmPtr); break; }
+ }
+}
+
+void SINSTR_copy_value() //copy_value Yn,Ai -- E_R_X
+{
+ INSACC_ERX(envY, regA);
+ tmPtr = DF_termDeref((DF_TermPtr)envY);
+ if (AM_stackAddr((MemPtr)tmPtr)) {
+ *regA = *((AM_DataTypePtr)tmPtr);
+ } else DF_mkRef((MemPtr)regA, tmPtr);
+}
+
+void SINSTR_put_m_const() //put_m_const Ai,c -- R_C_X
+{
+ INSACC_RCX(regA, constInd);
+ DF_mkConst((MemPtr)regA, AM_cstUnivCount(constInd), constInd);
+}
+
+void SINSTR_put_p_const() //put_p_const Ai,c -- R_C_X
+{
+ INSACC_RCX(regA, constInd);
+ nhreg = AM_hreg + DF_TM_TCONST_SIZE;
+ AM_heapError((MemPtr)(((DF_TypePtr)nhreg) + AM_cstTyEnvSize(constInd)));
+ DF_mkTConst(AM_hreg, AM_cstUnivCount(constInd), constInd,(DF_TypePtr)nhreg);
+ DF_mkRef((MemPtr)regA, (DF_TermPtr)AM_hreg);
+ AM_hreg = nhreg;
+}
+
+void SINSTR_put_nil() //put_nil Ai -- R_X
+{
+ INSACC_RX(regA);
+ DF_mkNil((MemPtr)regA);
+}
+
+void SINSTR_put_integer() //put_integer Ai,i -- R_I_X
+{
+ INSACC_RIX(regA, intValue);
+ DF_mkInt((MemPtr)regA, intValue);
+}
+
+void SINSTR_put_float() //put_float Ai,f -- R_F_X
+{
+ INSACC_RFX(regA, floatValue);
+ DF_mkFloat((MemPtr)regA, floatValue);
+}
+
+void SINSTR_put_string() //put_string Ai,str -- R_S_X
+{
+ INSACC_RSX(regA, str);
+ DF_mkStr((MemPtr)regA, str);
+}
+
+void SINSTR_put_index() //put_index Ai,n -- R_I1_X
+{
+ INSACC_RI1X(regA, n);
+ nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_mkBV(AM_hreg, n);
+ DF_mkRef((MemPtr)regA, (DF_TermPtr)AM_hreg);
+ AM_hreg = nhreg;
+}
+
+void SINSTR_put_app() //put_app Ai,Xj,n -- R_R_I1_X
+{
+ INSACC_RRI1X(regA, regX, n);
+ nhreg = (MemPtr)(((DF_TermPtr)(AM_hreg + DF_TM_APP_SIZE)) + n);
+ if (DF_isRef((DF_TermPtr)regX)) {
+ AM_heapError(nhreg);
+ tmPtr = DF_refTarget((DF_TermPtr)regX);
+ } else { //regX not a reference
+ nhreg += DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_copyAtomic((DF_TermPtr)regX, AM_hreg);
+ tmPtr = (DF_TermPtr)AM_hreg;
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ }
+ AM_sreg = (DF_TermPtr)(AM_hreg + DF_TM_APP_SIZE);
+ DF_mkApp(AM_hreg, n, tmPtr, AM_sreg);
+ DF_mkRef((MemPtr)regA, (DF_TermPtr)AM_hreg);
+ AM_hreg = nhreg;
+}
+
+void SINSTR_put_list() //put_list Ai -- R_X
+{
+ INSACC_RX(regA);
+ nhreg = (MemPtr)(((DF_TermPtr)AM_hreg) + DF_CONS_ARITY);
+ AM_heapError(nhreg);
+ AM_sreg = (DF_TermPtr)AM_hreg;
+ DF_mkCons((MemPtr)regA, AM_sreg);
+ AM_hreg = nhreg;
+}
+
+void SINSTR_put_lambda() //put_lambda Ai,Xj,n -- R_R_I1_X
+{
+ INSACC_RRI1X(regA, regX, n);
+ nhreg = AM_hreg + DF_TM_LAM_SIZE;
+ if (DF_isRef((DF_TermPtr)regX)) {
+ AM_heapError(nhreg);
+ tmPtr = DF_refTarget((DF_TermPtr)regX);
+ } else {
+ nhreg += DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_copyAtomic((DF_TermPtr)regX, AM_hreg);
+ tmPtr = (DF_TermPtr)AM_hreg;
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ }
+ DF_mkLam(AM_hreg, n, tmPtr);
+ DF_mkRef((MemPtr)regA, (DF_TermPtr)AM_hreg);
+ AM_hreg = nhreg;
+}
+
+/*************************************************************************/
+/* SET CLASS */
+/*************************************************************************/
+void SINSTR_set_variable_t() //set_variable Xi -- R_X
+{
+ INSACC_RX(regX);
+ DF_mkVar((MemPtr)AM_sreg, AM_ucreg);
+ DF_mkRef((MemPtr)regX, AM_sreg);
+ AM_sreg++;
+}
+
+void SINSTR_set_variable_te() //set_variable_te Xi -- R_X
+{
+ INSACC_RX(regX);
+ DF_mkVar((MemPtr)AM_sreg, AM_envUC());
+ DF_mkRef((MemPtr)regX, AM_sreg);
+ AM_sreg++;
+}
+
+void SINSTR_set_variable_p() //set_variable_p Yi -- E_X
+{
+ INSACC_EX(envY);
+ DF_mkVar((MemPtr)AM_sreg, AM_envUC());
+ DF_mkRef((MemPtr)envY, AM_sreg);
+ AM_sreg++;
+}
+
+void SINSTR_set_value_t() //set_value Xi -- R_X
+{
+ INSACC_RX(regX);
+ DF_copyAtomic((DF_TermPtr)regX, (MemPtr)AM_sreg);
+ AM_sreg++;
+}
+
+void SINSTR_set_value_p() //set_value Yi -- E_X
+{
+ INSACC_EX(envY);
+ tmPtr = DF_termDeref((DF_TermPtr)envY);
+ if (AM_stackAddr((MemPtr)tmPtr)) { //needed?; in fact, what if a fv?
+ //printf("set_value_p -- stack addr\n");
+ DF_copyAtomic(tmPtr, (MemPtr)AM_sreg);
+ } else DF_mkRef((MemPtr)AM_sreg, tmPtr);
+ AM_sreg++;
+}
+
+void SINSTR_globalize_pt() //globalize_pt Yj,Xi -- E_R_X
+{
+ INSACC_ERX(envY, regX);
+ tmPtr = DF_termDeref((DF_TermPtr)envY);
+ if (AM_stackAddr((MemPtr)tmPtr)) {
+ nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_copyAtomic(tmPtr, AM_hreg);
+ if (DF_isFV(tmPtr)) {
+ TR_trailETerm(tmPtr);
+ DF_mkRef((MemPtr)tmPtr, (DF_TermPtr)AM_hreg);
+ }
+ DF_mkRef((MemPtr)regX, (DF_TermPtr)AM_hreg);
+ AM_hreg = nhreg;
+ } else DF_mkRef((MemPtr)regX, tmPtr);
+}
+
+void SINSTR_globalize_t() //globalize_t Xi -- R_X
+{
+ INSACC_RX(regX);
+ tmPtr = DF_termDeref((DF_TermPtr)regX);
+ if (AM_nHeapAddr((MemPtr)tmPtr)){
+ nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_copyAtomic(tmPtr, AM_hreg);
+ if (DF_isFV(tmPtr)) {
+ TR_trailETerm(tmPtr);
+ DF_mkRef((MemPtr)tmPtr, (DF_TermPtr)AM_hreg);
+ }
+ DF_mkRef((MemPtr)regX, (DF_TermPtr)AM_hreg);
+ AM_hreg = nhreg;
+ } else DF_mkRef((MemPtr)regX, tmPtr);
+}
+
+void SINSTR_set_m_const() //set_m_const c -- C_X
+{
+ INSACC_CX(constInd);
+ DF_mkConst((MemPtr)AM_sreg, AM_cstUnivCount(constInd), constInd);
+ AM_sreg++;
+}
+
+void SINSTR_set_p_const() //set_p_const c -- C_X
+{
+ INSACC_CX(constInd);
+ nhreg = AM_hreg + DF_TM_TCONST_SIZE;
+ AM_heapError(nhreg + AM_cstTyEnvSize(constInd) * DF_TY_ATOMIC_SIZE);
+ DF_mkTConst(AM_hreg,AM_cstUnivCount(constInd),constInd,(DF_TypePtr)nhreg);
+ DF_mkRef((MemPtr)AM_sreg, (DF_TermPtr)AM_hreg);
+ AM_sreg++;
+ AM_hreg = nhreg;
+}
+
+void SINSTR_set_nil() //set_nil -- X
+{
+ INSACC_X();
+ DF_mkNil((MemPtr)AM_sreg);
+ AM_sreg++;
+}
+
+void SINSTR_set_integer() //set_integer i -- I_X
+{
+ INSACC_IX(intValue);
+ DF_mkInt((MemPtr)AM_sreg, intValue);
+ AM_sreg++;
+}
+
+void SINSTR_set_float() //set_float f -- F_X
+{
+ INSACC_FX(floatValue);
+ DF_mkFloat((MemPtr)AM_sreg, floatValue);
+ AM_sreg++;
+}
+
+void SINSTR_set_string() //set_string str -- S_X
+{
+ INSACC_SX(str);
+ DF_mkStr((MemPtr)AM_sreg, str);
+ AM_sreg++;
+}
+
+void SINSTR_set_index() //set_index n -- I1_X
+{
+ INSACC_I1X(n);
+ DF_mkBV((MemPtr)AM_sreg, n);
+ AM_sreg++;
+}
+
+void SINSTR_set_void() //set_void n -- I1_X
+{
+ INSACC_I1X(n);
+ while (n > 0) {
+ DF_mkVar((MemPtr)AM_sreg, AM_ucreg);
+ AM_sreg++;
+ n--;
+ }
+}
+
+void SINSTR_deref() //deref Xi -- R_X; needed?
+{
+ INSACC_RX(regX);
+ regA = (AM_DataTypePtr)(DF_termDeref((DF_TermPtr)regX));
+ *regX = *regA; //assume an atomic term?
+}
+
+void SINSTR_set_lambda() //set_lambda Xi, n -- R_I1_X; needed?
+{
+ INSACC_RI1X(regX, n);
+ if (!DF_isRef((DF_TermPtr)regX)) {
+ nhreg += DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_copyAtomic((DF_TermPtr)regX, AM_hreg);
+ DF_mkRef((MemPtr)regX, (DF_TermPtr)AM_hreg);
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ }
+ DF_mkLam((MemPtr)AM_sreg, n, DF_refTarget((DF_TermPtr)regX));
+ AM_sreg++;
+}
+
+/*************************************************************************/
+/* GET CLASS */
+/*************************************************************************/
+
+void SINSTR_get_variable_t() //get_variable Xn,Ai -- R_R_X
+{
+ INSACC_RRX(regX, regA);
+ *regX = *regA;
+}
+
+void SINSTR_get_variable_p() //get_variable Yn,Ai -- E_R_X
+{
+ INSACC_ERX(envY, regA);
+ *envY = *regA;
+}
+
+void SINSTR_init_variable_t() //init_variable Xn,Ym -- R_CE_X
+{
+ INSACC_RCEX(regA, clenvY);
+ DF_mkRef((MemPtr)regA, DF_termDeref((DF_TermPtr)clenvY));
+}
+
+void SINSTR_init_variable_p() //init_variable Yn,Ym -- E_CE_X
+{
+ INSACC_ECEX(envY, clenvY);
+ DF_mkRef((MemPtr)envY, DF_termDeref((DF_TermPtr)clenvY));
+}
+
+void SINSTR_get_m_constant() //get_m_constant Xi,c -- R_C_X
+{
+ INSACC_RCX(regX, constInd);
+ tmPtr = DF_termDeref((DF_TermPtr)regX);
+ SINSTRL_unifyConst(tmPtr, constInd);
+}
+
+void SINSTR_get_p_constant() //get_p_constant Xi,c,L -- R_C_L_X
+{
+ INSACC_RCLX(regX, constInd, label);
+ tmPtr = DF_termDeref((DF_TermPtr)regX);
+ SINSTRL_unifyTConst(tmPtr, constInd, label);
+}
+
+void SINSTR_get_integer() //get_integer Xi,i -- R_I_X
+{
+ INSACC_RIX(regX, intValue);
+ tmPtr = DF_termDeref((DF_TermPtr)regX);
+ SINSTRL_unifyInt(tmPtr, intValue);
+}
+
+void SINSTR_get_float() //get_float Xi,f -- R_F_X
+{
+ INSACC_RFX(regX, floatValue);
+ tmPtr = DF_termDeref((DF_TermPtr)regX);
+ SINSTRL_unifyFloat(tmPtr, floatValue);
+}
+
+void SINSTR_get_string() //get_string Xi,str --R_S_X
+{
+ INSACC_RSX(regX, str);
+ tmPtr = DF_termDeref((DF_TermPtr)regX);
+ SINSTRL_unifyString(tmPtr, str);
+}
+
+void SINSTR_get_nil() //get_nil Xi -- R_X
+{
+ INSACC_RX(regX);
+ tmPtr = DF_termDeref((DF_TermPtr)regX);
+ SINSTRL_unifyNil(tmPtr);
+
+}
+
+void SINSTR_get_m_structure() //get_m_structure Xi,f,n--R_C_I1_X
+{
+ INSACC_RCI1X(regX, constInd, n);
+ tmPtr = DF_termDeref((DF_TermPtr)regX);
+ switch (DF_termTag(tmPtr)) {
+ case DF_TM_TAG_VAR:
+ {
+ if (DF_fvUnivCount(tmPtr) >= AM_cstUnivCount(constInd)) {
+ SINSTRL_bindStr(tmPtr, constInd, n);
+ return;
+ } else {
+ EM_THROW(EM_FAIL);
+ }
+ }
+ case DF_TM_TAG_APP:
+ {
+ func = DF_termDeref(DF_appFunc(tmPtr));
+ if (DF_isConst(func)) {
+ if ((DF_constTabIndex(func)==constInd)&&(DF_appArity(tmPtr)==n)){
+ AM_sreg = DF_appArgs(tmPtr); AM_writeFlag = OFF; //READ MODE
+ return;
+ } else EM_THROW(EM_FAIL); //diff const head
+ } //otherwise continue with the next case
+ }
+ case DF_TM_TAG_LAM: case DF_TM_TAG_SUSP: //and other APP cases
+ {
+ HN_hnorm(tmPtr);
+ if (AM_rigFlag) {
+ if (DF_isConst(AM_head) && (DF_constTabIndex(AM_head) == constInd)){
+ if (AM_numArgs == (AM_numAbs + n)){
+ if (AM_numAbs == 0) {
+ AM_sreg = AM_argVec; AM_writeFlag = OFF; //READ MODE
+ } else SINSTRL_delayStr(tmPtr, constInd, n); //#abs > 0
+ } else EM_THROW(EM_FAIL); //numArgs != numAbs + n
+ } else EM_THROW(EM_FAIL); //non const rig head or diff const head
+ } else { //AM_rigFlag == OFF
+ if (AM_numArgs == 0) {
+ if ((AM_numAbs == 0) &&
+ (DF_fvUnivCount(AM_head) >= AM_cstUnivCount(constInd)))
+ SINSTRL_bindStr(AM_head, constInd, n);
+ else EM_THROW(EM_FAIL);
+ } else SINSTRL_delayStr(tmPtr, constInd, n);
+ } //AM_rigFlag == OFF
+ return;
+ }
+ default:
+ {//CONS, NIL, CONST, INT, FLOAT, STR, BV, (STREAM)
+ EM_THROW(EM_FAIL);
+ }
+ } //switch
+}
+
+void SINSTR_get_p_structure() //get_p_structure Xi,f,n--R_C_I1_X
+{
+ INSACC_RCI1X(regX, constInd, n);
+ tmPtr = DF_termDeref((DF_TermPtr)regX);
+ switch (DF_termTag(tmPtr)) {
+ case DF_TM_TAG_VAR:
+ {
+ if (DF_fvUnivCount(tmPtr) >= AM_cstUnivCount(constInd)) {
+ SINSTRL_bindTStr(tmPtr, constInd, n);
+ return;
+ } else {
+ EM_THROW(EM_FAIL);
+ }
+ }
+ case DF_TM_TAG_APP:
+ {
+ func = DF_termDeref(DF_appFunc(tmPtr));
+ if (DF_isConst(func)) {
+ if ((DF_constTabIndex(func)==constInd)&&(DF_appArity(tmPtr)==n)){
+ AM_sreg = DF_appArgs(tmPtr); AM_writeFlag = OFF;
+ AM_tysreg = DF_constType(func); AM_tyWriteFlag = OFF;
+ return;
+ } else EM_THROW(EM_FAIL); //diff const head
+ } //otherwise continue with the next case
+ }
+ case DF_TM_TAG_LAM: case DF_TM_TAG_SUSP: //and other APP cases
+ {
+ HN_hnorm(tmPtr);
+ if (AM_rigFlag) {
+ if (DF_isConst(AM_head) && (DF_constTabIndex(AM_head) == constInd)){
+ if (AM_numAbs == (AM_numArgs + n)){
+ if (AM_numAbs == 0) {//first order app
+ AM_sreg = AM_argVec; AM_writeFlag = OFF;
+ AM_tysreg = DF_constType(AM_head);AM_tyWriteFlag = OFF;
+ } else SINSTRL_delayTStr(tmPtr, constInd, n);//#abs > 0
+ } else EM_THROW(EM_FAIL); //numArgs != numAbs + n
+ } else EM_THROW(EM_FAIL); //non const rig head or diff const head
+ } else { //AM_rigFlag == OFF
+ if (AM_numArgs == 0) {
+ if ((AM_numArgs == 0) &&
+ (DF_fvUnivCount(AM_head) >= AM_cstUnivCount(constInd)))
+ SINSTRL_bindTStr(AM_head, constInd, n);
+ else EM_THROW(EM_FAIL);
+ } else SINSTRL_delayTStr(tmPtr, constInd, n);
+ } //AM_rigFlag == OFF
+ return;
+ }
+ default:
+ { //CONS, NIL, CONST, INT, FLOAT, STR, BV, (STREAM)
+ EM_THROW(EM_FAIL);
+ }
+ } //switch
+}
+
+void SINSTR_get_list() //get_list Xi -- R_X
+{
+ INSACC_RX(regX);
+ tmPtr = DF_termDeref((DF_TermPtr)regX);
+ switch (DF_termTag(tmPtr)){
+ case DF_TM_TAG_VAR:{ SINSTRL_bindCons(tmPtr); return; }
+ case DF_TM_TAG_CONS: {AM_sreg=DF_consArgs(tmPtr); AM_writeFlag=OFF; return; }
+ case DF_TM_TAG_APP:
+ {
+ if (DF_isConst(DF_termDeref(DF_appFunc(tmPtr)))) EM_THROW(EM_FAIL);
+ //otherwise continue with next case
+ }
+ case DF_TM_TAG_SUSP: //and other APP cases
+ { //Note ABS cannot arise here due to well-typedness
+ HN_hnorm(tmPtr);
+ if (AM_consFlag) { //#abs must be 0 and #args must be 2 due to type
+ AM_sreg = AM_argVec; AM_writeFlag = OFF;
+ return;
+ }
+ if (AM_rigFlag) EM_THROW(EM_FAIL); //non cons rigid term
+ //otherwise flex term with #abs being 0 (due to well-typedness)
+ if (AM_numArgs == 0) SINSTRL_bindCons(AM_head); //fv
+ else SINSTRL_delayCons(tmPtr); //higher-order
+ return;
+ }
+ default: { EM_THROW(EM_FAIL); } //NIL, CONST, BV
+ } //switch
+}
+
+/*************************************************************************/
+/* UNIFY CLASS */
+/*************************************************************************/
+void SINSTR_unify_variable_t() //unify_variable_t Xi -- R_X
+{
+ INSACC_RX(regX);
+ if (AM_writeFlag) {
+ DF_mkVar((MemPtr)AM_sreg, AM_adjreg);
+ DF_mkRef((MemPtr)regX, AM_sreg);
+ } else { //read mode
+ if (DF_isFV(AM_sreg))
+ DF_mkRef((MemPtr)regX, AM_sreg);
+ else *regX = *((AM_DataTypePtr)AM_sreg);
+ }
+ AM_sreg++;
+}
+
+void SINSTR_unify_variable_p() //unify_variable_p Yi -- E_X
+{
+ INSACC_EX(envY);
+ if (AM_writeFlag) {
+ DF_mkVar((MemPtr)AM_sreg, AM_adjreg);
+ DF_mkRef((MemPtr)envY, AM_sreg);
+ } else { //read mode
+ if (DF_isFV(AM_sreg))
+ DF_mkRef((MemPtr)envY, AM_sreg);
+ else *envY = *((AM_DataTypePtr)AM_sreg);
+ }
+ AM_sreg++;
+}
+
+void SINSTR_unify_value_t() //unify_value Xi -- R_X
+{
+ INSACC_RX(regX);
+ if (AM_writeFlag) {
+ if (AM_ocFlag) SINSTRL_bindSreg(DF_termDeref((DF_TermPtr)regX));
+ else *((AM_DataTypePtr)AM_sreg) = *regX;
+
+ } else {
+ HOPU_patternUnifyPair((DF_TermPtr)regX, AM_sreg); //read mode
+ }
+ AM_sreg++;
+}
+
+void SINSTR_unify_value_p() //unify_value Yi -- E_X
+{
+ INSACC_EX(envY);
+ if (AM_writeFlag) {
+ tmPtr = DF_termDeref((DF_TermPtr)envY);
+ if (AM_ocFlag) SINSTRL_bindSreg(tmPtr);
+ else {// AM_ocFlag == OFF
+ if (AM_stackAddr((MemPtr)tmPtr)) { //needed?; in fact, what if a fv?
+ //printf("unify_value_p -- stack addr\n");
+ DF_copyAtomic(tmPtr, (MemPtr)AM_sreg);
+ } else DF_mkRef((MemPtr)AM_sreg, tmPtr);
+ }
+ } else HOPU_patternUnifyPair((DF_TermPtr)envY, AM_sreg); //read mode
+ AM_sreg++;
+}
+
+void SINSTR_unify_local_value_t() //unify_local_value Xi -- R_X
+{
+ INSACC_RX(regX);
+ if (AM_writeFlag){
+ tmPtr = DF_termDeref((DF_TermPtr)regX);
+ if (DF_isCons(tmPtr)) {
+ *regX = *((AM_DataTypePtr)tmPtr); //update reg Xi
+ if (AM_ocFlag) SINSTRL_bindSreg(tmPtr);
+ else DF_copyAtomic(tmPtr, (MemPtr)AM_sreg);
+ } else { //tmPtr not cons
+ if (AM_nHeapAddr((MemPtr)tmPtr)) { //then globalize and then bind
+ if (DF_isConst(tmPtr)) { //must be a const without type assoc
+ if (AM_ocFlag && (DF_constUnivCount(tmPtr) > AM_adjreg))
+ EM_THROW(EM_FAIL);
+ DF_copyAtomic(tmPtr, (MemPtr)AM_sreg);//move the cst to heap
+ *regX = *((AM_DataTypePtr)tmPtr); //update reg Xi
+ } else { //not const
+ if (DF_isFV(tmPtr)) {
+ TR_trailETerm(tmPtr);
+ if (AM_ocFlag && (DF_fvUnivCount(tmPtr) > AM_adjreg)){
+ DF_modVarUC(tmPtr, AM_adjreg);
+ AM_bndFlag = ON;
+ }
+ DF_copyAtomic(tmPtr, (MemPtr)AM_sreg);//move fv to heap
+ DF_mkRef((MemPtr)regX, AM_sreg); //reg Xi
+ DF_mkRef((MemPtr)tmPtr, AM_sreg); //env cell
+ } else {//INT, FLOAT, STR, (STREAM), NIL
+ DF_copyAtomic(tmPtr, (MemPtr)AM_sreg);//move to heap
+ *regX = *((AM_DataTypePtr)tmPtr); //update reg Xi
+ }
+ } //not const
+ } else { //tmPtr is a heap address
+ DF_mkRef((MemPtr)regX, tmPtr); //update reg Xi
+ if (AM_ocFlag) SINSTRL_bindSregH(tmPtr);
+ else DF_mkRef((MemPtr)AM_sreg, tmPtr);
+ } //tmPtr is a heap address
+ } //tmPtr not cons
+ } else HOPU_patternUnifyPair((DF_TermPtr)regX, AM_sreg); //read mode
+ AM_sreg++;
+}
+
+void SINSTR_unify_local_value_p() //unify_local_value Yi -- E_X
+{
+ INSACC_EX(envY);
+ if (AM_writeFlag) {
+ tmPtr = DF_termDeref((DF_TermPtr)envY);
+ if (DF_isCons(tmPtr))
+ if (AM_ocFlag) SINSTRL_bindSreg(tmPtr);
+ else DF_copyAtomic(tmPtr, (MemPtr)AM_sreg);
+ else { //tmPtr not cons
+ if (AM_nHeapAddr((MemPtr)tmPtr)) { //then globalize and then bind
+ if (DF_isConst(tmPtr)) { //must be a const without type assoc
+ if (AM_ocFlag && (DF_constUnivCount(tmPtr) > AM_adjreg))
+ EM_THROW(EM_FAIL);
+ DF_copyAtomic(tmPtr, (MemPtr)AM_sreg);
+ } else { //not const
+ if (DF_isFV(tmPtr)) {
+ TR_trailETerm(tmPtr);
+ if (AM_ocFlag && (DF_fvUnivCount(tmPtr) > AM_adjreg)){
+ DF_modVarUC(tmPtr, AM_adjreg);
+ AM_bndFlag = ON;
+ }
+ DF_copyAtomic(tmPtr, (MemPtr)AM_sreg);//move fv to heap
+ DF_mkRef((MemPtr)tmPtr, AM_sreg); //env cell
+ } else DF_copyAtomic(tmPtr, (MemPtr)AM_sreg); //I/F/STR/NIL
+ } //not const
+ } else { //tmPtr is a heap address
+ if (AM_ocFlag) SINSTRL_bindSregH(tmPtr);
+ else DF_mkRef((MemPtr)AM_sreg, tmPtr);
+ } //tmPtr is a heap address
+ } //tmPtr not cons
+ } else //read mode
+ HOPU_patternUnifyPair((DF_TermPtr)envY, AM_sreg);
+ AM_sreg++;
+}
+
+void SINSTR_unify_m_constant() //unify_m_constant C -- C_X
+{
+ INSACC_CX(constInd);
+ if (AM_writeFlag) {
+ if (AM_ocFlag && (AM_adjreg < (uc = AM_cstUnivCount(constInd))))
+ EM_THROW(EM_FAIL);
+ DF_mkConst((MemPtr)AM_sreg, uc, constInd);
+ } else { //read mode
+ tmPtr = DF_termDeref(AM_sreg);
+ SINSTRL_unifyConst(tmPtr, constInd);
+ }
+ AM_sreg++;
+}
+
+void SINSTR_unify_p_constant() //unify_p_constant C,L -- C_L_X
+{
+ INSACC_CLX(constInd, label);
+ if (AM_writeFlag) {
+ if (AM_ocFlag && (AM_adjreg < (uc = AM_cstUnivCount(constInd))))
+ EM_THROW(EM_FAIL);
+ nhreg = AM_hreg + DF_TM_TCONST_SIZE;
+ AM_heapError(nhreg + AM_cstTyEnvSize(constInd) * DF_TY_ATOMIC_SIZE);
+ DF_mkTConst(AM_hreg, uc, constInd, (DF_TypePtr)nhreg);
+ DF_mkRef((MemPtr)AM_sreg, (DF_TermPtr)AM_hreg);
+ AM_hreg = nhreg;
+ AM_tyWriteFlag = ON;
+ } else {// read mode
+ tmPtr = DF_termDeref(AM_sreg);
+ SINSTRL_unifyTConst(tmPtr, constInd, label);
+ }
+ AM_sreg++;
+}
+
+void SINSTR_unify_integer() //unify_integer i -- I_X
+{
+ INSACC_IX(intValue);
+ if (AM_writeFlag) DF_mkInt((MemPtr)AM_sreg, intValue);
+ else { //read mode
+ tmPtr = DF_termDeref(AM_sreg);
+ SINSTRL_unifyInt(tmPtr, intValue);
+ }
+ AM_sreg++;
+}
+
+void SINSTR_unify_float() //unify_float f -- F_X
+{
+ INSACC_FX(floatValue);
+ if (AM_writeFlag) DF_mkFloat((MemPtr)AM_sreg, floatValue);
+ else { //read mode
+ tmPtr = DF_termDeref(AM_sreg);
+ SINSTRL_unifyFloat(tmPtr, floatValue);
+ }
+ AM_sreg++;
+}
+
+void SINSTR_unify_string() //unify_string str -- S_X
+{
+ INSACC_SX(str);
+ if (AM_writeFlag) DF_mkStr((MemPtr)AM_sreg, str);
+ else { //read mode
+ tmPtr = DF_termDeref(AM_sreg);
+ SINSTRL_unifyString(tmPtr, str);
+ }
+ AM_sreg++;
+}
+
+void SINSTR_unify_nil() //unify_nil -- X
+{
+ INSACC_X();
+ if (AM_writeFlag) DF_mkNil((MemPtr)AM_sreg);
+ else { // in read mode
+ tmPtr = DF_termDeref(AM_sreg);
+ SINSTRL_unifyNil(tmPtr);
+ }
+ AM_sreg++;
+}
+
+void SINSTR_unify_void() //unify_void n -- I1_X
+{
+ INSACC_I1X(n);
+ if (AM_writeFlag) {
+ while (n > 0) {
+ DF_mkVar((MemPtr)AM_sreg, AM_adjreg);
+ AM_sreg++;
+ n--;
+ }
+ } else AM_sreg += n;
+}
+
+/*****************************************************************************/
+/* INSTRUCTIONS FOR UNIFYING AND CREATING TYPES */
+/*****************************************************************************/
+void SINSTR_put_type_variable_t() //put_type_variable Xn,Ai -- R_R_X
+{
+ INSACC_RRX(regX, regA);
+ nhreg = AM_hreg + DF_TY_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_mkFreeVarType(AM_hreg);
+ *regA = *regX = *((AM_DataTypePtr)AM_hreg);
+ AM_hreg = nhreg;
+}
+
+void SINSTR_put_type_variable_p() //put_type_variable Yn,Ai -- E_R_X
+{
+ INSACC_ERX(envY, regA);
+ DF_mkFreeVarType((MemPtr)envY);
+ *regA = *envY;
+}
+
+void SINSTR_put_type_value_t() //put_type_value Xn,Ai -- R_R_X
+{
+ INSACC_RRX(regX, regA);
+ *regA = *((AM_DataTypePtr)DF_typeDeref((DF_TypePtr)regX));
+}
+
+void SINSTR_put_type_value_p() //put_type_value Yn,Ai -- E_R_X
+{
+ INSACC_ERX(envY, regA);
+ *regA = *((AM_DataTypePtr)DF_typeDeref((DF_TypePtr)envY));
+}
+
+void SINSTR_put_type_unsafe_value() //put_type_unsafe_value Yn,Ai -- E_R_X
+{
+ INSACC_ERX(envY, regA);
+ tyPtr = DF_typeDeref((DF_TypePtr)envY);
+ if (DF_isRefType(tyPtr) && AM_inCurEnv((MemPtr)tyPtr)){
+ nhreg = AM_hreg + DF_TY_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_mkFreeVarType(AM_hreg);
+ TR_trailType(tyPtr);
+ DF_mkRefType((MemPtr)tyPtr, (DF_TypePtr)AM_hreg);
+ *regA = *((AM_DataTypePtr)tyPtr);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+ } else *regA = *((AM_DataTypePtr)tyPtr);
+}
+
+
+void SINSTR_put_type_const() //put_type_const Ai,k -- R_K_X
+{
+ INSACC_RKX(regA, kindInd);
+ DF_mkSortType((MemPtr)regA, kindInd);
+}
+
+void SINSTR_put_type_structure() //put_type_structure Ai,k -- R_K_X
+{
+ INSACC_RKX(regA, kindInd);
+ n = AM_kstArity(kindInd);
+ nhreg = AM_hreg + DF_TY_ATOMIC_SIZE;
+ AM_heapError(nhreg + n * DF_TY_ATOMIC_SIZE);
+ DF_mkStrType((MemPtr)regA, (DF_TypePtr)AM_hreg);
+ DF_mkStrFuncType(AM_hreg, kindInd, n);
+ AM_hreg = nhreg;
+}
+
+void SINSTR_put_type_arrow() //put_type_arrow Ai -- R_X
+{
+ INSACC_RX(regA);
+ AM_heapError(AM_hreg + DF_TY_ATOMIC_SIZE * DF_TY_ARROW_ARITY);
+ DF_mkArrowType((MemPtr)regA, (DF_TypePtr)AM_hreg);
+}
+
+/**********************************************************/
+/* SET CLASS */
+/**********************************************************/
+void SINSTR_set_type_variable_t() //set_type_variable Xi -- R_X
+{
+ INSACC_RX(regX);
+ DF_mkFreeVarType(AM_hreg);
+ *regX = *((AM_DataTypePtr)AM_hreg);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+}
+
+void SINSTR_set_type_variable_p() //set_type_variable Yi -- E_X
+{
+ INSACC_EX(envY);
+ DF_mkFreeVarType(AM_hreg);
+ *envY = *((AM_DataTypePtr)AM_hreg);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+}
+
+void SINSTR_set_type_value_t() //set_type_value Xi -- R_X
+{
+ INSACC_RX(regX);
+ tyPtr = DF_typeDeref((DF_TypePtr)regX);
+ DF_copyAtomicType(tyPtr, AM_hreg);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+}
+
+void SINSTR_set_type_value_p() //set_type_value Yi -- E_X
+{
+ INSACC_EX(envY);
+ tyPtr = DF_typeDeref((DF_TypePtr)envY);
+ DF_copyAtomicType(tyPtr, AM_hreg);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+}
+
+void SINSTR_set_type_local_value_t() //set_type_local_value Xi -- R_X
+{
+ INSACC_RX(regX);
+ tyPtr = DF_typeDeref((DF_TypePtr)regX);
+ if (DF_isRefType(tyPtr) && AM_stackAddr((MemPtr)tyPtr)){//fv on stack
+ TR_trailType(tyPtr);
+ DF_mkFreeVarType(AM_hreg);
+ DF_mkRefType((MemPtr)tyPtr, (DF_TypePtr)AM_hreg);
+ } else DF_copyAtomicType(tyPtr, AM_hreg);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+}
+
+void SINSTR_set_type_local_value_p() //set_type_local_value Yi -- E_X
+{
+ INSACC_EX(envY);
+ tyPtr = DF_typeDeref((DF_TypePtr)envY);
+ if (DF_isRefType(tyPtr) && AM_stackAddr((MemPtr)tyPtr)) {//fv on stack
+ TR_trailType(tyPtr);
+ DF_mkFreeVarType(AM_hreg);
+ DF_mkRefType((MemPtr)tyPtr, (DF_TypePtr)AM_hreg);
+ } else DF_copyAtomicType(tyPtr, AM_hreg);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+}
+
+void SINSTR_set_type_constant() //set_type_constant k -- K_X
+{
+ INSACC_KX(kindInd);
+ DF_mkSortType(AM_hreg, kindInd);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+}
+
+/**********************************************************/
+/* GET CLASS */
+/**********************************************************/
+void SINSTR_get_type_variable_t() //get_type_variable Xn,Ai -- R_R_X
+{
+ INSACC_RRX(regX, regA);
+ *regX = *regA;
+}
+
+void SINSTR_get_type_variable_p() //get_type_variable Yn,Ai -- E_R_X
+{
+ INSACC_ERX(envY, regA);
+ *envY = *regA;
+}
+
+void SINSTR_init_type_variable_t() //init_type_variable Xn,Ym -- R_CE_X
+{
+ INSACC_RCEX(regX, clenvY);
+ *regX = *((AM_DataTypePtr)DF_typeDeref((DF_TypePtr)clenvY));
+}
+
+void SINSTR_init_type_variable_p() //init_type_variable Yn,Ym -- E_CE_X
+{
+ INSACC_ECEX(envY, clenvY);
+ *envY = *((AM_DataTypePtr)DF_typeDeref((DF_TypePtr)clenvY));
+}
+
+void SINSTR_get_type_value_t() //get_type_value Xn,Ai -- R_R_X
+{
+ INSACC_RRX(regX, regA);
+ AM_pdlError(2);
+ AM_initTypesPDL();
+ AM_pushPDL((MemPtr)regX);
+ AM_pushPDL((MemPtr)regA);
+ TY_typesUnify();
+}
+
+void SINSTR_get_type_value_p() //get_type_value Yn,Ai -- E_R_X
+{
+ INSACC_ERX(envY, regA);
+ AM_pdlError(2);
+ AM_initTypesPDL();
+ AM_pushPDL((MemPtr)envY);
+ AM_pushPDL((MemPtr)regA);
+ TY_typesUnify();
+}
+
+void SINSTR_get_type_constant() //get_type_constant Xi,k -- R_K_X
+{
+ INSACC_RKX(regX, kindInd);
+ tyPtr = DF_typeDeref((DF_TypePtr)regX);
+ if (DF_isRefType(tyPtr)) {
+ TR_trailType(tyPtr);
+ DF_mkSortType((MemPtr)tyPtr, kindInd);
+ return;
+ }
+ if (DF_isSortType(tyPtr) && (DF_typeKindTabIndex(tyPtr) == kindInd)) return;
+ EM_THROW(EM_FAIL); //all other cases
+}
+
+void SINSTR_get_type_structure() //get_type_structure Xi,k -- R_K_X
+{
+ INSACC_RKX(regX, kindInd);
+ tyPtr = DF_typeDeref((DF_TypePtr)regX);
+ if (DF_isRefType(tyPtr)) {
+ nhreg = AM_hreg + DF_TY_ATOMIC_SIZE;
+ n = AM_kstArity(kindInd);
+ AM_heapError(nhreg + DF_TY_ATOMIC_SIZE * n);
+ TR_trailType(tyPtr);
+ DF_mkStrType((MemPtr)tyPtr, (DF_TypePtr)AM_hreg);
+ DF_mkStrFuncType(AM_hreg, kindInd, n);
+ AM_tyvbbreg = (DF_TypePtr)AM_hreg;
+ AM_tyWriteFlag = ON;
+
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+ return;
+ } //else not ref
+ if (DF_isStrType(tyPtr)) {
+ tyPtr = DF_typeStrFuncAndArgs(tyPtr);
+ if (DF_typeStrFuncInd(tyPtr) == kindInd) {
+ AM_tysreg = DF_typeStrArgs(tyPtr);
+ AM_tyWriteFlag = OFF;
+ return;
+ }
+ }
+ EM_THROW(EM_FAIL);
+}
+
+void SINSTR_get_type_arrow() //get_type_arrow Xi -- R_X
+{
+ INSACC_RX(regX);
+ tyPtr = DF_typeDeref((DF_TypePtr)regX);
+ if (DF_isRefType(tyPtr)) {
+ AM_heapError(nhreg + DF_TY_ATOMIC_SIZE * DF_TY_ARROW_ARITY);
+ TR_trailType(tyPtr);
+ DF_mkArrowType((MemPtr)tyPtr, (DF_TypePtr)AM_hreg);
+ AM_tyvbbreg = (DF_TypePtr)AM_hreg;
+ AM_tyWriteFlag = ON;
+ return;
+ } //else not ref
+ if (DF_isArrowType(tyPtr)) {
+ AM_tysreg = DF_typeArrowArgs(tyPtr);
+ AM_tyWriteFlag = OFF;
+ return;
+ }
+ EM_THROW(EM_FAIL);
+}
+
+/**********************************************************/
+/* UNIFY CLASS */
+/**********************************************************/
+void SINSTR_unify_type_variable_t() //unify_type_variable Xi -- R_X
+{
+ INSACC_RX(regX);
+ if (AM_tyWriteFlag) {
+ DF_mkFreeVarType(AM_hreg);
+ *regX = *((AM_DataTypePtr)AM_hreg);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+ } else { //read mode
+ *regX = *((AM_DataTypePtr)AM_tysreg);
+ AM_tysreg++;
+ }
+}
+
+void SINSTR_unify_type_variable_p() //unify_type_variable Yi -- E_X
+{
+ INSACC_EX(envY);
+ if (AM_tyWriteFlag) {
+ DF_mkFreeVarType(AM_hreg);
+ *envY = *((AM_DataTypePtr)AM_hreg);
+ AM_hreg += DF_TM_ATOMIC_SIZE;
+ } else { //read mode
+ *envY = *((AM_DataTypePtr)AM_tysreg);
+ AM_tysreg++;
+ }
+}
+
+void SINSTR_unify_type_value_t() //unify_type_value Xi -- R_X
+{
+ INSACC_RX(regX);
+ tyPtr = DF_typeDeref((DF_TypePtr)regX);
+ if (AM_tyWriteFlag) {
+ AM_pdlError(1);
+ AM_initTypesPDL();
+ AM_pushPDL((MemPtr)tyPtr);
+ TY_typesOccC();
+ DF_copyAtomicType(tyPtr, AM_hreg);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+ } else { //readmode
+ AM_pdlError(2);
+ AM_initTypesPDL();
+ AM_pushPDL((MemPtr)tyPtr);
+ AM_pushPDL((MemPtr)AM_tysreg);
+ TY_typesUnify();
+ AM_tysreg++;
+ }
+}
+
+void SINSTR_unify_type_value_p() //unify_type_value Yi -- E_X
+{
+ INSACC_EX(envY);
+ tyPtr = DF_typeDeref((DF_TypePtr)envY);
+ if (AM_tyWriteFlag) {
+ AM_pdlError(1);
+ AM_initTypesPDL();
+ AM_pushPDL((MemPtr)tyPtr);
+ TY_typesOccC();
+ DF_copyAtomicType(tyPtr, AM_hreg);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+ } else { //readmode
+ AM_pdlError(2);
+ AM_initTypesPDL();
+ AM_pushPDL((MemPtr)tyPtr);
+ AM_pushPDL((MemPtr)AM_tysreg);
+ TY_typesUnify();
+ AM_tysreg++;
+ }
+}
+
+void SINSTR_unify_envty_value_t() //unify_envty_value Xi -- R_X
+{
+ INSACC_RX(regX);
+ tyPtr = DF_typeDeref((DF_TypePtr)regX);
+ if (AM_tyWriteFlag) {
+ DF_copyAtomicType(tyPtr, AM_hreg);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+ } else { //readmode
+ AM_pdlError(2);
+ AM_initTypesPDL();
+ AM_pushPDL((MemPtr)tyPtr);
+ AM_pushPDL((MemPtr)AM_tysreg);
+ TY_typesUnify();
+ AM_tysreg++;
+ }
+}
+
+void SINSTR_unify_envty_value_p() //unify_envty_value Yi -- E_X
+{
+ INSACC_EX(envY);
+ tyPtr = DF_typeDeref((DF_TypePtr)envY);
+ if (AM_tyWriteFlag) {
+ DF_copyAtomicType(tyPtr, AM_hreg);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+ } else { //readmode
+ AM_pdlError(2);
+ AM_initTypesPDL();
+ AM_pushPDL((MemPtr)tyPtr);
+ AM_pushPDL((MemPtr)AM_tysreg);
+ TY_typesUnify();
+ AM_tysreg++;
+ }
+}
+
+void SINSTR_unify_type_local_value_t() //unify_type_local_value Xi -- R_X
+{
+ INSACC_RX(regX);
+ tyPtr = DF_typeDeref((DF_TypePtr)regX);
+ if (AM_tyWriteFlag) {
+ if (DF_isRefType(tyPtr)) {
+ if (AM_stackAddr((MemPtr)tyPtr)) {
+ TR_trailType(tyPtr);
+ DF_mkFreeVarType(AM_hreg);
+ DF_mkRefType((MemPtr)tyPtr, (DF_TypePtr)AM_hreg);
+ *regX = *((AM_DataTypePtr)tyPtr);
+ } else DF_copyAtomicType(tyPtr, AM_hreg); //a heap address
+ } else { //not free var type
+ AM_pdlError(1);
+ AM_initTypesPDL();
+ AM_pushPDL((MemPtr)tyPtr);
+ TY_typesOccC();
+ DF_copyAtomicType(tyPtr, AM_hreg);
+ }
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+ } else { //readmode
+ AM_pdlError(2);
+ AM_initTypesPDL();
+ AM_pushPDL((MemPtr)tyPtr);
+ AM_pushPDL((MemPtr)AM_tysreg);
+ TY_typesUnify();
+ AM_tysreg++;
+ }
+}
+
+void SINSTR_unify_type_local_value_p() //unify_type_local_value Yi -- E_X
+{
+ INSACC_EX(envY);
+ tyPtr = DF_typeDeref((DF_TypePtr)envY);
+ if (AM_tyWriteFlag) {
+ if (DF_isRefType(tyPtr)) {
+ if (AM_stackAddr((MemPtr)tyPtr)) {
+ TR_trailType(tyPtr);
+ DF_mkFreeVarType(AM_hreg);
+ DF_mkRefType((MemPtr)tyPtr, (DF_TypePtr)AM_hreg);
+ } else DF_copyAtomicType(tyPtr, AM_hreg);
+ } else { //not free var type
+ AM_pdlError(1);
+ AM_initTypesPDL();
+ AM_pushPDL((MemPtr)tyPtr);
+ TY_typesOccC();
+ DF_copyAtomicType(tyPtr, AM_hreg);
+ }
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+ } else { //readmode
+ AM_pdlError(2);
+ AM_initTypesPDL();
+ AM_pushPDL((MemPtr)tyPtr);
+ AM_pushPDL((MemPtr)AM_tysreg);
+ TY_typesUnify();
+ AM_tysreg++;
+ }
+}
+
+void SINSTR_unify_envty_local_value_t() //unify_envty_local_value Xi -- R_X
+{
+ INSACC_RX(regX);
+ tyPtr = DF_typeDeref((DF_TypePtr)regX);
+ if (AM_tyWriteFlag) {
+ if (DF_isRefType(tyPtr) && (AM_stackAddr((MemPtr)tyPtr))) {
+ TR_trailType(tyPtr);
+ DF_mkFreeVarType(AM_hreg);
+ DF_mkRefType((MemPtr)tyPtr, (DF_TypePtr)AM_hreg);
+ *regX = *((AM_DataTypePtr)tyPtr);
+ } else DF_copyAtomicType(tyPtr, AM_hreg);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+ } else { //read mode
+ AM_pdlError(2);
+ AM_initTypesPDL();
+ AM_pushPDL((MemPtr)tyPtr);
+ AM_pushPDL((MemPtr)AM_tysreg);
+ TY_typesUnify();
+ AM_tysreg++;
+ }
+}
+
+void SINSTR_unify_envty_local_value_p() //unify_envty_local_value Yi -- E_X
+{
+ INSACC_EX(envY);
+ tyPtr = DF_typeDeref((DF_TypePtr)envY);
+ if (AM_tyWriteFlag) {
+ if (DF_isRefType(tyPtr) && (AM_stackAddr((MemPtr)tyPtr))) {
+ TR_trailType(tyPtr);
+ DF_mkFreeVarType(AM_hreg);
+ DF_mkRefType((MemPtr)tyPtr, (DF_TypePtr)AM_hreg);
+ } else DF_copyAtomicType(tyPtr, AM_hreg);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+ } else { //read mode
+ AM_pdlError(2);
+ AM_initTypesPDL();
+ AM_pushPDL((MemPtr)tyPtr);
+ AM_pushPDL((MemPtr)AM_tysreg);
+ TY_typesUnify();
+ AM_tysreg++;
+ }
+}
+
+void SINSTR_unify_type_constant() //unify_type_constant k -- K_X
+{
+ INSACC_KX(kindInd);
+ if (AM_tyWriteFlag) {
+ DF_mkSortType(AM_hreg, kindInd);
+ AM_hreg += DF_TY_ATOMIC_SIZE;
+ } else { //read mode
+ tyPtr = DF_typeDeref(AM_tysreg);
+ AM_tysreg++;
+ if (DF_isRefType(tyPtr)) {
+ TR_trailType(tyPtr);
+ DF_mkSortType((MemPtr)tyPtr, kindInd);
+ return;
+ } //otherwise not ref
+ if (DF_isSortType(tyPtr) && (DF_typeKindTabIndex(tyPtr) == kindInd))
+ return;
+ EM_THROW(EM_FAIL);
+ }
+}
+
+/* init type var for implication goal */
+void SINSTR_create_type_variable() //create_type_variable Yi -- E_X
+{
+ INSACC_EX(envY);
+ DF_mkFreeVarType((MemPtr)envY);
+}
+
+/*****************************************************************************/
+/* HIGHER-ORDER INSTRUCTIONS */
+/*****************************************************************************/
+void SINSTR_pattern_unify_t() //pattern_unify Xi,Aj -- R_R_X
+{
+ INSACC_RRX(regX, regA);
+ HOPU_patternUnifyPair((DF_TermPtr)regX, (DF_TermPtr)regA);
+}
+
+void SINSTR_pattern_unify_p() //pattern_unify Yi,Aj -- E_R_X
+{
+ INSACC_ERX(envY, regA);
+ HOPU_patternUnifyPair((DF_TermPtr)envY, (DF_TermPtr)regA);
+}
+
+void SINSTR_finish_unify() //finish_unify -- X
+{
+ INSACC_X();
+ HOPU_patternUnify();
+}
+
+void SINSTR_head_normalize_t() //head_normalize Xi -- R_X
+{
+ INSACC_RX(regX);
+ HN_hnorm((DF_TermPtr)regX); //no need to deref (hnorm takes care of it)
+}
+
+void SINSTR_head_normalize_p() //head_normalize Yi -- E_X
+{
+ INSACC_EX(envY);
+ HN_hnorm((DF_TermPtr)envY); //no need to deref (hnorm takes care of it)
+}
+
+/*****************************************************************************/
+/* LOGICAL INSTRUCTIONS */
+/*****************************************************************************/
+void SINSTR_incr_universe() //incr_universe -- X
+{
+ INSACC_X();
+ AM_ucError(AM_ucreg);
+ AM_ucreg++;
+}
+
+void SINSTR_decr_universe() //decr_universe -- X
+{
+ INSACC_X();
+ AM_ucreg--;
+}
+
+void SINSTR_set_univ_tag() //set_univ_tag Yi,c -- E_C_X
+{
+ INSACC_ECX(envY, constInd);
+ DF_mkConst((MemPtr)envY, AM_ucreg, constInd);
+}
+
+void SINSTR_tag_exists_t() //tag_exists Xi -- R_X
+{
+ INSACC_RX(regX);
+ nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_mkVar(AM_hreg, AM_ucreg);
+ DF_mkRef((MemPtr)regX, (DF_TermPtr)AM_hreg);
+ AM_hreg = nhreg;
+}
+
+void SINSTR_tag_exists_p() //tag_exists Yi -- E_X
+{
+ INSACC_EX(envY);
+ DF_mkVar((MemPtr)envY, AM_ucreg);
+}
+
+void SINSTR_tag_variable() //tag_variable Yi -- E_X
+{
+ INSACC_EX(envY);
+ DF_mkVar((MemPtr)envY, AM_envUC());
+}
+
+void SINSTR_push_impl_point() //put_impl_point n,t -- I1_IT_X
+{
+ INSACC_I1ITX(n, impTab);
+ m = MEM_implLTS(impTab);
+ ip = AM_findtos(n) + AM_NCLT_ENTRY_SIZE * m;
+ AM_tosreg = ip + AM_IMP_FIX_SIZE;
+ AM_stackError(AM_tosreg);
+ AM_mkImplRec(ip, MEM_implPST(impTab, m), MEM_implPSTS(impTab),
+ MEM_implFC(impTab));
+ if (m > 0) AM_mkImpNCLTab(ip, MEM_implLT(impTab), m);
+ AM_ireg = ip;
+}
+
+void SINSTR_pop_impl_point() //pop_impl_point -- X
+{
+ INSACC_X();
+ AM_ireg = AM_curimpPIP();
+ AM_settosreg();
+}
+
+void SINSTR_add_imports() //add_imports n,m,L -- SEG_I1_L_X
+{
+ INSACC_SEGI1LX(n, m, label);
+ bckfd = AM_cimpBCK(n);
+ l = AM_impBCKNo(bckfd);
+ if (AM_breg > AM_impBCKMRCP(bckfd)) TR_trailImport(bckfd);
+ AM_setBCKNo(bckfd, l+1);
+ AM_setBCKMRCP(bckfd, AM_breg);
+ if (l > 0) AM_preg = label;
+ else AM_tosreg = AM_findtos(m);
+}
+
+void SINSTR_remove_imports() //remove_imports n,L -- SEG_L_X
+{
+ INSACC_SEGLX(n, label);
+ bckfd = AM_cimpBCK(n);
+ l = AM_impBCKNo(bckfd);
+ if (AM_breg > AM_impBCKMRCP(bckfd)) TR_trailImport(bckfd);
+ AM_setBCKNo(bckfd, l-1);
+ AM_setBCKMRCP(bckfd, AM_breg);
+ if (l > 1) AM_preg = label;
+}
+
+void SINSTR_push_import() //push_import t -- MT_X
+{
+ INSACC_MTX(impTab);
+ n = MEM_impNCSEG(impTab); // n = # code segs (# bc field)
+ m = MEM_impLTS(impTab); // m = link tab size
+ l = AM_NCLT_ENTRY_SIZE * m; // l = space for next clause table
+ ip = AM_tosreg + (AM_BCKV_ENTRY_SIZE * n) + l;
+ AM_tosreg = ip + AM_IMP_FIX_SIZE;
+ AM_stackError(AM_tosreg);
+ if (n > 0) AM_initBCKVector(ip, l, n);
+ n = MEM_impNLC(impTab); // reuse n as the number of local consts
+ if (n > 0) {
+ AM_mkImptRecWL(ip, m, MEM_impPST(impTab, m, n), MEM_impPSTS(impTab),
+ MEM_impFC(impTab));
+ AM_ucError(AM_ucreg);
+ AM_ucreg++;
+ AM_initLocs(n, MEM_impLCT(impTab, m));
+ } else AM_mkImptRecWOL(ip, m, MEM_impPST(impTab, m, n), MEM_impPSTS(impTab),
+ MEM_impFC(impTab));
+ if (m > 0) AM_mkImpNCLTab(ip, MEM_impLT(impTab), m);
+ AM_ireg = ip;
+}
+
+void SINSTR_pop_imports() //pop_imports n -- I1_X
+{
+ INSACC_I1X(n);
+ for (; n > 0; n--){
+ if (AM_isCurImptWL()) AM_ucreg--;
+ AM_ireg = AM_curimpPIP();
+ }
+ AM_settosreg();
+}
+
+/*****************************************************************************/
+/* CONTROL INSTRUCTIONS */
+/*****************************************************************************/
+void SINSTR_allocate() //allocate n -- I1_X
+{
+ INSACC_I1X(n);
+ ep = AM_findtosEnv() + AM_ENV_FIX_SIZE;
+ AM_stackError(ep + AM_DATA_SIZE * n);
+ AM_ereg = AM_mkEnv(ep);
+}
+
+void SINSTR_deallocate() //deallocate -- X
+{
+ INSACC_X();
+ AM_cpreg = AM_envCP();
+ AM_ereg = AM_envCE();
+}
+
+void SINSTR_call() //call n,L -- I1_L_X
+{
+ AM_cpreg = AM_preg + INSTR_I1LX_LEN; //next instruction
+ AM_cereg = AM_ereg;
+ AM_b0reg = AM_breg;
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_I1LX_L));
+}
+
+void SINSTR_call_name() //call_name n,c -- I1_C_WP_X
+{
+ INSACC_I1CWPX_C(constInd);
+ AM_findCode(constInd, &cl, &ip);
+ if (cl) {
+ AM_cpreg = (AM_preg + INSTR_I1CWPX_LEN); // next instr
+ AM_b0reg = AM_breg;
+ AM_preg = cl;
+ AM_cireg = ip;
+ if (AM_isImplCI()) AM_cereg = AM_cimpCE();
+ } else EM_THROW(EM_FAIL);
+}
+
+void SINSTR_execute() //execute label -- L_X
+{
+ INSACC_LX(); //AM_preg has been set to label
+ AM_b0reg = AM_breg;
+}
+
+void SINSTR_execute_name() //execute_name c -- C_WP_X
+{
+ INSACC_CWPX(constInd);
+ AM_findCode(constInd, &cl, &ip);
+ if (cl) {
+ AM_b0reg = AM_breg;
+ AM_preg = cl;
+ AM_cireg = ip;
+ if (AM_isImplCI()) AM_cereg = AM_cimpCE();
+ } else EM_THROW(EM_FAIL);
+}
+
+void SINSTR_proceed() //proceed -- X
+{
+ /* We use a nonlocal procedure exit to get back to the toplevel
+ when a query has a result. We do this so that we don't have to
+ return values from instruction functions, and we don't have to
+ do any checks in the simulator loop. We use the exception
+ mechanism to acheive our nonlocal exit. */
+ if (AM_noEnv()) EM_THROW(EM_QUERY_RESULT);
+ else {
+ AM_preg = AM_cpreg;
+ AM_cireg = AM_envCI();
+ if (AM_isImplCI()) AM_cereg = AM_cimpCE();
+ }
+}
+
+/*****************************************************************************/
+/* CHOICE INSTRUCTIONS */
+/*****************************************************************************/
+void SINSTR_try_me_else() //try_me_else n,lab -- I1_L_X
+{
+ INSACC_I1LX(n, label);
+ AM_tosreg = (MemPtr)((AM_DataTypePtr)(AM_findtosEnv() + AM_CP_FIX_SIZE)+n);
+ AM_stackError(AM_tosreg);
+ cp = AM_tosreg - 1;
+ AM_mkCP(cp, label, n);
+ AM_breg = cp;
+ AM_hbreg = AM_hreg;
+}
+
+void SINSTR_retry_me_else() //retry_me_else n,lab -- I1_L_X
+{
+ INSACC_I1LX(n, label);
+ AM_restoreRegs(n);
+ AM_hbreg = AM_hreg;
+ if (AM_isImplCI()) AM_cereg = AM_cimpCE();
+ AM_setNClCP(label);
+}
+
+void SINSTR_trust_me() //trust_me n -- I1_WP_X
+{
+ INSACC_I1WPX(n);
+ AM_restoreRegs(n);
+ if (AM_isImplCI()) AM_cereg = AM_cimpCE();
+ AM_breg = AM_cpB();
+ AM_hbreg = AM_cpH();
+ AM_settosreg();
+}
+
+void SINSTR_try() //try n,label -- I1_L_X
+{
+ INSACC_I1LX_I1(n);
+ AM_tosreg = (MemPtr)((AM_DataTypePtr)(AM_findtosEnv() + AM_CP_FIX_SIZE)+n);
+ AM_stackError(AM_tosreg);
+ cp = AM_tosreg - 1;
+ AM_mkCP(cp, (AM_preg + INSTR_I1LX_LEN), n);
+ AM_breg = cp;
+ AM_hbreg = AM_hreg;
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_I1LX_L));
+}
+
+void SINSTR_retry() //retry n,label -- I1_L_X
+{
+ INSACC_I1LX_I1(n);
+ AM_restoreRegs(n);
+ AM_hbreg = AM_hreg;
+ if (AM_isImplCI()) AM_cereg = AM_cimpCE();
+ AM_setNClCP(AM_preg + INSTR_I1LX_LEN);
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_I1LX_L));
+}
+
+void SINSTR_trust() //trust n,label -- I1_L_WP_X
+{
+ INSACC_I1LWPX_I1(n);
+ AM_restoreRegs(n);
+ if (AM_isImplCI()) AM_cereg = AM_cimpCE();
+ AM_breg = AM_cpB();
+ AM_hbreg = AM_cpH();
+ AM_settosreg();
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_I1LWPX_L));
+}
+
+void SINSTR_trust_ext() //trust_ext n,m -- I1_N_X
+{
+ INSACC_I1NX(n, m);
+ nextcl = AM_impNCL(AM_cpCI(), m);
+ AM_preg = AM_impNCLCode(nextcl);
+
+ if (AM_isFailInstr(AM_preg)) {
+ AM_breg = AM_cpB();
+ AM_settosreg();
+ EM_THROW(EM_FAIL);
+ }
+ AM_restoreRegsWoCI(n);
+ AM_cireg = AM_impNCLIP(nextcl);
+ if (AM_isImplCI()) AM_cereg = AM_cimpCE();
+ AM_breg = AM_cpB();
+ AM_hbreg = AM_cpH();
+ AM_settosreg();
+}
+
+void SINSTR_try_else() //try_else n,lab1,lab2 -- I1_L_L_X
+{
+ INSACC_I1LLX(n, label); //AM_preg has been set
+ AM_tosreg = (MemPtr)((AM_DataTypePtr)(AM_findtosEnv() + AM_CP_FIX_SIZE)+n);
+ AM_stackError(AM_tosreg);
+ cp = AM_tosreg - 1;
+ AM_mkCP(cp, label, n);
+ AM_breg = cp;
+ AM_hbreg = AM_hreg;
+}
+
+void SINSTR_retry_else() //retry_else n,lab1,lab2 -- I1_L_L_X
+{
+ INSACC_I1LLX(n, label); //AM_preg has been set
+ AM_restoreRegs(n);
+ AM_hbreg = AM_hreg;
+ if (AM_isImplCI()) AM_cereg = AM_cimpCE();
+ AM_setNClCP(label);
+}
+
+void SINSTR_branch() //branch lab -- L_X
+{
+ INSACC_LX(); //AM_preg has been set to label
+}
+
+
+/*****************************************************************************/
+/* INDEXING INSTRUCTIONS */
+/*****************************************************************************/
+void SINSTR_switch_on_term() //switch_on_term lv,lc,ll,lbv --L_L_L_L_X
+{
+ regA = AM_reg(1);
+ tmPtr = DF_termDeref((DF_TermPtr)regA);
+ numAbs = 0;
+ while (DF_isLam(tmPtr)) {
+ numAbs += DF_lamNumAbs(tmPtr);
+ tmPtr = DF_termDeref(DF_lamBody(tmPtr));
+ }
+ if (DF_isCons(tmPtr)) {
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_LLLLX_L3));
+ return;
+ } else {
+ if (DF_isApp(tmPtr)) tmPtr = DF_termDeref(DF_appFunc(tmPtr));
+ if (DF_isNAtomic(tmPtr)) {
+ HN_hnorm(tmPtr);
+ numAbs += AM_numAbs;
+ tmPtr = AM_head;
+ }
+ switch (DF_termTag(tmPtr)) {
+ case DF_TM_TAG_VAR: {
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_LLLLX_L1));
+ return;
+ }
+ case DF_TM_TAG_CONST: {
+ tablInd = DF_constTabIndex(tmPtr);
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_LLLLX_L2));
+ return;
+ }
+ case DF_TM_TAG_INT: {
+ tablInd = PERV_INTC_INDEX;
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_LLLLX_L2));
+ return;
+ }
+ case DF_TM_TAG_FLOAT: {
+ tablInd = PERV_REALC_INDEX;
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_LLLLX_L2));
+ return;
+ }
+ case DF_TM_TAG_STR: {
+ tablInd = PERV_STRC_INDEX;
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_LLLLX_L2));
+ return;
+ }
+ case DF_TM_TAG_NIL: {
+ tablInd = PERV_NIL_INDEX;
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_LLLLX_L2));
+ return;
+ }
+ case DF_TM_TAG_STREAM:{ EM_THROW(EM_FAIL); }
+ case DF_TM_TAG_CONS: {
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_LLLLX_L3));
+ return;
+ }
+ case DF_TM_TAG_BVAR:
+ {
+ numAbs = numAbs - DF_bvIndex(tmPtr);
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_LLLLX_L4));
+ return;
+ }
+ }
+ }
+}
+
+void SINSTR_switch_on_constant() //switch_on_constant n,tab -- I1_HT_X
+{
+ INSACC_I1HTX(n, table);
+ cl = LD_SEARCHTAB_HashSrch(tablInd, n, table);
+ if (cl) {
+ AM_preg = cl;
+ return;
+ } else EM_THROW(EM_FAIL);
+}
+
+void SINSTR_switch_on_bvar() //switch_on_bvar n,tab -- I1_BVT_X
+{
+ INSACC_I1BVTX(n, table);
+ for (m = 0; m != n; m++)
+ if (numAbs = MEM_branchTabIndexVal(table, m)) break;
+ if (m < n) AM_preg = MEM_branchTabCodePtr(table, m);
+ else EM_THROW(EM_FAIL);
+}
+
+void SINSTR_switch_on_reg() //switch_on_reg n,SL1,FL2 -- N_L_L_X
+{
+ INSACC_NLLX_N(n);
+ nextcl = AM_impNCL(AM_cireg, n);
+ if (AM_isFailInstr(AM_impNCLCode(nextcl))){
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_NLLX_L2));}
+ else {
+ AM_preg = *((INSTR_CodeLabel *)(AM_preg + INSTR_NLLX_L1));
+ }
+}
+
+/*****************************************************************************/
+/* CUT INSTRUCTIONS */
+/*****************************************************************************/
+void SINSTR_neck_cut() //neck_cut -- X
+{
+ INSACC_X();
+ AM_breg = AM_b0reg;
+ AM_hbreg = AM_cpH();
+ AM_settosreg();
+}
+
+void SINSTR_get_level() //get_level Yn -- E_X
+{
+ INSACC_EX(envY);
+ *((MemPtr *)envY) = AM_b0reg;
+}
+
+void SINSTR_put_level() //put_level Yn -- E_X
+{
+ INSACC_EX(envY);
+ AM_b0reg = *((MemPtr *)envY);
+}
+
+void SINSTR_cut() //cut Yn -- E_X
+{
+ INSACC_EX(envY);
+ AM_breg = *((MemPtr *)envY);
+ AM_hbreg = AM_cpH();
+ AM_settosreg();
+}
+
+/*****************************************************************************/
+/* MISCELLANEOUS INSTRUCTIONS */
+/*****************************************************************************/
+void SINSTR_call_builtin() //call_builtin n -- I1_WP_X
+{
+ INSACC_I1I1WPX(n);
+ AM_cpreg = AM_preg;
+ BI_dispatch(n);
+}
+
+void SINSTR_builtin() //builtin n -- I1_X
+{
+ INSACC_I1X(n);
+ if (!AM_noEnv()) {
+ AM_cireg = AM_envCI();
+ if (AM_isImplCI()) AM_cereg = AM_cimpCE();
+ }
+ BI_dispatch(n);
+}
+
+void SINSTR_stop() //stop -- X
+{
+ EM_THROW(EM_TOP_LEVEL);
+}
+
+void SINSTR_halt() //halt -- X
+{
+ EM_THROW(EM_EXIT);
+}
+
+void SINSTR_fail() //fail -- X
+{
+ EM_THROW(EM_FAIL);
+}
+
+
+/**************************************************************************/
+/* linker only */
+/**************************************************************************/
+void SINSTR_execute_link_only()
+{
+ EM_THROW(EM_ABORT);
+}
+
+void SINSTR_call_link_only()
+{
+ EM_THROW(EM_ABORT);
+}
+
+
+#endif //SIMINSTR_C
diff --git a/src/runtime/c/teyjus/simulator/siminstr.h b/src/runtime/c/teyjus/simulator/siminstr.h
new file mode 100644
index 000000000..d0521fb99
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/siminstr.h
@@ -0,0 +1,248 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/*****************************************************************************/
+/* */
+/* File siminstr.h. The instruction set of the virtual machine. */
+/*****************************************************************************/
+#ifndef SIMINSTR_H
+#define SIMINSTR_H
+
+/*****************************************************************************/
+/* INSTRUCTIONS FOR UNIFYING AND CREATING TERMS */
+/*****************************************************************************/
+
+/**********************************************************/
+/* PUT CLASS */
+/**********************************************************/
+void SINSTR_put_variable_t();
+void SINSTR_put_variable_te();
+void SINSTR_put_variable_p();
+void SINSTR_put_value_t();
+void SINSTR_put_value_p();
+void SINSTR_put_unsafe_value();
+void SINSTR_copy_value();
+void SINSTR_put_m_const();
+void SINSTR_put_p_const();
+void SINSTR_put_nil();
+void SINSTR_put_integer();
+void SINSTR_put_float();
+void SINSTR_put_string();
+void SINSTR_put_index();
+void SINSTR_put_app();
+void SINSTR_put_list();
+void SINSTR_put_lambda();
+
+/**********************************************************/
+/* SET CLASS */
+/**********************************************************/
+void SINSTR_set_variable_t();
+void SINSTR_set_variable_te();
+void SINSTR_set_variable_p();
+void SINSTR_set_value_t();
+void SINSTR_set_value_p();
+void SINSTR_globalize_pt();
+void SINSTR_globalize_t();
+void SINSTR_set_m_const();
+void SINSTR_set_p_const();
+void SINSTR_set_nil();
+void SINSTR_set_integer();
+void SINSTR_set_float();
+void SINSTR_set_string();
+void SINSTR_set_index();
+void SINSTR_set_void();
+//needed?
+void SINSTR_deref();
+void SINSTR_set_lambda();
+
+/**********************************************************/
+/* GET CLASS */
+/**********************************************************/
+void SINSTR_get_variable_t();
+void SINSTR_get_variable_p();
+void SINSTR_init_variable_t();
+void SINSTR_init_variable_p();
+void SINSTR_get_m_constant();
+void SINSTR_get_p_constant();
+void SINSTR_get_integer();
+void SINSTR_get_float();
+void SINSTR_get_string();
+void SINSTR_get_nil();
+void SINSTR_get_m_structure();
+void SINSTR_get_p_structure();
+void SINSTR_get_list();
+
+/**********************************************************/
+/* UNIFY CLASS */
+/**********************************************************/
+void SINSTR_unify_variable_t();
+void SINSTR_unify_variable_p();
+void SINSTR_unify_value_t();
+void SINSTR_unify_value_p();
+void SINSTR_unify_local_value_t();
+void SINSTR_unify_local_value_p();
+void SINSTR_unify_m_constant();
+void SINSTR_unify_p_constant();
+void SINSTR_unify_nil();
+void SINSTR_unify_integer();
+void SINSTR_unify_float();
+void SINSTR_unify_string();
+void SINSTR_unify_void();
+
+/*****************************************************************************/
+/* INSTRUCTIONS FOR UNIFYING AND CREATING TYPES */
+/*****************************************************************************/
+
+/**********************************************************/
+/* PUT CLASS */
+/**********************************************************/
+void SINSTR_put_type_variable_t();
+void SINSTR_put_type_variable_p();
+void SINSTR_put_type_value_t();
+void SINSTR_put_type_value_p();
+void SINSTR_put_type_unsafe_value();
+void SINSTR_put_type_const();
+void SINSTR_put_type_structure();
+void SINSTR_put_type_arrow();
+
+/**********************************************************/
+/* SET CLASS */
+/**********************************************************/
+void SINSTR_set_type_variable_t();
+void SINSTR_set_type_variable_p();
+void SINSTR_set_type_value_t();
+void SINSTR_set_type_value_p();
+void SINSTR_set_type_local_value_t();
+void SINSTR_set_type_local_value_p();
+void SINSTR_set_type_constant();
+
+/**********************************************************/
+/* GET CLASS */
+/**********************************************************/
+void SINSTR_get_type_variable_t();
+void SINSTR_get_type_variable_p();
+void SINSTR_init_type_variable_t();
+void SINSTR_init_type_variable_p();
+void SINSTR_get_type_value_t();
+void SINSTR_get_type_value_p();
+void SINSTR_get_type_constant();
+void SINSTR_get_type_structure();
+void SINSTR_get_type_arrow();
+
+/**********************************************************/
+/* UNIFY CLASS */
+/**********************************************************/
+void SINSTR_unify_type_variable_t();
+void SINSTR_unify_type_variable_p();
+void SINSTR_unify_type_value_t();
+void SINSTR_unify_type_value_p();
+void SINSTR_unify_envty_value_t();
+void SINSTR_unify_envty_value_p();
+void SINSTR_unify_type_local_value_t();
+void SINSTR_unify_type_local_value_p();
+void SINSTR_unify_envty_local_value_t();
+void SINSTR_unify_envty_local_value_p();
+void SINSTR_unify_type_constant();
+
+/* init type var for implication goal */
+void SINSTR_create_type_variable();
+
+/*****************************************************************************/
+/* HIGHER-ORDER INSTRUCTIONS */
+/*****************************************************************************/
+void SINSTR_pattern_unify_t();
+void SINSTR_pattern_unify_p();
+void SINSTR_finish_unify();
+void SINSTR_head_normalize_t();
+void SINSTR_head_normalize_p();
+
+/*****************************************************************************/
+/* LOGICAL INSTRUCTIONS */
+/*****************************************************************************/
+void SINSTR_incr_universe();
+void SINSTR_decr_universe();
+void SINSTR_set_univ_tag();
+void SINSTR_tag_exists_t();
+void SINSTR_tag_exists_p();
+void SINSTR_tag_variable();
+
+void SINSTR_push_impl_point();
+void SINSTR_pop_impl_point();
+void SINSTR_add_imports();
+void SINSTR_remove_imports();
+void SINSTR_push_import();
+void SINSTR_pop_imports();
+
+/*****************************************************************************/
+/* CONTROL INSTRUCTIONS */
+/*****************************************************************************/
+void SINSTR_allocate();
+void SINSTR_deallocate();
+void SINSTR_call();
+void SINSTR_call_name();
+void SINSTR_execute();
+void SINSTR_execute_name();
+void SINSTR_proceed();
+
+/*****************************************************************************/
+/* CHOICE INSTRUCTIONS */
+/*****************************************************************************/
+void SINSTR_try_me_else();
+void SINSTR_retry_me_else();
+void SINSTR_trust_me();
+void SINSTR_try();
+void SINSTR_retry();
+void SINSTR_trust();
+void SINSTR_trust_ext();
+void SINSTR_try_else();
+void SINSTR_retry_else();
+void SINSTR_branch();
+
+/*****************************************************************************/
+/* INDEXING INSTRUCTIONS */
+/*****************************************************************************/
+void SINSTR_switch_on_term();
+void SINSTR_switch_on_constant();
+void SINSTR_switch_on_bvar();
+void SINSTR_switch_on_reg();
+
+/*****************************************************************************/
+/* CUT INSTRUCTIONS */
+/*****************************************************************************/
+void SINSTR_neck_cut();
+void SINSTR_get_level();
+void SINSTR_put_level();
+void SINSTR_cut();
+
+/*****************************************************************************/
+/* MISCELLANEOUS INSTRUCTIONS */
+/*****************************************************************************/
+void SINSTR_call_builtin();
+void SINSTR_builtin();
+void SINSTR_stop();
+void SINSTR_halt();
+void SINSTR_fail();
+
+/**************************************************************************/
+/* linker only */
+/**************************************************************************/
+void SINSTR_execute_link_only();
+void SINSTR_call_link_only();
+
+#endif //SIMINSTR_H
diff --git a/src/runtime/c/teyjus/simulator/siminstrlocal.c b/src/runtime/c/teyjus/simulator/siminstrlocal.c
new file mode 100644
index 000000000..3e7d70292
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/siminstrlocal.c
@@ -0,0 +1,583 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/***************************************************************************/
+/* */
+/* File siminstrlocal.c. This file contains the definitions of auxiliary */
+/* functions used in siminstr.c. */
+/***************************************************************************/
+
+#include "siminstrlocal.h"
+#include "dataformats.h"
+#include "abstmachine.h"
+#include "trail.h"
+#include "hnorm.h"
+#include "hopu.h"
+#include "../system/error.h" //to be modified
+
+#include //to be removed
+
+//Bind a free variable to a constant (without type association)
+//Note the BND register is set to ON
+static void SINSTRL_bindConst(DF_TermPtr varPtr, int c)
+{
+ TR_trailTerm(varPtr);
+ DF_mkConst((MemPtr)varPtr, AM_cstUnivCount(c), c);
+ AM_bndFlag = ON;
+}
+
+//Bind a free variable to an integer
+//Note the BND register is set to ON
+static void SINSTRL_bindInt(DF_TermPtr varPtr, int i)
+{
+ TR_trailTerm(varPtr);
+ DF_mkInt((MemPtr)varPtr, i);
+ AM_bndFlag = ON;
+}
+
+//Bind a free variable to a float
+//Note the BND register is set to ON
+static void SINSTRL_bindFloat(DF_TermPtr varPtr, float f)
+{
+ TR_trailTerm(varPtr);
+ DF_mkFloat((MemPtr)varPtr, f);
+ AM_bndFlag = ON;
+}
+
+//Bind a free variable to a string
+//Note the BND register is set to ON
+void SINSTRL_bindString(DF_TermPtr varPtr, DF_StrDataPtr str)
+{
+ TR_trailTerm(varPtr);
+ DF_mkStr((MemPtr)varPtr, str);
+ AM_bndFlag = ON;
+}
+
+//Bind a free variable to a constant with type association
+//Note the BND register is set to ON; the TYWIRTE mode is set to ON
+static void SINSTRL_bindTConst(DF_TermPtr varPtr, int c)
+{
+ MemPtr nhreg = AM_hreg + DF_TM_TCONST_SIZE;
+ AM_heapError(nhreg + DF_TY_ATOMIC_SIZE * AM_cstTyEnvSize(c));
+ DF_mkTConst(AM_hreg, AM_cstUnivCount(c), c, (DF_TypePtr)nhreg);
+ TR_trailTerm(varPtr);
+ DF_mkRef((MemPtr)varPtr, (DF_TermPtr)AM_hreg);
+ AM_hreg = nhreg;
+ AM_bndFlag = ON;
+ AM_tyWriteFlag = ON;
+}
+
+//Bind a free variable to nil
+//Note the BND register is set to ON
+static void SINSTRL_bindNil(DF_TermPtr varPtr)
+{
+ TR_trailTerm(varPtr);
+ DF_mkNil((MemPtr)varPtr);
+ AM_bndFlag = ON;
+}
+
+
+//Bind a free variable to an application object with a non-type-associated
+//constant head.
+//Setting relevant registers for 1)entering WRITE mode 2)entering OCC mode
+// 3)indicating the occurrence of binding (BND = ON).
+void SINSTRL_bindStr(DF_TermPtr varPtr, int constInd, int arity)
+{
+ MemPtr args = AM_hreg + DF_TM_APP_SIZE;
+ MemPtr func = args + arity * DF_TM_ATOMIC_SIZE;
+ MemPtr nhreg = func + DF_TM_ATOMIC_SIZE; //new heap top
+ AM_heapError(nhreg);
+ DF_mkApp(AM_hreg, arity, (DF_TermPtr)func, (DF_TermPtr)args); //mk app
+ DF_mkConst(func, AM_cstUnivCount(constInd), constInd); //mk const
+ //enter WRITE mode
+ AM_sreg = (DF_TermPtr)args; AM_writeFlag = ON;
+ //enter OCC mode
+ AM_adjreg = DF_fvUnivCount(varPtr); AM_vbbreg = (DF_TermPtr)AM_hreg;
+ AM_ocFlag = ON;
+ //performing binding
+ TR_trailTerm(varPtr);
+ DF_mkRef((MemPtr)varPtr, (DF_TermPtr)AM_hreg);
+ AM_bndFlag = ON;
+
+ AM_hreg = nhreg;
+}
+
+//Bind a free variable to an application object with a type-associated
+//constant head.
+//Setting relevant registers for 1)entering WRITE and TYWRITE mode 2)entering
+// OCC mode 3)indicating the occurrence of binding (BND = ON).
+void SINSTRL_bindTStr(DF_TermPtr varPtr, int constInd, int arity)
+{
+ MemPtr args = AM_hreg + DF_TM_APP_SIZE;
+ MemPtr func = args + arity * DF_TM_ATOMIC_SIZE;
+ MemPtr nhreg = func + DF_TM_TCONST_SIZE; //new heap top
+ AM_heapError(nhreg + AM_cstTyEnvSize(constInd) + DF_TY_ATOMIC_SIZE);
+ DF_mkApp(AM_hreg, arity, (DF_TermPtr)func, (DF_TermPtr)args); //mk app
+ DF_mkTConst(func, AM_cstUnivCount(constInd), constInd, (DF_TypePtr)nhreg);
+ //enter WRITE and TYWRITE mode
+ AM_sreg = (DF_TermPtr)args; AM_writeFlag = ON; AM_tyWriteFlag = ON;
+ //enter OCC mode
+ AM_adjreg = DF_fvUnivCount(varPtr); AM_vbbreg = (DF_TermPtr)AM_hreg;
+ AM_ocFlag = ON;
+ //perform binding
+ TR_trailTerm(varPtr);
+ DF_mkRef((MemPtr)varPtr, (DF_TermPtr)AM_hreg);
+ AM_bndFlag = ON;
+
+ AM_hreg = nhreg;
+}
+
+//Bind a free variable to a list cons.
+//Setting relevant registers for 1)entering WRITE mode 2)entering OCC mode
+// 3)indicating the occurrence of binding (BND = ON).
+void SINSTRL_bindCons(DF_TermPtr varPtr)
+{
+ MemPtr nhreg = AM_hreg + DF_CONS_ARITY * DF_TM_ATOMIC_SIZE; //new heap top
+ AM_heapError(nhreg);
+ //enter WRITE mode
+ AM_sreg = (DF_TermPtr)AM_hreg; AM_writeFlag = ON;
+ //enter OCC mode
+ AM_adjreg = DF_fvUnivCount(varPtr); AM_vbbreg = (DF_TermPtr)AM_hreg;
+ AM_ocFlag = ON;
+ //perform binding
+ TR_trailTerm(varPtr);
+ DF_mkCons((MemPtr)varPtr, AM_sreg);
+ AM_bndFlag = ON;
+
+ AM_hreg = nhreg;
+}
+
+
+// Delay a pair (onto the PDL stack) with a given term as the first, and a
+// constant (without type association) as the second.
+// Note this function is invoked in get_m_constant() when the 'dynamic' term
+// is higher-order, and so it is guaranteed that tPtr is a heap address.
+static void SINSTRL_delayConst(DF_TermPtr tPtr, int c)
+{
+ MemPtr nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_mkConst(AM_hreg, AM_cstUnivCount(c), c);
+ AM_pdlError(2);
+ AM_pushPDL((MemPtr)tPtr);
+ AM_pushPDL(AM_hreg);
+ AM_hreg = nhreg;
+}
+
+//Delay a pair (onto the PDL stack) with a given term as the first, and a
+//constant with type association the second.
+//Note TYWRITE mode is set to ON.
+static void SINSTRL_delayTConst(DF_TermPtr tPtr, int c)
+{
+ MemPtr nhreg = AM_hreg + DF_TM_TCONST_SIZE;
+ AM_heapError(nhreg + DF_TY_ATOMIC_SIZE * AM_cstTyEnvSize(c));
+ DF_mkTConst(AM_hreg, AM_cstUnivCount(c), c, (DF_TypePtr)nhreg);
+ AM_pdlError(2);
+ AM_pushPDL((MemPtr)tPtr);
+ AM_pushPDL(AM_hreg);
+ AM_hreg = nhreg;
+ AM_tyWriteFlag = ON;
+}
+
+//Delay a pair (onto the PDL stack) with a given term and an integer
+static void SINSTRL_delayInt(DF_TermPtr tPtr, int i)
+{
+ MemPtr nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_mkInt(AM_hreg, i);
+ AM_pdlError(2);
+ AM_pushPDL((MemPtr)tPtr);
+ AM_pushPDL(AM_hreg);
+ AM_hreg = nhreg;
+}
+
+//Delay a pair (onto the PDL stack) with a given term and a float
+static void SINSTRL_delayFloat(DF_TermPtr tPtr, float f)
+{
+ MemPtr nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_mkFloat(AM_hreg, f);
+ AM_pdlError(2);
+ AM_pushPDL((MemPtr)tPtr);
+ AM_pushPDL(AM_hreg);
+ AM_hreg = nhreg;
+}
+
+//Delay a pair (onto the PDL stack) with a given term and a string
+static void SINSTRL_delayString(DF_TermPtr tPtr, DF_StrDataPtr str)
+{
+ MemPtr nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_mkStr(AM_hreg, str);
+ AM_pdlError(2);
+ AM_pushPDL((MemPtr)tPtr);
+ AM_pushPDL(AM_hreg);
+ AM_hreg = nhreg;
+}
+
+//Delay a pair (onto the PDL stack) with a given term and nil list
+static void SINSTRL_delayNil(DF_TermPtr tPtr)
+{
+ MemPtr nhreg = AM_hreg + DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_mkNil(AM_hreg);
+ AM_pdlError(2);
+ AM_pushPDL((MemPtr)tPtr);
+ AM_pushPDL(AM_hreg);
+ AM_hreg = nhreg;
+}
+
+//Delay a pair (onto the PDL stack) with a given term and an application
+//object with a non-type-associated constant head.
+//Setting registers 1)entering WRITE mode: S and WRITE; 2)entering OCC OFF
+//mode; 3) ADJ
+void SINSTRL_delayStr(DF_TermPtr tPtr, int constInd, int arity)
+{
+ MemPtr args = AM_hreg + DF_TM_APP_SIZE;
+ MemPtr func = args + arity * DF_TM_ATOMIC_SIZE;
+ MemPtr nhreg = func + DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_mkApp(AM_hreg, arity, (DF_TermPtr)func, (DF_TermPtr)args); //mk app
+ DF_mkConst(func, AM_cstUnivCount(constInd), constInd); //mk const
+ //push onto PDL
+ AM_pdlError(2);
+ AM_pushPDL((MemPtr)tPtr);
+ AM_pushPDL(AM_hreg);
+ //enter WRITE mode
+ AM_sreg = (DF_TermPtr)args; AM_writeFlag = ON;
+ //enter OCC OFF mode
+ AM_ocFlag = OFF;
+ AM_adjreg = AM_ucreg;
+
+ AM_hreg = nhreg;
+}
+
+//Delay a pair (onto the PDL stack) with a given term and an application
+//object with a type-associated constant head.
+//Setting registers 1)entering WRITE and TYWRITE mode: S, WRITE and TYWRITE;
+// 2)entering OCC OFF mode; 3) ADJ
+void SINSTRL_delayTStr(DF_TermPtr tPtr, int constInd, int arity)
+{
+ MemPtr args = AM_hreg + DF_TM_APP_SIZE;
+ MemPtr func = args + arity * DF_TM_ATOMIC_SIZE;
+ MemPtr nhreg = func + DF_TM_TCONST_SIZE;
+ AM_heapError(nhreg + AM_cstTyEnvSize(constInd) + DF_TY_ATOMIC_SIZE);
+ DF_mkApp(AM_hreg, arity, (DF_TermPtr)func, (DF_TermPtr)args); //mk app
+ DF_mkTConst(func, AM_cstUnivCount(constInd), constInd, (DF_TypePtr)nhreg);
+ //push onto PDL
+ AM_pdlError(2);
+ AM_pushPDL((MemPtr)tPtr);
+ AM_pushPDL(AM_hreg);
+ //enter WRITE and TYWRITE mode
+ AM_sreg = (DF_TermPtr)args; AM_writeFlag = ON; AM_tyWriteFlag = ON;
+ //enter OCC OFF mode
+ AM_ocFlag = OFF;
+ AM_adjreg = AM_ucreg;
+
+ AM_hreg = nhreg;
+}
+
+//Delay a pair (onto the PDL stack) with a given term and a list cons
+//Setting registers 1)entering WRITE mode: S and WRITE; 2)entering OCC OFF
+//mode; 3) ADJ
+void SINSTRL_delayCons(DF_TermPtr tPtr)
+{
+ MemPtr args = AM_hreg + DF_TM_ATOMIC_SIZE;
+ MemPtr nhreg = args + DF_CONS_ARITY * DF_TM_ATOMIC_SIZE;
+ AM_heapError(nhreg);
+ DF_mkCons(AM_hreg, (DF_TermPtr)args);
+ //push onto PDL
+ AM_pdlError(2);
+ AM_pushPDL((MemPtr)tPtr);
+ AM_pushPDL(AM_hreg);
+ //enter WRITE mode
+ AM_sreg = (DF_TermPtr)args; AM_writeFlag = ON;
+ //enter OCC OFF mode
+ AM_ocFlag = OFF;
+ AM_adjreg = AM_ucreg;
+
+ AM_hreg = nhreg;
+}
+
+/*The main action of unify_value in write mode. This code carries out the */
+/*necessary occurs checking in the binding of a variable that has already */
+/*commenced through an enclosing get_structure instruction. */
+/*Care has been taken to avoid making a reference to a register or stack */
+/*address. */
+void SINSTRL_bindSreg(DF_TermPtr tmPtr)
+{
+ DF_TermPtr bndBody;
+ int nabs;
+
+ HN_hnormOcc(tmPtr);
+ nabs = AM_numAbs;
+ HOPU_copyFlagGlb = FALSE;
+ if (AM_rigFlag) {
+ bndBody = HOPU_rigNestedSubstC(AM_head, HOPU_lamBody(tmPtr), AM_argVec,
+ AM_numArgs, nabs);
+ if (nabs) DF_mkLam((MemPtr)AM_sreg, nabs, bndBody); //no emb error
+ else {
+ if (HOPU_copyFlagGlb) DF_mkRef((MemPtr)AM_sreg, bndBody);
+ else HOPU_globalizeCopyRigid(bndBody, AM_sreg);
+ }
+ } else { //AM_rigFlag = FALSE
+ bndBody = HOPU_flexNestedSubstC(AM_head, AM_argVec, AM_numArgs,
+ HOPU_lamBody(tmPtr), nabs);
+ if (HOPU_copyFlagGlb == FALSE) bndBody = HOPU_globalizeFlex(bndBody);
+ if (nabs) DF_mkLam((MemPtr)AM_sreg, nabs, bndBody);
+ else DF_mkRef((MemPtr)AM_sreg, bndBody);
+ }
+}
+
+/*The main component of unify_local_value in write mode when it is determined */
+/*that we are dealing with a heap cell. */
+void SINSTRL_bindSregH(DF_TermPtr tmPtr)
+{
+ DF_TermPtr bndBody;
+ int nabs;
+
+ HN_hnormOcc(tmPtr);
+ nabs = AM_numAbs;
+ HOPU_copyFlagGlb = FALSE;
+ if (AM_rigFlag) {
+ bndBody = HOPU_rigNestedSubstC(AM_head, HOPU_lamBody(tmPtr), AM_argVec,
+ AM_numArgs, nabs);
+ if (nabs) DF_mkLam((MemPtr)AM_sreg, nabs, bndBody);
+ else DF_mkRef((MemPtr)AM_sreg, bndBody);
+ } else { //AM_rigFlag = FALSE
+ bndBody = HOPU_flexNestedSubstC(AM_head, AM_argVec, AM_numArgs,
+ HOPU_lamBody(tmPtr), nabs);
+ if (nabs) DF_mkLam((MemPtr)AM_sreg, nabs, bndBody);
+ else DF_mkRef((MemPtr)AM_sreg, bndBody);
+ }
+}
+
+
+/*****************************************************************************/
+/* Auxiliary functions for unifying terms used in get- and unify- instrutions*/
+/*****************************************************************************/
+
+//attempting to unify a dereference term with a constant without type assoc
+void SINSTRL_unifyConst(DF_TermPtr tmPtr, int constInd)
+{
+ switch (DF_termTag(tmPtr)) {
+ case DF_TM_TAG_VAR:
+ {
+ if (DF_fvUnivCount(tmPtr)= AM_cstUnivCount(constInd)))
+ SINSTRL_bindConst(AM_head, constInd);
+ else EM_THROW(EM_FAIL);
+ } else SINSTRL_delayConst(tmPtr, constInd); //higher-order
+ } // (AM_rigFlag == OFF)
+ return;
+ }
+ default:{ EM_THROW(EM_FAIL); } //CONS, NIL, BVAR, INT, FLOAT, STR, (STREAM)
+ } //switch
+}
+
+//attempting to unify a dereferenced term with an integer
+void SINSTRL_unifyInt(DF_TermPtr tmPtr, int intValue)
+{
+ switch (DF_termTag(tmPtr)) {
+ case DF_TM_TAG_VAR: { SINSTRL_bindInt(tmPtr, intValue); return; }
+ case DF_TM_TAG_INT:
+ {
+ if (intValue != DF_intValue(tmPtr)) EM_THROW(EM_FAIL);
+ return;
+ }
+ case DF_TM_TAG_APP:
+ { //Note the functor of app cannot be an integer per well-typedness
+ if (DF_isConst(DF_termDeref(DF_appFunc(tmPtr)))) EM_THROW(EM_FAIL);
+ }
+ case DF_TM_TAG_SUSP: //and other APP cases
+ { // Note ABS cannot occur due to well-typedness
+ HN_hnorm(tmPtr);
+ if (AM_rigFlag) {
+ if (DF_isInt(AM_head) && (DF_intValue(AM_head) == intValue)) return;
+ else EM_THROW(EM_FAIL);
+ } else { //(AM_rigFlag == OFF)
+ if (AM_numArgs == 0) //note AM_numAbs must be 0 because of type
+ SINSTRL_bindInt(AM_head, intValue);
+ else SINSTRL_delayInt(tmPtr, intValue);
+ return;
+ } //(AM_rigFlag == OFF)
+ }
+ default: { EM_THROW(EM_FAIL); } //BVAR, CONST
+ } //switch
+}
+
+//attempting to unify a dereferenced term with a real number
+void SINSTRL_unifyFloat(DF_TermPtr tmPtr, float floatValue)
+{
+ switch (DF_termTag(tmPtr)){
+ case DF_TM_TAG_VAR: { SINSTRL_bindFloat(tmPtr, floatValue); return; }
+ case DF_TM_TAG_FLOAT:
+ {
+ if (floatValue != DF_floatValue(tmPtr)) EM_THROW(EM_FAIL);
+ return;
+ }
+ case DF_TM_TAG_APP:
+ { //Note the functor of app cannot be a float per well-typedness
+ if (DF_isConst(DF_termDeref(DF_appFunc(tmPtr)))) EM_THROW(EM_FAIL);
+ }
+ case DF_TM_TAG_SUSP: //other APP cases
+ { //Note ABS cannot occur due to well-typedness
+ HN_hnorm(tmPtr);
+ if (AM_rigFlag) {
+ if (DF_isFloat(AM_head) && (DF_floatValue(AM_head) == floatValue))
+ return;
+ else EM_THROW(EM_FAIL);
+ } else { //(AM_rigFlag == OFF)
+ if (AM_numArgs == 0) //note AM_numAbs must be 0 because of type
+ SINSTRL_bindFloat(AM_head, floatValue);
+ else SINSTRL_delayFloat(tmPtr, floatValue);
+ return;
+ } //(AM_rigFlag == OFF)
+ }
+ default: { EM_THROW(EM_FAIL); } //BVAR, CONST
+ } //switch
+}
+
+//attempting to unify a dereferenced term with a string
+void SINSTRL_unifyString(DF_TermPtr tmPtr, DF_StrDataPtr str)
+{
+ switch (DF_termTag(tmPtr)){
+ case DF_TM_TAG_VAR: { SINSTRL_bindString(tmPtr, str); return; }
+ case DF_TM_TAG_STR:
+ {
+ if (!DF_sameStrData(tmPtr, str)) EM_THROW(EM_FAIL);
+ return;
+ }
+ case DF_TM_TAG_APP:
+ { //Note the functor of app cannot be a string per well-typedness
+ if (DF_isConst(DF_termDeref(DF_appFunc(tmPtr)))) EM_THROW(EM_FAIL);
+ }
+ case DF_TM_TAG_SUSP: //and other APP cases
+ { //Note ABS cannot occur due to well-typedness
+ HN_hnorm(tmPtr);
+ if (AM_rigFlag) {
+ if (DF_isStr(AM_head) && (DF_sameStrData(AM_head, str))) return;
+ else EM_THROW(EM_FAIL);
+ } else {//(AM_rigFlag == OFF)
+ if (AM_numArgs == 0) //note AM_numAbs must be 0 because of type
+ SINSTRL_bindString(AM_head, str);
+ else SINSTRL_delayString(tmPtr, str);
+ return;
+ } //(AM_rigFlag == OFF)
+ }
+ default: { EM_THROW(EM_FAIL); } //BVAR, CONST
+ } //switch
+}
+
+
+//attempting to unify a dereferenced term with a constant with type assoc
+void SINSTRL_unifyTConst(DF_TermPtr tmPtr, int constInd, CSpacePtr label)
+{
+ switch (DF_termTag(tmPtr)) {
+ case DF_TM_TAG_VAR:
+ {
+ if (DF_fvUnivCount(tmPtr)= AM_cstUnivCount(constInd)))
+ SINSTRL_bindTConst(AM_head, constInd);
+ else EM_THROW(EM_FAIL);
+ } else SINSTRL_delayTConst(tmPtr, constInd); //higher-order
+ } //(AM_rigFlag == OFF)
+ return;
+ }
+ default: { EM_THROW(EM_FAIL); } //CONS, NIL, BVAR, INT, FLOAT, STR, (STREAM)
+ } //switch
+}
+
+//attempting to unify a dereferenced term with a nil list
+void SINSTRL_unifyNil(DF_TermPtr tmPtr)
+{
+ switch (DF_termTag(tmPtr)){
+ case DF_TM_TAG_VAR: { SINSTRL_bindNil(tmPtr); return; }
+ case DF_TM_TAG_NIL: { return; }
+ case DF_TM_TAG_CONS: { EM_THROW(EM_FAIL);}
+ case DF_TM_TAG_APP:
+ {
+ if (DF_isConst(DF_termDeref(DF_appFunc(tmPtr)))) EM_THROW(EM_FAIL);
+ }
+ case DF_TM_TAG_SUSP: //and other APP cases
+ { //Note ABS cannot occur due to well-typedness
+ HN_hnorm(tmPtr);
+ if (AM_consFlag) EM_THROW(EM_FAIL);
+ if (AM_rigFlag) {
+ if (DF_isNil(AM_head)) return;
+ EM_THROW(EM_FAIL);
+ } else { //(AM_rigFlag == OFF)
+ if (AM_numArgs == 0) //note AM_numAbs must be 0 because of type
+ SINSTRL_bindNil(AM_head);
+ else SINSTRL_delayNil(tmPtr);
+ return;
+ } //(AM_rigFlag == OFF)
+ }
+ default: { EM_THROW(EM_FAIL); }//BVAR, CONST, CONS
+ } //switch
+}
+
+
diff --git a/src/runtime/c/teyjus/simulator/siminstrlocal.h b/src/runtime/c/teyjus/simulator/siminstrlocal.h
new file mode 100644
index 000000000..e5a938261
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/siminstrlocal.h
@@ -0,0 +1,99 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/***************************************************************************/
+/* */
+/* File siminstrlocal.h. This file contains the declarations of auxiliary */
+/* functions used in siminstr.c. */
+/***************************************************************************/
+#ifndef SIMINSTRL_H
+#define SIMINSTRL_H
+
+#include "dataformats.h"
+
+/*****************************************************************************/
+/* Auxiliary functions for unifying terms used in get- and unify- instrutions*/
+/*****************************************************************************/
+
+//attempting to unify a dereferenced term with a constant without type assoc
+void SINSTRL_unifyConst(DF_TermPtr tmPtr, int constInd);
+
+//attempting to unify a dereferenced term with an integer
+void SINSTRL_unifyInt(DF_TermPtr tmPtr, int intValue);
+
+//attempting to unify a dereferenced term with a real number
+void SINSTRL_unifyFloat(DF_TermPtr tmPtr, float floatValue);
+
+//attempting to unify a dereferenced term with a string
+void SINSTRL_unifyString(DF_TermPtr tmPtr, DF_StrDataPtr str);
+
+//attempting to unify a dereferenced term with a constant with type assoc
+void SINSTRL_unifyTConst(DF_TermPtr tmPtr, int constInd, CSpacePtr label);
+
+//attempting to unify a dereferenced term with a nil list
+void SINSTRL_unifyNil(DF_TermPtr tmPtr);
+
+//Bind a free variable to an application object with a non-type-associated
+//constant head.
+//Setting relevant registers for 1)entering WRITE mode 2)entering OCC mode
+// 3)indicating the occurrence of binding (BND = ON).
+void SINSTRL_bindStr(DF_TermPtr varPtr, int constInd, int arity);
+
+//Bind a free variable to an application object with a type-associated
+//constant head.
+//Setting relevant registers for 1)entering WRITE and TYWRITE mode 2)entering
+// OCC mode 3)indicating the occurrence of binding (BND = ON).
+void SINSTRL_bindTStr(DF_TermPtr varPtr, int constInd, int arity);
+
+//Bind a free variable to a list cons.
+//Setting relevant registers for 1)entering WRITE mode 2)entering OCC mode
+// 3)indicating the occurrence of binding (BND = ON).
+void SINSTRL_bindCons(DF_TermPtr varPtr);
+
+//Delay a pair (onto the PDL stack) with a given term and an application
+//object with a non-type-associated constant head.
+//Setting registers 1)entering WRITE mode: S and WRITE; 2)entering OCC OFF
+//mode; 3) ADJ
+void SINSTRL_delayStr(DF_TermPtr tPtr, int constInd, int arity);
+
+//Delay a pair (onto the PDL stack) with a given term and an application
+//object with a type-associated constant head.
+//Setting registers 1)entering WRITE and TYWRITE mode: S, WRITE and TYWRITE;
+// 2)entering OCC OFF mode; 3) ADJ
+void SINSTRL_delayTStr(DF_TermPtr tPtr, int constInd, int arity);
+
+//Delay a pair (onto the PDL stack) with a given term and a list cons
+//Setting registers 1)entering WRITE mode: S and WRITE; 2)entering OCC OFF
+//mode; 3) ADJ
+void SINSTRL_delayCons(DF_TermPtr tPtr);
+
+
+/*The main action of unify_value in write mode. This code carries out the */
+/*necessary occurs checking in the binding of a variable that has already */
+/*commenced through an enclosing get_structure instruction. */
+/*Care has been taken to avoid making a reference to a register or stack */
+/*address. */
+void SINSTRL_bindSreg(DF_TermPtr tmPtr);
+
+/*The main component of unify_local_value in write mode when it is determined */
+/*that we are dealing with a heap cell. */
+void SINSTRL_bindSregH(DF_TermPtr tmPtr);
+
+
+#endif //SIMINSTRL_H
diff --git a/src/runtime/c/teyjus/simulator/simulator.c b/src/runtime/c/teyjus/simulator/simulator.c
new file mode 100644
index 000000000..6d9b8645b
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/simulator.c
@@ -0,0 +1,62 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************
+ * *
+ * File simulator.c. This file contains the procedure that emulates the *
+ * lambda Prolog abstract machine. *
+ ****************************************************************************/
+
+#ifndef SIMULATOR_C
+#define SIMULATOR_C
+
+#include "simdispatch.h"
+#include "abstmachine.h"
+#include "trail.h"
+#include "../system/error.h" //to be modified
+#include "../tables/instructions.h" //to be modified
+
+#include //temp
+
+void SIM_simulate()
+{
+ restart_loop:
+ EM_TRY {
+ while(1) {
+ /*fprintf(stderr, "AM_preg %u opcode: %d\n", AM_preg,
+ *((INSTR_OpCode *)AM_preg)); */
+ SDP_dispatchTable[*((INSTR_OpCode *)AM_preg)]();
+ }
+ /* it's expected that this statement not be reached: the only
+ way out of this while loop is by an exception */
+ } EM_CATCH {
+ if (EM_CurrentExnType == EM_FAIL) {
+ if (AM_botCP()) EM_RETHROW();
+ else {
+ TR_unwindTrail(AM_cpTR());
+ AM_initPDL();
+ AM_bndFlag = OFF;
+ AM_preg = AM_cpNCL();
+ goto restart_loop;
+ }
+ } else EM_RETHROW();
+ }
+}
+
+#endif /* SIMULATOR_C */
diff --git a/src/runtime/c/teyjus/simulator/simulator.h b/src/runtime/c/teyjus/simulator/simulator.h
new file mode 100644
index 000000000..5aed0b67e
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/simulator.h
@@ -0,0 +1,32 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************
+ * *
+ * File simulator.h. This ``header'' file identifies the functions defined *
+ * in simulator.c that are exported from there. *
+ * *
+ ****************************************************************************/
+
+#ifndef SIMULATOR_H
+#define SIMULATOR_H
+
+void SIM_simulate();
+
+#endif /* SIMULATOR_H */
diff --git a/src/runtime/c/teyjus/simulator/trail.c b/src/runtime/c/teyjus/simulator/trail.c
new file mode 100644
index 000000000..9a758f043
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/trail.c
@@ -0,0 +1,141 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************/
+/* */
+/* File trail.c. This file defines the trail operations including */
+/* trailing and unwinding. */
+/* */
+/****************************************************************************/
+
+#ifndef TRAIL_C
+#define TRAIL_C
+
+#include "trail.h"
+
+static int TR_trailItemTag(TR_TrailItem *trPtr) { return (trPtr -> tag); }
+static MemPtr TR_trailItemAddr(TR_TrailItem *trPtr) { return (trPtr -> addr);}
+
+/***************************************************************************/
+/* TRAILING FUNCTIONS */
+/***************************************************************************/
+void TR_trailTerm(DF_TermPtr addr) //trailing a term of atomic size
+{
+ if (((MemPtr)addr <= AM_hbreg) ||
+ (AM_hreg < (MemPtr)addr) && ((MemPtr)addr < AM_breg)) {
+ AM_trailError(TR_TRAIL_TERM_SIZE);
+ DF_copyAtomic(addr, AM_trreg);
+ ((TR_TrailItem*)(AM_trreg+DF_TM_ATOMIC_SIZE))->tag = TR_TAG_TERM;
+ ((TR_TrailItem*)(AM_trreg+DF_TM_ATOMIC_SIZE))->addr = (MemPtr)addr;
+ AM_trreg += TR_TRAIL_TERM_SIZE;
+ }
+}
+
+void TR_trailHTerm(DF_TermPtr addr) //trailing a heap term of atomic size
+{
+ if ((MemPtr)addr < AM_hbreg) {
+ AM_trailError(TR_TRAIL_TERM_SIZE);
+ DF_copyAtomic(addr, AM_trreg);
+ ((TR_TrailItem*)(AM_trreg+DF_TM_ATOMIC_SIZE)) -> tag = TR_TAG_TERM;
+ ((TR_TrailItem*)(AM_trreg+DF_TM_ATOMIC_SIZE)) -> addr = (MemPtr)addr;
+ AM_trreg += TR_TRAIL_TERM_SIZE;
+ }
+}
+
+void TR_trailETerm(DF_TermPtr addr) //trailing a stack term
+{
+ if ((MemPtr)addr < AM_breg) {
+ AM_trailError(TR_TRAIL_TERM_SIZE);
+ DF_copyAtomic(addr, AM_trreg);
+ ((TR_TrailItem*)(AM_trreg+DF_TM_ATOMIC_SIZE)) -> tag = TR_TAG_TERM;
+ ((TR_TrailItem*)(AM_trreg+DF_TM_ATOMIC_SIZE)) -> addr = (MemPtr)addr;
+ AM_trreg += TR_TRAIL_TERM_SIZE;
+ }
+}
+
+
+void TR_trailType(DF_TypePtr addr) //trailing a type (free variable)
+{
+ if (((MemPtr)addr < AM_hbreg) ||
+ ((AM_hreg < (MemPtr)addr) && ((MemPtr)addr < AM_breg))){
+ AM_trailError(TR_TRAIL_TYPE_SIZE);
+ ((TR_TrailItem*)AM_trreg) -> tag = TR_TAG_TYPE;
+ ((TR_TrailItem*)AM_trreg) -> addr = (MemPtr)addr;
+ AM_trreg += TR_TRAIL_TYPE_SIZE;
+ }
+}
+
+//temp
+void TR_trailImport(MemPtr addr) //trailing a backchained field
+{
+ AM_trailError(TR_TRAIL_MOD_SIZE);
+ *AM_trreg = *addr;
+ *(AM_trreg+1) = *(addr+1);
+ ((TR_TrailItem*)(AM_trreg+2)) -> tag = TR_TAG_MOD;
+ ((TR_TrailItem*)(AM_trreg+2)) -> addr = addr;
+ AM_trreg += TR_TRAIL_MOD_SIZE;
+}
+
+/****************************************************************************/
+/* UNWIND TRAIL FUNCTION */
+/****************************************************************************/
+void TR_unwindTrail(MemPtr trOld)
+{
+ MemPtr addr;
+
+ while (AM_trreg > trOld){
+ AM_trreg -= TR_TRAIL_ITEM_HEAD_SIZE;
+ addr = TR_trailItemAddr((TR_TrailItem*)AM_trreg);
+ switch (TR_trailItemTag((TR_TrailItem*)AM_trreg)){
+ case TR_TAG_TERM:
+ {
+ AM_trreg -= DF_TM_ATOMIC_SIZE;
+ DF_copyAtomic((DF_TermPtr)AM_trreg, addr);
+ break;
+ }
+ case TR_TAG_MULTERM1:
+ {
+ AM_trreg -= DF_TM_APP_SIZE;
+ DF_copyApp((DF_TermPtr)AM_trreg, addr);
+ break;
+ }
+ case TR_TAG_MULTERM2:
+ {
+ AM_trreg -= DF_TM_SUSP_SIZE;
+ DF_copySusp((DF_TermPtr)AM_trreg, addr);
+ break;
+ }
+ case TR_TAG_TYPE:
+ {
+ DF_mkFreeVarType(addr);
+ break;
+ }
+ case TR_TAG_MOD: //temp
+ {
+ AM_trreg -= 2;
+ *addr = *AM_trreg;
+ *(addr+1) = *(AM_trreg + 1);
+ break;
+ }
+ } //switch
+ } //while
+}
+
+
+#endif //TRAIL_C
diff --git a/src/runtime/c/teyjus/simulator/trail.h b/src/runtime/c/teyjus/simulator/trail.h
new file mode 100644
index 000000000..675392b4b
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/trail.h
@@ -0,0 +1,80 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************/
+/* */
+/* File trail.h. This header file includes the interface functions */
+/* for trail operations. */
+/* */
+/****************************************************************************/
+#ifndef TRAIL_H
+#define TRAIL_H
+
+#include
+#include "mctypes.h"
+#include "abstmachine.h"
+#include "dataformats.h"
+
+/****************************************************************************/
+/* DATA STRUCTURE OF TRAIL ITEMS */
+/****************************************************************************/
+/* The tags of trail items */
+enum TR_TrailDataCategory
+{
+ TR_TAG_TERM,
+ TR_TAG_MULTERM1,
+ TR_TAG_MULTERM2,
+ TR_TAG_TYPE,
+ TR_TAG_MOD
+};
+
+/* The leading slot of trail items */
+typedef struct
+{
+ Byte tag; //trial data category tag
+ MemPtr addr; //the starting address of the trailed item
+} TR_TrailItem;
+
+/* The size of the trail item head */
+#define TR_TRAIL_ITEM_HEAD_SIZE (int)ceil((double)sizeof(TR_TrailItem)/WORD_SIZE)
+/* The sizes of different trail items */
+#define TR_TRAIL_TERM_SIZE TR_TRAIL_ITEM_HEAD_SIZE + DF_TM_ATOMIC_SIZE
+#define TR_TRAIL_MULTERM1_SIZE TR_TRAIL_ITEM_HEAD_SIZE + DF_TM_APP_SIZE
+#define TR_TRAIL_MULTERM2_SIZE TR_TRAIL_ITEM_HEAD_SIZE + DF_TM_SUSP_SIZE
+#define TR_TRAIL_TYPE_SIZE TR_TRAIL_ITEM_HEAD_SIZE
+//temp
+#define TR_TRAIL_MOD_SIZE TR_TRAIL_ITEM_HEAD_SIZE + 2
+
+/***************************************************************************/
+/* TRAILING FUNCTIONS */
+/***************************************************************************/
+void TR_trailTerm(DF_TermPtr addr); //trailing a term of atomic size
+void TR_trailHTerm(DF_TermPtr addr); //trailing a heap term of atomic size
+void TR_trailETerm(DF_TermPtr addr); //trailing a stack term
+void TR_trailType(DF_TypePtr addr); //trailing a type (free type variable)
+void TR_trailImport(MemPtr addr); //trailing a backchained field
+
+
+/****************************************************************************/
+/* UNWIND TRAIL FUNCTION */
+/****************************************************************************/
+void TR_unwindTrail(MemPtr trOld);
+
+#endif //TRAIL_H
+
diff --git a/src/runtime/c/teyjus/simulator/types.c b/src/runtime/c/teyjus/simulator/types.c
new file mode 100644
index 000000000..653ccbd9b
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/types.c
@@ -0,0 +1,194 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************/
+/* */
+/* File types.c. This file contains routines implementing the interpretive */
+/* part of type unification including those needed within (interpretive) */
+/* higher-order pattern unification. */
+/* */
+/****************************************************************************/
+#ifndef TYPES_C
+#define TYPES_C
+
+#include "dataformats.h"
+#include "abstmachine.h"
+#include "trail.h"
+#include "../system/error.h"
+
+/* Push n types onto PDL */
+static void TY_pushTypesToPDL(MemPtr tyPtr, int n)
+{
+ AM_pdlError(n);
+ n--; tyPtr += n * DF_TY_ATOMIC_SIZE; //start from the nth type
+ for (; n >= 0; n--) { AM_pushPDL(tyPtr); tyPtr -= DF_TY_ATOMIC_SIZE; }
+}
+
+/* Push n pair of types onto PDL. */
+void TY_pushPairsToPDL(MemPtr tyPtr1, MemPtr tyPtr2, int n)
+{
+ AM_pdlError(2*n);
+ n--; tyPtr1 += n * DF_TY_ATOMIC_SIZE; tyPtr2 += n * DF_TY_ATOMIC_SIZE;
+ for (; n >= 0; n--){ //start from the nth pair
+ AM_pushPDL(tyPtr1); tyPtr1 -= DF_TY_ATOMIC_SIZE;
+ AM_pushPDL(tyPtr2); tyPtr2 -= DF_TY_ATOMIC_SIZE;
+ }
+}
+
+/* Perform occurs check for the type variable currently referred to by
+ AM_tyvbbreg over the type on the current top of PDL.
+*/
+static void TY_typesOcc()
+{
+ DF_TypePtr tyPtr; // current type structure being examined
+ MemPtr pdlBotTmp = AM_pdlTop - 1; //tmp PDL
+ while (AM_pdlTop > pdlBotTmp){
+ tyPtr = DF_typeDeref((DF_TypePtr)AM_popPDL());
+ switch (DF_typeTag(tyPtr)){
+ case DF_TY_TAG_REF: {
+ if (AM_tyvbbreg == tyPtr) EM_THROW(EM_FAIL);
+ break;
+ }
+ case DF_TY_TAG_SORT: break;
+ case DF_TY_TAG_STR: {
+ DF_TypePtr fPtr = DF_typeStrFuncAndArgs(tyPtr);
+ TY_pushTypesToPDL((MemPtr)DF_typeStrArgs(fPtr),
+ DF_typeStrFuncArity(fPtr));
+ break;
+ }
+ case DF_TY_TAG_ARROW: {
+ TY_pushTypesToPDL((MemPtr)DF_typeArrowArgs(tyPtr),
+ DF_TY_ARROW_ARITY);
+ break;
+ }
+ } //switch
+ } //while (AM_pdlTop > pdlBotTmp
+}
+
+
+/* Bind two free variables. The one with higher address is updated. */
+static void TY_bindVars(DF_TypePtr varPtr1, DF_TypePtr varPtr2)
+{
+ if (varPtr2 < varPtr1){
+ TR_trailType(varPtr1);
+ DF_copyAtomicType(varPtr2, (MemPtr)varPtr1);
+ } else {
+ TR_trailType(varPtr2);
+ DF_copyAtomicType(varPtr1, (MemPtr)varPtr2);
+ }
+}
+
+/* Bind a variable to a type. Note occurs-check is performed. */
+static void TY_bind(DF_TypePtr varPtr, DF_TypePtr tyPtr)
+{
+ AM_pdlError(1);
+ AM_pushPDL((MemPtr)tyPtr);
+ AM_tyvbbreg = varPtr; //type variable being bound
+ TY_typesOcc();
+ TR_trailType(varPtr);
+ DF_copyAtomicType(tyPtr, (MemPtr)varPtr);
+}
+
+/* The main routine for interpretive type unification. The assumption is
+ that the pair of types are referred from the top two cells in the PDL
+ stack.
+*/
+void TY_typesUnify()
+{
+ DF_TypePtr tyPtr1, tyPtr2;
+
+ while (AM_nemptyTypesPDL()){
+ tyPtr2 = DF_typeDeref((DF_TypePtr)AM_popPDL());
+ tyPtr1 = DF_typeDeref((DF_TypePtr)AM_popPDL());
+ if (tyPtr1 != tyPtr2) { //not referring to the same mem location
+ if (DF_isRefType(tyPtr1))
+ if (DF_isRefType(tyPtr2)) TY_bindVars(tyPtr1, tyPtr2);
+ else TY_bind(tyPtr1, tyPtr2);
+ else { //tyPtr1 is not reference
+ switch (DF_typeTag(tyPtr2)){
+ case DF_TY_TAG_REF: { TY_bind(tyPtr2, tyPtr1); break; }
+ case DF_TY_TAG_SORT: {
+ if (!(DF_isSortType(tyPtr1) &&
+ DF_typeKindTabIndex(tyPtr1)==DF_typeKindTabIndex(tyPtr2)))
+ EM_THROW(EM_FAIL);
+ break;
+ }
+ case DF_TY_TAG_ARROW:{
+ if (!DF_isArrowType(tyPtr1)) EM_THROW(EM_FAIL);
+ TY_pushPairsToPDL((MemPtr)DF_typeArrowArgs(tyPtr1),
+ (MemPtr)DF_typeArrowArgs(tyPtr2),
+ DF_TY_ARROW_ARITY);
+ break;
+ }
+ case DF_TY_TAG_STR: {
+ if (DF_isStrType(tyPtr1)){
+ DF_TypePtr fPtr1 = DF_typeStrFuncAndArgs(tyPtr1),
+ fPtr2 = DF_typeStrFuncAndArgs(tyPtr2);
+ if (DF_typeStrFuncInd(fPtr1) == DF_typeStrFuncInd(fPtr2))
+ TY_pushPairsToPDL((MemPtr)DF_typeStrArgs(fPtr1),
+ (MemPtr)DF_typeStrArgs(fPtr2),
+ DF_typeStrFuncArity(fPtr1));
+ else EM_THROW(EM_FAIL); //different function
+ } else EM_THROW(EM_FAIL); //tyPtr1 not str or ref
+ break;
+ }
+ } //switch
+ } //tyPtr1 not ref
+ } //tyPtr1 != tyPtr2
+ } //while (AM_nemptyTypesPDL())
+}
+
+
+/*****************************************************************************
+ * Occurs check over types. This version is used when the check has to be *
+ * performed within the compiled form of unification. In particular, this *
+ * routine would be invoked from within the unify_type_value class of *
+ * instructions in read mode. The peculiarity of this situation is that the *
+ * binding of the relevant type variable would have been started already by *
+ * a get_type_structure or get_type_arrow instruction, so we have to check *
+ * for the occurrence of the structure created as a consequence of this *
+ * rather than for a variable occurrence. *
+ *****************************************************************************/
+void TY_typesOccC()
+{
+ DF_TypePtr tyPtr;
+ while (AM_nemptyTypesPDL()){
+ tyPtr = DF_typeDeref((DF_TypePtr)AM_popPDL());
+ switch (DF_typeTag(tyPtr)) {
+ case DF_TY_TAG_REF: case DF_TY_TAG_SORT: break;
+ case DF_TY_TAG_STR:
+ {
+ DF_TypePtr fPtr = DF_typeStrFuncAndArgs(tyPtr);
+ if (AM_tyvbbreg == fPtr) EM_THROW(EM_FAIL);
+ TY_pushTypesToPDL((MemPtr)DF_typeStrArgs(fPtr),
+ DF_typeStrFuncArity(fPtr));
+ break;
+ }
+ case DF_TY_TAG_ARROW:
+ {
+ DF_TypePtr args = DF_typeArrowArgs(tyPtr);
+ if (AM_tyvbbreg == args) EM_THROW(EM_FAIL);
+ TY_pushTypesToPDL((MemPtr)args, DF_TY_ARROW_ARITY);
+ break;
+ }
+ } //switch
+ } //while
+}
+
+#endif //TYPES_C
diff --git a/src/runtime/c/teyjus/simulator/types.h b/src/runtime/c/teyjus/simulator/types.h
new file mode 100644
index 000000000..9cbd0e535
--- /dev/null
+++ b/src/runtime/c/teyjus/simulator/types.h
@@ -0,0 +1,47 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************/
+/* */
+/* File types.h. This header file identifies the routines defined in */
+/* types.c that are exported from there. These routines implement */
+/* operations on types, in particular the interpretive unification on */
+/* types. These operations are typically needed in the simulator */
+/* (simulator.c) and higher-order pattern unification (houp.c). */
+/* */
+/****************************************************************************/
+#ifndef TYPES_H
+#define TYPES_H
+
+void TY_typesUnify(); //interpretive unification on types
+void TY_pushPairsToPDL(MemPtr, MemPtr, int);//push n pairs of types to PDL
+
+/*****************************************************************************
+ * Occurs check over types. This version is used when the check has to be *
+ * performed within the compiled form of unification. In particular, this *
+ * routine would be invoked from within the unify_type_value class of *
+ * instructions in read mode. The peculiarity of this situation is that the *
+ * binding of the relevant type variable would have been started already by *
+ * a get_type_structure or get_type_arrow instruction, so we have to check *
+ * for the occurrence of the structure created as a consequence of this *
+ * rather than for a variable occurrence. *
+ *****************************************************************************/
+void TY_typesOccC();
+
+#endif //TYPES_H
diff --git a/src/runtime/c/teyjus/system/error.h b/src/runtime/c/teyjus/system/error.h
new file mode 100644
index 000000000..6fee02113
--- /dev/null
+++ b/src/runtime/c/teyjus/system/error.h
@@ -0,0 +1,170 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************
+ * *
+ * File error.h -- error-handling functions *
+ * *
+ ****************************************************************************/
+
+#ifndef ERROR_H
+#define ERROR_H
+
+#include
+#include
+#include
+#include "tjsignal.h"
+#include "../simulator/mctypes.h" //to be modified
+
+/****************************************************************************
+ * Exception stack declarations. *
+ ****************************************************************************/
+
+typedef enum EM_ExnType{
+ EM_NO_ERR = 0, // no errors
+ EM_NO_EXN, // used for warnings ??
+ EM_ABORT, // exit the executable immediately
+ EM_EXIT, // traverse the exception stack and exit
+ EM_TOP_LEVEL, // return to the toplevel
+ EM_QUERY, // abort solving the query
+ EM_QUERY_RESULT, // query is solved; print answer
+ EM_FAIL, // fail to simulator level
+} EM_ExnType;
+
+//function call environment stack
+extern SIGNAL_jmp_buf *EM_ExnHandlerStack;
+extern int EM_ExnHandlerStackTop;
+extern int EM_ExnHandlerStackSize;
+
+//exception type
+extern EM_ExnType EM_CurrentExnType;
+
+/****************************************************************************
+ * Exception-handling macros *
+ ****************************************************************************/
+
+//try
+#define EM_TRY \
+if (EM_ExnHandlerStackTop >= EM_ExnHandlerStackSize) \
+{ \
+ EM_ExnHandlerStackSize = \
+ (EM_ExnHandlerStackSize + 1) * 2; \
+ EM_ExnHandlerStack = \
+ (SIGNAL_jmp_buf *)EM_realloc((void *)EM_ExnHandlerStack, \
+ EM_ExnHandlerStackSize * sizeof(SIGNAL_jmp_buf)); \
+} \
+if (SIGNAL_setjmp(EM_ExnHandlerStack[EM_ExnHandlerStackTop++]) == 0) \
+{
+
+//catch
+#define EM_CATCH \
+ EM_ExnHandlerStackTop--; \
+} \
+else
+
+//throw
+/* Jump to the nearest (in a dynamic sense) EM_Try block, setting
+ EM_CurrentExnType to TYPE. Given a constant, the conditional in
+ this macro will be optimized away.
+
+ TODO: added cast to EM_CurrentExnType. */
+#define EM_THROW(type) EM_THROWVAL((type), 1)
+
+#define EM_THROWVAL(type, val) \
+do { \
+ if ((type) == EM_ABORT) \
+ exit(1); \
+ else \
+ { \
+ EM_CurrentExnType = (EM_ExnType)(type); \
+ SIGNAL_longjmp(EM_ExnHandlerStack[--EM_ExnHandlerStackTop], val); \
+ } \
+} while(0)
+
+//rethrow
+/* pass the current exception to the next handler. Use only within an
+ EM_Catch block. */
+#define EM_RETHROW() \
+ SIGNAL_longjmp(EM_ExnHandlerStack[--EM_ExnHandlerStackTop], 1)
+
+/* Here's an example use of the above macros:
+
+...
+EM_TRY
+{
+ foo();
+ if (foobar)
+ EM_THROW(EM_FOOBAR);
+}
+EM_CATCH
+{
+ un_foo(); /* clean up *
+ if (EM_CurrentExnType == EM_FOOBAR)
+ printf("foobar!"); /* stop the error here *
+ else
+ EM_RETHROW(); /* let a later handler handle it *
+}
+*/
+
+/****************************************************************************
+ * Routines which will generate errors automatically. *
+ ****************************************************************************/
+void *EM_malloc(unsigned int);
+void *EM_realloc(void *, unsigned int);
+char *EM_strdup(char *);
+
+/****************************************************************************
+ * Beginning error indices for different modules (by module abbreviation) *
+ ****************************************************************************/
+/* general errors */
+#define EM_NO_ERROR 0
+#define EM_FIRST_ERR_INDEX 1
+#define LINKER_FIRST_ERR_INDEX 50
+#define LOADER_FIRST_ERR_INDEX 100
+#define STREAM_FIRST_ERR_INDEX 150
+#define SIM_FIRST_ERR_INDEX 200
+#define BI_FIRST_ERR_INDEX 300
+#define RT_FIRST_ERR_INDEX 400
+#define FRONT_FIRST_ERR_INDEX 500
+
+/****************************************************************************
+ * General-use error messages *
+ ****************************************************************************/
+enum
+{
+ EM_OUT_OF_MEMORY = EM_FIRST_ERR_INDEX,
+ EM_OUT_OF_HEAP,
+ EM_NEWLINE,
+ EM_ERROR_COLON,
+ EM_WARNING_COLON
+};
+
+/****************************************************************************
+ * The routine that gets called in the event of an error *
+ ****************************************************************************/
+void EM_error(int inIndex, ...);
+
+
+/****************************************************************************
+ * Have there been any errors since last EM_Reset()? *
+ ****************************************************************************/
+extern Boolean EM_anyErrors;
+void EM_reset();
+
+#endif //ERROR_H
diff --git a/src/runtime/c/teyjus/system/memory.h b/src/runtime/c/teyjus/system/memory.h
new file mode 100644
index 000000000..b35078ad8
--- /dev/null
+++ b/src/runtime/c/teyjus/system/memory.h
@@ -0,0 +1,222 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************/
+/* */
+/* Files memory.h{c}. These files define the system memory structures and */
+/* their access functions, including the system memory, run-time symbol */
+/* tables, implication and import tables and the system module table. */
+/* */
+/****************************************************************************/
+
+#ifndef MEMORY_H
+#define MEMORY_H
+
+#include
+#include
+#include "../simulator/mctypes.h" //to be changed
+#include "../simulator/dataformats.h" //to be changed
+//#include "../config.h"
+
+/******************************************************************************/
+/* FIND CODE FUNCTION */
+/******************************************************************************/
+//arguments: constInd, search table size, search table addr
+typedef CSpacePtr (*MEM_FindCodeFnPtr)(int, int, MemPtr);
+
+/******************************************************************************/
+/* SYSTEM MEMORY MANAGEMENT */
+/******************************************************************************/
+extern WordPtr MEM_memBeg; //starting addr of the system memory
+extern WordPtr MEM_memEnd; //end addr of the system memory
+extern WordPtr MEM_memTop; //the first usable word in the system memory
+extern WordPtr MEM_memBot; //the last usable word in the system memory
+
+/* Asking for the system memory of a given size (in word), */
+/* and initialize relevant global variables. */
+void MEM_memInit(unsigned int size);
+/* Asking the simulator (system) memory for space of a given size (in word) */
+WordPtr MEM_memExtend(unsigned int size);
+
+/******************************************************************************/
+/* MODULE SPACE COMPONENTS */
+/*----------------------------------------------------------------------------*/
+/* I. Run time symbol tables: kind table; type skeleton table; constant table*/
+/* II. Implication table */
+/* III.Import table */
+/******************************************************************************/
+
+/*****************************************************************************/
+/* KIND SYMBOL TABLE */
+/*****************************************************************************/
+/* kind symbol table entry */
+typedef struct
+{
+ DF_StrDataPtr name;
+ TwoBytes arity; //agree with DF_StrTypeArity (simulator/dataformats.c)
+} MEM_KstEnt;
+
+typedef MEM_KstEnt *MEM_KstPtr;
+
+/* max possible index of kind table */
+/* (agree with DF_KstTabInd in simulator/dataformats.c) */
+#define MEM_KST_MAX_IND USHRT_MAX
+
+/* size of each entry of this table (in word) */
+//Note this arithematic should in reality go into "config.h"
+#define MEM_KST_ENTRY_SIZE (int)ceil((double)sizeof(MEM_KstEnt)/WORD_SIZE)
+
+/*****************************************************************************/
+/* TYPE SKELETON TABLE */
+/*****************************************************************************/
+/* type skeleton table entry */
+typedef DF_TypePtr MEM_TstEnt;
+
+typedef MEM_TstEnt *MEM_TstPtr;
+
+/* max possible index of type skeleton table */
+#define MEM_TST_MAX_IND USHRT_MAX
+
+/* size of each entry of this table (in word) */
+//Note this arithematic should in reality go into "config.h"
+#define MEM_TST_ENTRY_SIZE (int)ceil((double)sizeof(MEM_TstEnt)/WORD_SIZE)
+
+/*****************************************************************************/
+/* CONSTANT SYMBOL TABLE */
+/*****************************************************************************/
+/* constant symbol table entry */
+typedef struct
+{
+ DF_StrDataPtr name;
+ TwoBytes typeEnvSize;
+ TwoBytes tskTabIndex; //index to the type skeleton table
+ TwoBytes neededness; //neededness info
+ TwoBytes univCount;
+ int precedence;
+ int fixity;
+} MEM_CstEnt;
+
+typedef MEM_CstEnt *MEM_CstPtr;
+
+/* max possible index of constant symbol table */
+/* (agree with DF_CstTabInd in simulator/dataformats.c) */
+#define MEM_CST_MAX_IND USHRT_MAX
+ //add one entry at the current top
+/* size of each entry of this table (in word) */
+//Note this arithematic should in reality go into "config.h"
+#define MEM_CST_ENTRY_SIZE (int)(sizeof(MEM_CstEnt)/WORD_SIZE)
+
+/*****************************************************************************/
+/* ACCESSING THE IMPLICATION GOAL TABLE */
+/*****************************************************************************/
+#define MEM_IMPL_FIX_SIZE 3
+/* functions for filling in the fields of an impl table */
+/* Q: the data stored in each field in byte code: are they word or in their */
+/* specific types? */
+void MEM_implPutLTS(WordPtr tab, int lts); //# pred (def extended)
+void MEM_implPutFC(WordPtr tab, MEM_FindCodeFnPtr fcPtr);//ptr to find code func
+void MEM_implPutPSTS(WordPtr tab, int tabSize); //# entries link tab
+void MEM_implPutLT(WordPtr tab, int ind, int cst); //link tab; ind from 0
+
+/* functions for retrieving the addresses of associated tables */
+MemPtr MEM_implLT(MemPtr tab); //start add of seq. of pred (link tab)
+MemPtr MEM_implPST(MemPtr tab, int lts); //start add of pred search tab
+
+/* functions for retrieving the fields of a impl table */
+int MEM_implLTS(MemPtr tab); //pred field (def extended)
+MEM_FindCodeFnPtr MEM_implFC(MemPtr tab); //ptr to find code func
+int MEM_implPSTS(MemPtr tab); //num entries in link tab
+int MEM_implIthLT(MemPtr ltab, int index); /* value in ith entry of link tab
+ ltab is the addr of link tab;
+ index should start from 0 */
+
+/*****************************************************************************
+ * ACCESSING THE IMPORTED MODULE TABLE *
+ *****************************************************************************/
+#define MEM_IMP_FIX_SIZE 5
+/* functions for filling in the fields of an import table */
+/* Q: the data stored in each field in byte code: are they word or in their */
+/* specific types? */
+void MEM_impPutNCSEG(WordPtr tab, int nseg); //# code segments
+void MEM_impPutNLC(WordPtr tab, int nlc); //# local constants
+void MEM_impPutLTS(WordPtr tab, int lts); //# pred (def extended)
+void MEM_impPutFC(WordPtr tab, MEM_FindCodeFnPtr fcp); //ptr to find code func
+void MEM_impPutPSTS(WordPtr tab, int tabSize); //# entries in link tab
+void MEM_impPutLT(WordPtr tab, int ind, int cst); //link tab; ind from 0
+void MEM_impPutLCT(WordPtr lcTab, int ind, int cst); /*loc c tab(may null)
+ lcTab addr of local
+ ctab; ind from 0 */
+
+/* functions for retrieving the addresses of associated tables */
+MemPtr MEM_impLT(MemPtr tab); //start addr of seq. of pred (link tab)
+MemPtr MEM_impLCT(MemPtr tab, int lts); //start addr of local const table
+MemPtr MEM_impPST(MemPtr tab, int lts, int nlc); //start addr of pred search tab
+
+/* functions for retrieving the fields of a impl table */
+int MEM_impNCSEG(MemPtr tab); //# code segments
+int MEM_impNLC(MemPtr tab); //# local constants
+int MEM_impLTS(MemPtr tab); //# of preds (def extended)
+MEM_FindCodeFnPtr MEM_impFC(MemPtr tab); //ptr to find code func
+int MEM_impPSTS(MemPtr tab); //# entries in link tab
+int MEM_impIthLT(MemPtr lt, int ind); /* ith entry in the link table: lt addr
+ of link tab; ind start from 0 */
+int MEM_impIthLCT(MemPtr lct, int ind); /* ith entry in the local const table:
+ lct local c tab; ind start from 0 */
+
+
+/*****************************************************************************/
+/* ACCESSING THE BOUND VARIABLE INDEXING TABLE (BRACHING TABLE) */
+/*****************************************************************************/
+int MEM_branchTabIndexVal(MemPtr tab, int index); //the nth index value
+CSpacePtr MEM_branchTabCodePtr(MemPtr tab, int index); //transfer addr
+
+/*****************************************************************************/
+/* SYSTEM MODULE TABLE */
+/*****************************************************************************/
+typedef struct
+{
+ char *modname; //(top-level) module name
+ CSpacePtr addtable; //addr to the add code table of the top module
+ MEM_KstPtr kstBase; //starting addr of kind table
+ MEM_TstPtr tstBase; //starting addr of type skel table
+ MEM_CstPtr cstBase; //starting addr of constant table
+ WordPtr modSpaceBeg; //starting addr of module space
+ WordPtr modSpaceEnd; //ending addr of module space
+ WordPtr codeSpaceBeg; //starting addr of module space
+ WordPtr codeSpaceEnd; //ending addr of module space
+} MEM_GmtEnt;
+
+#define MEM_MAX_MODULES 255 //max number of modules (temp)
+
+typedef MEM_GmtEnt MEM_Gmt[MEM_MAX_MODULES];
+
+extern MEM_Gmt MEM_modTable; //global module table
+
+MEM_GmtEnt *MEM_findInModTable(char* name);
+MEM_GmtEnt *MEM_findFreeModTableEntry();
+void MEM_removeModTableEntry(char* name);
+
+
+extern MEM_GmtEnt MEM_topModule; //top module
+void MEM_topModuleInit();
+
+extern MEM_GmtEnt *MEM_currentModule; //current module being used
+
+
+#endif //MEMORY_H
diff --git a/src/runtime/c/teyjus/system/message.h b/src/runtime/c/teyjus/system/message.h
new file mode 100644
index 000000000..cf0fa00fd
--- /dev/null
+++ b/src/runtime/c/teyjus/system/message.h
@@ -0,0 +1,76 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************
+ * *
+ * File message.h -- code to present messages to the user in Teyjus. *
+ * supports dynamically adding "%x"-style formatting switches, as well as *
+ * complete support for simply making separate builds. *
+ * *
+ ****************************************************************************/
+
+#ifndef MESSAGE_H
+#define MESSAGE_H
+
+#include
+#include "../simulator/mctypes.h"
+
+/****************************************************************************
+ * Type of a function to handle a particular formatting switch. *
+ ****************************************************************************/
+/* these functions should increment ioArgument as necessary. */
+typedef void (*MSG_SwitchFunction)(char *inSwitch, WordPtr inStream,
+ va_list *ioArgument);
+
+
+/****************************************************************************
+ * Type of a block of messages, with associated constants. *
+ ****************************************************************************/
+typedef struct MSG_Msg
+{
+ int mIndex; /* Index of this error message */
+ int mPreChain; /* Index of message to print before this one */
+ char *mMessage; /* The message itself */
+ int mPostChain; /* Index of message to print after this one */
+
+ int mExnType; /* if MSG_NO_EXN, MSG_Error() will return */
+ unsigned int mExitStatus; /* value to return with abort() */
+} MSG_Msg;
+
+typedef struct MSG_MessageBlock
+{
+ int mCount; /* No. of messages in this block */
+ int mMinIndex, mMaxIndex; /* mMinIndex <= every index <= mMaxIndex */
+ struct MSG_MessageBlock *mNext; /* Next block of messages in linked list */
+ MSG_Msg *mMessages; /* Array of messages */
+} MSG_MessageBlock;
+
+/****************************************************************************
+ * Initialization functions *
+ ****************************************************************************/
+void MSG_addSwitch(char inSwitch, MSG_SwitchFunction inFunction);
+void MSG_addMessages(int inCount, MSG_Msg *inMessages);
+
+/****************************************************************************
+ * The routine that gets called to print a message, returning the exception *
+ * type for the error message (mExnType) *
+ ****************************************************************************/
+int MSG_vMessage(int inIndex, va_list *ap);
+
+#endif /* MESSAGE_H */
diff --git a/src/runtime/c/teyjus/system/operators.h b/src/runtime/c/teyjus/system/operators.h
new file mode 100644
index 000000000..9f016ef5b
--- /dev/null
+++ b/src/runtime/c/teyjus/system/operators.h
@@ -0,0 +1,91 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+#ifndef OPERATORS_H
+#define OPERATORS_H
+
+//#include
+
+/* Fixity types */
+typedef enum
+{
+ OP_INFIX = 0,
+ OP_INFIXL = 1,
+ OP_INFIXR = 2,
+ OP_NONE = 3,
+ OP_PREFIX = 4,
+ OP_PREFIXR = 5,
+ OP_POSTFIX = 6,
+ OP_POSTFIXL = 7
+} OP_FixityType;
+
+
+typedef enum {
+ OP_WHOLE_TERM,
+ OP_LEFT_TERM,
+ OP_RIGHT_TERM
+} OP_TermContext;
+
+#define OP_MAXPREC 255
+#define OP_MINPREC 0
+
+#define OP_LAM_FIXITY OP_PREFIXR
+#define OP_LAM_PREC -1
+
+#define OP_APP_FIXITY OP_INFIXL
+#define OP_APP_PREC 257
+
+//usful ?
+/*
+#define OP_CCOMMA_FIXITY OP_infixr
+#define OP_CCOMMA_PREC -2
+
+
+
+
+
+#define OP_LT_FIXITY OP_infix
+#define OP_LT_PREC 130
+
+#define OP_LE_FIXITY OP_infix
+#define OP_LE_PREC 130
+
+#define OP_GT_FIXITY OP_infix
+#define OP_GT_PREC 130
+
+#define OP_GE_FIXITY OP_infix
+#define OP_GE_PREC 130
+
+#define OP_UM_FIXITY OP_prefix
+#define OP_UM_PREC 256 //?
+
+#define OP_PLUS_FIXITY OP_infixl
+#define OP_PLUS_PREC 150
+
+#define OP_MINUS_FIXITY OP_infixl
+#define OP_MINUS_PREC 150
+
+#define OP_TIMES_FIXITY OP_infixl
+#define OP_TIMES_PREC 160
+
+#define OP_COMMA_FIXITY OP_infixl
+#define OP_COMMA_PREC 110
+*/
+
+#endif // OPERATORS_H
diff --git a/src/runtime/c/teyjus/system/stream.h b/src/runtime/c/teyjus/system/stream.h
new file mode 100644
index 000000000..ec24fb474
--- /dev/null
+++ b/src/runtime/c/teyjus/system/stream.h
@@ -0,0 +1,90 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************
+ * *
+ * system/stream.h{c} implements stream support for the C part of the LP *
+ * system. *
+ ****************************************************************************/
+#ifndef STREAM_H
+#define STREAM_H
+
+#include
+#include
+#include "../simulator/mctypes.h" //to be modified
+
+/*****************************************************************************
+ * CONSTANTS *
+ *****************************************************************************/
+
+#define STREAM_ILLEGAL 0
+
+#define STREAM_READ "r"
+#define STREAM_WRITE "w"
+#define STREAM_APPEND "a"
+
+/*****************************************************************************
+ * EXPORTED VARIABLES *
+ *****************************************************************************/
+/* STREAMs corresponding to the three standard streams */
+extern WordPtr STREAM_stdin, STREAM_stdout, STREAM_stderr;
+
+/****************************************************************************
+ * BASIC FUNCTIONS *
+ ****************************************************************************/
+
+/* STREAM_open returns STREAM_ILLEGAL if the stream can't be opened;
+ if inDoCountLines is false, the line numbering calls below will not
+ work. */
+WordPtr STREAM_open(char *inFilename, char *inMode, int inDoUsePaths);
+/* open strings as streams. Note that the STREAM system does not
+ distinguish to_string and from_string streams after they are
+ opened. Results are undefined for a write to a from_string or read
+ from a to_string. */
+WordPtr STREAM_fromString(char *inString, int inDoCopyString);
+WordPtr STREAM_toString();
+
+/* will not close the standard streams */
+void STREAM_close(WordPtr inStream);
+
+
+/***************************************************************************
+ * RAW I/O SUPPORT ROUTINES *
+ * each routine returns -1 to indicate an error *
+ ***************************************************************************/
+int STREAM_readCharacters(WordPtr inStream, int inMaxCount, char* outString,
+ int inDoStopOnNewline);
+/* STREAM_printf and STREAM_sans_printf return the number of characters
+ written, -1 in case of error. STREAM_printf takes a format
+ STREAM_sans_printf interprets the input as a string to be printed */
+int STREAM_printf(WordPtr inStream, char *format, ...);
+int STREAM_sans_printf(WordPtr inStream, char *str);
+/* STREAM_printf returns the number of characters written, -1 in case of error*/
+int STREAM_lookahead(WordPtr inStream, char *outChar);
+Boolean STREAM_eof(WordPtr inStream);
+int STREAM_flush(WordPtr inStream);
+
+/***************************************************************************
+ * ACCESSORS *
+ ***************************************************************************/
+char* STREAM_getString(WordPtr inStream);
+FILE* STREAM_getFile(WordPtr inStream);
+char* STREAM_getName(WordPtr inStream);
+
+#endif //STREAM_H
diff --git a/src/runtime/c/teyjus/system/tjsignal.h b/src/runtime/c/teyjus/system/tjsignal.h
new file mode 100644
index 000000000..77dd04d92
--- /dev/null
+++ b/src/runtime/c/teyjus/system/tjsignal.h
@@ -0,0 +1,41 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/****************************************************************************
+ * *
+ * File signal.h -- code to implement signals and signal handlers for *
+ * Teyjus. (TEMP) *
+ * *
+ ****************************************************************************/
+#ifndef SIGNAL_H
+#define SIGNAL_H
+
+#include
+
+
+/****************************************************************************
+ * Different sigsetjmp/siglongjmp depending on support.. *
+ ****************************************************************************/
+
+#define SIGNAL_jmp_buf jmp_buf
+#define SIGNAL_setjmp(env) setjmp(env)
+#define SIGNAL_longjmp(env, val) longjmp(env, val)
+
+
+#endif /* SIGNAL_H */
diff --git a/src/runtime/c/teyjus/tables/README b/src/runtime/c/teyjus/tables/README
new file mode 100644
index 000000000..00c92caa2
--- /dev/null
+++ b/src/runtime/c/teyjus/tables/README
@@ -0,0 +1,27 @@
+ TABLES
+ ======
+The files in source/tables define the pervasive tables and instruction
+format tables.
+
+pervasives:
+
+ pervasives.h{c}
+ ===============
+ Defines the pervasive tables for pervasive kinds, type skeletons
+ and constants. Note these files are automatically generated.
+
+ pervinit.h{c}
+ =============
+ Defines the initialization functions for pervasive tables: such functions
+ are necessary because the pervasive names in the system run-time have
+ special encoding in the simulator (source/simulator/mcstring.h{c}) for
+ garbage collection as opposed to simply C strings. These names have to
+ be laid out on the system memory upon system initialization.
+
+ instructions.h{c}
+ =================
+ Defines instruction formats and instruction opcodes.
+ Note these files are automatically generated.
+
+
+
\ No newline at end of file
diff --git a/src/runtime/c/teyjus/tables/instructions.c b/src/runtime/c/teyjus/tables/instructions.c
new file mode 100644
index 000000000..183eb1875
--- /dev/null
+++ b/src/runtime/c/teyjus/tables/instructions.c
@@ -0,0 +1,292 @@
+/****************************************************************************/
+/* */
+/* File instructions.c. This file defines the operand types table and */
+/* the instruction information table. */
+/* */
+/****************************************************************************/
+
+
+#include "instructions.h"
+
+/****************************************************************************/
+/* OPERAND TYPES TABLE */
+/****************************************************************************/
+
+/* Max number of operand that could be taken by instructions including the */
+/* padding bytes and one to terminate the list. (machine dependent) */
+#define INSTR_MAX_OPERAND 8
+
+/* this array is indexed by instruction category. For each category,
+ INSTR_operandTypeTab contains a string of values indicating the type
+ of the operand at that position, terminated by INSTR_X. This
+ information is useful when parsing instruction streams. */
+typedef INSTR_OperandType
+ INSTR_OperandTypeTab[INSTR_NUM_INSTR_CATS][INSTR_MAX_OPERAND];
+
+INSTR_OperandTypeTab INSTR_operandTypeTable ={
+ //INSTR_CAT_X
+ {INSTR_P, INSTR_P, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_RX
+ {INSTR_R, INSTR_P, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_EX
+ {INSTR_E, INSTR_P, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_I1X
+ {INSTR_I1, INSTR_P, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_CX
+ {INSTR_P, INSTR_C, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_KX
+ {INSTR_P, INSTR_K, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_IX
+ {INSTR_P, INSTR_P, INSTR_P, INSTR_I, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_FX
+ {INSTR_P, INSTR_P, INSTR_P, INSTR_F, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_SX
+ {INSTR_P, INSTR_P, INSTR_P, INSTR_S, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_MTX
+ {INSTR_P, INSTR_P, INSTR_P, INSTR_MT, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_LX
+ {INSTR_P, INSTR_P, INSTR_P, INSTR_L, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_RRX
+ {INSTR_R, INSTR_R, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_ERX
+ {INSTR_E, INSTR_R, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_RCX
+ {INSTR_R, INSTR_C, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_RIX
+ {INSTR_R, INSTR_P, INSTR_P, INSTR_I, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_RFX
+ {INSTR_R, INSTR_P, INSTR_P, INSTR_F, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_RSX
+ {INSTR_R, INSTR_P, INSTR_P, INSTR_S, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_RI1X
+ {INSTR_R, INSTR_I1, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_RCEX
+ {INSTR_R, INSTR_CE, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_ECEX
+ {INSTR_E, INSTR_CE, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_CLX
+ {INSTR_P, INSTR_C, INSTR_L, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_RKX
+ {INSTR_R, INSTR_K, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_ECX
+ {INSTR_E, INSTR_C, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_I1ITX
+ {INSTR_I1, INSTR_P, INSTR_P, INSTR_IT, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_I1LX
+ {INSTR_I1, INSTR_P, INSTR_P, INSTR_L, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_SEGLX
+ {INSTR_SEG, INSTR_P, INSTR_P, INSTR_L, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_I1LWPX
+ {INSTR_I1, INSTR_P, INSTR_P, INSTR_L, INSTR_WP, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_I1NX
+ {INSTR_I1, INSTR_N, INSTR_P, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_I1HTX
+ {INSTR_I1, INSTR_P, INSTR_P, INSTR_HT, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_I1BVTX
+ {INSTR_I1, INSTR_P, INSTR_P, INSTR_BVT, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_CWPX
+ {INSTR_P, INSTR_C, INSTR_WP, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_I1WPX
+ {INSTR_I1, INSTR_P, INSTR_P, INSTR_WP, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_RRI1X
+ {INSTR_R, INSTR_R, INSTR_I1, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_RCLX
+ {INSTR_R, INSTR_C, INSTR_L, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_RCI1X
+ {INSTR_R, INSTR_C, INSTR_I1, INSTR_P, INSTR_P, INSTR_P, INSTR_X, INSTR_X},
+ //INSTR_CAT_SEGI1LX
+ {INSTR_SEG, INSTR_I1, INSTR_P, INSTR_L, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_I1LLX
+ {INSTR_I1, INSTR_P, INSTR_P, INSTR_L, INSTR_L, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_NLLX
+ {INSTR_N, INSTR_P, INSTR_P, INSTR_L, INSTR_L, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_LLLLX
+ {INSTR_P, INSTR_P, INSTR_P, INSTR_L, INSTR_L, INSTR_L, INSTR_L, INSTR_X},
+ //INSTR_CAT_I1CWPX
+ {INSTR_I1, INSTR_C, INSTR_WP, INSTR_X, INSTR_X, INSTR_X, INSTR_X, INSTR_X},
+ //INSTR_CAT_I1I1WPX
+ {INSTR_I1, INSTR_I1, INSTR_P, INSTR_WP, INSTR_X, INSTR_X, INSTR_X, INSTR_X}
+};
+
+INSTR_OperandType* INSTR_operandTypes(INSTR_InstrCategory index)
+{
+ return INSTR_operandTypeTable[index];
+}
+
+/****************************************************************************/
+/* INSTRUCTION INFORMATION TABLE */
+/****************************************************************************/
+typedef struct //entry of the instruction info table
+{
+ char* name;
+ INSTR_InstrCategory type;
+ int size;
+} INSTR_InstrInfoTab_;
+
+typedef INSTR_InstrInfoTab_ INSTR_InstrInfoTab[INSTR_NUM_INSTRS];
+
+INSTR_InstrInfoTab INSTR_instrInfoTable ={
+ {"put_variable_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
+ {"put_variable_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
+ {"put_value_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
+ {"put_value_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
+ {"put_unsafe_value", INSTR_CAT_ERX, INSTR_ERX_LEN},
+ {"copy_value", INSTR_CAT_ERX, INSTR_ERX_LEN},
+ {"put_m_const", INSTR_CAT_RCX, INSTR_RCX_LEN},
+ {"put_p_const", INSTR_CAT_RCX, INSTR_RCX_LEN},
+ {"put_nil", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"put_integer", INSTR_CAT_RIX, INSTR_RIX_LEN},
+ {"put_float", INSTR_CAT_RFX, INSTR_RFX_LEN},
+ {"put_string", INSTR_CAT_RSX, INSTR_RSX_LEN},
+ {"put_index", INSTR_CAT_RI1X, INSTR_RI1X_LEN},
+ {"put_app", INSTR_CAT_RRI1X, INSTR_RRI1X_LEN},
+ {"put_list", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"put_lambda", INSTR_CAT_RRI1X, INSTR_RRI1X_LEN},
+ {"set_variable_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"set_variable_te", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"set_variable_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"set_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"set_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"globalize_pt", INSTR_CAT_ERX, INSTR_ERX_LEN},
+ {"globalize_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"set_m_const", INSTR_CAT_CX, INSTR_CX_LEN},
+ {"set_p_const", INSTR_CAT_CX, INSTR_CX_LEN},
+ {"set_nil", INSTR_CAT_X, INSTR_X_LEN},
+ {"set_integer", INSTR_CAT_IX, INSTR_IX_LEN},
+ {"set_float", INSTR_CAT_FX, INSTR_FX_LEN},
+ {"set_string", INSTR_CAT_SX, INSTR_SX_LEN},
+ {"set_index", INSTR_CAT_I1X, INSTR_I1X_LEN},
+ {"set_void", INSTR_CAT_I1X, INSTR_I1X_LEN},
+ {"deref", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"set_lambda", INSTR_CAT_RI1X, INSTR_RI1X_LEN},
+ {"get_variable_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
+ {"get_variable_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
+ {"init_variable_t", INSTR_CAT_RCEX, INSTR_RCEX_LEN},
+ {"init_variable_p", INSTR_CAT_ECEX, INSTR_ECEX_LEN},
+ {"get_m_constant", INSTR_CAT_RCX, INSTR_RCX_LEN},
+ {"get_p_constant", INSTR_CAT_RCLX, INSTR_RCLX_LEN},
+ {"get_integer", INSTR_CAT_RIX, INSTR_RIX_LEN},
+ {"get_float", INSTR_CAT_RFX, INSTR_RFX_LEN},
+ {"get_string", INSTR_CAT_RSX, INSTR_RSX_LEN},
+ {"get_nil", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"get_m_structure", INSTR_CAT_RCI1X, INSTR_RCI1X_LEN},
+ {"get_p_structure", INSTR_CAT_RCI1X, INSTR_RCI1X_LEN},
+ {"get_list", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"unify_variable_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"unify_variable_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"unify_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"unify_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"unify_local_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"unify_local_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"unify_m_constant", INSTR_CAT_CX, INSTR_CX_LEN},
+ {"unify_p_constant", INSTR_CAT_CLX, INSTR_CLX_LEN},
+ {"unify_integer", INSTR_CAT_IX, INSTR_IX_LEN},
+ {"unify_float", INSTR_CAT_FX, INSTR_FX_LEN},
+ {"unify_string", INSTR_CAT_SX, INSTR_SX_LEN},
+ {"unify_nil", INSTR_CAT_X, INSTR_X_LEN},
+ {"unify_void", INSTR_CAT_I1X, INSTR_I1X_LEN},
+ {"put_type_variable_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
+ {"put_type_variable_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
+ {"put_type_value_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
+ {"put_type_value_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
+ {"put_type_unsafe_value", INSTR_CAT_ERX, INSTR_ERX_LEN},
+ {"put_type_const", INSTR_CAT_RKX, INSTR_RKX_LEN},
+ {"put_type_structure", INSTR_CAT_RKX, INSTR_RKX_LEN},
+ {"put_type_arrow", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"set_type_variable_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"set_type_variable_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"set_type_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"set_type_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"set_type_local_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"set_type_local_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"set_type_constant", INSTR_CAT_KX, INSTR_KX_LEN},
+ {"get_type_variable_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
+ {"get_type_variable_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
+ {"init_type_variable_t", INSTR_CAT_RCEX, INSTR_RCEX_LEN},
+ {"init_type_variable_p", INSTR_CAT_ECEX, INSTR_ECEX_LEN},
+ {"get_type_value_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
+ {"get_type_value_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
+ {"get_type_constant", INSTR_CAT_RKX, INSTR_RKX_LEN},
+ {"get_type_structure", INSTR_CAT_RKX, INSTR_RKX_LEN},
+ {"get_type_arrow", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"unify_type_variable_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"unify_type_variable_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"unify_type_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"unify_type_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"unify_envty_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"unify_envty_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"unify_type_local_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"unify_type_local_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"unify_envty_local_value_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"unify_envty_local_value_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"unify_type_constant", INSTR_CAT_KX, INSTR_KX_LEN},
+ {"pattern_unify_t", INSTR_CAT_RRX, INSTR_RRX_LEN},
+ {"pattern_unify_p", INSTR_CAT_ERX, INSTR_ERX_LEN},
+ {"finish_unify", INSTR_CAT_X, INSTR_X_LEN},
+ {"head_normalize_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"head_normalize_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"incr_universe", INSTR_CAT_X, INSTR_X_LEN},
+ {"decr_universe", INSTR_CAT_X, INSTR_X_LEN},
+ {"set_univ_tag", INSTR_CAT_ECX, INSTR_ECX_LEN},
+ {"tag_exists_t", INSTR_CAT_RX, INSTR_RX_LEN},
+ {"tag_exists_p", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"tag_variable", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"push_impl_point", INSTR_CAT_I1ITX, INSTR_I1ITX_LEN},
+ {"pop_impl_point", INSTR_CAT_X, INSTR_X_LEN},
+ {"add_imports", INSTR_CAT_SEGI1LX, INSTR_SEGI1LX_LEN},
+ {"remove_imports", INSTR_CAT_SEGLX, INSTR_SEGLX_LEN},
+ {"push_import", INSTR_CAT_MTX, INSTR_MTX_LEN},
+ {"pop_imports", INSTR_CAT_I1X, INSTR_I1X_LEN},
+ {"allocate", INSTR_CAT_I1X, INSTR_I1X_LEN},
+ {"deallocate", INSTR_CAT_X, INSTR_X_LEN},
+ {"call", INSTR_CAT_I1LX, INSTR_I1LX_LEN},
+ {"call_name", INSTR_CAT_I1CWPX, INSTR_I1CWPX_LEN},
+ {"execute", INSTR_CAT_LX, INSTR_LX_LEN},
+ {"execute_name", INSTR_CAT_CWPX, INSTR_CWPX_LEN},
+ {"proceed", INSTR_CAT_X, INSTR_X_LEN},
+ {"try_me_else", INSTR_CAT_I1LX, INSTR_I1LX_LEN},
+ {"retry_me_else", INSTR_CAT_I1LX, INSTR_I1LX_LEN},
+ {"trust_me", INSTR_CAT_I1WPX, INSTR_I1WPX_LEN},
+ {"try", INSTR_CAT_I1LX, INSTR_I1LX_LEN},
+ {"retry", INSTR_CAT_I1LX, INSTR_I1LX_LEN},
+ {"trust", INSTR_CAT_I1LWPX, INSTR_I1LWPX_LEN},
+ {"trust_ext", INSTR_CAT_I1NX, INSTR_I1NX_LEN},
+ {"try_else", INSTR_CAT_I1LLX, INSTR_I1LLX_LEN},
+ {"retry_else", INSTR_CAT_I1LLX, INSTR_I1LLX_LEN},
+ {"branch", INSTR_CAT_LX, INSTR_LX_LEN},
+ {"switch_on_term", INSTR_CAT_LLLLX, INSTR_LLLLX_LEN},
+ {"switch_on_constant", INSTR_CAT_I1HTX, INSTR_I1HTX_LEN},
+ {"switch_on_bvar", INSTR_CAT_I1BVTX, INSTR_I1BVTX_LEN},
+ {"switch_on_reg", INSTR_CAT_NLLX, INSTR_NLLX_LEN},
+ {"neck_cut", INSTR_CAT_X, INSTR_X_LEN},
+ {"get_level", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"put_level", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"cut", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"call_builtin", INSTR_CAT_I1I1WPX, INSTR_I1I1WPX_LEN},
+ {"builtin", INSTR_CAT_I1X, INSTR_I1X_LEN},
+ {"stop", INSTR_CAT_X, INSTR_X_LEN},
+ {"halt", INSTR_CAT_X, INSTR_X_LEN},
+ {"fail", INSTR_CAT_X, INSTR_X_LEN},
+ {"create_type_variable", INSTR_CAT_EX, INSTR_EX_LEN},
+ {"execute_link_only", INSTR_CAT_CWPX, INSTR_CWPX_LEN},
+ {"call_link_only", INSTR_CAT_I1CWPX, INSTR_I1CWPX_LEN},
+ {"put_variable_te", INSTR_CAT_RRX, INSTR_RRX_LEN}
+};
+
+/* Accessing functions */
+INSTR_InstrCategory INSTR_instrType(int index)
+{
+ return (INSTR_instrInfoTable[index]).type;
+}
+
+char* INSTR_instrName(int index)
+{
+ return (INSTR_instrInfoTable[index]).name;
+}
+
+int INSTR_instrSize(int index)
+{
+ return (INSTR_instrInfoTable[index]).size;
+}
+
+
diff --git a/src/runtime/c/teyjus/tables/instructions.h b/src/runtime/c/teyjus/tables/instructions.h
new file mode 100644
index 000000000..2ced4e85d
--- /dev/null
+++ b/src/runtime/c/teyjus/tables/instructions.h
@@ -0,0 +1,480 @@
+/****************************************************************************/
+/* File instructions.h. */
+/* This file defines instruction operand types, instruction categories and */
+/* instruction opcode. */
+/****************************************************************************/
+
+#ifndef INSTRUCTIONS_H
+#define INSTRUCTIONS_H
+
+#include "../simulator/mctypes.h" //to be changed
+#include "../simulator/dataformats.h" //to be changed
+
+/****************************************************************************/
+/* OPERAND TYPES */
+/****************************************************************************/
+
+/* possible types of instruction operands */
+typedef enum INSTR_OperandType
+{
+ // (1 byte) padding
+ INSTR_P,
+ // (1 word) padding
+ INSTR_WP,
+ // argument register number
+ INSTR_R,
+ // environment variable number
+ INSTR_E,
+ // next clause number in impt or impl pt
+ INSTR_N,
+ // 1 byte natural number
+ INSTR_I1,
+ // closure environment variable number
+ INSTR_CE,
+ // import segment index
+ INSTR_SEG,
+ // constant symbol table index
+ INSTR_C,
+ // kind symbol table index
+ INSTR_K,
+ // code location
+ INSTR_L,
+ // integer immediate value
+ INSTR_I,
+ // floating point immediate value
+ INSTR_F,
+ // string pointer
+ INSTR_S,
+ // module table address
+ INSTR_MT,
+ // impl table address
+ INSTR_IT,
+ // hash table address
+ INSTR_HT,
+ // branch table for bound var indexing
+ INSTR_BVT,
+ // operand list terminator
+ INSTR_X
+} INSTR_OperandType;
+
+/**************************************************************************/
+/* Types for instruction operants */
+/**************************************************************************/
+
+typedef Byte INSTR_OpCode;
+typedef Byte INSTR_RegInd;
+typedef Byte INSTR_EnvInd;
+typedef Byte INSTR_NextClauseInd;
+typedef Byte INSTR_OneByteInt;
+typedef Byte INSTR_ClEnvInd;
+typedef Byte INSTR_ImpSegInd;
+typedef TwoBytes INSTR_CstIndex;
+typedef TwoBytes INSTR_KstIndex;
+typedef CSpacePtr INSTR_CodeLabel;
+typedef int INSTR_Int;
+typedef float INSTR_Float;
+typedef DF_StrDataPtr INSTR_Str;
+typedef MemPtr INSTR_ModTab;
+typedef MemPtr INSTR_ImplTab;
+typedef MemPtr INSTR_HashTab;
+typedef MemPtr INSTR_BranchTab;
+
+/***************************************************************************/
+/* INSTRUCTION CATEGORIES */
+/***************************************************************************/
+ /* The names of instruction categories no longer include padding bytes. */
+/* Thus we do not need to maintain two sets of names for different machine */
+/* architectures. */
+typedef enum INSTR_InstrCategory
+{
+ INSTR_CAT_X = 0,
+ INSTR_CAT_RX = 1,
+ INSTR_CAT_EX = 2,
+ INSTR_CAT_I1X = 3,
+ INSTR_CAT_CX = 4,
+ INSTR_CAT_KX = 5,
+ INSTR_CAT_IX = 6,
+ INSTR_CAT_FX = 7,
+ INSTR_CAT_SX = 8,
+ INSTR_CAT_MTX = 9,
+ INSTR_CAT_LX = 10,
+ INSTR_CAT_RRX = 11,
+ INSTR_CAT_ERX = 12,
+ INSTR_CAT_RCX = 13,
+ INSTR_CAT_RIX = 14,
+ INSTR_CAT_RFX = 15,
+ INSTR_CAT_RSX = 16,
+ INSTR_CAT_RI1X = 17,
+ INSTR_CAT_RCEX = 18,
+ INSTR_CAT_ECEX = 19,
+ INSTR_CAT_CLX = 20,
+ INSTR_CAT_RKX = 21,
+ INSTR_CAT_ECX = 22,
+ INSTR_CAT_I1ITX = 23,
+ INSTR_CAT_I1LX = 24,
+ INSTR_CAT_SEGLX = 25,
+ INSTR_CAT_I1LWPX = 26,
+ INSTR_CAT_I1NX = 27,
+ INSTR_CAT_I1HTX = 28,
+ INSTR_CAT_I1BVTX = 29,
+ INSTR_CAT_CWPX = 30,
+ INSTR_CAT_I1WPX = 31,
+ INSTR_CAT_RRI1X = 32,
+ INSTR_CAT_RCLX = 33,
+ INSTR_CAT_RCI1X = 34,
+ INSTR_CAT_SEGI1LX = 35,
+ INSTR_CAT_I1LLX = 36,
+ INSTR_CAT_NLLX = 37,
+ INSTR_CAT_LLLLX = 38,
+ INSTR_CAT_I1CWPX = 39,
+ INSTR_CAT_I1I1WPX = 40
+} INSTR_InstrCategory;
+
+#define INSTR_NUM_INSTR_CATS 41
+
+#define INSTR_CALL_I1_LEN 7
+
+/**************************************************************************/
+/* Macros defines instruction lengths and distances between op code and */
+/* operands. */
+/* The assumption is that the op code occupies 1 byte. */
+/**************************************************************************/
+
+//INSTR_CAT_X
+#define INSTR_X_LEN 4
+//INSTR_CAT_RX
+#define INSTR_RX_LEN 4
+#define INSTR_RX_R 1
+//INSTR_CAT_EX
+#define INSTR_EX_LEN 4
+#define INSTR_EX_E 1
+//INSTR_CAT_I1X
+#define INSTR_I1X_LEN 4
+#define INSTR_I1X_I1 1
+//INSTR_CAT_CX
+#define INSTR_CX_LEN 4
+#define INSTR_CX_C 2
+//INSTR_CAT_KX
+#define INSTR_KX_LEN 4
+#define INSTR_KX_K 2
+//INSTR_CAT_IX
+#define INSTR_IX_LEN 8
+#define INSTR_IX_I 4
+//INSTR_CAT_FX
+#define INSTR_FX_LEN 8
+#define INSTR_FX_F 4
+//INSTR_CAT_SX
+#define INSTR_SX_LEN 8
+#define INSTR_SX_S 4
+//INSTR_CAT_MTX
+#define INSTR_MTX_LEN 8
+#define INSTR_MTX_MT 4
+//INSTR_CAT_LX
+#define INSTR_LX_LEN 8
+#define INSTR_LX_L 4
+//INSTR_CAT_RRX
+#define INSTR_RRX_LEN 4
+#define INSTR_RRX_R1 1
+#define INSTR_RRX_R2 2
+//INSTR_CAT_ERX
+#define INSTR_ERX_LEN 4
+#define INSTR_ERX_E 1
+#define INSTR_ERX_R 2
+//INSTR_CAT_RCX
+#define INSTR_RCX_LEN 4
+#define INSTR_RCX_R 1
+#define INSTR_RCX_C 2
+//INSTR_CAT_RIX
+#define INSTR_RIX_LEN 8
+#define INSTR_RIX_R 1
+#define INSTR_RIX_I 4
+//INSTR_CAT_RFX
+#define INSTR_RFX_LEN 8
+#define INSTR_RFX_R 1
+#define INSTR_RFX_F 4
+//INSTR_CAT_RSX
+#define INSTR_RSX_LEN 8
+#define INSTR_RSX_R 1
+#define INSTR_RSX_S 4
+//INSTR_CAT_RI1X
+#define INSTR_RI1X_LEN 4
+#define INSTR_RI1X_R 1
+#define INSTR_RI1X_I1 2
+//INSTR_CAT_RCEX
+#define INSTR_RCEX_LEN 4
+#define INSTR_RCEX_R 1
+#define INSTR_RCEX_CE 2
+//INSTR_CAT_ECEX
+#define INSTR_ECEX_LEN 4
+#define INSTR_ECEX_E 1
+#define INSTR_ECEX_CE 2
+//INSTR_CAT_CLX
+#define INSTR_CLX_LEN 8
+#define INSTR_CLX_C 2
+#define INSTR_CLX_L 4
+//INSTR_CAT_RKX
+#define INSTR_RKX_LEN 4
+#define INSTR_RKX_R 1
+#define INSTR_RKX_K 2
+//INSTR_CAT_ECX
+#define INSTR_ECX_LEN 4
+#define INSTR_ECX_E 1
+#define INSTR_ECX_C 2
+//INSTR_CAT_I1ITX
+#define INSTR_I1ITX_LEN 8
+#define INSTR_I1ITX_I1 1
+#define INSTR_I1ITX_IT 4
+//INSTR_CAT_I1LX
+#define INSTR_I1LX_LEN 8
+#define INSTR_I1LX_I1 1
+#define INSTR_I1LX_L 4
+//INSTR_CAT_SEGLX
+#define INSTR_SEGLX_LEN 8
+#define INSTR_SEGLX_SEG 1
+#define INSTR_SEGLX_L 4
+//INSTR_CAT_I1LWPX
+#define INSTR_I1LWPX_LEN 12
+#define INSTR_I1LWPX_I1 1
+#define INSTR_I1LWPX_L 4
+//INSTR_CAT_I1NX
+#define INSTR_I1NX_LEN 4
+#define INSTR_I1NX_I1 1
+#define INSTR_I1NX_N 2
+//INSTR_CAT_I1HTX
+#define INSTR_I1HTX_LEN 8
+#define INSTR_I1HTX_I1 1
+#define INSTR_I1HTX_HT 4
+//INSTR_CAT_I1BVTX
+#define INSTR_I1BVTX_LEN 8
+#define INSTR_I1BVTX_I1 1
+#define INSTR_I1BVTX_BVT 4
+//INSTR_CAT_CWPX
+#define INSTR_CWPX_LEN 8
+#define INSTR_CWPX_C 2
+//INSTR_CAT_I1WPX
+#define INSTR_I1WPX_LEN 8
+#define INSTR_I1WPX_I1 1
+//INSTR_CAT_RRI1X
+#define INSTR_RRI1X_LEN 4
+#define INSTR_RRI1X_R1 1
+#define INSTR_RRI1X_R2 2
+#define INSTR_RRI1X_I1 3
+//INSTR_CAT_RCLX
+#define INSTR_RCLX_LEN 8
+#define INSTR_RCLX_R 1
+#define INSTR_RCLX_C 2
+#define INSTR_RCLX_L 4
+//INSTR_CAT_RCI1X
+#define INSTR_RCI1X_LEN 8
+#define INSTR_RCI1X_R 1
+#define INSTR_RCI1X_C 2
+#define INSTR_RCI1X_I1 4
+//INSTR_CAT_SEGI1LX
+#define INSTR_SEGI1LX_LEN 8
+#define INSTR_SEGI1LX_SEG 1
+#define INSTR_SEGI1LX_I1 2
+#define INSTR_SEGI1LX_L 4
+//INSTR_CAT_I1LLX
+#define INSTR_I1LLX_LEN 12
+#define INSTR_I1LLX_I1 1
+#define INSTR_I1LLX_L1 4
+#define INSTR_I1LLX_L2 8
+//INSTR_CAT_NLLX
+#define INSTR_NLLX_LEN 12
+#define INSTR_NLLX_N 1
+#define INSTR_NLLX_L1 4
+#define INSTR_NLLX_L2 8
+//INSTR_CAT_LLLLX
+#define INSTR_LLLLX_LEN 20
+#define INSTR_LLLLX_L1 4
+#define INSTR_LLLLX_L2 8
+#define INSTR_LLLLX_L3 12
+#define INSTR_LLLLX_L4 16
+//INSTR_CAT_I1CWPX
+#define INSTR_I1CWPX_LEN 8
+#define INSTR_I1CWPX_I1 1
+#define INSTR_I1CWPX_C 2
+//INSTR_CAT_I1I1WPX
+#define INSTR_I1I1WPX_LEN 8
+#define INSTR_I1I1WPX_I11 1
+#define INSTR_I1I1WPX_I12 2
+
+/****************************************************************************/
+/* OPERAND TYPES TABLE */
+/****************************************************************************/
+
+//the operand types array in a given entry
+INSTR_OperandType* INSTR_operandTypes(INSTR_InstrCategory index);
+
+/***************************************************************************/
+/* OPCODES OF INSTRUCTIONS */
+/***************************************************************************/
+// Instructions for term unification and creation
+#define put_variable_t 0
+#define put_variable_p 1
+#define put_value_t 2
+#define put_value_p 3
+#define put_unsafe_value 4
+#define copy_value 5
+#define put_m_const 6
+#define put_p_const 7
+#define put_nil 8
+#define put_integer 9
+#define put_float 10
+#define put_string 11
+#define put_index 12
+#define put_app 13
+#define put_list 14
+#define put_lambda 15
+#define set_variable_t 16
+#define set_variable_te 17
+#define set_variable_p 18
+#define set_value_t 19
+#define set_value_p 20
+#define globalize_pt 21
+#define globalize_t 22
+#define set_m_const 23
+#define set_p_const 24
+#define set_nil 25
+#define set_integer 26
+#define set_float 27
+#define set_string 28
+#define set_index 29
+#define set_void 30
+#define deref 31
+#define set_lambda 32
+#define get_variable_t 33
+#define get_variable_p 34
+#define init_variable_t 35
+#define init_variable_p 36
+#define get_m_constant 37
+#define get_p_constant 38
+#define get_integer 39
+#define get_float 40
+#define get_string 41
+#define get_nil 42
+#define get_m_structure 43
+#define get_p_structure 44
+#define get_list 45
+#define unify_variable_t 46
+#define unify_variable_p 47
+#define unify_value_t 48
+#define unify_value_p 49
+#define unify_local_value_t 50
+#define unify_local_value_p 51
+#define unify_m_constant 52
+#define unify_p_constant 53
+#define unify_integer 54
+#define unify_float 55
+#define unify_string 56
+#define unify_nil 57
+#define unify_void 58
+// Instructions for type unification and creation
+#define put_type_variable_t 59
+#define put_type_variable_p 60
+#define put_type_value_t 61
+#define put_type_value_p 62
+#define put_type_unsafe_value 63
+#define put_type_const 64
+#define put_type_structure 65
+#define put_type_arrow 66
+#define set_type_variable_t 67
+#define set_type_variable_p 68
+#define set_type_value_t 69
+#define set_type_value_p 70
+#define set_type_local_value_t 71
+#define set_type_local_value_p 72
+#define set_type_constant 73
+#define get_type_variable_t 74
+#define get_type_variable_p 75
+#define init_type_variable_t 76
+#define init_type_variable_p 77
+#define get_type_value_t 78
+#define get_type_value_p 79
+#define get_type_constant 80
+#define get_type_structure 81
+#define get_type_arrow 82
+#define unify_type_variable_t 83
+#define unify_type_variable_p 84
+#define unify_type_value_t 85
+#define unify_type_value_p 86
+#define unify_envty_value_t 87
+#define unify_envty_value_p 88
+#define unify_type_local_value_t 89
+#define unify_type_local_value_p 90
+#define unify_envty_local_value_t 91
+#define unify_envty_local_value_p 92
+#define unify_type_constant 93
+// Instructions for handling higher-order aspects
+#define pattern_unify_t 94
+#define pattern_unify_p 95
+#define finish_unify 96
+#define head_normalize_t 97
+#define head_normalize_p 98
+// Instructions for handling logical aspects
+#define incr_universe 99
+#define decr_universe 100
+#define set_univ_tag 101
+#define tag_exists_t 102
+#define tag_exists_p 103
+#define tag_variable 104
+#define push_impl_point 105
+#define pop_impl_point 106
+#define add_imports 107
+#define remove_imports 108
+#define push_import 109
+#define pop_imports 110
+// Control Instructions
+#define allocate 111
+#define deallocate 112
+#define call 113
+#define call_name 114
+#define execute 115
+#define execute_name 116
+#define proceed 117
+// Choice Instructions
+#define try_me_else 118
+#define retry_me_else 119
+#define trust_me 120
+#define try 121
+#define retry 122
+#define trust 123
+#define trust_ext 124
+#define try_else 125
+#define retry_else 126
+#define branch 127
+// Indexing Instructions
+#define switch_on_term 128
+#define switch_on_constant 129
+#define switch_on_bvar 130
+#define switch_on_reg 131
+// Cut Instructions
+#define neck_cut 132
+#define get_level 133
+#define put_level 134
+#define cut 135
+// Miscellaneous Instructions
+#define call_builtin 136
+#define builtin 137
+#define stop 138
+#define halt 139
+#define fail 140
+// new added
+#define create_type_variable 141
+// resolved by the linker
+#define execute_link_only 142
+#define call_link_only 143
+#define put_variable_te 144
+
+
+#define INSTR_NUM_INSTRS 145
+
+/***************************************************************************/
+/* INSTRUCTION INFORMATION TABLE */
+/***************************************************************************/
+INSTR_InstrCategory INSTR_instrType(int index); //instr type in a given entry
+char* INSTR_instrName(int index); //instr name in a given entry
+int INSTR_instrSize(int index); //instr size in a given entry
+
+#endif //INSTRUCTIONS_H
+
diff --git a/src/runtime/c/teyjus/tables/pervasives.c b/src/runtime/c/teyjus/tables/pervasives.c
new file mode 100644
index 000000000..4c2b3ad4c
--- /dev/null
+++ b/src/runtime/c/teyjus/tables/pervasives.c
@@ -0,0 +1,810 @@
+/***************************************************************************/
+/* File pervasives.c. */
+/***************************************************************************/
+
+#ifndef PERVASIVES_C
+#define PERVASIVES_C
+
+#include
+#include "pervasives.h"
+#include "../system/error.h" //to be changed
+#include "../system/operators.h" //to be changed
+
+
+/****************************************************************************/
+/* PERVASIVE KIND */
+/****************************************************************************/
+//pervasive kind data table (array)
+PERV_KindData PERV_kindDataTab[PERV_KIND_NUM] = {
+ //name, arity
+ // int
+ {"int", 0},
+ // real
+ {"real", 0},
+ // bool
+ {"o", 0},
+ // string
+ {"string", 0},
+ // list type constructor
+ {"list", 1},
+ // in_stream
+ {"in_stream", 0},
+ // out_stream
+ {"out_stream", 0}
+};
+
+PERV_KindData PERV_getKindData(int index)
+{
+ return PERV_kindDataTab[index];
+}
+
+void PERV_copyKindDataTab(PERV_KindData* dst)
+{
+ //this way of copy relies on the assumption that the pervasive kind data
+ //has the same structure as that of the run-time kind symbol table entries.
+ memcpy((void*)dst, (void*)PERV_kindDataTab,
+ sizeof(PERV_KindData) * PERV_KIND_NUM);
+}
+
+
+/***************************************************************************/
+/* TYPE SKELETIONS FOR PERVASIVE CONSTANTS */
+/****************************************************************************/
+
+//pervasive type skeleton table (array)
+PERV_TySkelData PERV_tySkelTab[PERV_TY_SKEL_NUM];
+
+//pervasive type skeletons and type skeleton table initialization
+//The type skeletons are created in the memory of the system through malloc,
+//and addresses are entered into the pervasive type skeleton table.
+void PERV_tySkelTabInit()
+{
+ int tySkelInd = 0; //ts tab index
+ MemPtr tySkelBase = (MemPtr)EM_malloc(WORD_SIZE * 336 ); //ts area
+
+ // A
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkSkelVarType(tySkelBase, 0);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // (list A)
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkStrType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkStrFuncType(tySkelBase, PERV_LIST_INDEX, 1);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSkelVarType(tySkelBase, 0);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // A->(list A)->(list A)
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSkelVarType(tySkelBase, 0);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkStrType(tySkelBase, (DF_TypePtr)(tySkelBase + 2 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkStrType(tySkelBase, (DF_TypePtr)(tySkelBase + 3 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkStrFuncType(tySkelBase, PERV_LIST_INDEX, 1);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSkelVarType(tySkelBase, 0);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkStrFuncType(tySkelBase, PERV_LIST_INDEX, 1);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSkelVarType(tySkelBase, 0);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // int
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // real
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // string
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // o (type of proposition)
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // int -> int
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // int -> int -> int
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // int -> int -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // int -> real
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // real -> int
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // real -> real
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // real -> string
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // real -> real -> real
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // real -> real -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_REAL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // string -> int
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // int -> string
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // string -> string -> string
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // string -> string -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // string -> int -> int -> string
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // o -> o -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // (A -> o) -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 2 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSkelVarType(tySkelBase, 0);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // A -> A -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSkelVarType(tySkelBase, 0);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSkelVarType(tySkelBase, 0);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // in_stream
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkSortType(tySkelBase, PERV_INSTREAM_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // out_stream
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkSortType(tySkelBase, PERV_OUTSTREAM_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // string -> in_stream -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INSTREAM_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // string -> out_stream -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_OUTSTREAM_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // in_stream -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INSTREAM_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // out_stream -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_OUTSTREAM_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // A -> string -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSkelVarType(tySkelBase, 0);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // string -> A -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSkelVarType(tySkelBase, 0);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // out_stream -> string -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_OUTSTREAM_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // in_stream -> int -> string -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INSTREAM_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // in_stream -> string -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INSTREAM_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // string -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // A -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSkelVarType(tySkelBase, 0);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // out_stream -> A -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_OUTSTREAM_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSkelVarType(tySkelBase, 0);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // in_stream -> A -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INSTREAM_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSkelVarType(tySkelBase, 0);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // o -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // string -> int -> in_stream -> out_stream -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INSTREAM_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_OUTSTREAM_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+ // string -> int -> o
+ PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;
+ tySkelInd++;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_STRING_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + 1 * DF_TY_ATOMIC_SIZE));
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_INT_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+ DF_mkSortType(tySkelBase, PERV_BOOL_INDEX);
+ tySkelBase += DF_TY_ATOMIC_SIZE;
+
+}
+
+void PERV_copyTySkelTab(PERV_TySkelData* dst)
+{
+ memcpy((void*)dst, (void*)PERV_tySkelTab,
+ sizeof(PERV_TySkelData) * PERV_KIND_NUM);
+}
+
+
+/***************************************************************************/
+/* PERVASIVE CONSTANTS */
+/***************************************************************************/
+
+//pervasive constant data table (array)
+PERV_ConstData PERV_constDataTab[PERV_CONST_NUM] = {
+ //name, tesize, tst, neededness, UC, prec, fixity
+ // logical and
+ {",", 0, 21, 0, 0, 110, OP_INFIXL},
+ // logical or
+ {";", 0, 21, 0, 0, 100, OP_INFIXL},
+ // existential quantifier
+ {"sigma", 1, 22, 1, 0, 0, OP_NONE},
+ // universal quantifier
+ {"pi", 1, 22, 1, 0, 0, OP_NONE},
+ // true proposition
+ {"true", 0, 6, 0, 0, 0, OP_NONE},
+ // cut predicate
+ {"!", 0, 6, 0, 0, 0, OP_NONE},
+ // fail predicate
+ {"fail", 0, 6, 0, 0, 0, OP_NONE},
+ //nothing
+ {NULL, 0, 0, 0, 0, OP_NONE },
+ // another logical and
+ {"&", 0, 21, 0, 0, 120, OP_INFIXR},
+ // halt the system
+ {"halt", 0, 6, 0, 0, 0, OP_NONE},
+ // return to top level
+ {"stop", 0, 6, 0, 0, 0, OP_NONE},
+ // Prolog if; needed?
+ {":-", 0, 21, 0, 0, 0, OP_INFIXL},
+ // implication; needed?
+ {"=>", 0, 21, 0, 0, 130, OP_INFIXR},
+ //nothing
+ {NULL, 0, 0, 0, 0, OP_NONE },
+ //nothing
+ {NULL, 0, 0, 0, 0, OP_NONE },
+ // solve; used by code generator
+ {"solve", 0, 39, 0, 0, 0, OP_NONE},
+ // is
+ {"is", 1, 23, 1, 0, 130, OP_INFIX},
+ // not
+ {"not", 0, 39, 0, 0, 0, OP_NONE},
+ // equality (unify) predicate
+ {"=", 1, 23, 1, 0, 130, OP_INFIX},
+ // less than on integers
+ {"<", 0, 9, 0, 0, 130, OP_INFIX},
+ // greater than on integers
+ {">", 0, 9, 0, 0, 130, OP_INFIX},
+ // less than or eq on integers
+ {"<=", 0, 9, 0, 0, 130, OP_INFIX},
+ // greater than or eq on integers
+ {">=", 0, 9, 0, 0, 130, OP_INFIX},
+ // less than in reals
+ {"<", 0, 15, 0, 0, 130, OP_INFIX},
+ // greater than on reals
+ {">", 0, 15, 0, 0, 130, OP_INFIX},
+ // less than or eq on reals
+ {"<=", 0, 15, 0, 0, 130, OP_INFIX},
+ // greater than or eq on reals
+ {">=", 0, 15, 0, 0, 130, OP_INFIX},
+ // less than on strings
+ {"<", 0, 19, 0, 0, 130, OP_INFIX},
+ // greater than on strings
+ {">", 0, 19, 0, 0, 130, OP_INFIX},
+ // less than or eq on strings
+ {"<=", 0, 19, 0, 0, 130, OP_INFIX},
+ // greater than or eq on strings
+ {">=", 0, 19, 0, 0, 130, OP_INFIX},
+ // open_in
+ {"open_in", 0, 26, 0, 0, 0, OP_NONE},
+ // open_out
+ {"open_out", 0, 27, 0, 0, 0, OP_NONE},
+ // open_append
+ {"open_append", 0, 27, 0, 0, 0, OP_NONE},
+ // close_in
+ {"close_in", 0, 28, 0, 0, 0, OP_NONE},
+ // close_out
+ {"close_out", 0, 29, 0, 0, 0, OP_NONE},
+ // open_string
+ {"open_string", 0, 26, 0, 0, 0, OP_NONE},
+ // input
+ {"input", 0, 33, 0, 0, 0, OP_NONE},
+ // output
+ {"output", 0, 32, 0, 0, 0, OP_NONE},
+ // input_line
+ {"input_line", 0, 34, 0, 0, 0, OP_NONE},
+ // lookahead
+ {"lookahead", 0, 34, 0, 0, 0, OP_NONE},
+ // eof
+ {"eof", 0, 28, 0, 0, 0, OP_NONE},
+ // flush
+ {"flush", 0, 29, 0, 0, 0, OP_NONE},
+ // print
+ {"print", 0, 35, 0, 0, 0, OP_NONE},
+ // read
+ {"read", 1, 36, 1, 0, 0, OP_NONE},
+ // printterm
+ {"printterm", 1, 37, 0, 0, 0, OP_NONE},
+ // term_to_string
+ {"term_to_string", 1, 30, 0, 0, 0, OP_NONE},
+ // string_to_term
+ {"string_to_term", 1, 31, 1, 0, 0, OP_NONE},
+ // readterm
+ {"readterm", 1, 38, 1, 0, 0, OP_NONE},
+ // getenv predicate; needed?
+ {"getenv", 0, 19, 0, 0, 0, OP_NONE},
+ // open_socket predicate
+ {"open_socket", 0, 40, 0, 0, 0, OP_NONE},
+ // time predicate
+ {"time", 0, 9, 0, 0, 0, OP_NONE},
+ // system predicate
+ {"system", 0, 41, 0, 0, 0, OP_NONE},
+ //nothing
+ {NULL, 0, 0, 0, 0, OP_NONE },
+ //nothing
+ {NULL, 0, 0, 0, 0, OP_NONE },
+ //nothing
+ {NULL, 0, 0, 0, 0, OP_NONE },
+ // unary minus on integers
+ {"-", 0, 7, 0, 0, 256, OP_PREFIX},
+ // addition on integers
+ {"+", 0, 8, 0, 0, 150, OP_INFIXL},
+ // subtraction on integers
+ {"-", 0, 8, 0, 0, 150, OP_INFIXL},
+ // mutiplication on integers
+ {"*", 0, 8, 0, 0, 160, OP_INFIXL},
+ // integer division
+ {"div", 0, 8, 0, 0, 160, OP_INFIXL},
+ // modulus
+ {"mod", 0, 7, 0, 0, 160, OP_INFIXL},
+ // coercion to real
+ {"int_to_real", 0, 10, 0, 0, 0, OP_NONE},
+ // integer abs
+ {"abs", 0, 7, 0, 0, 0, OP_NONE},
+ // unary minus on real
+ {"-", 0, 12, 0, 0, 256, OP_PREFIX},
+ // addition on reals
+ {"+", 0, 14, 0, 0, 150, OP_INFIXL},
+ // subtraction on reals
+ {"-", 0, 14, 0, 0, 150, OP_INFIXL},
+ // multiplication on reals
+ {"*", 0, 14, 0, 0, 160, OP_INFIXL},
+ // division
+ {"/", 0, 14, 0, 0, 160, OP_INFIXL},
+ // square root
+ {"sqrt", 0, 12, 0, 0, 0, OP_NONE},
+ // sine
+ {"sin", 0, 12, 0, 0, 0, OP_NONE},
+ // cosine
+ {"cos", 0, 12, 0, 0, 0, OP_NONE},
+ // arc tan
+ {"arctan", 0, 12, 0, 0, 0, OP_NONE},
+ // natural log
+ {"ln", 0, 12, 0, 0, 0, OP_NONE},
+ // floor function
+ {"floor", 0, 11, 0, 0, 0, OP_NONE},
+ // ceiling function
+ {"ceil", 0, 11, 0, 0, 0, OP_NONE},
+ // truncation
+ {"truncate", 0, 11, 0, 0, 0, OP_NONE},
+ // real abs
+ {"rabs", 0, 12, 0, 0, 0, OP_NONE},
+ // string concatination
+ {"^", 0, 18, 0, 0, 150, OP_INFIXL},
+ // string length
+ {"size", 0, 16, 0, 0, 0, OP_NONE},
+ // chr function
+ {"chr", 0, 17, 0, 0, 0, OP_NONE},
+ // ord function
+ {"string_to_int", 0, 16, 0, 0, 0, OP_NONE},
+ // substring
+ {"substring", 0, 20, 0, 0, 0, OP_NONE},
+ // int to string
+ {"int_to_string", 0, 17, 0, 0, 0, OP_NONE},
+ // real to string
+ {"real_to_string", 0, 13, 0, 0, 0, OP_NONE},
+ // for unnamed universal constants (Note: tesize should be 0)
+ {"", 0, 0, 0, 0, 0, OP_NONE},
+ // std_in
+ {"std_in", 0, 24, 0, 0, 0, OP_NONE},
+ // std_out
+ {"std_out", 0, 25, 0, 0, 0, OP_NONE},
+ // std_err
+ {"std_err", 0, 25, 0, 0, 0, OP_NONE},
+ // nil
+ {"nil", 0, 1, 0, 0, 0, OP_NONE},
+ // integer constant
+ {"", 0, 3, 0, 0, 0, OP_NONE},
+ // real constant
+ {"", 0, 4, 0, 0, 0, OP_NONE},
+ // string constant
+ {"", 0, 5, 0, 0, 0, OP_NONE},
+ // cons
+ {"::", 0, 2, 0, 0, 140, OP_INFIXR}
+};
+
+PERV_ConstData PERV_getConstData(int index)
+{
+ return PERV_constDataTab[index];
+}
+
+void PERV_copyConstDataTab(PERV_ConstData* dst)
+{
+ //this way of copy relies on the assumption that the pervasive kind data
+ //has the same structure as that of the run-time kind symbol table entries.
+ memcpy((void*)dst, (void*)PERV_constDataTab,
+ sizeof(PERV_ConstData) * PERV_CONST_NUM);
+}
+
+Boolean PERV_isLogicSymb(int index)
+{
+ return ((index >= PERV_LSSTART) && (index <= PERV_LSEND));
+}
+
+Boolean PERV_isPredSymb(int index)
+{
+ return ((index >= PERV_PREDSTART) && (index <= PERV_PREDEND));
+}
+
+PERV_LogicSymbTypes PERV_logicSymb(int index)
+{
+ return ((PERV_LogicSymbTypes)(index - PERV_LSSTART));
+}
+
+int PERV_predBuiltin(int index)
+{
+ return (index - PERV_PREDSTART);
+}
+
+
+#endif //PERVASIVES_C
+
diff --git a/src/runtime/c/teyjus/tables/pervasives.h b/src/runtime/c/teyjus/tables/pervasives.h
new file mode 100644
index 000000000..48a96964c
--- /dev/null
+++ b/src/runtime/c/teyjus/tables/pervasives.h
@@ -0,0 +1,326 @@
+/****************************************************************************/
+/* File pervasives.h. */
+/****************************************************************************/
+
+#ifndef PERVASIVES_H
+#define PERVASIVES_H
+
+#include "../simulator/mctypes.h" //to be changed
+#include "../simulator/dataformats.h" //to be changed
+
+
+/****************************************************************************/
+/* PERVASIVE KIND */
+/****************************************************************************/
+//indices for predefined sorts and type constructors
+typedef enum PERV_KindIndexType
+{
+ // int
+ PERV_INT_INDEX = 0,
+ // real
+ PERV_REAL_INDEX = 1,
+ // bool
+ PERV_BOOL_INDEX = 2,
+ // string
+ PERV_STRING_INDEX = 3,
+ // list type constructor
+ PERV_LIST_INDEX = 4,
+ // in_stream
+ PERV_INSTREAM_INDEX = 5,
+ // out_stream
+ PERV_OUTSTREAM_INDEX = 6
+} PERV_KindIndexType;
+
+//total number of pervasive kinds
+#define PERV_KIND_NUM 7
+
+//pervasive kind data type
+typedef struct
+{
+ char *name;
+ TwoBytes arity;
+} PERV_KindData;
+
+//pervasive kind data table (array)
+extern PERV_KindData PERV_kindDataTab[PERV_KIND_NUM];
+
+//pervasive kind data access function
+PERV_KindData PERV_getKindData(int index);
+
+//pervasive kind table copy function (used in module space initialization)
+//this functiion relies on the assumption that the pervasive kind data
+//has the same structure as that of the run-time kind symbol table entries.
+void PERV_copyKindDataTab(PERV_KindData* dst);
+
+
+/***************************************************************************/
+/* TYPE SKELETIONS FOR PERVASIVE CONSTANTS */
+/****************************************************************************/
+
+//total number of type skeletons needed for pervasive constants
+#define PERV_TY_SKEL_NUM 42
+
+//pervasive type skel data type
+typedef DF_TypePtr PERV_TySkelData;
+
+//pervasive type skel table (array)
+extern PERV_TySkelData PERV_tySkelTab[PERV_TY_SKEL_NUM];
+
+//pervasive type skeletons and type skeleton table initialization
+//Note that type skeltons have to be dynamically allocated, and so does the
+//info recorded in each entry of the pervasive type skeleton table
+void PERV_tySkelTabInit();
+
+//pervasive tyskel table copy function
+void PERV_copyTySkelTab(PERV_TySkelData* dst);
+
+
+/***************************************************************************/
+/* PERVASIVE CONSTANTS */
+/***************************************************************************/
+
+//indices for predefined constants
+typedef enum PERV_ConstIndexType
+{
+ // logical and
+ PERV_AND_INDEX = 0,
+ // logical or
+ PERV_OR_INDEX = 1,
+ // existential quantifier
+ PERV_SOME_INDEX = 2,
+ // universal quantifier
+ PERV_ALL_INDEX = 3,
+ // true proposition
+ PERV_TRUE_INDEX = 4,
+ // cut predicate
+ PERV_CUT_INDEX = 5,
+ // fail predicate
+ PERV_FAIL_INDEX = 6,
+ // empty
+ // another logical and
+ PERV_AMPAND_INDEX = 8,
+ // halt the system
+ PERV_HALT_INDEX = 9,
+ // return to top level
+ PERV_STOP_INDEX = 10,
+ // Prolog if; needed?
+ PERV_COLONDASH_INDEX = 11,
+ // implication; needed?
+ PERV_IMPL_INDEX = 12,
+ // empty
+ // empty
+ // solve; used by code generator
+ PERV_SOLVE_INDEX = 15,
+ // is
+ PERV_IS_INDEX = 16,
+ // not
+ PERV_NOT_INDEX = 17,
+ // equality (unify) predicate
+ PERV_EQ_INDEX = 18,
+ // less than on integers
+ PERV_INTLSS_INDEX = 19,
+ // greater than on integers
+ PERV_INTGRT_INDEX = 20,
+ // less than or eq on integers
+ PERV_INTLEQ_INDEX = 21,
+ // greater than or eq on integers
+ PERV_INTGEQ_INDEX = 22,
+ // less than in reals
+ PERV_REALLSS_INDEX = 23,
+ // greater than on reals
+ PERV_REALGRT_INDEX = 24,
+ // less than or eq on reals
+ PERV_REALLEQ_INDEX = 25,
+ // greater than or eq on reals
+ PERV_REALGEQ_INDEX = 26,
+ // less than on strings
+ PERV_STRLSS_INDEX = 27,
+ // greater than on strings
+ PERV_STRGRT_INDEX = 28,
+ // less than or eq on strings
+ PERV_STRLEQ_INDEX = 29,
+ // greater than or eq on strings
+ PERV_STRGEQ_INDEX = 30,
+ // open_in
+ PERV_OPENIN_INDEX = 31,
+ // open_out
+ PERV_OPENOUT_INDEX = 32,
+ // open_append
+ PERV_OPENAPP_INDEX = 33,
+ // close_in
+ PERV_CLOSEIN_INDEX = 34,
+ // close_out
+ PERV_CLOSEOUT_INDEX = 35,
+ // open_string
+ PERV_OPENSTR_INDEX = 36,
+ // input
+ PERV_INPUT_INDEX = 37,
+ // output
+ PERV_OUTPUT_INDEX = 38,
+ // input_line
+ PERV_INPUTLINE_INDEX = 39,
+ // lookahead
+ PERV_LOOKAHEAD_INDEX = 40,
+ // eof
+ PERV_EOF_INDEX = 41,
+ // flush
+ PERV_FLUSH_INDEX = 42,
+ // print
+ PERV_PRINT_INDEX = 43,
+ // read
+ PERV_READ_INDEX = 44,
+ // printterm
+ PERV_PRINTTERM_INDEX = 45,
+ // term_to_string
+ PERV_TERMTOSTR_INDEX = 46,
+ // string_to_term
+ PERV_STRTOTERM_INDEX = 47,
+ // readterm
+ PERV_READTERM_INDEX = 48,
+ // getenv predicate; needed?
+ PERV_GETENV_INDEX = 49,
+ // open_socket predicate
+ PERV_OPENSOCKET_INDEX = 50,
+ // time predicate
+ PERV_TIME_INDEX = 51,
+ // system predicate
+ PERV_SYSTEM_INDEX = 52,
+ // empty
+ // empty
+ // empty
+ // unary minus on integers
+ PERV_INTUMINUS_INDEX = 56,
+ // addition on integers
+ PERV_INTPLUS_INDEX = 57,
+ // subtraction on integers
+ PERV_INTMINUS_INDEX = 58,
+ // mutiplication on integers
+ PERV_INTMULT_INDEX = 59,
+ // integer division
+ PERV_INTDIV_INDEX = 60,
+ // modulus
+ PERV_MOD_INDEX = 61,
+ // coercion to real
+ PERV_ITOR_INDEX = 62,
+ // integer abs
+ PERV_IABS_INDEX = 63,
+ // unary minus on real
+ PERV_REALUMINUS_INDEX = 64,
+ // addition on reals
+ PERV_REALPLUS_INDEX = 65,
+ // subtraction on reals
+ PERV_REALMINUS_INDEX = 66,
+ // multiplication on reals
+ PERV_REALMULT_INDEX = 67,
+ // division
+ PERV_REALDIV_INDEX = 68,
+ // square root
+ PERV_SQRT_INDEX = 69,
+ // sine
+ PERV_SIN_INDEX = 70,
+ // cosine
+ PERV_COS_INDEX = 71,
+ // arc tan
+ PERV_ARCTAN_INDEX = 72,
+ // natural log
+ PERV_LOG_INDEX = 73,
+ // floor function
+ PERV_FLOOR_INDEX = 74,
+ // ceiling function
+ PERV_CEIL_INDEX = 75,
+ // truncation
+ PERV_TRUNC_INDEX = 76,
+ // real abs
+ PERV_RABS_INDEX = 77,
+ // string concatination
+ PERV_SCAT_INDEX = 78,
+ // string length
+ PERV_SLEN_INDEX = 79,
+ // chr function
+ PERV_ITOCHR_INDEX = 80,
+ // ord function
+ PERV_STOI_INDEX = 81,
+ // substring
+ PERV_SUBSTR_INDEX = 82,
+ // int to string
+ PERV_ITOSTR_INDEX = 83,
+ // real to string
+ PERV_RTOS_INDEX = 84,
+ // for unnamed universal constants (Note: tesize should be 0)
+ PERV_UNIV_INDEX = 85,
+ // std_in
+ PERV_STDIN_INDEX = 86,
+ // std_out
+ PERV_STDOUT_INDEX = 87,
+ // std_err
+ PERV_STDERR_INDEX = 88,
+ // nil
+ PERV_NIL_INDEX = 89,
+ // integer constant
+ PERV_INTC_INDEX = 90,
+ // real constant
+ PERV_REALC_INDEX = 91,
+ // string constant
+ PERV_STRC_INDEX = 92,
+ // cons
+ PERV_CONS_INDEX = 93
+} PERV_ConstIndexType;
+
+//total number pervasive constants
+#define PERV_CONST_NUM 94
+
+//pervasive const data type
+typedef struct
+{
+ char *name;
+ TwoBytes typeEnvSize;
+ TwoBytes tskTabIndex; //index to the type skeleton table
+ TwoBytes neededness; //neededness (predicate constant)
+ TwoBytes univCount;
+ int precedence;
+ int fixity;
+} PERV_ConstData;
+
+//pervasive const data table (array)
+extern PERV_ConstData PERV_constDataTab[PERV_CONST_NUM];
+
+//pervasive const data access function
+PERV_ConstData PERV_getConstData(int index);
+
+//pervasive const table copy function (used in module space initialization)
+//this functiion relies on the assumption that the pervasive kind data
+//has the same structure as that of the run-time kind symbol table entries.
+void PERV_copyConstDataTab(PERV_ConstData* dst);
+
+#define PERV_LSSTART PERV_AND_INDEX //begin of interpretable symbols
+#define PERV_LSEND PERV_STOP_INDEX //end of interpretable symbols
+
+#define PERV_PREDSTART PERV_SOLVE_INDEX //begin of predicate symbols
+#define PERV_PREDEND PERV_SYSTEM_INDEX //end of predicate symbols
+
+typedef enum PERV_LogicSymbTypes
+{
+ PERV_AND = 0,
+ PERV_OR = 1,
+ PERV_SOME = 2,
+ PERV_ALL = 3,
+ PERV_L_TRUE = 4,
+ PERV_CUT = 5,
+ PERV_FAIL = 6,
+ PERV_EQ = 7,
+ PERV_AMPAND = 8,
+ PERV_HALT = 9,
+ PERV_STOP = 10,
+} PERV_LogicSymbTypes;
+
+//functions used by the simulator for interpreted goals
+Boolean PERV_isLogicSymb(int index);
+Boolean PERV_isPredSymb(int index);
+
+PERV_LogicSymbTypes PERV_logicSymb(int index);
+
+int PERV_predBuiltin(int index);
+
+
+#endif //PERVASIVES_H
+
diff --git a/src/runtime/c/teyjus/tables/pervinit.c b/src/runtime/c/teyjus/tables/pervinit.c
new file mode 100644
index 000000000..4e518572f
--- /dev/null
+++ b/src/runtime/c/teyjus/tables/pervinit.c
@@ -0,0 +1,152 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+/***************************************************************************/
+/* File pervinit.h{c}. */
+/* Functions for setting up the symbol tables of pervasive constants and */
+/* kinds are provided. */
+/***************************************************************************/
+#include
+#include
+
+#include "pervinit.h"
+#include "pervasives.h"
+#include "../system/memory.h"
+#include "../simulator/dataformats.h"
+#include "../simulator/mcstring.h"
+#include "../simulator/mctypes.h"
+
+DF_StrDataPtr PERVINIT_writeName(char* name)
+{
+ int length = strlen(name);
+ MemPtr rtPtr, mcStr;
+
+ rtPtr = (MemPtr)MEM_memExtend(MCSTR_numWords(length) +
+ DF_STRDATA_HEAD_SIZE);
+ mcStr = rtPtr + DF_STRDATA_HEAD_SIZE;
+
+ //create data head
+ DF_mkStrDataHead((MemPtr)rtPtr);
+ //create the string data
+ MCSTR_toString((MCSTR_Str)mcStr, name, length);
+ return (DF_StrDataPtr)rtPtr;
+}
+
+/***************************************************************************/
+/* PERVASIVE KINDS */
+/***************************************************************************/
+MEM_KstEnt PERVINIT_kindDataTab[PERV_KIND_NUM];
+
+/* Set up pervasive kind symbol table. */
+/* The kind names are supposed to be written in the current top of system */
+/* memory. */
+static void PERVINIT_kindTabInit()
+{
+ int tabInd;
+ for (tabInd = 0; tabInd < PERV_KIND_NUM; tabInd++) {
+ if (PERV_kindDataTab[tabInd].name)
+ PERVINIT_kindDataTab[tabInd].name=
+ PERVINIT_writeName(PERV_kindDataTab[tabInd].name);
+ else PERVINIT_kindDataTab[tabInd].name = NULL;
+
+ PERVINIT_kindDataTab[tabInd].arity=PERV_kindDataTab[tabInd].arity;
+ }
+}
+
+/* copy the pervasive kind table into given address */
+void PERVINIT_copyKindDataTab(MEM_KstPtr dst)
+{
+ memcpy((void*)dst, (void*)PERVINIT_kindDataTab,
+ MEM_KST_ENTRY_SIZE * WORD_SIZE * PERV_KIND_NUM);
+}
+
+/***************************************************************************/
+/* PERVASIVE TYPE SKELETONS */
+/***************************************************************************/
+MEM_TstPtr PERVINIT_tySkelTab;
+
+/* Set up pervasive type skeleton table. */
+static void PERVINIT_tySkelTabInit()
+{
+ PERVINIT_tySkelTab = PERV_tySkelTab;
+ PERV_tySkelTabInit();
+}
+
+/* copy the pervasive type skeleton table into given address */
+void PERVINIT_copyTySkelTab(PERV_TySkelData* dst)
+{
+ memcpy((void*)dst, (void*)PERVINIT_tySkelTab,
+ MEM_TST_ENTRY_SIZE * WORD_SIZE * PERV_TY_SKEL_NUM);
+}
+
+/***************************************************************************/
+/* PERVASIVE CONSTANTS */
+/***************************************************************************/
+MEM_CstEnt PERVINIT_constDataTab[PERV_CONST_NUM];
+
+/* Set up pervasive constant symbol table. */
+/* The constant names are supposed to be written in the current top of */
+/* system memory. */
+static void PERVINIT_constTabInit()
+{
+ int tabInd;
+
+ for (tabInd = 0; tabInd < PERV_CONST_NUM; tabInd++) {
+ if (PERV_constDataTab[tabInd].name)
+ PERVINIT_constDataTab[tabInd].name =
+ PERVINIT_writeName(PERV_constDataTab[tabInd].name);
+ else PERVINIT_constDataTab[tabInd].name = NULL;
+
+ PERVINIT_constDataTab[tabInd].typeEnvSize =
+ PERV_constDataTab[tabInd].typeEnvSize;
+ PERVINIT_constDataTab[tabInd].tskTabIndex =
+ PERV_constDataTab[tabInd].tskTabIndex;
+ PERVINIT_constDataTab[tabInd].neededness =
+ PERV_constDataTab[tabInd].neededness;
+ PERVINIT_constDataTab[tabInd].univCount =
+ PERV_constDataTab[tabInd].univCount;
+ PERVINIT_constDataTab[tabInd].precedence =
+ PERV_constDataTab[tabInd].precedence;
+ PERVINIT_constDataTab[tabInd].fixity =
+ PERV_constDataTab[tabInd].fixity;
+ }
+}
+
+/* copy the pervsive constant table into given address */
+void PERVINIT_copyConstDataTab(MEM_CstPtr dst)
+{
+ memcpy((void*)dst, (void*)PERVINIT_constDataTab,
+ MEM_CST_ENTRY_SIZE * WORD_SIZE * PERV_CONST_NUM);
+
+}
+
+/***************************************************************************/
+/* PERVASIVE TABLES INITIALIZATION */
+/* Fill in the actual pervasive tables; create string data needed for names*/
+/* onto the current top of the system memory; create the type skeletons in */
+/* a malloced space. */
+/***************************************************************************/
+void PERVINIT_tableInit()
+{
+ PERVINIT_kindTabInit();
+ PERVINIT_tySkelTabInit();
+ PERVINIT_constTabInit();
+}
+
diff --git a/src/runtime/c/teyjus/tables/pervinit.h b/src/runtime/c/teyjus/tables/pervinit.h
new file mode 100644
index 000000000..666b88776
--- /dev/null
+++ b/src/runtime/c/teyjus/tables/pervinit.h
@@ -0,0 +1,73 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+/***************************************************************************/
+/* File pervinit.h{c}. */
+/* Functions for setting up the symbol tables of pervasive constants and */
+/* kinds are provided. */
+/***************************************************************************/
+
+#ifndef PERVINIT_H
+#define PERVINIT_H
+
+#include "../simulator/dataformats.h" //to be modified
+#include "../system/memory.h" //to be modified
+#include "pervasives.h"
+#include "../simulator/mctypes.h"
+
+/***************************************************************************/
+/* PERVASIVE KINDS */
+/***************************************************************************/
+//the actual pervasive kind table get copied during loading
+extern MEM_KstEnt PERVINIT_kindDataTab[PERV_KIND_NUM];
+
+/* copy the pervasive kind table into given address */
+void PERVINIT_copyKindDataTab(MEM_KstPtr dst);
+
+
+/***************************************************************************/
+/* PERVASIVE TYPE SKELETONS */
+/***************************************************************************/
+//pervasive type skeleton table
+extern MEM_TstPtr PERVINIT_tySkelTab;
+
+/* copy the pervasive type skeleton table into given address */
+void PERVINIT_copyTySkelTab(MEM_TstPtr dst);
+
+
+/***************************************************************************/
+/* PERVASIVE CONSTANTS */
+/***************************************************************************/
+//the acutual pervasive constant table get copied during loading
+extern MEM_CstEnt PERVINIT_constDataTab[PERV_CONST_NUM];
+
+/* copy the pervasive constant table into given address */
+void PERVINIT_copyConstDataTab(MEM_CstPtr dst);
+
+
+/***************************************************************************/
+/* PERVASIVE TABLES INITIALIZATION */
+/* Fill in the actual pervasive tables; create string data needed for names*/
+/* onto the current top of the system memory; create the type skeletons in */
+/* a malloced space. */
+/***************************************************************************/
+void PERVINIT_tableInit();
+
+#endif //PERVINIT_H
diff --git a/src/runtime/c/teyjus/tables_gen/Makefile b/src/runtime/c/teyjus/tables_gen/Makefile
new file mode 100644
index 000000000..7cf2c532a
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/Makefile
@@ -0,0 +1,28 @@
+all: instrformats/gen pervasives/gen
+
+instrformats/gen: instrformats/y.tab.o instrformats/lex.yy.o \
+ instrformats/instrgen-c.o instrformats/instrgen-ocaml.o \
+ util/util.o
+ gcc -o instrformats/gen $^
+
+pervasives/gen: pervasives/y.tab.o pervasives/lex.yy.o \
+ pervasives/ccode.o pervasives/ocamlcode.o \
+ pervasives/pervgen-c.o pervasives/pervgen-ocaml.o \
+ pervasives/types.o pervasives/op.o \
+ util/util.o
+ gcc -o pervasives/gen $^
+
+.o : .c
+ gcc -c -o $@ $^
+
+instrformats/y.tab.c instrformats/y.tab.h : instrformats/instrformats.y
+ yacc -o instrformats/y.tab.c --defines=instrformats/y.tab.h instrformats/instrformats.y
+
+instrformats/lex.yy.c : instrformats/instrformats.l instrformats/y.tab.h
+ flex -o instrformats/lex.yy.c instrformats/instrformats.l
+
+pervasives/y.tab.c pervasives/y.tab.h : pervasives/pervasives.y
+ yacc -o pervasives/y.tab.c --defines=pervasives/y.tab.h pervasives/pervasives.y
+
+pervasives/lex.yy.c : pervasives/pervasives.l pervasives/y.tab.h
+ flex -o pervasives/lex.yy.c pervasives/pervasives.l
diff --git a/src/runtime/c/teyjus/tables_gen/instrformats/instrformats.l b/src/runtime/c/teyjus/tables_gen/instrformats/instrformats.l
new file mode 100644
index 000000000..28e43ab1b
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/instrformats/instrformats.l
@@ -0,0 +1,69 @@
+%{
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+#include "y.tab.h"
+#include
+#include
+
+static int commentLev = 0;
+%}
+
+LETTER [A-Za-z]
+DIGIT [0-9]
+SYMBOL "_"|"+"|"-"|"*"|"/"|"!"|"~"|"@"|"$"|"%"|"^"|"&"|"*"|"<"|">"|"="|"'"|":"|","
+
+ID ({LETTER}|{SYMBOL})({LETTER}|{DIGIT}|{SYMBOL})*
+NUM {DIGIT}+
+WSPACE [ \t]+
+STRING [^*/]+
+STRING2 [^}]+
+
+%x COMMENT COMMENT2 INCLUDE
+
+%%
+"\n" {continue; }
+";" {return SEMICOLON; }
+"[" {return LBRACKET; }
+"]" {return RBRACKET; }
+"OPERAND TYPES" {return OPTYPES; }
+"OPCODE" {return OPCODE; }
+"INSTR CATEGORY" {return INSTRCAT; }
+"MAX OPERAND" {return MAXOPERAND; }
+"CALL_I1_LEN" {return CALL_I1_LEN; }
+"INSTRUCTIONS" {return INSTRUCTIONS; }
+{WSPACE} {continue; }
+"/%" {commentLev = 1; BEGIN(COMMENT); continue; }
+"/*" {BEGIN(COMMENT2); continue; }
+"{" {BEGIN(INCLUDE); continue; }
+{ID} {yylval.name = strdup(yytext); return ID; }
+{NUM} {yylval.isval.ival = atoi(yytext);
+ yylval.isval.sval = strdup(yytext);
+ return NUM; }
+"*/" {BEGIN(INITIAL); continue; }
+{STRING} {yylval.text = strdup(yytext); return STRING; }
+
+[^%/\n]+ {continue; }
+"/%" {commentLev++; continue; }
+"%/" {commentLev--;
+ if (!commentLev) BEGIN(INITIAL); continue; }
+"}" {BEGIN(INITIAL); continue; }
+{STRING2} {yylval.text = strdup(yytext); return STRING2; }
+. {return ERROR; }
diff --git a/src/runtime/c/teyjus/tables_gen/instrformats/instrformats.y b/src/runtime/c/teyjus/tables_gen/instrformats/instrformats.y
new file mode 100644
index 000000000..348312732
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/instrformats/instrformats.y
@@ -0,0 +1,283 @@
+%{
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+#include
+#include "instrgen-c.h"
+#include "instrgen-ocaml.h"
+#include "../util/util.h"
+
+extern int yylex();
+
+int yywrap() {return 1;}
+
+void yyerror(const char* str)
+{
+ printf("%s\n", str);
+}
+
+%}
+
+%union{
+ char* name;
+ char* text;
+ struct
+ {
+ int ival;
+ char* sval;
+ } isval;
+}
+
+%token OPTYPES INSTRCAT INSTRUCTIONS OPCODE MAXOPERAND
+ CALL_I1_LEN SEMICOLON ERROR LBRACKET RBRACKET
+%token ID
+%token NUM
+%token STRING STRING2
+
+%start instr_format
+%type operand_name operand_tname operand_type instr_name instr_cat
+ instr_head instr_length operand_comp_type
+%type comments compiler_include
+%type max_operand opcode operand_size
+%%
+
+instr_format : compiler_include operands instrcats instructions
+
+compiler_include : STRING2 { ocgenInclude($1);}
+
+
+operands : OPTYPES operand_decs opcode_type
+ { cgenOpsH(); ocgenOps();}
+ ;
+
+operand_decs : operand_dec operand_decs
+ | operand_dec_last
+ ;
+
+operand_dec : operand_name operand_tname operand_type operand_size operand_comp_type comments
+ { cgenOpTypes($1, $2, $3, $6, 0);
+ ocgenOpType($1, $4.ival, $5);
+ }
+ | operand_name comments
+ { cgenOpTypes($1, NULL, NULL, $2, 0); }
+ ;
+
+operand_dec_last : operand_name operand_tname operand_type operand_size operand_comp_type comments
+ { cgenOpTypes($1, $2, $3, $6, 1);
+ ocgenOpType($1, $4.ival, $5);
+ }
+ | operand_name comments
+ { cgenOpTypes($1, NULL, NULL, $2, 1); }
+ ;
+
+
+operand_name : ID { $$ = $1; }
+ ;
+
+operand_tname : ID { $$ = $1; }
+ ;
+
+operand_type : ID { $$ = $1; }
+ ;
+
+operand_comp_type : ID { $$ = $1; }
+ ;
+
+comments : STRING {$$ = $1; }
+ ;
+
+operand_size : NUM { $$ = $1; }
+ ;
+
+opcode_type : OPCODE ID operand_size
+ { cgenOpCodeType($2);
+ ocgenOpCodeType($3.ival);}
+ ;
+
+instrcats : INSTRCAT max_operand instrcat_decs CALL_I1_LEN NUM
+ { cgenInstrCatH($5.sval); cgenInstrCatC($2.sval);
+ ocgenInstrCat();
+ }
+ ;
+
+max_operand : MAXOPERAND NUM { $$ = $2; }
+ ;
+
+instrcat_decs : instrcat_dec instrcat_decs
+ | instrcat_dec_last
+ ;
+
+instrcat_dec : ID LBRACKET instr_format RBRACKET instr_lengths
+ { cgenOneInstrCatH($1, 0); cgenOneInstrCatC($1, 0);
+ ocgenOneInstrCat($1);
+ }
+ ;
+
+instrcat_dec_last : ID LBRACKET instr_format RBRACKET instr_lengths
+ { cgenOneInstrCatH($1, 1); cgenOneInstrCatC($1, 1);
+ ocgenOneInstrCat($1);
+ }
+ ;
+
+instr_format : oneOp instr_format
+ | lastOp
+ ;
+
+oneOp : ID { cgenInstrFormat($1, 0); ocgenInstrFormat($1); }
+ ;
+
+lastOp : ID { cgenInstrFormat($1, 1); ocgenInstrFormat($1); }
+ ;
+
+
+instr_lengths : instr_len_first SEMICOLON instr_lengths_rest
+ | instr_len_first
+ ;
+
+instr_lengths_rest : instr_len SEMICOLON instr_lengths_rest
+ | instr_len
+ ;
+
+instr_len_first : ID NUM
+ {cgenInstrLength($1, $2.sval);
+ ocgenInstrLength($1, $2.sval);}
+ ;
+
+instr_len : ID NUM { cgenInstrLength($1, $2.sval);}
+ ;
+
+
+instructions : instr_head instrs
+ { cgenInstrH($1); cgenInstrC(); cgenSimDispatch();
+ ocgenInstr();
+ }
+ ;
+
+instr_head : INSTRUCTIONS NUM
+ { cinitInstrC($2.ival);
+ cinitSimDispatch($2.ival);
+ $$ = $2.sval;
+ }
+ ;
+
+
+instrs : instr SEMICOLON instrs
+ | last_instr
+ ;
+
+instr : comments opcode instr_name instr_cat instr_length
+ { cgenOneInstrH($1, $2.sval , $3);
+ cgenOneInstrC($2.ival, $3, $4, $5, 0);
+ cgenOneSimDispatch($2.ival, $3, 0);
+ ocgenOneInstr($2.sval, $3, $4, $5, 0);
+ }
+ | opcode instr_name instr_cat instr_length
+ { cgenOneInstrH(NULL, $1.sval , $2);
+ cgenOneInstrC($1.ival, $2, $3, $4, 0);
+ cgenOneSimDispatch($1.ival, $2, 0);
+ ocgenOneInstr($1.sval, $2, $3, $4, 0);
+ }
+ ;
+
+last_instr : comments opcode instr_name instr_cat instr_length
+ { cgenOneInstrH($1, $2.sval , $3);
+ cgenOneInstrC($2.ival, $3, $4, $5, 1);
+ cgenOneSimDispatch($2.ival, $3, 1);
+ ocgenOneInstr($2.sval, $3, $4, $5, 1);
+ }
+ | opcode instr_name instr_cat instr_length
+ { cgenOneInstrH(NULL, $1.sval , $2);
+ cgenOneInstrC($1.ival, $2, $3, $4, 1);
+ cgenOneSimDispatch($1.ival, $2, 1);
+ ocgenOneInstr($1.sval, $2, $3, $4, 1);
+ }
+ ;
+
+opcode : NUM { $$ = $1; }
+ ;
+
+instr_name : ID { $$ = $1; }
+ ;
+
+instr_cat : ID { $$ = $1; }
+ ;
+
+instr_length : ID { $$ = $1; }
+ ;
+
+
+%%
+
+extern FILE* yyin;
+
+int main(argc, argv)
+ int argc;
+ char * argv[];
+{
+ char * root = NULL;
+ int ret = 0;
+
+ if(argc <= 1)
+ {
+ if (sizeof(void*) == 8)
+ {
+ //printf("No input file specified; using 'instrformats_64.in'.\n");
+ yyin = UTIL_fopenR("instrformats_64.in");
+ }
+ else
+ {
+ //printf("No input file specified; using 'instrformats_32.in'.\n");
+ yyin = UTIL_fopenR("instrformats_32.in");
+ }
+ }
+ else
+ {
+ yyin = UTIL_fopenR(argv[1]);
+ }
+
+ if(argc > 2)
+ {
+ root = argv[2];
+ }
+ else
+ {
+ //printf("Teyjus source root directory not specified; using '../../'.\n");
+ root = "../../";
+ }
+
+ //printf("Generating instruction files...\n");
+
+ ret = yyparse();
+ UTIL_fclose(yyin);
+
+ if(ret != 0)
+ {
+ printf("Generation failed.\n");
+ return -1;
+ }
+ cspitCInstructionsH(root);
+ cspitCInstructionsC(root);
+ cspitSimDispatch(root);
+ //ocSpitInstructionMLI(root);
+ //ocSpitInstructionML(root);
+ //printf("Done.\n");
+
+ return 0;
+}
diff --git a/src/runtime/c/teyjus/tables_gen/instrformats/instrformats_32.in b/src/runtime/c/teyjus/tables_gen/instrformats/instrformats_32.in
new file mode 100644
index 000000000..1cfddddfb
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/instrformats/instrformats_32.in
@@ -0,0 +1,346 @@
+{
+type intref = int ref
+type aconstant = Absyn.aconstant
+type akind = Absyn.akind
+
+}
+
+OPERAND TYPES
+
+ P /* (1 byte) padding */
+ WP /* (1 word) padding */
+ R RegInd Byte 1 int /* argument register number */
+ E EnvInd Byte 1 int /* environment variable number */
+ N NextClauseInd Byte 1 int /* next clause number in impt or impl pt */
+ I1 OneByteInt Byte 1 int /* 1 byte natural number */
+ CE ClEnvInd Byte 1 int /* closure environment variable number */
+ SEG ImpSegInd Byte 1 int /* import segment index */
+ C CstIndex TwoBytes 2 aconstant /* constant symbol table index */
+ K KstIndex TwoBytes 2 akind /* kind symbol table index */
+ L CodeLabel CSpacePtr 4 intref /* code location */
+ I Int int 4 int /* integer immediate value */
+ F Float float 4 float /* floating point immediate value */
+ S Str DF_StrDataPtr 2 int /* string pointer */
+ MT ModTab MemPtr 2 int /* module table address */
+ IT ImplTab MemPtr 2 int /* impl table address */
+ HT HashTab MemPtr 2 int /* hash table address */
+ BVT BranchTab MemPtr 2 int /* branch table for bound var indexing */
+ X /* operand list terminator */
+ OPCODE Byte 1
+
+
+INSTR CATEGORY
+
+ MAX OPERAND 8
+
+ X [P P P X X X X X]
+ X_LEN 4
+
+ RX [R P P X X X X X]
+ RX_LEN 4; RX_R 1
+
+ EX [E P P X X X X X]
+ EX_LEN 4; EX_E 1
+
+ I1X [I1 P P X X X X X]
+ I1X_LEN 4; I1X_I1 1
+
+ CX [P C X X X X X X]
+ CX_LEN 4; CX_C 2
+
+ KX [P K X X X X X X]
+ KX_LEN 4; KX_K 2
+
+ IX [P P P I X X X X]
+ IX_LEN 8; IX_I 4
+
+ FX [P P P F X X X X]
+ FX_LEN 8; FX_F 4
+
+ SX [P P P S X X X X]
+ SX_LEN 8; SX_S 4
+
+ MTX [P P P MT X X X X]
+ MTX_LEN 8; MTX_MT 4
+
+ LX [P P P L X X X X]
+ LX_LEN 8; LX_L 4
+
+ RRX [R R P X X X X X]
+ RRX_LEN 4; RRX_R1 1; RRX_R2 2
+
+ ERX [E R P X X X X X]
+ ERX_LEN 4; ERX_E 1; ERX_R 2
+
+ RCX [R C X X X X X X]
+ RCX_LEN 4; RCX_R 1; RCX_C 2
+
+ RIX [R P P I X X X X]
+ RIX_LEN 8; RIX_R 1; RIX_I 4
+
+ RFX [R P P F X X X X]
+ RFX_LEN 8; RFX_R 1; RFX_F 4
+
+ RSX [R P P S X X X X]
+ RSX_LEN 8; RSX_R 1; RSX_S 4
+
+ RI1X [R I1 P X X X X X]
+ RI1X_LEN 4; RI1X_R 1; RI1X_I1 2
+
+ RCEX [R CE P X X X X X]
+ RCEX_LEN 4; RCEX_R 1; RCEX_CE 2
+
+ ECEX [E CE P X X X X X]
+ ECEX_LEN 4; ECEX_E 1; ECEX_CE 2
+
+ CLX [P C L X X X X X]
+ CLX_LEN 8; CLX_C 2; CLX_L 4
+
+ RKX [R K X X X X X X]
+ RKX_LEN 4; RKX_R 1; RKX_K 2
+
+ ECX [E C X X X X X X]
+ ECX_LEN 4; ECX_E 1; ECX_C 2
+
+ I1ITX [I1 P P IT X X X X]
+ I1ITX_LEN 8; I1ITX_I1 1; I1ITX_IT 4
+
+ I1LX [I1 P P L X X X X]
+ I1LX_LEN 8; I1LX_I1 1; I1LX_L 4
+
+ SEGLX [SEG P P L X X X X]
+ SEGLX_LEN 8; SEGLX_SEG 1; SEGLX_L 4
+
+ I1LWPX [I1 P P L WP X X X]
+ I1LWPX_LEN 12; I1LWPX_I1 1; I1LWPX_L 4
+
+ I1NX [I1 N P X X X X X]
+ I1NX_LEN 4; I1NX_I1 1; I1NX_N 2
+
+ I1HTX [I1 P P HT X X X X]
+ I1HTX_LEN 8; I1HTX_I1 1; I1HTX_HT 4
+
+ I1BVTX [I1 P P BVT X X X X]
+ I1BVTX_LEN 8; I1BVTX_I1 1; I1BVTX_BVT 4
+
+ CWPX [P C WP X X X X X]
+ CWPX_LEN 8; CWPX_C 2
+
+ I1WPX [I1 P P WP X X X X]
+ I1WPX_LEN 8; I1WPX_I1 1
+
+ RRI1X [R R I1 X X X X X]
+ RRI1X_LEN 4; RRI1X_R1 1; RRI1X_R2 2; RRI1X_I1 3
+
+ RCLX [R C L X X X X X]
+ RCLX_LEN 8; RCLX_R 1; RCLX_C 2; RCLX_L 4
+
+ RCI1X [R C I1 P P P X X]
+ RCI1X_LEN 8; RCI1X_R 1; RCI1X_C 2; RCI1X_I1 4
+
+ SEGI1LX [SEG I1 P L X X X X]
+ SEGI1LX_LEN 8; SEGI1LX_SEG 1; SEGI1LX_I1 2; SEGI1LX_L 4
+
+ I1LLX [I1 P P L L X X X]
+ I1LLX_LEN 12; I1LLX_I1 1; I1LLX_L1 4; I1LLX_L2 8
+
+ NLLX [N P P L L X X X]
+ NLLX_LEN 12; NLLX_N 1; NLLX_L1 4; NLLX_L2 8
+
+ LLLLX [P P P L L L L X]
+ LLLLX_LEN 20; LLLLX_L1 4; LLLLX_L2 8; LLLLX_L3 12; LLLLX_L4 16
+
+ I1CWPX [I1 C WP X X X X X]
+ I1CWPX_LEN 8; I1CWPX_I1 1; I1CWPX_C 2
+
+ I1I1WPX [I1 I1 P WP X X X X]
+ I1I1WPX_LEN 8; I1I1WPX_I11 1; I1I1WPX_I12 2
+
+ CALL_I1_LEN 7
+
+
+INSTRUCTIONS 145
+
+ /* Instructions for term unification and creation */
+
+ 0 put_variable_t RRX RRX_LEN;
+ 1 put_variable_p ERX ERX_LEN;
+ 2 put_value_t RRX RRX_LEN;
+ 3 put_value_p ERX ERX_LEN;
+ 4 put_unsafe_value ERX ERX_LEN;
+ 5 copy_value ERX ERX_LEN;
+ 6 put_m_const RCX RCX_LEN;
+ 7 put_p_const RCX RCX_LEN;
+ 8 put_nil RX RX_LEN;
+ 9 put_integer RIX RIX_LEN;
+ 10 put_float RFX RFX_LEN;
+ 11 put_string RSX RSX_LEN;
+ 12 put_index RI1X RI1X_LEN;
+ 13 put_app RRI1X RRI1X_LEN;
+ 14 put_list RX RX_LEN;
+ 15 put_lambda RRI1X RRI1X_LEN;
+
+ 16 set_variable_t RX RX_LEN;
+ 17 set_variable_te RX RX_LEN;
+ 18 set_variable_p EX EX_LEN;
+ 19 set_value_t RX RX_LEN;
+ 20 set_value_p EX EX_LEN;
+ 21 globalize_pt ERX ERX_LEN;
+ 22 globalize_t RX RX_LEN;
+ 23 set_m_const CX CX_LEN;
+ 24 set_p_const CX CX_LEN;
+ 25 set_nil X X_LEN;
+ 26 set_integer IX IX_LEN;
+ 27 set_float FX FX_LEN;
+ 28 set_string SX SX_LEN;
+ 29 set_index I1X I1X_LEN;
+ 30 set_void I1X I1X_LEN;
+ 31 deref RX RX_LEN;
+ 32 set_lambda RI1X RI1X_LEN;
+
+
+ 33 get_variable_t RRX RRX_LEN;
+ 34 get_variable_p ERX ERX_LEN;
+ 35 init_variable_t RCEX RCEX_LEN;
+ 36 init_variable_p ECEX ECEX_LEN;
+ 37 get_m_constant RCX RCX_LEN;
+ 38 get_p_constant RCLX RCLX_LEN;
+ 39 get_integer RIX RIX_LEN;
+ 40 get_float RFX RFX_LEN;
+ 41 get_string RSX RSX_LEN;
+ 42 get_nil RX RX_LEN;
+ 43 get_m_structure RCI1X RCI1X_LEN;
+ 44 get_p_structure RCI1X RCI1X_LEN;
+ 45 get_list RX RX_LEN;
+
+ 46 unify_variable_t RX RX_LEN;
+ 47 unify_variable_p EX EX_LEN;
+ 48 unify_value_t RX RX_LEN;
+ 49 unify_value_p EX EX_LEN;
+ 50 unify_local_value_t RX RX_LEN;
+ 51 unify_local_value_p EX EX_LEN;
+ 52 unify_m_constant CX CX_LEN;
+ 53 unify_p_constant CLX CLX_LEN;
+ 54 unify_integer IX IX_LEN;
+ 55 unify_float FX FX_LEN;
+ 56 unify_string SX SX_LEN;
+ 57 unify_nil X X_LEN;
+ 58 unify_void I1X I1X_LEN;
+
+ /* Instructions for type unification and creation */
+ 59 put_type_variable_t RRX RRX_LEN;
+ 60 put_type_variable_p ERX ERX_LEN;
+ 61 put_type_value_t RRX RRX_LEN;
+ 62 put_type_value_p ERX ERX_LEN;
+ 63 put_type_unsafe_value ERX ERX_LEN;
+ 64 put_type_const RKX RKX_LEN;
+ 65 put_type_structure RKX RKX_LEN;
+ 66 put_type_arrow RX RX_LEN;
+
+ 67 set_type_variable_t RX RX_LEN;
+ 68 set_type_variable_p EX EX_LEN;
+ 69 set_type_value_t RX RX_LEN;
+ 70 set_type_value_p EX EX_LEN;
+ 71 set_type_local_value_t RX RX_LEN;
+ 72 set_type_local_value_p EX EX_LEN;
+ 73 set_type_constant KX KX_LEN;
+
+ 74 get_type_variable_t RRX RRX_LEN;
+ 75 get_type_variable_p ERX ERX_LEN;
+ 76 init_type_variable_t RCEX RCEX_LEN;
+ 77 init_type_variable_p ECEX ECEX_LEN;
+ 78 get_type_value_t RRX RRX_LEN;
+ 79 get_type_value_p ERX ERX_LEN;
+ 80 get_type_constant RKX RKX_LEN;
+ 81 get_type_structure RKX RKX_LEN;
+ 82 get_type_arrow RX RX_LEN;
+
+ 83 unify_type_variable_t RX RX_LEN;
+ 84 unify_type_variable_p EX EX_LEN;
+ 85 unify_type_value_t RX RX_LEN;
+ 86 unify_type_value_p EX EX_LEN;
+ 87 unify_envty_value_t RX RX_LEN;
+ 88 unify_envty_value_p EX EX_LEN;
+ 89 unify_type_local_value_t RX RX_LEN;
+ 90 unify_type_local_value_p EX EX_LEN;
+ 91 unify_envty_local_value_t RX RX_LEN;
+ 92 unify_envty_local_value_p EX EX_LEN;
+ 93 unify_type_constant KX KX_LEN;
+
+ /* Instructions for handling higher-order aspects */
+
+ 94 pattern_unify_t RRX RRX_LEN;
+ 95 pattern_unify_p ERX ERX_LEN;
+ 96 finish_unify X X_LEN;
+ 97 head_normalize_t RX RX_LEN;
+ 98 head_normalize_p EX EX_LEN;
+
+ /* Instructions for handling logical aspects */
+
+ 99 incr_universe X X_LEN;
+ 100 decr_universe X X_LEN;
+ 101 set_univ_tag ECX ECX_LEN;
+ 102 tag_exists_t RX RX_LEN;
+ 103 tag_exists_p EX EX_LEN;
+ 104 tag_variable EX EX_LEN;
+
+ 105 push_impl_point I1ITX I1ITX_LEN;
+ 106 pop_impl_point X X_LEN;
+ 107 add_imports SEGI1LX SEGI1LX_LEN;
+ 108 remove_imports SEGLX SEGLX_LEN;
+ 109 push_import MTX MTX_LEN;
+ 110 pop_imports I1X I1X_LEN;
+
+ /* Control Instructions */
+
+ 111 allocate I1X I1X_LEN;
+ 112 deallocate X X_LEN;
+ 113 call I1LX I1LX_LEN;
+ 114 call_name I1CWPX I1CWPX_LEN;
+ 115 execute LX LX_LEN;
+ 116 execute_name CWPX CWPX_LEN;
+ 117 proceed X X_LEN;
+
+ /* Choice Instructions */
+
+ 118 try_me_else I1LX I1LX_LEN;
+ 119 retry_me_else I1LX I1LX_LEN;
+ 120 trust_me I1WPX I1WPX_LEN;
+ 121 try I1LX I1LX_LEN;
+ 122 retry I1LX I1LX_LEN;
+ 123 trust I1LWPX I1LWPX_LEN;
+ 124 trust_ext I1NX I1NX_LEN;
+ 125 try_else I1LLX I1LLX_LEN;
+ 126 retry_else I1LLX I1LLX_LEN;
+ 127 branch LX LX_LEN;
+
+ /* Indexing Instructions */
+
+ 128 switch_on_term LLLLX LLLLX_LEN;
+ 129 switch_on_constant I1HTX I1HTX_LEN;
+ 130 switch_on_bvar I1BVTX I1BVTX_LEN;
+ 131 switch_on_reg NLLX NLLX_LEN;
+
+ /* Cut Instructions */
+
+ 132 neck_cut X X_LEN;
+ 133 get_level EX EX_LEN;
+ 134 put_level EX EX_LEN;
+ 135 cut EX EX_LEN;
+
+ /* Miscellaneous Instructions */
+
+ 136 call_builtin I1I1WPX I1I1WPX_LEN;
+ 137 builtin I1X I1X_LEN;
+ 138 stop X X_LEN;
+ 139 halt X X_LEN;
+ 140 fail X X_LEN;
+
+ /* new added */
+ 141 create_type_variable EX EX_LEN;
+
+ /* resolved by the linker */
+ 142 execute_link_only CWPX CWPX_LEN;
+ 143 call_link_only I1CWPX I1CWPX_LEN;
+
+ 144 put_variable_te RRX RRX_LEN
\ No newline at end of file
diff --git a/src/runtime/c/teyjus/tables_gen/instrformats/instrformats_64.in b/src/runtime/c/teyjus/tables_gen/instrformats/instrformats_64.in
new file mode 100644
index 000000000..3aaebdf48
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/instrformats/instrformats_64.in
@@ -0,0 +1,346 @@
+{
+type intref = int ref
+type aconstant = Absyn.aconstant
+type akind = Absyn.akind
+
+}
+
+OPERAND TYPES
+
+ P /* (1 byte) padding */
+ WP /* (1 word) padding */
+ R RegInd Byte 1 int /* argument register number */
+ E EnvInd Byte 1 int /* environment variable number */
+ N NextClauseInd Byte 1 int /* next clause number in impt or impl pt */
+ I1 OneByteInt Byte 1 int /* 1 byte natural number */
+ CE ClEnvInd Byte 1 int /* closure environment variable number */
+ SEG ImpSegInd Byte 1 int /* import segment index */
+ C CstIndex TwoBytes 2 aconstant /* constant symbol table index */
+ K KstIndex TwoBytes 2 akind /* kind symbol table index */
+ L CodeLabel CSpacePtr 8 intref /* code location */
+ I Int int 4 int /* integer immediate value */
+ F Float float 4 float /* floating point immediate value */
+ S Str DF_StrDataPtr 2 int /* string pointer */
+ MT ModTab MemPtr 2 int /* module table address */
+ IT ImplTab MemPtr 2 int /* impl table address */
+ HT HashTab MemPtr 2 int /* hash table address */
+ BVT BranchTab MemPtr 2 int /* branch table for bound var indexing */
+ X /* operand list terminator */
+ OPCODE Byte 1
+
+
+INSTR CATEGORY
+
+ MAX OPERAND 12
+
+ X [P P P P P P P X X X X X]
+ X_LEN 8
+
+ RX [R P P P P P P X X X X X]
+ RX_LEN 8; RX_R 1
+
+ EX [E P P P P P P X X X X X]
+ EX_LEN 8; EX_E 1
+
+ I1X [I1 P P P P P P X X X X X]
+ I1X_LEN 8; I1X_I1 1
+
+ CX [P C P P P P X X X X X X]
+ CX_LEN 8; CX_C 2
+
+ KX [P K P P P P X X X X X X]
+ KX_LEN 8; KX_K 2
+
+ IX [P P P P P P P I X X X X]
+ IX_LEN 16; IX_I 8
+
+ FX [P P P P P P P F X X X X]
+ FX_LEN 16; FX_F 8
+
+ SX [P P P P P P P S X X X X]
+ SX_LEN 16; SX_S 8
+
+ MTX [P P P P P P P MT X X X X]
+ MTX_LEN 16; MTX_MT 8
+
+ LX [P P P P P P P L X X X X]
+ LX_LEN 16; LX_L 8
+
+ RRX [R R P P P P P X X X X X]
+ RRX_LEN 8; RRX_R1 1; RRX_R2 2
+
+ ERX [E R P P P P P X X X X X]
+ ERX_LEN 8; ERX_E 1; ERX_R 2
+
+ RCX [R C P P P P X X X X X X]
+ RCX_LEN 8; RCX_R 1; RCX_C 2
+
+ RIX [R P P P P P P I X X X X]
+ RIX_LEN 16; RIX_R 1; RIX_I 8
+
+ RFX [R P P P P P P F X X X X]
+ RFX_LEN 16; RFX_R 1; RFX_F 8
+
+ RSX [R P P P P P P S X X X X]
+ RSX_LEN 16; RSX_R 1; RSX_S 8
+
+ RI1X [R I1 P P P P P X X X X X]
+ RI1X_LEN 8; RI1X_R 1; RI1X_I1 2
+
+ RCEX [R CE P P P P P X X X X X]
+ RCEX_LEN 8; RCEX_R 1; RCEX_CE 2
+
+ ECEX [E CE P P P P P X X X X X]
+ ECEX_LEN 8; ECEX_E 1; ECEX_CE 2
+
+ CLX [P C P P P P L X X X X X]
+ CLX_LEN 16; CLX_C 2; CLX_L 8
+
+ RKX [R K P P P P X X X X X X]
+ RKX_LEN 8; RKX_R 1; RKX_K 2
+
+ ECX [E C P P P P X X X X X X]
+ ECX_LEN 8; ECX_E 1; ECX_C 2
+
+ I1ITX [I1 P P P P P P IT X X X X]
+ I1ITX_LEN 16; I1ITX_I1 1; I1ITX_IT 8
+
+ I1LX [I1 P P P P P P L X X X X]
+ I1LX_LEN 16; I1LX_I1 1; I1LX_L 8
+
+ SEGLX [SEG P P P P P P L X X X X]
+ SEGLX_LEN 16; SEGLX_SEG 1; SEGLX_L 8
+
+ I1LWPX [I1 P P P P P P L WP X X X]
+ I1LWPX_LEN 24; I1LWPX_I1 1; I1LWPX_L 8
+
+ I1NX [I1 N P P P P P X X X X X]
+ I1NX_LEN 8; I1NX_I1 1; I1NX_N 2
+
+ I1HTX [I1 P P P P P P HT X X X X]
+ I1HTX_LEN 16; I1HTX_I1 1; I1HTX_HT 8
+
+ I1BVTX [I1 P P P P P P BVT X X X X]
+ I1BVTX_LEN 16; I1BVTX_I1 1; I1BVTX_BVT 8
+
+ CWPX [P C P P P P WP X X X X X]
+ CWPX_LEN 16; CWPX_C 2
+
+ I1WPX [I1 P P P P P P WP X X X X]
+ I1WPX_LEN 16; I1WPX_I1 1
+
+ RRI1X [R R I1 P P P P X X X X X]
+ RRI1X_LEN 8; RRI1X_R1 1; RRI1X_R2 2; RRI1X_I1 3
+
+ RCLX [R C P P P P L X X X X X]
+ RCLX_LEN 16; RCLX_R 1; RCLX_C 2; RCLX_L 8
+
+ RCI1X [R C I1 P P P X X X X X X]
+ RCI1X_LEN 8; RCI1X_R 1; RCI1X_C 2; RCI1X_I1 4
+
+ SEGI1LX [SEG I1 P P P P P L X X X X]
+ SEGI1LX_LEN 16; SEGI1LX_SEG 1; SEGI1LX_I1 2; SEGI1LX_L 8
+
+ I1LLX [I1 P P P P P P L L X X X]
+ I1LLX_LEN 24; I1LLX_I1 1; I1LLX_L1 8; I1LLX_L2 16
+
+ NLLX [N P P P P P P L L X X X]
+ NLLX_LEN 24; NLLX_N 1; NLLX_L1 8; NLLX_L2 16
+
+ LLLLX [P P P P P P P L L L L X]
+ LLLLX_LEN 40; LLLLX_L1 8; LLLLX_L2 16; LLLLX_L3 24; LLLLX_L4 32
+
+ I1CWPX [I1 C P P P P WP X X X X X]
+ I1CWPX_LEN 16; I1CWPX_I1 1; I1CWPX_C 2
+
+ I1I1WPX [I1 I1 P P P P P WP X X X X]
+ I1I1WPX_LEN 16; I1I1WPX_I11 1; I1I1WPX_I12 2
+
+ CALL_I1_LEN 15
+
+
+INSTRUCTIONS 145
+
+ /* Instructions for term unification and creation */
+
+ 0 put_variable_t RRX RRX_LEN;
+ 1 put_variable_p ERX ERX_LEN;
+ 2 put_value_t RRX RRX_LEN;
+ 3 put_value_p ERX ERX_LEN;
+ 4 put_unsafe_value ERX ERX_LEN;
+ 5 copy_value ERX ERX_LEN;
+ 6 put_m_const RCX RCX_LEN;
+ 7 put_p_const RCX RCX_LEN;
+ 8 put_nil RX RX_LEN;
+ 9 put_integer RIX RIX_LEN;
+ 10 put_float RFX RFX_LEN;
+ 11 put_string RSX RSX_LEN;
+ 12 put_index RI1X RI1X_LEN;
+ 13 put_app RRI1X RRI1X_LEN;
+ 14 put_list RX RX_LEN;
+ 15 put_lambda RRI1X RRI1X_LEN;
+
+ 16 set_variable_t RX RX_LEN;
+ 17 set_variable_te RX RX_LEN;
+ 18 set_variable_p EX EX_LEN;
+ 19 set_value_t RX RX_LEN;
+ 20 set_value_p EX EX_LEN;
+ 21 globalize_pt ERX ERX_LEN;
+ 22 globalize_t RX RX_LEN;
+ 23 set_m_const CX CX_LEN;
+ 24 set_p_const CX CX_LEN;
+ 25 set_nil X X_LEN;
+ 26 set_integer IX IX_LEN;
+ 27 set_float FX FX_LEN;
+ 28 set_string SX SX_LEN;
+ 29 set_index I1X I1X_LEN;
+ 30 set_void I1X I1X_LEN;
+ 31 deref RX RX_LEN;
+ 32 set_lambda RI1X RI1X_LEN;
+
+
+ 33 get_variable_t RRX RRX_LEN;
+ 34 get_variable_p ERX ERX_LEN;
+ 35 init_variable_t RCEX RCEX_LEN;
+ 36 init_variable_p ECEX ECEX_LEN;
+ 37 get_m_constant RCX RCX_LEN;
+ 38 get_p_constant RCLX RCLX_LEN;
+ 39 get_integer RIX RIX_LEN;
+ 40 get_float RFX RFX_LEN;
+ 41 get_string RSX RSX_LEN;
+ 42 get_nil RX RX_LEN;
+ 43 get_m_structure RCI1X RCI1X_LEN;
+ 44 get_p_structure RCI1X RCI1X_LEN;
+ 45 get_list RX RX_LEN;
+
+ 46 unify_variable_t RX RX_LEN;
+ 47 unify_variable_p EX EX_LEN;
+ 48 unify_value_t RX RX_LEN;
+ 49 unify_value_p EX EX_LEN;
+ 50 unify_local_value_t RX RX_LEN;
+ 51 unify_local_value_p EX EX_LEN;
+ 52 unify_m_constant CX CX_LEN;
+ 53 unify_p_constant CLX CLX_LEN;
+ 54 unify_integer IX IX_LEN;
+ 55 unify_float FX FX_LEN;
+ 56 unify_string SX SX_LEN;
+ 57 unify_nil X X_LEN;
+ 58 unify_void I1X I1X_LEN;
+
+ /* Instructions for type unification and creation */
+ 59 put_type_variable_t RRX RRX_LEN;
+ 60 put_type_variable_p ERX ERX_LEN;
+ 61 put_type_value_t RRX RRX_LEN;
+ 62 put_type_value_p ERX ERX_LEN;
+ 63 put_type_unsafe_value ERX ERX_LEN;
+ 64 put_type_const RKX RKX_LEN;
+ 65 put_type_structure RKX RKX_LEN;
+ 66 put_type_arrow RX RX_LEN;
+
+ 67 set_type_variable_t RX RX_LEN;
+ 68 set_type_variable_p EX EX_LEN;
+ 69 set_type_value_t RX RX_LEN;
+ 70 set_type_value_p EX EX_LEN;
+ 71 set_type_local_value_t RX RX_LEN;
+ 72 set_type_local_value_p EX EX_LEN;
+ 73 set_type_constant KX KX_LEN;
+
+ 74 get_type_variable_t RRX RRX_LEN;
+ 75 get_type_variable_p ERX ERX_LEN;
+ 76 init_type_variable_t RCEX RCEX_LEN;
+ 77 init_type_variable_p ECEX ECEX_LEN;
+ 78 get_type_value_t RRX RRX_LEN;
+ 79 get_type_value_p ERX ERX_LEN;
+ 80 get_type_constant RKX RKX_LEN;
+ 81 get_type_structure RKX RKX_LEN;
+ 82 get_type_arrow RX RX_LEN;
+
+ 83 unify_type_variable_t RX RX_LEN;
+ 84 unify_type_variable_p EX EX_LEN;
+ 85 unify_type_value_t RX RX_LEN;
+ 86 unify_type_value_p EX EX_LEN;
+ 87 unify_envty_value_t RX RX_LEN;
+ 88 unify_envty_value_p EX EX_LEN;
+ 89 unify_type_local_value_t RX RX_LEN;
+ 90 unify_type_local_value_p EX EX_LEN;
+ 91 unify_envty_local_value_t RX RX_LEN;
+ 92 unify_envty_local_value_p EX EX_LEN;
+ 93 unify_type_constant KX KX_LEN;
+
+ /* Instructions for handling higher-order aspects */
+
+ 94 pattern_unify_t RRX RRX_LEN;
+ 95 pattern_unify_p ERX ERX_LEN;
+ 96 finish_unify X X_LEN;
+ 97 head_normalize_t RX RX_LEN;
+ 98 head_normalize_p EX EX_LEN;
+
+ /* Instructions for handling logical aspects */
+
+ 99 incr_universe X X_LEN;
+ 100 decr_universe X X_LEN;
+ 101 set_univ_tag ECX ECX_LEN;
+ 102 tag_exists_t RX RX_LEN;
+ 103 tag_exists_p EX EX_LEN;
+ 104 tag_variable EX EX_LEN;
+
+ 105 push_impl_point I1ITX I1ITX_LEN;
+ 106 pop_impl_point X X_LEN;
+ 107 add_imports SEGI1LX SEGI1LX_LEN;
+ 108 remove_imports SEGLX SEGLX_LEN;
+ 109 push_import MTX MTX_LEN;
+ 110 pop_imports I1X I1X_LEN;
+
+ /* Control Instructions */
+
+ 111 allocate I1X I1X_LEN;
+ 112 deallocate X X_LEN;
+ 113 call I1LX I1LX_LEN;
+ 114 call_name I1CWPX I1CWPX_LEN;
+ 115 execute LX LX_LEN;
+ 116 execute_name CWPX CWPX_LEN;
+ 117 proceed X X_LEN;
+
+ /* Choice Instructions */
+
+ 118 try_me_else I1LX I1LX_LEN;
+ 119 retry_me_else I1LX I1LX_LEN;
+ 120 trust_me I1WPX I1WPX_LEN;
+ 121 try I1LX I1LX_LEN;
+ 122 retry I1LX I1LX_LEN;
+ 123 trust I1LWPX I1LWPX_LEN;
+ 124 trust_ext I1NX I1NX_LEN;
+ 125 try_else I1LLX I1LLX_LEN;
+ 126 retry_else I1LLX I1LLX_LEN;
+ 127 branch LX LX_LEN;
+
+ /* Indexing Instructions */
+
+ 128 switch_on_term LLLLX LLLLX_LEN;
+ 129 switch_on_constant I1HTX I1HTX_LEN;
+ 130 switch_on_bvar I1BVTX I1BVTX_LEN;
+ 131 switch_on_reg NLLX NLLX_LEN;
+
+ /* Cut Instructions */
+
+ 132 neck_cut X X_LEN;
+ 133 get_level EX EX_LEN;
+ 134 put_level EX EX_LEN;
+ 135 cut EX EX_LEN;
+
+ /* Miscellaneous Instructions */
+
+ 136 call_builtin I1I1WPX I1I1WPX_LEN;
+ 137 builtin I1X I1X_LEN;
+ 138 stop X X_LEN;
+ 139 halt X X_LEN;
+ 140 fail X X_LEN;
+
+ /* new added */
+ 141 create_type_variable EX EX_LEN;
+
+ /* resolved by the linker */
+ 142 execute_link_only CWPX CWPX_LEN;
+ 143 call_link_only I1CWPX I1CWPX_LEN;
+
+ 144 put_variable_te RRX RRX_LEN
\ No newline at end of file
diff --git a/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-c.c b/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-c.c
new file mode 100644
index 000000000..394f85d9e
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-c.c
@@ -0,0 +1,650 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+/******************************************************************************/
+/* File instrgen-c.h. This files contains function declarations for generating*/
+/* files instructions.h and instructions.c */
+/******************************************************************************/
+#include
+#include
+#include
+#include "instrgen-c.h"
+#include "../util/util.h"
+
+#define INDENT1 " "
+#define INDENT1_LEN 4u
+#define PREFIX "INSTR_"
+#define PREFIX_LEN 6u
+#define CATPREFIX "INSTR_CAT_"
+#define CATPREFIX_LEN 10u
+#define DEF "#define "
+#define DEF_LEN 8u
+
+/*************************************************************************/
+/* instructions.h */
+/*************************************************************************/
+#define COMMENTS_BEG_H \
+"/****************************************************************************/\n/* File instructions.h. */ \n/* This file defines instruction operand types, instruction categories and */ \n/* instruction opcode. */ \n/****************************************************************************/ \n"
+
+#define COMPDEF_BEG_H "#ifndef INSTRUCTIONS_H\n#define INSTRUCTIONS_H\n"
+#define COMPDEF_END_H "#endif //INSTRUCTIONS_H\n"
+
+#define INCLUDE_H \
+"#include \"../simulator/mctypes.h\" //to be changed \n#include \"../simulator/dataformats.h\" //to be changed \n"
+
+/* OPERAND TYPES */
+#define OPTYPES_COMMENTS_H \
+"/****************************************************************************/\n/* OPERAND TYPES */ \n/****************************************************************************/ \n\n"
+#define OPTYPES_COMMENTS_H_LEN 300
+
+#define OPERAND_TYPE_BEG \
+"/* possible types of instruction operands */ \ntypedef enum INSTR_OperandType \n{\n"
+#define OPERAND_TYPE_BEG_LEN 200
+
+#define OPERAND_TYPE_END "} INSTR_OperandType;\n\n"
+#define OPERAND_TYPE_END_LEN 30
+
+static char* opTypes = NULL;
+static char* opTypeMaps = NULL ;
+
+void cgenOpTypes(char *name, char* typeName, char* types, char* comments,
+ int last)
+{
+ char* myOpTypes = opTypes;
+ char* myOpTypeMaps = opTypeMaps;
+ size_t length;
+ size_t commentLen = comments ? strlen(comments) : 0u;
+ length = (opTypes ? strlen(opTypes) : 0u) + INDENT1_LEN + PREFIX_LEN +
+ strlen(name) + (comments ? strlen(comments) : 0u) + 30u;
+ opTypes = UTIL_mallocStr(length);
+ if (myOpTypes) { strcpy(opTypes, myOpTypes); strcat(opTypes, INDENT1); }
+ else strcpy(opTypes, INDENT1);
+ if (comments) {
+ strcat(opTypes, "//");
+ strcat(opTypes, comments);
+ strcat(opTypes, "\n");
+ strcat(opTypes, INDENT1);
+ }
+ strcat(opTypes, PREFIX);
+ strcat(opTypes, name);
+ if (last) strcat(opTypes, "\n");
+ else strcat(opTypes, ",\n");
+ if (myOpTypes) free(myOpTypes);
+
+ if (typeName) {
+ length = (opTypeMaps ? strlen(opTypeMaps) : 0u) + PREFIX_LEN +
+ strlen(types) + strlen(typeName) + 30u;
+ opTypeMaps = UTIL_mallocStr(length);
+ if (myOpTypeMaps) {
+ strcpy(opTypeMaps, myOpTypeMaps);
+ strcat(opTypeMaps, "typedef ");
+ } else strcpy(opTypeMaps, "typedef ");
+ strcat(opTypeMaps, types);
+ strcat(opTypeMaps, " ");
+ strcat(opTypeMaps, PREFIX);
+ strcat(opTypeMaps, typeName);
+ strcat(opTypeMaps, ";\n");
+ if (myOpTypeMaps) free(myOpTypeMaps);
+ }
+}
+
+#define OPTYPEMAP_COMMENT \
+"/**************************************************************************/ \n/* Types for instruction operants */ \n/**************************************************************************/ \n\n"
+#define OPTYPEMAP_COMMENT_LEN 300
+
+static char *opcodeType = NULL;
+
+void cgenOpCodeType(char* optype)
+{
+ size_t length = PREFIX_LEN + strlen(optype) + 50;
+ opcodeType = UTIL_mallocStr(length);
+ strcpy(opcodeType, "typedef ");
+ strcat(opcodeType, optype);
+ strcat(opcodeType, " ");
+ strcat(opcodeType, PREFIX);
+ strcat(opcodeType, "OpCode;\n");
+}
+
+
+static char *opsH = NULL;
+
+void cgenOpsH() //assume neither opTypes nor opTypeMaps is empty
+{
+ size_t length = OPTYPES_COMMENTS_H_LEN + OPERAND_TYPE_BEG_LEN +
+ OPTYPEMAP_COMMENT_LEN + OPERAND_TYPE_END_LEN + strlen(opTypes) +
+ strlen(opTypeMaps) + strlen(opcodeType) + 50u;
+ opsH = UTIL_mallocStr(length);
+
+ strcpy(opsH, OPTYPES_COMMENTS_H);
+ strcat(opsH, OPERAND_TYPE_BEG);
+ strcat(opsH, opTypes);
+ strcat(opsH, OPERAND_TYPE_END);
+ strcat(opsH, OPTYPEMAP_COMMENT);
+ strcat(opsH, opcodeType);
+ strcat(opsH, opTypeMaps);
+
+ free(opTypes);
+ free(opcodeType);
+ free(opTypeMaps);
+}
+
+/* INSTRUCTION CATEGORIES */
+#define INSTRCAT_COMMENTS_H \
+"/***************************************************************************/ \n/* INSTRUCTION CATEGORIES */ \n/***************************************************************************/ \n"
+#define INSTRCAT_COMMENTS_H_LEN 300
+
+#define INSTRCAT_TYPE_BEG \
+" /* The names of instruction categories no longer include padding bytes. */\n/* Thus we do not need to maintain two sets of names for different machine */ \n/* architectures. */ \ntypedef enum INSTR_InstrCategory \n{\n"
+#define INSTRCAT_TYPE_BEG_LEN 350
+#define INSTRCAT_TYPE_END "} INSTR_InstrCategory;\n\n"
+#define INSTRCAT_TYPE_END_LEN 50
+
+
+static char *instrcat_type = NULL;
+static char *instrLen = NULL;
+static char *oneInstrLen = NULL;
+static int catNum = 0;
+
+void cgenOneInstrCatH(char* name, int last)
+{
+ char *myInstrCat = instrcat_type, *myInstrLen = instrLen;
+ size_t length = (myInstrCat ? strlen(myInstrCat) : 0u) + strlen(name) +
+ CATPREFIX_LEN + INDENT1_LEN + 10u;
+ instrcat_type = UTIL_mallocStr(length);
+ if (myInstrCat) {
+ strcpy(instrcat_type, myInstrCat);
+ strcat(instrcat_type, INDENT1);
+ } else strcpy(instrcat_type, INDENT1);
+ strcat(instrcat_type, CATPREFIX);
+ strcat(instrcat_type, name);
+ strcat(instrcat_type, " = ");
+ strcat(instrcat_type, UTIL_itoa(catNum));
+ if (last) strcat(instrcat_type, "\n");
+ else strcat(instrcat_type, ",\n");
+ catNum++;
+
+ if (myInstrCat) free(myInstrCat);
+
+ //assume oneInstrLen cannot be empty
+ length = (myInstrLen ? strlen(myInstrLen) : 0u) + strlen(name) +
+ CATPREFIX_LEN + 10u + strlen(oneInstrLen);
+ instrLen = UTIL_mallocStr(length);
+
+ if (myInstrLen) {
+ strcpy(instrLen, myInstrLen);
+ strcat(instrLen, "//");
+ } else strcpy(instrLen, "//");
+ strcat(instrLen, CATPREFIX);
+ strcat(instrLen, name);
+ strcat(instrLen, "\n");
+ strcat(instrLen, oneInstrLen);
+
+ free(oneInstrLen);
+ oneInstrLen = NULL;
+ if (myInstrLen) free(myInstrLen);
+}
+
+#define INSTRLEN_COMMENTS \
+"/**************************************************************************/ \n/* Macros defines instruction lengths and distances between op code and */ \n/* operands. */ \n/* The assumption is that the op code occupies 1 byte. */ \n/**************************************************************************/ \n\n"
+#define INSTRLEN_COMMENTS_LEN 450u
+
+void cgenInstrLength(char* name, char* len)
+{
+ char *myInstrLen = oneInstrLen;
+ size_t length = (myInstrLen ? strlen(myInstrLen) : 0u) + DEF_LEN + PREFIX_LEN
+ + strlen(name) + strlen(len) + 10u;
+ oneInstrLen = UTIL_mallocStr(length);
+ if (myInstrLen) {
+ strcpy(oneInstrLen, myInstrLen);
+ strcat(oneInstrLen, DEF);
+ } else strcpy(oneInstrLen, DEF);
+ strcat(oneInstrLen, PREFIX);
+ strcat(oneInstrLen, name);
+ strcat(oneInstrLen, " ");
+ strcat(oneInstrLen, len);
+ strcat(oneInstrLen, "\n");
+
+ free(myInstrLen);
+}
+
+#define OPTYPE_TAB_H \
+"/****************************************************************************/\n/* OPERAND TYPES TABLE */ \n/****************************************************************************/ \n \n//the operand types array in a given entry \nINSTR_OperandType* INSTR_operandTypes(INSTR_InstrCategory index); \n"
+#define OPTYPE_TAB_H_LEN 500
+
+
+static char *instrCatH = NULL;
+
+void cgenInstrCatH(char* callI1Len)
+{
+ size_t length = strlen(instrcat_type) + strlen(instrLen) +
+ INSTRCAT_TYPE_BEG_LEN + INSTRCAT_TYPE_END_LEN + INSTRCAT_COMMENTS_H_LEN
+ + INSTRLEN_COMMENTS_LEN + OPTYPE_TAB_H_LEN + 160u;
+ instrCatH = UTIL_mallocStr(length);
+
+ strcpy(instrCatH, INSTRCAT_COMMENTS_H);
+ strcat(instrCatH, INSTRCAT_TYPE_BEG);
+ strcat(instrCatH, instrcat_type);
+ strcat(instrCatH, INSTRCAT_TYPE_END);
+ strcat(instrCatH, DEF);
+ strcat(instrCatH, "INSTR_NUM_INSTR_CATS ");
+ strcat(instrCatH, UTIL_itoa(catNum));
+ strcat(instrCatH, "\n\n");
+ strcat(instrCatH, DEF);
+ strcat(instrCatH, "INSTR_CALL_I1_LEN ");
+ strcat(instrCatH, callI1Len);
+ strcat(instrCatH, "\n\n");
+ strcat(instrCatH, INSTRLEN_COMMENTS);
+ strcat(instrCatH, instrLen);
+ strcat(instrCatH, "\n");
+ strcat(instrCatH, OPTYPE_TAB_H);
+
+
+ free(instrcat_type);
+ free(instrLen);
+}
+
+#define INSTR_COMMENTS_H \
+"/***************************************************************************/ \n/* OPCODES OF INSTRUCTIONS */ \n/***************************************************************************/ \n"
+#define INSTR_COMMENTS_H_LEN 250
+
+static char* instrH = NULL;
+
+void cgenOneInstrH(char* comments, char* opCode, char* instrName)
+{
+ char* myInstrH = instrH;
+ size_t length = (myInstrH ? strlen(myInstrH) : 0u) + strlen(instrName) +
+ strlen(opCode) + DEF_LEN + CATPREFIX_LEN +
+ (comments ? strlen(comments) : 0u) + 10u;
+ instrH = UTIL_mallocStr(length);
+ if (myInstrH) {
+ strcpy(instrH, myInstrH);
+ if (comments) {
+ strcat(instrH, "//");
+ strcat(instrH, comments);
+ strcat(instrH, "\n");
+ strcat(instrH, DEF);
+ } else strcat(instrH, DEF);
+ } else {
+ if (comments) {
+ strcpy(instrH, "//");
+ strcat(instrH, comments);
+ strcat(instrH, "\n");
+ strcat(instrH, DEF);
+ } else strcpy(instrH, DEF);
+ }
+ strcat(instrH, instrName);
+ strcat(instrH, " ");
+ strcat(instrH, opCode);
+ strcat(instrH, "\n");
+
+
+ if (myInstrH) free(myInstrH);
+}
+
+#define INSTRTAB_H \
+"/***************************************************************************/ \n/* INSTRUCTION INFORMATION TABLE */ \n/***************************************************************************/ \nINSTR_InstrCategory INSTR_instrType(int index); //instr type in a given entry \nchar* INSTR_instrName(int index); //instr name in a given entry \nint INSTR_instrSize(int index); //instr size in a given entry \n"
+#define INSTRTAB_H_LEN 500
+
+
+
+char* instrOpc = NULL;
+
+void cgenInstrH(char* numInstr)
+{
+ size_t length = INSTR_COMMENTS_H_LEN + strlen(instrH) + DEF_LEN +
+ strlen(numInstr) + INSTRTAB_H_LEN + 20u;
+
+ instrOpc = UTIL_mallocStr(length);
+ strcpy(instrOpc, INSTR_COMMENTS_H);
+ strcat(instrOpc, instrH);
+ strcat(instrOpc, "\n\n");
+ strcat(instrOpc, DEF);
+ strcat(instrOpc, "INSTR_NUM_INSTRS");
+ strcat(instrOpc, " ");
+ strcat(instrOpc, numInstr);
+ strcat(instrOpc, "\n\n");
+ strcat(instrOpc, INSTRTAB_H);
+
+ free(instrH);
+}
+
+
+/* dump instructions.h" */
+void cspitCInstructionsH(char * root)
+{
+ FILE* outFile;
+ char * filename = malloc(strlen(root) + 32);
+ strcpy(filename, root);
+ strcat(filename, "tables/instructions.h");
+
+ outFile = UTIL_fopenW(filename);
+ fprintf(outFile, "%s\n%s\n%s\n", COMMENTS_BEG_H, COMPDEF_BEG_H, INCLUDE_H);
+ fprintf(outFile, "%s\n", opsH);
+ fprintf(outFile, "%s\n", instrCatH);
+ fprintf(outFile, "%s\n", instrOpc);
+ fprintf(outFile, "%s\n", COMPDEF_END_H);
+ UTIL_fclose(outFile);
+
+ free(opsH);
+ free(instrCatH);
+ free(instrOpc);
+
+ free(filename);
+}
+
+
+/*************************************************************************/
+/* instructions.c */
+/*************************************************************************/
+#define COMMENTS_BEG_C \
+"/****************************************************************************/\n/* */ \n/* File instructions.c. This file defines the operand types table and */ \n/* the instruction information table. */ \n/* */ \n/****************************************************************************/ \n\n"
+#define INCLUDE_C "#include \"instructions.h\"\n"
+
+/*OPERAND TYPE TABLE */
+#define OPTYPE_TAB_COMMENTS \
+"/****************************************************************************/\n/* OPERAND TYPES TABLE */ \n/****************************************************************************/ \n\n"
+#define OPTYPE_TAB_COMMENTS_LEN 250
+
+#define MAX_OP_COMMENTS \
+"/* Max number of operand that could be taken by instructions including the */\n/* padding bytes and one to terminate the list. (machine dependent) */ \n"
+#define MAX_OP_COMMENTS_LEN 200
+
+
+#define OPTYPE_TAB_TYPE \
+"/* this array is indexed by instruction category. For each category, \n INSTR_operandTypeTab contains a string of values indicating the type \n of the operand at that position, terminated by INSTR_X. This \n information is useful when parsing instruction streams. */ \ntypedef INSTR_OperandType \n INSTR_OperandTypeTab[INSTR_NUM_INSTR_CATS][INSTR_MAX_OPERAND]; \n\n"
+
+#define OPTYPE_TAB_TYPE_LEN 500
+
+#define OPTYPE_TAB_BEG "INSTR_OperandTypeTab INSTR_operandTypeTable ={\n"
+#define OPTYPE_TAB_BEG_LEN 80
+#define OPTYPE_TAB_END "};\n\n"
+#define OPTYPE_TAB_END_LEN 10
+
+static char* optypeTabEntry = NULL;
+
+void cgenInstrFormat(char* opType, int last)
+{
+ char* mytabEntry = optypeTabEntry;
+ size_t length = (mytabEntry ? strlen(mytabEntry) : 0u) + PREFIX_LEN +
+ strlen(opType) + 5u;
+ optypeTabEntry = UTIL_mallocStr(length);
+
+ if (mytabEntry) {
+ strcpy(optypeTabEntry, mytabEntry);
+ strcat(optypeTabEntry, PREFIX);
+ } else strcpy(optypeTabEntry, PREFIX);
+ strcat(optypeTabEntry, opType);
+ if (!last) strcat(optypeTabEntry, ", ");
+
+ if (mytabEntry) free(mytabEntry);
+}
+
+static char* optypeTab = NULL;
+
+//assume optypeEntry is not empty
+void cgenOneInstrCatC(char* name, int last)
+{
+ char* myoptypeTab = optypeTab;
+ size_t length = (myoptypeTab ? strlen(myoptypeTab) : 0u) + INDENT1_LEN*2 +
+ strlen(optypeTabEntry) + strlen(name) + 10u + CATPREFIX_LEN;
+
+ optypeTab = UTIL_mallocStr(length);
+
+ if (myoptypeTab) {
+ strcpy(optypeTab, myoptypeTab);
+ strcat(optypeTab, INDENT1);
+ } else strcpy(optypeTab, INDENT1);
+ strcat(optypeTab, "//");
+ strcat(optypeTab, CATPREFIX);
+ strcat(optypeTab, name);
+ strcat(optypeTab, "\n");
+ strcat(optypeTab, INDENT1);
+ strcat(optypeTab, "{");
+ strcat(optypeTab, optypeTabEntry);
+ if (last) strcat(optypeTab, "}\n");
+ else strcat(optypeTab, "},\n");
+
+ free(optypeTabEntry);
+ optypeTabEntry = NULL;
+ if (myoptypeTab) free(myoptypeTab);
+}
+
+#define OPTYPE_FUNC \
+"INSTR_OperandType* INSTR_operandTypes(INSTR_InstrCategory index) \n{ \n return INSTR_operandTypeTable[index]; \n}\n"
+#define OPTYPE_FUNC_LEN 250
+
+static char* opTypeC = NULL;
+
+void cgenInstrCatC(char* max_op){
+ size_t length = OPTYPE_TAB_COMMENTS_LEN + MAX_OP_COMMENTS_LEN +
+ OPTYPE_TAB_TYPE_LEN + OPTYPE_TAB_BEG_LEN + OPTYPE_TAB_END_LEN +
+ strlen(optypeTab) + OPTYPE_FUNC_LEN + strlen(max_op) + 100u;
+ opTypeC = UTIL_mallocStr(length);
+ strcpy(opTypeC, OPTYPE_TAB_COMMENTS);
+ strcat(opTypeC, MAX_OP_COMMENTS);
+ strcat(opTypeC, "#define INSTR_MAX_OPERAND ");
+ strcat(opTypeC, max_op);
+ strcat(opTypeC, "\n\n");
+ strcat(opTypeC, OPTYPE_TAB_TYPE);
+ strcat(opTypeC, OPTYPE_TAB_BEG);
+ strcat(opTypeC, optypeTab);
+ strcat(opTypeC, OPTYPE_TAB_END);
+ strcat(opTypeC, OPTYPE_FUNC);
+}
+
+//dynamic string array type
+typedef struct StringArray
+{
+ char **array;
+ unsigned int length;
+} StringArray;
+
+
+static StringArray instrTab;
+
+void cinitInstrC(int numInstrs)
+{
+ instrTab.length = numInstrs;
+ instrTab.array = (char**)UTIL_malloc(sizeof(char*)*numInstrs);
+}
+
+void cgenOneInstrC(int opcode, char* name, char* cat, char* len, int last)
+{
+ size_t length = strlen(name) + strlen(cat) + strlen(len) + PREFIX_LEN
+ + CATPREFIX_LEN + 20u + INDENT1_LEN ;
+ char* myText = UTIL_mallocStr(length);
+
+ strcpy(myText, INDENT1);
+ strcat(myText, "{\"");
+ strcat(myText, name);
+ strcat(myText, "\", ");
+ strcat(myText, CATPREFIX);
+ strcat(myText, cat);
+ strcat(myText, ", ");
+ strcat(myText, PREFIX);
+ strcat(myText, len);
+ if (last) strcat(myText, "}\n");
+ else strcat(myText, "},\n");
+
+ instrTab.array[opcode] = myText;
+}
+
+#define INSTR_TAB_C_COMMENTS \
+"/****************************************************************************/\n/* INSTRUCTION INFORMATION TABLE */ \n/****************************************************************************/ \n"
+#define INSTR_TAB_C_COMMENTS_LEN 250
+
+#define INSTR_TAB_TYPE \
+"typedef struct //entry of the instruction info table \n{ \n char* name; \n INSTR_InstrCategory type; \n int size; \n} INSTR_InstrInfoTab_; \n\ntypedef INSTR_InstrInfoTab_ INSTR_InstrInfoTab[INSTR_NUM_INSTRS]; \n\n"
+#define INSTR_TAB_TYPE_LEN 600
+
+#define INSTR_TAB_BEG "INSTR_InstrInfoTab INSTR_instrInfoTable ={\n"
+#define INSTR_TAB_BEG_LEN 80
+
+#define INSTR_TAB_END "};\n\n"
+#define INSTR_TAB_END_LEN 10
+
+#define INSTR_TAB_FUNC_C \
+"/* Accessing functions */ \nINSTR_InstrCategory INSTR_instrType(int index) \n{ \n return (INSTR_instrInfoTable[index]).type; \n} \n\nchar* INSTR_instrName(int index) \n{ \n return (INSTR_instrInfoTable[index]).name; \n} \n\nint INSTR_instrSize(int index) \n{ \n return (INSTR_instrInfoTable[index]).size; \n}\n\n"
+#define INSTR_TAB_FUNC_C_LEN 1000
+
+static char* instrC = NULL;
+
+void cgenInstrC()
+{
+ size_t i, length;
+ char *myText = NULL, *myText2;
+ for (i = 0; i < instrTab.length; i++) {
+ if (instrTab.array[i]) {
+ length = (myText ? strlen(myText) : 0u) + strlen(instrTab.array[i]);
+ myText2 = UTIL_mallocStr(length + 100u);
+ if (myText) {
+ strcpy(myText2, myText);
+ strcat(myText2, instrTab.array[i]);
+ } else strcpy(myText2, instrTab.array[i]);
+ free(instrTab.array[i]);
+ free(myText);
+ myText = myText2;
+ }
+ }
+ free(instrTab.array);
+ length = INSTR_TAB_C_COMMENTS_LEN + INSTR_TAB_TYPE_LEN +
+ INSTR_TAB_BEG_LEN + INSTR_TAB_END_LEN + INSTR_TAB_FUNC_C_LEN +
+ strlen(myText);
+ instrC = UTIL_mallocStr(length);
+ strcpy(instrC, INSTR_TAB_C_COMMENTS);
+ strcat(instrC, INSTR_TAB_TYPE);
+ strcat(instrC, INSTR_TAB_BEG);
+ strcat(instrC, myText);
+ strcat(instrC, INSTR_TAB_END);
+ strcat(instrC, INSTR_TAB_FUNC_C);
+ free(myText);
+}
+
+
+/* dump instructions.c" */
+void cspitCInstructionsC(char * root)
+{
+ FILE* outFile;
+ char * filename = malloc(strlen(root) + 32);
+ strcpy(filename, root);
+ strcat(filename, "tables/instructions.c");
+
+ outFile = UTIL_fopenW(filename);
+ fprintf(outFile, "%s\n%s\n", COMMENTS_BEG_C, INCLUDE_C);
+ fprintf(outFile, "%s\n", opTypeC);
+ fprintf(outFile, "%s\n", instrC);
+ UTIL_fclose(outFile);
+
+ free(opTypeC);
+ free(instrC);
+ free(filename);
+}
+
+/* simdispatch.c */
+#define SIMPREFIX "SINSTR_"
+#define SIMPREFIX_LEN 7
+
+#define SIMDIS_COMMENTS \
+"/***************************************************************************/ \n/* */ \n/* File simdispatch.c. The instruction dispatch table used by the */ \n/* simulator is defined here as an array of function pointers, each of */ \n/* which refers to a function realizing a corresponding instruction. */ \n/* These functions are defined in the file ./siminstr.c. */ \n/***************************************************************************/ \n\n"
+#define SIMDIS_COMMENTS_LEN 600
+
+#define SIMDIS_INCLUDE \
+"#include \"../tables/instructions.h\" //to be modified \n#include \"siminstr.h\" \n#include \"simdispatch.h\"\n\n"
+#define SIMDIS_INCLUDE_LEN 250
+
+#define SIMDIS_TAB_BEG \
+"SDP_InstrFunctionPtr SDP_dispatchTable[INSTR_NUM_INSTRS] = {\n"
+#define SIMDIS_TAB_BEG_LEN 80
+
+#define SIMDIS_TAB_END "};\n"
+#define SIMDIS_TAB_END_LEN 10
+
+static StringArray dispatchTab;
+
+void cinitSimDispatch(int size)
+{
+ dispatchTab.length = size;
+ dispatchTab.array = (char**)UTIL_malloc(sizeof(char*)*size);
+}
+
+void cgenOneSimDispatch(int ind, char* instr, int last)
+{
+ size_t length = strlen(instr) + SIMPREFIX_LEN + INDENT1_LEN + 10u;
+ char* myText = UTIL_mallocStr(length);
+
+ strcpy(myText, INDENT1);
+ strcat(myText, SIMPREFIX);
+ strcat(myText, instr);
+ if (last) strcat(myText, "\n");
+ else strcat(myText, ",\n");
+
+ dispatchTab.array[ind] = myText;
+}
+
+static char* dispatch = NULL;
+
+void cgenSimDispatch()
+{
+ size_t i, length;
+ char *myText = NULL, *myText2;
+
+ for(i = 0; i < dispatchTab.length; i++) {
+ if (dispatchTab.array[i]){
+ length = (myText ? strlen(myText) : 0)+strlen(dispatchTab.array[i]);
+ myText2 = UTIL_mallocStr(length);
+ if (myText){
+ strcpy(myText2, myText);
+ strcat(myText2, dispatchTab.array[i]);
+ } else strcpy(myText2, dispatchTab.array[i]);
+ free(dispatchTab.array[i]);
+ free(myText);
+ myText = myText2;
+ }
+ }
+ free(dispatchTab.array);
+ length = SIMDIS_COMMENTS_LEN + SIMDIS_INCLUDE_LEN + SIMDIS_TAB_BEG_LEN
+ + SIMDIS_TAB_BEG_LEN + SIMDIS_TAB_END_LEN + strlen(myText);
+ dispatch = UTIL_mallocStr(length);
+ strcpy(dispatch, SIMDIS_COMMENTS);
+ strcat(dispatch, SIMDIS_INCLUDE);
+ strcat(dispatch, SIMDIS_TAB_BEG);
+ strcat(dispatch, myText);
+ strcat(dispatch, SIMDIS_TAB_END);
+
+ free(myText);
+}
+
+void cspitSimDispatch(char * root)
+{
+ FILE* outFile;
+ char * filename = malloc(strlen(root) + 32);
+ strcpy(filename, root);
+ strcat(filename, "simulator/simdispatch.c");
+ outFile = UTIL_fopenW(filename);
+ fprintf(outFile, "%s\n", dispatch);
+
+ free(dispatch);
+ UTIL_fclose(outFile);
+ free(filename);
+}
+
+
+
+
diff --git a/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-c.h b/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-c.h
new file mode 100644
index 000000000..0c1c6b6fd
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-c.h
@@ -0,0 +1,70 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+/******************************************************************************/
+/* File instrgen-c.h. This files contains function declarations for generating*/
+/* files instructions.h and instructions.c */
+/******************************************************************************/
+
+/* instructions.h */
+/* generating operand types */
+
+void cgenOpTypes(char *name, char* typeName, char* types, char* comments,
+ int last);
+
+void cgenOpCodeType(char* optype);
+
+void cgenOpsH();
+
+void cgenInstrCatH(char* callI1Len);
+
+void cgenOneInstrCatH(char* name, int last);
+
+void cgenInstrLength(char* name, char* length);
+
+void cgenInstrH(char* numInstr);
+
+void cgenOneInstrH(char* comments, char* opcode, char* name);
+
+
+/* dump instructions.h" */
+void cspitCInstructionsH(char * root);
+
+/* instructions.c */
+
+void cgenInstrFormat(char* opType, int last);
+
+void cgenOneInstrCatC(char* name, int last);
+
+void cgenInstrCatC(char* max_op);
+
+void cinitInstrC(int numInstr);
+void cgenOneInstrC(int opcode, char* name, char* cat, char* len, int last);
+void cgenInstrC();
+
+/* dump instructions.c" */
+void cspitCInstructionsC(char * root);
+
+/* simdispatch.c */
+void cinitSimDispatch(int size);
+void cgenOneSimDispatch(int ind, char* instr, int last);
+void cgenSimDispatch();
+
+void cspitSimDispatch(char * root);
diff --git a/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-ocaml.c b/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-ocaml.c
new file mode 100644
index 000000000..5309509c8
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-ocaml.c
@@ -0,0 +1,841 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+/*************************************************************************/
+/* functions for generating ocaml instr.mli and instr.ml */
+/*************************************************************************/
+#include "../util/util.h"
+#include
+#include
+#include
+#include
+
+static char* addLine(char* str, char* addOn)
+{
+ size_t length = (str ? strlen(str) : 0) + strlen(addOn) + 2;
+ char* newStr = UTIL_mallocStr(length);
+
+ if (str) {
+ strcpy(newStr, str);
+ strcat(newStr, addOn);
+ } else strcpy(newStr, addOn);
+ strcat(newStr, "\n\n");
+ return newStr;
+}
+
+static char* addStr(char* str, char* addOn)
+{
+ size_t length = (str ? strlen(str) : 0) + strlen(addOn);
+ char* newStr = UTIL_mallocStr(length);
+
+ if (str) {
+ strcpy(newStr, str);
+ strcat(newStr, addOn);
+ } else strcpy(newStr, addOn);
+ return newStr;
+}
+
+
+/**********************************************************************/
+/* auxiliary functions for making ocaml language constructs */
+/**********************************************************************/
+#define TYPE_SUFFIX "type"
+#define SIZE_SUFFIX "Size"
+#define WRITE_PREFIX "write"
+#define READ_PREFIX "read"
+#define DISPLAY_PREFIX "display"
+#define INDENT " "
+#define INDENT2 " "
+#define WRITE "Bytecode.write"
+#define READ "Bytecode.read"
+#define DISPLAY "Bytecode.display"
+#define INSCAT_PREFIX "inscat"
+#define INS_PREFIX "Ins_"
+
+static char* OC_mkVarDec(char* varName, char* varType)
+{
+ size_t length = strlen(varName) + strlen(varType) + 10;
+ char* vardec = UTIL_mallocStr(length);
+
+ strcpy(vardec, "val ");
+ strcat(vardec, varName);
+ strcat(vardec, " : ");
+ strcat(vardec, varType);
+ strcat(vardec, "\n");
+
+ return vardec;
+}
+
+static char* OC_mkVarDef(char* varName, char* defs)
+{
+ size_t length = strlen(varName) + strlen(defs) + 10;
+ char* vardef = UTIL_mallocStr(length);
+
+ strcpy(vardef, "let ");
+ strcat(vardef, varName);
+ strcat(vardef, " = ");
+ strcat(vardef, defs);
+ strcat(vardef, "\n");
+
+ return vardef;
+}
+
+static char* OC_mkTypeDec(char* typeName, char* defs)
+{
+ size_t length = strlen(typeName) + strlen(defs) + 10;
+ char* typedec = UTIL_mallocStr(length);
+
+ strcpy(typedec, "type ");
+ strcat(typedec, typeName);
+ strcat(typedec, " = ");
+ strcat(typedec, defs);
+ strcat(typedec, "\n");
+
+ return typedec;
+}
+
+static char* OC_mkFunc(char* funcName, char* arg, char* body)
+{
+ size_t length = strlen(funcName) + strlen(arg) + strlen(body) + 20;
+ char* func = UTIL_mallocStr(length);
+
+ strcpy(func, "let ");
+ strcat(func, funcName);
+ strcat(func, " ");
+ strcat(func, arg);
+ strcat(func, " = ");
+ strcat(func, body);
+ strcat(func, "\n");
+
+ return func;
+}
+
+static char* OC_mkCrossType(char *lop, char *rop)
+{
+ size_t length = strlen(lop) + strlen(rop) + 5;
+ char* crossType = UTIL_mallocStr(length);
+
+ strcpy(crossType, lop);
+ strcat(crossType, " * ");
+ strcat(crossType, rop);
+
+ return crossType;
+}
+
+static char* OC_mkValueCtr(char* ctrName, char* types)
+{
+ size_t length = strlen(ctrName) + strlen(types) + 10;
+ char* ctr = UTIL_mallocStr(length);
+
+ strcpy(ctr, ctrName);
+ strcat(ctr, " of ");
+ strcat(ctr, types);
+ return ctr;
+}
+
+static char* OC_mkDisjValueCtrs(char* prev, char* next)
+{
+ size_t length = strlen(prev) + strlen(next) + 10;
+ char* ctr = UTIL_mallocStr(length);
+
+ strcpy(ctr, prev);
+ strcat(ctr, "\n");
+ strcat(ctr, INDENT);
+ strcat(ctr, "| ");
+ strcat(ctr, next);
+
+ return ctr;
+}
+
+static char* OC_mkFuncSeq(char* prev, char* new)
+{
+ size_t length = strlen(prev) + strlen(new) + 20;
+ char* funcSeq = UTIL_mallocStr(length);
+
+ strcpy(funcSeq, prev);
+ strcat(funcSeq, "; ");
+ strcat(funcSeq, new);
+ return funcSeq;
+}
+
+static char* OC_mkArgList(char* prev, char* new)
+{
+ size_t length = strlen(prev) + strlen(new) + 2;
+ char* args = UTIL_mallocStr(length);
+
+ strcpy(args, prev);
+ strcat(args, ", ");
+ strcat(args, new);
+
+ return args;
+}
+
+static char* OC_mkStrConcat(char* prev, char* new)
+{
+ size_t length = strlen(prev) + strlen(new) + 20;
+ char* str = UTIL_mallocStr(length);
+
+ strcpy(str, "(");
+ strcat(str, prev);
+ strcat(str, ") ^ \", \" ^ (");
+ strcat(str, new);
+ strcat(str, ")");
+
+ return str;
+}
+
+
+static char* OC_mkArrow(char* left, char* right)
+{
+ size_t length = strlen(left) + strlen(right) + 20;
+ char* arrow = UTIL_mallocStr(length);
+
+ strcpy(arrow, left);
+ strcat(arrow, " -> ");
+ strcat(arrow, right);
+
+ return arrow;
+}
+
+static char* OC_mkStructure(char* func, char* arg)
+{
+ size_t length = strlen(func) + strlen(arg) + 5;
+ char* app = UTIL_mallocStr(length);
+
+ strcpy(app, func);
+ strcat(app, "(");
+ strcat(app, arg);
+ strcat(app, ")");
+
+ return app;
+}
+
+static char* OC_mkCond(char* cond, char* branch)
+{
+ size_t length = strlen(cond) + strlen(branch) + 20;
+ char* str = UTIL_mallocStr(length);
+
+ strcpy(str, INDENT);
+ strcat(str, "if ");
+ strcat(str, cond);
+ strcat(str, " then ");
+ strcat(str, branch);
+ strcat(str, "\n");
+ strcat(str, INDENT);
+ strcat(str, "else");
+
+ return str;
+}
+
+static char* OC_mkLetIn(char* varName, char* def)
+{
+ size_t length = strlen(varName) + strlen(def) + 20;
+ char* str = UTIL_mallocStr(length);
+
+ strcpy(str, INDENT);
+ strcat(str, "let ");
+ strcat(str, varName);
+ strcat(str, " = ");
+ strcat(str, def);
+ strcat(str, " in\n");
+
+ return str;
+}
+
+/**************************************************************************/
+/* type definitions */
+/**************************************************************************/
+static char* typeDefs;
+
+void ocgenInclude(char* include)
+{
+ typeDefs = include;
+}
+
+/**************************************************************************/
+/* operand types */
+/**************************************************************************/
+static char* opTypes;
+static char* opSizesMLI;
+static char* opSizesML;
+static char* writeFuncs;
+static char* readFuncs;
+
+static char* ocgenWriteOpFunc(char* typeName, char* compType, int numBytes)
+{
+ char* funcName = UTIL_appendStr(WRITE_PREFIX, typeName);
+ char* numBytesText = UTIL_itoa(numBytes);
+ char* arg = "arg";
+ char* funcBody1 = UTIL_mallocStr(strlen(WRITE) + strlen(compType) +
+ strlen(numBytesText));
+ char *funcBody2, *func;
+
+ strcpy(funcBody1, WRITE);
+ strcat(funcBody1, compType);
+ strcat(funcBody1, numBytesText); free(numBytesText);
+
+ funcBody2 = UTIL_appendStr(funcBody1, " arg"); free(funcBody1);
+ func = OC_mkFunc(funcName, arg, funcBody2);
+ free(funcName); free(funcBody2);
+ return func;
+}
+
+static char* ocgenReadOpFunc(char* typeName, char* compType, int numBytes)
+{
+ char* funcName = UTIL_appendStr(READ_PREFIX, typeName);
+ char* numBytesText = UTIL_itoa(numBytes);
+ char* arg = "()";
+ char* funcBody1 = UTIL_mallocStr(strlen(READ) + strlen(compType) +
+ strlen(numBytesText));
+ char* funcBody2, *func;
+
+ strcpy(funcBody1, READ);
+ strcat(funcBody1, compType);
+ strcat(funcBody1, numBytesText); free(numBytesText);
+
+ funcBody2 = UTIL_appendStr(funcBody1, " ()"); free(funcBody1);
+ func = OC_mkFunc(funcName, arg, funcBody2);
+ free(funcName); free(funcBody2);
+ return func;
+}
+
+void ocgenOpType(char* typeName, int numBytes, char* compType)
+{
+ /* generate type declarations*/
+ char* myName = UTIL_lowerCase(typeName);
+ char* myTypeName = UTIL_appendStr(myName, TYPE_SUFFIX);
+ char* myOpType = OC_mkTypeDec(myTypeName, compType);
+ char* myopTypes = addStr(opTypes, myOpType);
+ /* generate write functions */
+ char* func = ocgenWriteOpFunc(typeName, compType, numBytes);
+ char* myWriteFuncs = addStr(writeFuncs, func);
+ /* generate read functions */
+ char* readFunc = ocgenReadOpFunc(typeName, compType, numBytes);
+ char* myReadFuncs = addStr(readFuncs, readFunc);
+
+ /* generate sizes */
+ if (numBytes < 4) {
+ char* mySizeName = UTIL_appendStr(myName, SIZE_SUFFIX);
+ char* myOpSizeMLI = OC_mkVarDec(mySizeName, "int");
+ char* size = UTIL_itoa((int)(0 /*pow(2,(numBytes * 8))-1*/));
+ char* myOpSizeML = OC_mkVarDef(mySizeName, size);
+ char* myopSizesMLI = addStr(opSizesMLI, myOpSizeMLI);
+ char* myopSizesML = addStr(opSizesML, myOpSizeML);
+
+ free(mySizeName); free(size); free(myOpSizeMLI); free(myOpSizeML);
+ free(opSizesMLI); free(opSizesML);
+ opSizesMLI = myopSizesMLI;
+ opSizesML = myopSizesML;
+ }
+ free(myTypeName); free(myName);
+ free(opTypes); free(myOpType);
+ opTypes = myopTypes;
+ free(writeFuncs); free(func);
+ writeFuncs = myWriteFuncs;
+ free(readFuncs); free(readFunc);
+ readFuncs = myReadFuncs;
+}
+
+void ocgenOpCodeType(int numBytes)
+{
+ char* mySizeName = UTIL_appendStr("opcode", SIZE_SUFFIX);
+ char* size = UTIL_itoa((int)(0 /*pow(2,(numBytes * 8))-1*/));
+ char* myOpCodeSizeMLI = OC_mkVarDec(mySizeName, "int");
+ char* myOpCodeSizeML = OC_mkVarDef(mySizeName, size);
+ char* myopSizeMLI = addLine(opSizesMLI, myOpCodeSizeMLI);
+ char* myopSizeML = addLine(opSizesML, myOpCodeSizeML);
+ char* func = ocgenWriteOpFunc("opcode", "int", numBytes);
+ char* myWriteFuncs = addLine(writeFuncs, func);
+ char* readFunc = ocgenReadOpFunc("opcode", "int", numBytes);
+ char* myReadFuncs = addLine(readFuncs, readFunc);
+
+ free(size); free(mySizeName);
+ free(opSizesMLI); free(myOpCodeSizeMLI);
+ free(opSizesML); free(myOpCodeSizeML);
+ free(writeFuncs); free(func);
+ free(readFuncs); free(readFunc);
+ opSizesMLI = myopSizeMLI;
+ opSizesML = myopSizeML;
+ writeFuncs = myWriteFuncs;
+ readFuncs = myReadFuncs;
+}
+
+static char* opMLI;
+static char* opML;
+
+void ocgenOps()
+{
+ char* wordSizeName = "wordSize";
+ char* wordSizeMLI = OC_mkVarDec(wordSizeName, "int");
+ char* wordSize = UTIL_itoa(sizeof(void*));
+ char* wordSizeML = OC_mkVarDef(wordSizeName, wordSize);
+ char* text;
+
+ free(wordSize);
+ opMLI = addLine(opMLI, wordSizeMLI); free(wordSizeMLI);
+ text = addLine(opMLI, opSizesMLI); free(opMLI); free(opSizesMLI);
+ opMLI = addLine(text, opTypes); free(text);
+
+ opML = addLine(opML, wordSizeML); free(wordSizeML);
+ text = addLine(opML, opSizesML); free(opML); free(opSizesML);
+ opML = addLine(text, writeFuncs); free(text); free(writeFuncs);
+ text = addLine(opML, readFuncs); free(opML); free(readFuncs);
+ opML = addLine(text, opTypes); free(text); free(opTypes);
+}
+
+/****************************************************************************/
+/* instruction categories */
+/****************************************************************************/
+static char* instrCatWriteFunc = NULL;
+static char* instrCatReadFunc = NULL;
+static char* instrCatDisplayFunc = NULL;
+static char* instrCatType = NULL;
+static int argInd = 1;
+static char* argList = NULL;
+
+void ocgenInstrFormat(char* opName)
+{
+ char *myop, *myOpName, *myFuncName, *myArgInd, *myFuncCall, *myArg,
+ *myArgList, *myinstrCatType, *myinstrCatWriteFunc, *myReadBody,
+ *myinstrCatReadFunc, * myinstrCatDisplayFunc;
+
+ if (strcmp(opName, "P") == 0 || strcmp(opName, "WP") == 0 ||
+ strcmp(opName, "X") == 0) return;
+
+ //type declaration
+ myop = UTIL_lowerCase(opName);
+ myOpName = UTIL_appendStr(myop, TYPE_SUFFIX); free(myop);
+ if (instrCatType) {
+ myinstrCatType = OC_mkCrossType(instrCatType, myOpName);
+ free(instrCatType); free(myOpName);
+ instrCatType = myinstrCatType;
+ } else instrCatType = myOpName;
+
+ //argument
+ myArgInd = UTIL_itoa(argInd);
+ argInd++;
+ myArg = UTIL_appendStr("arg", myArgInd); free(myArgInd);
+ //argument list
+ if (argList) {
+ myArgList = OC_mkArgList(argList, myArg); free(argList);
+ argList = myArgList;
+ } else argList = myArg;
+
+ //write function
+ myFuncName = UTIL_appendStr(WRITE_PREFIX, opName);
+ myFuncCall = UTIL_mallocStr(strlen(myFuncName) + strlen(myArg) + 5);
+ strcpy(myFuncCall, myFuncName); free(myFuncName);
+ strcat(myFuncCall, " ");
+ strcat(myFuncCall, myArg);
+ if (instrCatWriteFunc) {
+ myinstrCatWriteFunc = OC_mkFuncSeq(instrCatWriteFunc, myFuncCall);
+ free(instrCatWriteFunc);
+ instrCatWriteFunc = myinstrCatWriteFunc;
+ free(myFuncCall);
+ } else instrCatWriteFunc = myFuncCall;
+
+ //read function
+ myFuncName = UTIL_appendStr(READ_PREFIX, opName);
+ myFuncCall = UTIL_mallocStr(strlen(myFuncName) + 5);
+ strcpy(myFuncCall, myFuncName); free(myFuncName);
+ strcat(myFuncCall, " ()");
+ myReadBody = OC_mkLetIn(myArg, myFuncCall); free(myFuncCall);
+ if (instrCatReadFunc) {
+ myinstrCatReadFunc = UTIL_appendStr(instrCatReadFunc, myReadBody);
+ free(instrCatReadFunc);
+ instrCatReadFunc = myinstrCatReadFunc;
+ free(myReadBody);
+ } else instrCatReadFunc = myReadBody;
+
+ //display function
+ myFuncName = UTIL_appendStr(DISPLAY, opName);
+ myFuncCall = UTIL_mallocStr(strlen(myFuncName) + strlen(myArg) + 5);
+ strcpy(myFuncCall, myFuncName); free(myFuncName);
+ strcat(myFuncCall, " ");
+ strcat(myFuncCall, myArg);
+ if (instrCatDisplayFunc) {
+ myinstrCatDisplayFunc = OC_mkStrConcat(instrCatDisplayFunc, myFuncCall);
+ free(instrCatDisplayFunc);
+ instrCatDisplayFunc = myinstrCatDisplayFunc;
+ free(myFuncCall);
+ } else instrCatDisplayFunc = myFuncCall;
+}
+
+static char* instrCatTypes;
+static char* instrCatWriteFuncs;
+static char* instrCatReadFuncs;
+static char* instrCatDisplayFuncs;
+
+
+void ocgenOneInstrCat(char* catName)
+{
+ char *myCatName, *myInstrCatType, *myInstrCatTypes, *myArgs,
+ *myWriteFuncName, *myWriteFunc, *myInstrCatWriteFuncs,
+ *myReadFuncName, *myReadFunc, *myReadFuncBody, *myInstrCatReadFuncs,
+ *myDisplayFuncName, *myDisplayFunc, *myInstrCatDisplayFuncs, *myArgs2, *temp;
+
+ if (instrCatType) {
+ myCatName = UTIL_appendStr(INSCAT_PREFIX, catName);
+ myInstrCatType = OC_mkTypeDec(myCatName, instrCatType);
+ myInstrCatTypes = addStr(instrCatTypes, myInstrCatType);
+
+ myArgs = UTIL_mallocStr(strlen(argList) + 5);
+ strcpy(myArgs, "(");
+ strcat(myArgs, argList);
+ strcat(myArgs, ")");
+
+ /* write function */
+ myWriteFuncName = UTIL_appendStr(WRITE_PREFIX, catName);
+ myWriteFunc = OC_mkFunc(myWriteFuncName, myArgs, instrCatWriteFunc);
+ myInstrCatWriteFuncs = addStr(instrCatWriteFuncs, myWriteFunc);
+
+ /* read function */
+ myReadFuncName = UTIL_appendStr(READ_PREFIX, catName);
+ myArgs2 = UTIL_appendStr(INDENT, myArgs);
+ temp = UTIL_appendStr(instrCatReadFunc, myArgs2); free(myArgs2);
+ myReadFuncBody= UTIL_appendStr("\n", temp); free(temp);
+ myReadFunc = OC_mkFunc(myReadFuncName, "()", myReadFuncBody);
+ myInstrCatReadFuncs = addStr(instrCatReadFuncs, myReadFunc);
+
+ /* display function */
+ myDisplayFuncName = UTIL_appendStr(DISPLAY_PREFIX, catName);
+ myDisplayFunc = OC_mkFunc(myDisplayFuncName, myArgs, instrCatDisplayFunc);
+ myInstrCatDisplayFuncs = addStr(instrCatDisplayFuncs, myDisplayFunc);
+
+
+ free(myCatName); free(myInstrCatType);
+ free(instrCatType); free(instrCatTypes);
+ free(myWriteFuncName); free(myWriteFunc);
+ free(instrCatWriteFunc); free(instrCatWriteFuncs);
+ free(myReadFuncName); free(myReadFunc);
+ free(instrCatReadFunc); free(instrCatReadFuncs);
+ free(myDisplayFuncName); free(myDisplayFunc);
+ free(instrCatDisplayFunc); free(instrCatDisplayFuncs);
+ free(argList);
+
+ argList = NULL; argInd = 1;
+ instrCatType = NULL;
+ instrCatWriteFunc = NULL; instrCatReadFunc = NULL;
+ instrCatDisplayFunc = NULL;
+ instrCatTypes = myInstrCatTypes;
+ instrCatWriteFuncs = myInstrCatWriteFuncs;
+ instrCatReadFuncs = myInstrCatReadFuncs;
+ instrCatDisplayFuncs = myInstrCatDisplayFuncs;
+ }
+}
+
+static char* instrCatLength;
+void ocgenInstrLength(char* varName, char* numBytes)
+{
+ char* myVarName = UTIL_appendStr(INSCAT_PREFIX, varName);
+ char* varDef = OC_mkVarDef(myVarName, numBytes);
+ char* myInstrCatLength = addStr(instrCatLength, varDef);
+
+ free(myVarName); free(varDef); free(instrCatLength);
+ instrCatLength = myInstrCatLength;
+}
+
+static char* instrCatMLI;
+static char* instrCatML;
+
+void ocgenInstrCat()
+{
+ char* text = instrCatTypes;
+ char* text2 = addLine(text, "\n");
+
+ instrCatMLI = text;
+
+ text = addLine(text2, instrCatWriteFuncs);
+ free(instrCatWriteFuncs); free(text2);
+
+ text2 = addLine(text, instrCatReadFuncs);
+ free(instrCatReadFuncs); free(text);
+
+ text = addLine(text2, instrCatDisplayFuncs);
+ free(instrCatDisplayFuncs); free(text2);
+
+ instrCatML = addLine(text, instrCatLength);
+ free(text); free(instrCatLength);
+}
+
+/****************************************************************************/
+/* instructions */
+/****************************************************************************/
+#define GETSIZE_PREFIX "getSize_"
+#define WRITEOPCODE "writeopcode "
+
+static char* instructionTypes;
+static char* insWriteFuncBody;
+static char* insReadFuncBody;
+static char* insDisplayFuncBody;
+static char* insSizesDec;
+static char* insSizesDef;
+
+static void ocgenReadFuncBody(char* opcode, char* myInsName, char* myInsLength, char* insCat,
+ int last)
+{
+ char *ins, *readArgs, *returnValue, *myReadFuncBody, *mycond, *tmp;
+
+ if (strcmp(insCat, "X") == 0) ins = myInsName;
+ else {
+ readArgs = UTIL_appendStr(READ_PREFIX, insCat);
+ ins = UTIL_mallocStr(strlen(readArgs) + strlen(myInsName) + 10);
+ strcpy(ins, myInsName);
+ strcat(ins, " (");
+ strcat(ins, readArgs);
+ strcat(ins, " ())");
+ free(readArgs);
+ }
+ returnValue = UTIL_mallocStr(strlen(ins) + strlen(myInsLength) + 5);
+ strcpy(returnValue, "(");
+ strcat(returnValue, ins);
+ strcat(returnValue, ", ");
+ strcat(returnValue, myInsLength);
+ strcat(returnValue, ")");
+
+ if (last) {
+ tmp = UTIL_appendStr(" ", returnValue); free(returnValue);
+ }else {
+ mycond = UTIL_mallocStr(strlen(opcode) + 10);
+ strcpy(mycond, "opcode = ");
+ strcat(mycond, opcode);
+ tmp = OC_mkCond(mycond, returnValue);
+ free(mycond); free(returnValue);
+ }
+
+ if (insReadFuncBody) {
+ myReadFuncBody = UTIL_appendStr(insReadFuncBody, tmp);
+ free(insReadFuncBody); free(tmp);
+ insReadFuncBody = myReadFuncBody;
+ } else insReadFuncBody = tmp;
+
+}
+
+static char* OC_mkWS(int size)
+{
+ int i;
+ char* text;
+
+ if (size > 0) {
+ text = UTIL_mallocStr(size);
+ for (i = 0; i < size; i++) text[i]= ' ';
+ text[size] = '\0';
+ } else text = strdup(" ");
+
+ return text;
+}
+
+static void ocgenDisplayFuncBody(char* pattern, char* insName, char* insLength,
+ char* insCat)
+{
+ char *displayargs, *funcBody, *myInsName, *ins, *returnValue, *insText,
+ *myDisplayFuncBody;
+
+ myInsName = UTIL_appendStr(insName, OC_mkWS(25u - strlen(insName)));
+ insText = UTIL_mallocStr(strlen(myInsName) + 5);
+ strcpy(insText, "\"");
+ strcat(insText, myInsName); free(myInsName);
+ strcat(insText, "\"");
+
+
+ if (strcmp(insCat, "X") == 0) ins = insText;
+ else {
+ displayargs = UTIL_appendStr(DISPLAY_PREFIX, insCat);
+ ins = UTIL_mallocStr(strlen(displayargs) + strlen(insText) + 10);
+ strcpy(ins, insText);
+ strcat(ins, "^ (");
+ strcat(ins, displayargs);
+ strcat(ins, " arg)");
+ free(displayargs); free(insText);
+ }
+
+ returnValue = UTIL_mallocStr(strlen(ins) + strlen(insLength) + 5);
+ strcpy(returnValue, "(");
+ strcat(returnValue, ins);
+ strcat(returnValue, ", ");
+ strcat(returnValue, insLength);
+ strcat(returnValue, ")");
+
+ funcBody = OC_mkArrow(pattern, returnValue);
+ free(returnValue);
+
+ if (insDisplayFuncBody) {
+ myDisplayFuncBody = OC_mkDisjValueCtrs(insDisplayFuncBody, funcBody);
+ free(insDisplayFuncBody); free(funcBody);
+ insDisplayFuncBody = myDisplayFuncBody;
+ } else {
+ insDisplayFuncBody = UTIL_appendStr(INDENT2, funcBody);
+ free(funcBody);
+ }
+}
+
+
+void ocgenOneInstr(char* opcode, char* insName, char* insCat, char* insLength,
+ int last)
+{
+ char *myCatName, *myInsName, *myValueCtr, *myInstrTypes;
+ char *myInsSizeName, *myInsLength, *mySizeDef, *mySizeDec, *mySizeDefs,
+ *mySizeDecs;
+ char *myPattern, *myWriteOpCodeFunc, *myfuncBody, *myFunc, *myInsWriteFuncBody;
+
+ /* value constructors for type instruction */
+ myInsName = UTIL_appendStr(INS_PREFIX, insName);
+ if (strcmp(insCat, "X") == 0) {
+ myValueCtr = myInsName;
+ } else {
+ myCatName = UTIL_appendStr(INSCAT_PREFIX, insCat);
+ myValueCtr = OC_mkValueCtr(myInsName, myCatName); free(myCatName);
+ }
+ if (instructionTypes) {
+ myInstrTypes = OC_mkDisjValueCtrs(instructionTypes, myValueCtr);
+ free(instructionTypes);
+ instructionTypes = myInstrTypes;
+ } else instructionTypes = myValueCtr;
+
+ /* write function body */
+ myWriteOpCodeFunc = UTIL_appendStr(WRITEOPCODE, opcode);
+ if (strcmp(insCat, "X") == 0) {
+ myPattern = strdup(myInsName);
+ myfuncBody = myWriteOpCodeFunc;
+ } else {
+ char* myWriteArgsName = UTIL_appendStr(WRITE_PREFIX, insCat);
+ char* myWriteArgs = UTIL_mallocStr(strlen(myWriteArgsName) + 5);
+ myPattern = OC_mkStructure(myInsName, "arg");
+ strcpy(myWriteArgs, myWriteArgsName); free(myWriteArgsName);
+ strcat(myWriteArgs, " arg");
+ myfuncBody = OC_mkFuncSeq(myWriteOpCodeFunc, myWriteArgs);
+ free(myWriteArgs);
+ }
+ myFunc = OC_mkArrow(myPattern, myfuncBody);
+ free(myfuncBody);
+ if (insWriteFuncBody) {
+ myInsWriteFuncBody = OC_mkDisjValueCtrs(insWriteFuncBody, myFunc);
+ free(insWriteFuncBody); free(myFunc);
+ insWriteFuncBody = myInsWriteFuncBody;
+ } else {
+ insWriteFuncBody = UTIL_appendStr(INDENT2, myFunc);
+ free(myFunc);
+ }
+ /* instruction sizes */
+ myInsSizeName = UTIL_appendStr(GETSIZE_PREFIX, insName);
+ myInsLength = UTIL_appendStr(INSCAT_PREFIX, insLength);
+ mySizeDef = OC_mkVarDef(myInsSizeName, myInsLength);
+ mySizeDec = OC_mkVarDec(myInsSizeName, "int"); free(myInsSizeName);
+
+ mySizeDefs = addStr(insSizesDef, mySizeDef);
+ free(insSizesDef); free(mySizeDef);
+ mySizeDecs = addStr(insSizesDec, mySizeDec);
+ free(insSizesDec); free(mySizeDec);
+
+ insSizesDef = mySizeDefs;
+ insSizesDec = mySizeDecs;
+
+ ocgenReadFuncBody(opcode, myInsName, myInsLength, insCat, last);
+ ocgenDisplayFuncBody(myPattern, insName, myInsLength, insCat);
+
+ free(myInsName); free(myInsLength); free(myPattern);
+}
+
+#define INSTRTYPE_HEAD "type instruction = "
+
+#define INSTWRITEFUNC_DEF_HEAD "let writeInstruction inst =\n match inst with\n"
+#define INSTWRITEFUNC_DEC "val writeInstruction : instruction -> unit\n"
+
+#define INSTREADFUNC_DEF_HEAD \
+"let readInstruction getKindFunc getConstantFunc = \n Bytecode.setGetKindFn getKindFunc; \n Bytecode.setGetConstantFn getConstantFunc; \n let opcode = readopcode () in\n"
+
+#define INSTREADFUNC_DEC \
+"val readInstruction : \n(int -> int -> Absyn.akind option) -> (int -> int -> Absyn.aconstant option) ->\n(instruction * int)\n"
+
+#define INSTDISPLAYFUNC_DEF_HEAD \
+"let displayInstruction inst =\n match inst with\n"
+#define INSTDISPLAYFUNC_DEC \
+"val displayInstruction : instruction -> (string * int)\n"
+
+static char* instrMLI;
+static char* instrML;
+
+void ocgenInstr()
+{
+ char* text = UTIL_appendStr(INSTRTYPE_HEAD, instructionTypes);
+ char* text2 = UTIL_appendStr(text, "\n\n");
+
+ free(instructionTypes); free(text);
+
+ text = addLine(text2, insSizesDec); free(insSizesDec);
+ instrMLI = addStr(text, INSTWRITEFUNC_DEC); free(text);
+ text = addStr(instrMLI, INSTREADFUNC_DEC); free(instrMLI);
+ instrMLI = addStr(text, INSTDISPLAYFUNC_DEC); free(text);
+
+ text = addLine(text2, insSizesDef); free(text2); free(insSizesDef);
+ text2 = addStr(text, INSTWRITEFUNC_DEF_HEAD); free(text);
+ instrML = addStr(text2, insWriteFuncBody);
+ free(text2); free(insWriteFuncBody);
+ text = addStr(instrML, "\n\n"); free(instrML);
+ text2 = addStr(text, INSTREADFUNC_DEF_HEAD); free(text);
+ instrML = addStr(text2, insReadFuncBody);
+ free(text2); free(insReadFuncBody);
+ text = addStr(instrML, "\n\n"); free(instrML);
+ text2 = addStr(text, INSTDISPLAYFUNC_DEF_HEAD); free(text);
+ instrML = addStr(text2, insDisplayFuncBody);
+ free(text2); free(insDisplayFuncBody);
+}
+
+/****************************************************************************/
+/* dump files */
+/****************************************************************************/
+/* dump files */
+void ocSpitInstructionMLI(char * root)
+{
+ FILE* outFile;
+
+ char * filename = malloc(strlen(root) + 32);
+ strcpy(filename, root);
+ strcat(filename, "compiler/instr.mli");
+
+ outFile = UTIL_fopenW(filename);
+ fprintf(outFile, typeDefs);
+ fprintf(outFile, opMLI); free(opMLI);
+ fprintf(outFile, instrCatMLI); free(instrCatMLI);
+ fprintf(outFile, "\n\n");
+ fprintf(outFile, instrMLI); free(instrMLI);
+ UTIL_fclose(outFile);
+ free(filename);
+}
+
+/* dump files */
+void ocSpitInstructionML(char * root)
+{
+ FILE* outFile;
+
+ char * filename = malloc(strlen(root) + 32);
+ strcpy(filename, root);
+ strcat(filename, "compiler/instr.ml");
+
+ outFile = UTIL_fopenW(filename);
+ fprintf(outFile, typeDefs); free(typeDefs);
+ fprintf(outFile, opML); free(opML);
+ fprintf(outFile, instrCatML); free(instrCatML);
+ fprintf(outFile, instrML); free(instrML);
+ UTIL_fclose(outFile);
+
+ free(filename);
+}
+
diff --git a/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-ocaml.h b/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-ocaml.h
new file mode 100644
index 000000000..58cdd02b7
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-ocaml.h
@@ -0,0 +1,47 @@
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+/*************************************************************************/
+/* functions for generating ocaml instr.mli and instr.ml */
+/*************************************************************************/
+/* include */
+void ocgenInclude(char* include);
+
+/* operand types */
+void ocgenOpType(char* typeName, int numBytes, char* compType);
+void ocgenOpCodeType(int numBytes);
+void ocgenOps();
+
+/* instruction category */
+void ocgenInstrFormat(char* opName);
+void ocgenOneInstrCat(char* catName);
+void ocgenInstrLength(char* varName, char* numBytes);
+void ocgenInstrCat();
+
+/* instructions */
+void ocgenOneInstr(char* opcode, char* insName, char* insCat, char* insLength,
+ int last);
+void ocgenInstr();
+
+
+/* dump files */
+void ocSpitInstructionMLI(char * root);
+void ocSpitInstructionML(char * root);
+
diff --git a/src/runtime/c/teyjus/tables_gen/instrformats/lex.yy.c b/src/runtime/c/teyjus/tables_gen/instrformats/lex.yy.c
new file mode 100644
index 000000000..d8be9c390
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/instrformats/lex.yy.c
@@ -0,0 +1,1977 @@
+#line 2 "instrformats/lex.yy.c"
+
+#line 4 "instrformats/lex.yy.c"
+
+#define YY_INT_ALIGNED short int
+
+/* A lexical scanner generated by flex */
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 5
+#define YY_FLEX_SUBMINOR_VERSION 35
+#if YY_FLEX_SUBMINOR_VERSION > 0
+#define FLEX_BETA
+#endif
+
+/* First, we deal with platform-specific or compiler-specific issues. */
+
+/* begin standard C headers. */
+#include
+#include
+#include
+#include
+
+/* end standard C headers. */
+
+/* flex integer type definitions */
+
+#ifndef FLEXINT_H
+#define FLEXINT_H
+
+/* C99 systems have . Non-C99 systems may or may not. */
+
+#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
+
+/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h,
+ * if you want the limit (max/min) macros for int types.
+ */
+#ifndef __STDC_LIMIT_MACROS
+#define __STDC_LIMIT_MACROS 1
+#endif
+
+#include
+typedef int8_t flex_int8_t;
+typedef uint8_t flex_uint8_t;
+typedef int16_t flex_int16_t;
+typedef uint16_t flex_uint16_t;
+typedef int32_t flex_int32_t;
+typedef uint32_t flex_uint32_t;
+#else
+typedef signed char flex_int8_t;
+typedef short int flex_int16_t;
+typedef int flex_int32_t;
+typedef unsigned char flex_uint8_t;
+typedef unsigned short int flex_uint16_t;
+typedef unsigned int flex_uint32_t;
+
+/* Limits of integral types. */
+#ifndef INT8_MIN
+#define INT8_MIN (-128)
+#endif
+#ifndef INT16_MIN
+#define INT16_MIN (-32767-1)
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN (-2147483647-1)
+#endif
+#ifndef INT8_MAX
+#define INT8_MAX (127)
+#endif
+#ifndef INT16_MAX
+#define INT16_MAX (32767)
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX (2147483647)
+#endif
+#ifndef UINT8_MAX
+#define UINT8_MAX (255U)
+#endif
+#ifndef UINT16_MAX
+#define UINT16_MAX (65535U)
+#endif
+#ifndef UINT32_MAX
+#define UINT32_MAX (4294967295U)
+#endif
+
+#endif /* ! C99 */
+
+#endif /* ! FLEXINT_H */
+
+#ifdef __cplusplus
+
+/* The "const" storage-class-modifier is valid. */
+#define YY_USE_CONST
+
+#else /* ! __cplusplus */
+
+/* C99 requires __STDC__ to be defined as 1. */
+#if defined (__STDC__)
+
+#define YY_USE_CONST
+
+#endif /* defined (__STDC__) */
+#endif /* ! __cplusplus */
+
+#ifdef YY_USE_CONST
+#define yyconst const
+#else
+#define yyconst
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index. If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+/* Enter a start condition. This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN (yy_start) = 1 + 2 *
+
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state. The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START (((yy_start) - 1) / 2)
+#define YYSTATE YY_START
+
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE yyrestart(yyin )
+
+#define YY_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#ifndef YY_BUF_SIZE
+#ifdef __ia64__
+/* On IA-64, the buffer size is 16k, not 8k.
+ * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case.
+ * Ditto for the __ia64__ case accordingly.
+ */
+#define YY_BUF_SIZE 32768
+#else
+#define YY_BUF_SIZE 16384
+#endif /* __ia64__ */
+#endif
+
+/* The state buf must be large enough to hold one state per character in the main buffer.
+ */
+#define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type))
+
+#ifndef YY_TYPEDEF_YY_BUFFER_STATE
+#define YY_TYPEDEF_YY_BUFFER_STATE
+typedef struct yy_buffer_state *YY_BUFFER_STATE;
+#endif
+
+extern int yyleng;
+
+extern FILE *yyin, *yyout;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+ #define YY_LESS_LINENO(n)
+
+/* Return all but the first "n" matched characters back to the input stream. */
+#define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ int yyless_macro_arg = (n); \
+ YY_LESS_LINENO(yyless_macro_arg);\
+ *yy_cp = (yy_hold_char); \
+ YY_RESTORE_YY_MORE_OFFSET \
+ (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
+ YY_DO_BEFORE_ACTION; /* set up yytext again */ \
+ } \
+ while ( 0 )
+
+#define unput(c) yyunput( c, (yytext_ptr) )
+
+#ifndef YY_TYPEDEF_YY_SIZE_T
+#define YY_TYPEDEF_YY_SIZE_T
+typedef size_t yy_size_t;
+#endif
+
+#ifndef YY_STRUCT_YY_BUFFER_STATE
+#define YY_STRUCT_YY_BUFFER_STATE
+struct yy_buffer_state
+ {
+ FILE *yy_input_file;
+
+ char *yy_ch_buf; /* input buffer */
+ char *yy_buf_pos; /* current position in input buffer */
+
+ /* Size of input buffer in bytes, not including room for EOB
+ * characters.
+ */
+ yy_size_t yy_buf_size;
+
+ /* Number of characters read into yy_ch_buf, not including EOB
+ * characters.
+ */
+ int yy_n_chars;
+
+ /* Whether we "own" the buffer - i.e., we know we created it,
+ * and can realloc() it to grow it, and should free() it to
+ * delete it.
+ */
+ int yy_is_our_buffer;
+
+ /* Whether this is an "interactive" input source; if so, and
+ * if we're using stdio for input, then we want to use getc()
+ * instead of fread(), to make sure we stop fetching input after
+ * each newline.
+ */
+ int yy_is_interactive;
+
+ /* Whether we're considered to be at the beginning of a line.
+ * If so, '^' rules will be active on the next match, otherwise
+ * not.
+ */
+ int yy_at_bol;
+
+ int yy_bs_lineno; /**< The line count. */
+ int yy_bs_column; /**< The column count. */
+
+ /* Whether to try to fill the input buffer when we reach the
+ * end of it.
+ */
+ int yy_fill_buffer;
+
+ int yy_buffer_status;
+
+#define YY_BUFFER_NEW 0
+#define YY_BUFFER_NORMAL 1
+ /* When an EOF's been seen but there's still some text to process
+ * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+ * shouldn't try reading from the input source any more. We might
+ * still have a bunch of tokens to match, though, because of
+ * possible backing-up.
+ *
+ * When we actually see the EOF, we change the status to "new"
+ * (via yyrestart()), so that the user can continue scanning by
+ * just pointing yyin at a new input file.
+ */
+#define YY_BUFFER_EOF_PENDING 2
+
+ };
+#endif /* !YY_STRUCT_YY_BUFFER_STATE */
+
+/* Stack of input buffers. */
+static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
+static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
+static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ *
+ * Returns the top of the stack, or NULL.
+ */
+#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
+ ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
+ : NULL)
+
+/* Same as previous macro, but useful when we know that the buffer stack is not
+ * NULL or when we need an lvalue. For internal use only.
+ */
+#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
+
+/* yy_hold_char holds the character lost when yytext is formed. */
+static char yy_hold_char;
+static int yy_n_chars; /* number of characters read into yy_ch_buf */
+int yyleng;
+
+/* Points to current character in buffer. */
+static char *yy_c_buf_p = (char *) 0;
+static int yy_init = 0; /* whether we need to initialize */
+static int yy_start = 0; /* start state number */
+
+/* Flag which is used to allow yywrap()'s to do buffer switches
+ * instead of setting up a fresh yyin. A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void yyrestart (FILE *input_file );
+void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer );
+YY_BUFFER_STATE yy_create_buffer (FILE *file,int size );
+void yy_delete_buffer (YY_BUFFER_STATE b );
+void yy_flush_buffer (YY_BUFFER_STATE b );
+void yypush_buffer_state (YY_BUFFER_STATE new_buffer );
+void yypop_buffer_state (void );
+
+static void yyensure_buffer_stack (void );
+static void yy_load_buffer_state (void );
+static void yy_init_buffer (YY_BUFFER_STATE b,FILE *file );
+
+#define YY_FLUSH_BUFFER yy_flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE yy_scan_buffer (char *base,yy_size_t size );
+YY_BUFFER_STATE yy_scan_string (yyconst char *yy_str );
+YY_BUFFER_STATE yy_scan_bytes (yyconst char *bytes,int len );
+
+void *yyalloc (yy_size_t );
+void *yyrealloc (void *,yy_size_t );
+void yyfree (void * );
+
+#define yy_new_buffer yy_create_buffer
+
+#define yy_set_interactive(is_interactive) \
+ { \
+ if ( ! YY_CURRENT_BUFFER ){ \
+ yyensure_buffer_stack (); \
+ YY_CURRENT_BUFFER_LVALUE = \
+ yy_create_buffer(yyin,YY_BUF_SIZE ); \
+ } \
+ YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
+ }
+
+#define yy_set_bol(at_bol) \
+ { \
+ if ( ! YY_CURRENT_BUFFER ){\
+ yyensure_buffer_stack (); \
+ YY_CURRENT_BUFFER_LVALUE = \
+ yy_create_buffer(yyin,YY_BUF_SIZE ); \
+ } \
+ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
+ }
+
+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
+
+typedef unsigned char YY_CHAR;
+
+FILE *yyin = (FILE *) 0, *yyout = (FILE *) 0;
+
+typedef int yy_state_type;
+
+extern int yylineno;
+
+int yylineno = 1;
+
+extern char *yytext;
+#define yytext_ptr yytext
+
+static yy_state_type yy_get_previous_state (void );
+static yy_state_type yy_try_NUL_trans (yy_state_type current_state );
+static int yy_get_next_buffer (void );
+static void yy_fatal_error (yyconst char msg[] );
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up yytext.
+ */
+#define YY_DO_BEFORE_ACTION \
+ (yytext_ptr) = yy_bp; \
+ yyleng = (size_t) (yy_cp - yy_bp); \
+ (yy_hold_char) = *yy_cp; \
+ *yy_cp = '\0'; \
+ (yy_c_buf_p) = yy_cp;
+
+#define YY_NUM_RULES 25
+#define YY_END_OF_BUFFER 26
+/* This struct is not used in this scanner,
+ but its presence is necessary. */
+struct yy_trans_info
+ {
+ flex_int32_t yy_verify;
+ flex_int32_t yy_nxt;
+ };
+static yyconst flex_int16_t yy_accept[103] =
+ { 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 26, 24,
+ 11, 1, 15, 15, 15, 16, 2, 15, 15, 15,
+ 15, 3, 4, 14, 19, 25, 25, 18, 25, 25,
+ 23, 22, 11, 15, 15, 15, 12, 13, 16, 15,
+ 15, 15, 15, 19, 21, 20, 18, 17, 23, 15,
+ 15, 15, 15, 15, 15, 15, 0, 15, 15, 15,
+ 15, 0, 15, 15, 15, 0, 15, 0, 6, 15,
+ 15, 0, 15, 0, 15, 15, 0, 15, 0, 0,
+ 15, 0, 15, 0, 0, 15, 0, 15, 0, 0,
+ 9, 0, 15, 8, 0, 0, 10, 0, 0, 5,
+
+ 7, 0
+ } ;
+
+static yyconst flex_int32_t yy_ec[256] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 2, 3,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 4, 5, 1, 1, 6, 7, 8, 9, 1,
+ 1, 10, 11, 12, 13, 1, 14, 15, 16, 15,
+ 15, 15, 15, 15, 15, 15, 15, 17, 18, 19,
+ 20, 21, 1, 22, 23, 24, 25, 26, 27, 24,
+ 28, 24, 29, 24, 24, 30, 31, 32, 33, 34,
+ 24, 35, 36, 37, 38, 24, 24, 39, 40, 24,
+ 41, 1, 42, 43, 44, 1, 24, 24, 24, 24,
+
+ 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+ 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,
+ 24, 24, 45, 1, 46, 47, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1
+ } ;
+
+static yyconst flex_int32_t yy_meta[48] =
+ { 0,
+ 1, 1, 2, 1, 1, 1, 2, 1, 1, 3,
+ 1, 1, 1, 4, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 5, 1
+ } ;
+
+static yyconst flex_int16_t yy_base[109] =
+ { 0,
+ 0, 0, 45, 46, 40, 41, 146, 145, 190, 193,
+ 54, 193, 56, 0, 91, 89, 193, 166, 156, 164,
+ 152, 193, 193, 193, 0, 171, 177, 0, 169, 193,
+ 0, 193, 104, 0, 0, 0, 0, 0, 94, 152,
+ 145, 141, 86, 0, 193, 193, 0, 193, 0, 149,
+ 141, 173, 143, 140, 130, 138, 139, 145, 147, 140,
+ 93, 134, 140, 134, 149, 139, 138, 135, 0, 135,
+ 111, 131, 113, 113, 126, 99, 91, 98, 103, 88,
+ 97, 96, 89, 89, 80, 87, 90, 85, 90, 81,
+ 0, 81, 76, 193, 80, 67, 0, 38, 17, 193,
+
+ 193, 193, 131, 136, 141, 146, 151, 156
+ } ;
+
+static yyconst flex_int16_t yy_def[109] =
+ { 0,
+ 102, 1, 103, 103, 104, 104, 105, 105, 102, 102,
+ 102, 102, 102, 13, 13, 102, 102, 13, 13, 13,
+ 13, 102, 102, 102, 106, 102, 102, 107, 102, 102,
+ 108, 102, 102, 13, 13, 13, 13, 13, 102, 13,
+ 13, 13, 13, 106, 102, 102, 107, 102, 108, 13,
+ 13, 13, 13, 13, 13, 13, 102, 13, 13, 13,
+ 13, 102, 13, 13, 13, 102, 13, 102, 13, 13,
+ 13, 102, 13, 102, 13, 13, 102, 13, 102, 102,
+ 13, 102, 13, 102, 102, 13, 102, 13, 102, 102,
+ 13, 102, 13, 102, 102, 102, 13, 102, 102, 102,
+
+ 102, 0, 102, 102, 102, 102, 102, 102
+ } ;
+
+static yyconst flex_int16_t yy_nxt[241] =
+ { 0,
+ 10, 11, 12, 11, 13, 13, 13, 13, 13, 14,
+ 13, 13, 13, 15, 16, 16, 13, 17, 13, 13,
+ 13, 13, 13, 13, 18, 13, 13, 13, 19, 13,
+ 20, 13, 21, 13, 13, 13, 13, 13, 13, 13,
+ 22, 23, 13, 13, 24, 10, 13, 12, 12, 29,
+ 29, 26, 26, 30, 30, 33, 101, 33, 27, 27,
+ 34, 34, 34, 34, 34, 35, 34, 34, 34, 34,
+ 36, 36, 34, 100, 34, 34, 34, 34, 36, 36,
+ 36, 36, 36, 36, 36, 36, 36, 36, 36, 36,
+ 36, 36, 36, 36, 36, 36, 66, 37, 34, 34,
+
+ 38, 99, 34, 39, 39, 33, 98, 33, 39, 39,
+ 53, 97, 54, 96, 95, 94, 93, 92, 91, 90,
+ 89, 88, 87, 86, 85, 84, 83, 82, 81, 80,
+ 67, 25, 25, 25, 25, 25, 28, 28, 28, 28,
+ 28, 31, 31, 31, 31, 31, 44, 79, 44, 78,
+ 44, 47, 47, 77, 76, 47, 49, 49, 49, 49,
+ 75, 74, 73, 72, 71, 70, 69, 68, 65, 64,
+ 63, 62, 61, 60, 59, 58, 57, 56, 55, 52,
+ 51, 50, 48, 46, 45, 43, 42, 41, 40, 102,
+ 32, 32, 9, 102, 102, 102, 102, 102, 102, 102,
+
+ 102, 102, 102, 102, 102, 102, 102, 102, 102, 102,
+ 102, 102, 102, 102, 102, 102, 102, 102, 102, 102,
+ 102, 102, 102, 102, 102, 102, 102, 102, 102, 102,
+ 102, 102, 102, 102, 102, 102, 102, 102, 102, 102
+ } ;
+
+static yyconst flex_int16_t yy_chk[241] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 3, 4, 5,
+ 6, 3, 4, 5, 6, 11, 99, 11, 3, 4,
+ 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 98, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,
+ 13, 13, 13, 13, 13, 13, 61, 15, 13, 13,
+
+ 15, 96, 13, 16, 16, 33, 95, 33, 39, 39,
+ 43, 93, 43, 92, 90, 89, 88, 87, 86, 85,
+ 84, 83, 82, 81, 80, 79, 78, 77, 76, 75,
+ 61, 103, 103, 103, 103, 103, 104, 104, 104, 104,
+ 104, 105, 105, 105, 105, 105, 106, 74, 106, 73,
+ 106, 107, 107, 72, 71, 107, 108, 108, 108, 108,
+ 70, 68, 67, 66, 65, 64, 63, 62, 60, 59,
+ 58, 57, 56, 55, 54, 53, 52, 51, 50, 42,
+ 41, 40, 29, 27, 26, 21, 20, 19, 18, 9,
+ 8, 7, 102, 102, 102, 102, 102, 102, 102, 102,
+
+ 102, 102, 102, 102, 102, 102, 102, 102, 102, 102,
+ 102, 102, 102, 102, 102, 102, 102, 102, 102, 102,
+ 102, 102, 102, 102, 102, 102, 102, 102, 102, 102,
+ 102, 102, 102, 102, 102, 102, 102, 102, 102, 102
+ } ;
+
+static yy_state_type yy_last_accepting_state;
+static char *yy_last_accepting_cpos;
+
+extern int yy_flex_debug;
+int yy_flex_debug = 0;
+
+/* The intent behind this definition is that it'll catch
+ * any uses of REJECT which flex missed.
+ */
+#define REJECT reject_used_but_not_detected
+#define yymore() yymore_used_but_not_detected
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET
+char *yytext;
+#line 1 "instrformats/instrformats.l"
+#line 2 "instrformats/instrformats.l"
+//////////////////////////////////////////////////////////////////////////////
+//Copyright 2008
+// Andrew Gacek, Steven Holte, Gopalan Nadathur, Xiaochu Qi, Zach Snow
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+#include "y.tab.h"
+#include
+#include
+
+static int commentLev = 0;
+
+#line 571 "instrformats/lex.yy.c"
+
+#define INITIAL 0
+#define COMMENT 1
+#define COMMENT2 2
+#define INCLUDE 3
+
+#ifndef YY_NO_UNISTD_H
+/* Special case for "unistd.h", since it is non-ANSI. We include it way
+ * down here because we want the user's section 1 to have been scanned first.
+ * The user has a chance to override it with an option.
+ */
+#include
+#endif
+
+#ifndef YY_EXTRA_TYPE
+#define YY_EXTRA_TYPE void *
+#endif
+
+static int yy_init_globals (void );
+
+/* Accessor methods to globals.
+ These are made visible to non-reentrant scanners for convenience. */
+
+int yylex_destroy (void );
+
+int yyget_debug (void );
+
+void yyset_debug (int debug_flag );
+
+YY_EXTRA_TYPE yyget_extra (void );
+
+void yyset_extra (YY_EXTRA_TYPE user_defined );
+
+FILE *yyget_in (void );
+
+void yyset_in (FILE * in_str );
+
+FILE *yyget_out (void );
+
+void yyset_out (FILE * out_str );
+
+int yyget_leng (void );
+
+char *yyget_text (void );
+
+int yyget_lineno (void );
+
+void yyset_lineno (int line_number );
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int yywrap (void );
+#else
+extern int yywrap (void );
+#endif
+#endif
+
+ static void yyunput (int c,char *buf_ptr );
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char *,yyconst char *,int );
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * );
+#endif
+
+#ifndef YY_NO_INPUT
+
+#ifdef __cplusplus
+static int yyinput (void );
+#else
+static int input (void );
+#endif
+
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef YY_READ_BUF_SIZE
+#ifdef __ia64__
+/* On IA-64, the buffer size is 16k, not 8k */
+#define YY_READ_BUF_SIZE 16384
+#else
+#define YY_READ_BUF_SIZE 8192
+#endif /* __ia64__ */
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO do { if (fwrite( yytext, yyleng, 1, yyout )) {} } while (0)
+#endif
+
+/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+#ifndef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
+ { \
+ int c = '*'; \
+ size_t n; \
+ for ( n = 0; n < max_size && \
+ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \
+ buf[n] = (char) c; \
+ if ( c == '\n' ) \
+ buf[n++] = (char) c; \
+ if ( c == EOF && ferror( yyin ) ) \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ result = n; \
+ } \
+ else \
+ { \
+ errno=0; \
+ while ( (result = fread(buf, 1, max_size, yyin))==0 && ferror(yyin)) \
+ { \
+ if( errno != EINTR) \
+ { \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ break; \
+ } \
+ errno=0; \
+ clearerr(yyin); \
+ } \
+ }\
+\
+
+#endif
+
+/* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef yyterminate
+#define yyterminate() return YY_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef YY_START_STACK_INCR
+#define YY_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef YY_FATAL_ERROR
+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+#endif
+
+/* end tables serialization structures and prototypes */
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef YY_DECL
+#define YY_DECL_IS_OURS 1
+
+extern int yylex (void);
+
+#define YY_DECL int yylex (void)
+#endif /* !YY_DECL */
+
+/* Code executed at the beginning of each rule, after yytext and yyleng
+ * have been set up.
+ */
+#ifndef YY_USER_ACTION
+#define YY_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef YY_BREAK
+#define YY_BREAK break;
+#endif
+
+#define YY_RULE_SETUP \
+ YY_USER_ACTION
+
+/** The main scanner function which does all the work.
+ */
+YY_DECL
+{
+ register yy_state_type yy_current_state;
+ register char *yy_cp, *yy_bp;
+ register int yy_act;
+
+#line 41 "instrformats/instrformats.l"
+
+#line 763 "instrformats/lex.yy.c"
+
+ if ( !(yy_init) )
+ {
+ (yy_init) = 1;
+
+#ifdef YY_USER_INIT
+ YY_USER_INIT;
+#endif
+
+ if ( ! (yy_start) )
+ (yy_start) = 1; /* first start state */
+
+ if ( ! yyin )
+ yyin = stdin;
+
+ if ( ! yyout )
+ yyout = stdout;
+
+ if ( ! YY_CURRENT_BUFFER ) {
+ yyensure_buffer_stack ();
+ YY_CURRENT_BUFFER_LVALUE =
+ yy_create_buffer(yyin,YY_BUF_SIZE );
+ }
+
+ yy_load_buffer_state( );
+ }
+
+ while ( 1 ) /* loops until end-of-file is reached */
+ {
+ yy_cp = (yy_c_buf_p);
+
+ /* Support of yytext. */
+ *yy_cp = (yy_hold_char);
+
+ /* yy_bp points to the position in yy_ch_buf of the start of
+ * the current run.
+ */
+ yy_bp = yy_cp;
+
+ yy_current_state = (yy_start);
+yy_match:
+ do
+ {
+ register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
+ if ( yy_accept[yy_current_state] )
+ {
+ (yy_last_accepting_state) = yy_current_state;
+ (yy_last_accepting_cpos) = yy_cp;
+ }
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 103 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ ++yy_cp;
+ }
+ while ( yy_base[yy_current_state] != 193 );
+
+yy_find_action:
+ yy_act = yy_accept[yy_current_state];
+ if ( yy_act == 0 )
+ { /* have to back up */
+ yy_cp = (yy_last_accepting_cpos);
+ yy_current_state = (yy_last_accepting_state);
+ yy_act = yy_accept[yy_current_state];
+ }
+
+ YY_DO_BEFORE_ACTION;
+
+do_action: /* This label is used only to access EOF actions. */
+
+ switch ( yy_act )
+ { /* beginning of action switch */
+ case 0: /* must back up */
+ /* undo the effects of YY_DO_BEFORE_ACTION */
+ *yy_cp = (yy_hold_char);
+ yy_cp = (yy_last_accepting_cpos);
+ yy_current_state = (yy_last_accepting_state);
+ goto yy_find_action;
+
+case 1:
+/* rule 1 can match eol */
+YY_RULE_SETUP
+#line 42 "instrformats/instrformats.l"
+{continue; }
+ YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 43 "instrformats/instrformats.l"
+{return SEMICOLON; }
+ YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 44 "instrformats/instrformats.l"
+{return LBRACKET; }
+ YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 45 "instrformats/instrformats.l"
+{return RBRACKET; }
+ YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 46 "instrformats/instrformats.l"
+{return OPTYPES; }
+ YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 47 "instrformats/instrformats.l"
+{return OPCODE; }
+ YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 48 "instrformats/instrformats.l"
+{return INSTRCAT; }
+ YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 49 "instrformats/instrformats.l"
+{return MAXOPERAND; }
+ YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 50 "instrformats/instrformats.l"
+{return CALL_I1_LEN; }
+ YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 51 "instrformats/instrformats.l"
+{return INSTRUCTIONS; }
+ YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 52 "instrformats/instrformats.l"
+{continue; }
+ YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 53 "instrformats/instrformats.l"
+{commentLev = 1; BEGIN(COMMENT); continue; }
+ YY_BREAK
+case 13:
+YY_RULE_SETUP
+#line 54 "instrformats/instrformats.l"
+{BEGIN(COMMENT2); continue; }
+ YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 55 "instrformats/instrformats.l"
+{BEGIN(INCLUDE); continue; }
+ YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 56 "instrformats/instrformats.l"
+{yylval.name = strdup(yytext); return ID; }
+ YY_BREAK
+case 16:
+YY_RULE_SETUP
+#line 57 "instrformats/instrformats.l"
+{yylval.isval.ival = atoi(yytext);
+ yylval.isval.sval = strdup(yytext);
+ return NUM; }
+ YY_BREAK
+case 17:
+YY_RULE_SETUP
+#line 60 "instrformats/instrformats.l"
+{BEGIN(INITIAL); continue; }
+ YY_BREAK
+case 18:
+/* rule 18 can match eol */
+YY_RULE_SETUP
+#line 61 "instrformats/instrformats.l"
+{yylval.text = strdup(yytext); return STRING; }
+ YY_BREAK
+case 19:
+YY_RULE_SETUP
+#line 63 "instrformats/instrformats.l"
+{continue; }
+ YY_BREAK
+case 20:
+YY_RULE_SETUP
+#line 64 "instrformats/instrformats.l"
+{commentLev++; continue; }
+ YY_BREAK
+case 21:
+YY_RULE_SETUP
+#line 65 "instrformats/instrformats.l"
+{commentLev--;
+ if (!commentLev) BEGIN(INITIAL); continue; }
+ YY_BREAK
+case 22:
+YY_RULE_SETUP
+#line 67 "instrformats/instrformats.l"
+{BEGIN(INITIAL); continue; }
+ YY_BREAK
+case 23:
+/* rule 23 can match eol */
+YY_RULE_SETUP
+#line 68 "instrformats/instrformats.l"
+{yylval.text = strdup(yytext); return STRING2; }
+ YY_BREAK
+case 24:
+YY_RULE_SETUP
+#line 69 "instrformats/instrformats.l"
+{return ERROR; }
+ YY_BREAK
+case 25:
+YY_RULE_SETUP
+#line 70 "instrformats/instrformats.l"
+ECHO;
+ YY_BREAK
+#line 977 "instrformats/lex.yy.c"
+case YY_STATE_EOF(INITIAL):
+case YY_STATE_EOF(COMMENT):
+case YY_STATE_EOF(COMMENT2):
+case YY_STATE_EOF(INCLUDE):
+ yyterminate();
+
+ case YY_END_OF_BUFFER:
+ {
+ /* Amount of text matched not including the EOB char. */
+ int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
+
+ /* Undo the effects of YY_DO_BEFORE_ACTION. */
+ *yy_cp = (yy_hold_char);
+ YY_RESTORE_YY_MORE_OFFSET
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
+ {
+ /* We're scanning a new file or input source. It's
+ * possible that this happened because the user
+ * just pointed yyin at a new source and called
+ * yylex(). If so, then we have to assure
+ * consistency between YY_CURRENT_BUFFER and our
+ * globals. Here is the right place to do so, because
+ * this is the first action (other than possibly a
+ * back-up) that will match for the new input source.
+ */
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+ YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin;
+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
+ }
+
+ /* Note that here we test for yy_c_buf_p "<=" to the position
+ * of the first EOB in the buffer, since yy_c_buf_p will
+ * already have been incremented past the NUL character
+ * (since all states make transitions on EOB to the
+ * end-of-buffer state). Contrast this with the test
+ * in input().
+ */
+ if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+ { /* This was really a NUL. */
+ yy_state_type yy_next_state;
+
+ (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state( );
+
+ /* Okay, we're now positioned to make the NUL
+ * transition. We couldn't have
+ * yy_get_previous_state() go ahead and do it
+ * for us because it doesn't know how to deal
+ * with the possibility of jamming (and we don't
+ * want to build jamming into it because then it
+ * will run more slowly).
+ */
+
+ yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+
+ if ( yy_next_state )
+ {
+ /* Consume the NUL. */
+ yy_cp = ++(yy_c_buf_p);
+ yy_current_state = yy_next_state;
+ goto yy_match;
+ }
+
+ else
+ {
+ yy_cp = (yy_c_buf_p);
+ goto yy_find_action;
+ }
+ }
+
+ else switch ( yy_get_next_buffer( ) )
+ {
+ case EOB_ACT_END_OF_FILE:
+ {
+ (yy_did_buffer_switch_on_eof) = 0;
+
+ if ( yywrap( ) )
+ {
+ /* Note: because we've taken care in
+ * yy_get_next_buffer() to have set up
+ * yytext, we can now set up
+ * yy_c_buf_p so that if some total
+ * hoser (like flex itself) wants to
+ * call the scanner after we return the
+ * YY_NULL, it'll still work - another
+ * YY_NULL will get returned.
+ */
+ (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
+
+ yy_act = YY_STATE_EOF(YY_START);
+ goto do_action;
+ }
+
+ else
+ {
+ if ( ! (yy_did_buffer_switch_on_eof) )
+ YY_NEW_FILE;
+ }
+ break;
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ (yy_c_buf_p) =
+ (yytext_ptr) + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state( );
+
+ yy_cp = (yy_c_buf_p);
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+ goto yy_match;
+
+ case EOB_ACT_LAST_MATCH:
+ (yy_c_buf_p) =
+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
+
+ yy_current_state = yy_get_previous_state( );
+
+ yy_cp = (yy_c_buf_p);
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+ goto yy_find_action;
+ }
+ break;
+ }
+
+ default:
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--no action found" );
+ } /* end of action switch */
+ } /* end of scanning one token */
+} /* end of yylex */
+
+/* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ * EOB_ACT_LAST_MATCH -
+ * EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ * EOB_ACT_END_OF_FILE - end of file
+ */
+static int yy_get_next_buffer (void)
+{
+ register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
+ register char *source = (yytext_ptr);
+ register int number_to_move, i;
+ int ret_val;
+
+ if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--end of buffer missed" );
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
+ { /* Don't try to fill the buffer, so this is an EOF. */
+ if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
+ {
+ /* We matched a single character, the EOB, so
+ * treat this as a final EOF.
+ */
+ return EOB_ACT_END_OF_FILE;
+ }
+
+ else
+ {
+ /* We matched some text prior to the EOB, first
+ * process it.
+ */
+ return EOB_ACT_LAST_MATCH;
+ }
+ }
+
+ /* Try to read more data. */
+
+ /* First move last chars to start of buffer. */
+ number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1;
+
+ for ( i = 0; i < number_to_move; ++i )
+ *(dest++) = *(source++);
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+ /* don't do the read, it's not guaranteed to return an EOF,
+ * just force an EOF
+ */
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
+
+ else
+ {
+ int num_to_read =
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
+
+ while ( num_to_read <= 0 )
+ { /* Not enough room in the buffer - grow it. */
+
+ /* just a shorter name for the current buffer */
+ YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
+
+ int yy_c_buf_p_offset =
+ (int) ((yy_c_buf_p) - b->yy_ch_buf);
+
+ if ( b->yy_is_our_buffer )
+ {
+ int new_size = b->yy_buf_size * 2;
+
+ if ( new_size <= 0 )
+ b->yy_buf_size += b->yy_buf_size / 8;
+ else
+ b->yy_buf_size *= 2;
+
+ b->yy_ch_buf = (char *)
+ /* Include room in for 2 EOB chars. */
+ yyrealloc((void *) b->yy_ch_buf,b->yy_buf_size + 2 );
+ }
+ else
+ /* Can't grow it, we don't own it. */
+ b->yy_ch_buf = 0;
+
+ if ( ! b->yy_ch_buf )
+ YY_FATAL_ERROR(
+ "fatal error - scanner input buffer overflow" );
+
+ (yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset];
+
+ num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size -
+ number_to_move - 1;
+
+ }
+
+ if ( num_to_read > YY_READ_BUF_SIZE )
+ num_to_read = YY_READ_BUF_SIZE;
+
+ /* Read in more data. */
+ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
+ (yy_n_chars), (size_t) num_to_read );
+
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ if ( (yy_n_chars) == 0 )
+ {
+ if ( number_to_move == YY_MORE_ADJ )
+ {
+ ret_val = EOB_ACT_END_OF_FILE;
+ yyrestart(yyin );
+ }
+
+ else
+ {
+ ret_val = EOB_ACT_LAST_MATCH;
+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
+ YY_BUFFER_EOF_PENDING;
+ }
+ }
+
+ else
+ ret_val = EOB_ACT_CONTINUE_SCAN;
+
+ if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) {
+ /* Extend the array by 50%, plus the number we really need. */
+ yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size );
+ if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
+ }
+
+ (yy_n_chars) += number_to_move;
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
+
+ (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
+
+ return ret_val;
+}
+
+/* yy_get_previous_state - get the state just before the EOB char was reached */
+
+ static yy_state_type yy_get_previous_state (void)
+{
+ register yy_state_type yy_current_state;
+ register char *yy_cp;
+
+ yy_current_state = (yy_start);
+
+ for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
+ {
+ register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+ if ( yy_accept[yy_current_state] )
+ {
+ (yy_last_accepting_state) = yy_current_state;
+ (yy_last_accepting_cpos) = yy_cp;
+ }
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 103 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ }
+
+ return yy_current_state;
+}
+
+/* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ * next_state = yy_try_NUL_trans( current_state );
+ */
+ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state )
+{
+ register int yy_is_jam;
+ register char *yy_cp = (yy_c_buf_p);
+
+ register YY_CHAR yy_c = 1;
+ if ( yy_accept[yy_current_state] )
+ {
+ (yy_last_accepting_state) = yy_current_state;
+ (yy_last_accepting_cpos) = yy_cp;
+ }
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 103 )
+ yy_c = yy_meta[(unsigned int) yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+ yy_is_jam = (yy_current_state == 102);
+
+ return yy_is_jam ? 0 : yy_current_state;
+}
+
+ static void yyunput (int c, register char * yy_bp )
+{
+ register char *yy_cp;
+
+ yy_cp = (yy_c_buf_p);
+
+ /* undo effects of setting up yytext */
+ *yy_cp = (yy_hold_char);
+
+ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+ { /* need to shift things up to make room */
+ /* +2 for EOB chars. */
+ register int number_to_move = (yy_n_chars) + 2;
+ register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
+ register char *source =
+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
+
+ while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+ *--dest = *--source;
+
+ yy_cp += (int) (dest - source);
+ yy_bp += (int) (dest - source);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
+
+ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+ YY_FATAL_ERROR( "flex scanner push-back overflow" );
+ }
+
+ *--yy_cp = (char) c;
+
+ (yytext_ptr) = yy_bp;
+ (yy_hold_char) = *yy_cp;
+ (yy_c_buf_p) = yy_cp;
+}
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+ static int yyinput (void)
+#else
+ static int input (void)
+#endif
+
+{
+ int c;
+
+ *(yy_c_buf_p) = (yy_hold_char);
+
+ if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
+ {
+ /* yy_c_buf_p now points to the character we want to return.
+ * If this occurs *before* the EOB characters, then it's a
+ * valid NUL; if not, then we've hit the end of the buffer.
+ */
+ if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+ /* This was really a NUL. */
+ *(yy_c_buf_p) = '\0';
+
+ else
+ { /* need more input */
+ int offset = (yy_c_buf_p) - (yytext_ptr);
+ ++(yy_c_buf_p);
+
+ switch ( yy_get_next_buffer( ) )
+ {
+ case EOB_ACT_LAST_MATCH:
+ /* This happens because yy_g_n_b()
+ * sees that we've accumulated a
+ * token and flags that we need to
+ * try matching the token before
+ * proceeding. But for input(),
+ * there's no matching to consider.
+ * So convert the EOB_ACT_LAST_MATCH
+ * to EOB_ACT_END_OF_FILE.
+ */
+
+ /* Reset buffer status. */
+ yyrestart(yyin );
+
+ /*FALLTHROUGH*/
+
+ case EOB_ACT_END_OF_FILE:
+ {
+ if ( yywrap( ) )
+ return EOF;
+
+ if ( ! (yy_did_buffer_switch_on_eof) )
+ YY_NEW_FILE;
+#ifdef __cplusplus
+ return yyinput();
+#else
+ return input();
+#endif
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ (yy_c_buf_p) = (yytext_ptr) + offset;
+ break;
+ }
+ }
+ }
+
+ c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */
+ *(yy_c_buf_p) = '\0'; /* preserve yytext */
+ (yy_hold_char) = *++(yy_c_buf_p);
+
+ return c;
+}
+#endif /* ifndef YY_NO_INPUT */
+
+/** Immediately switch to a different input stream.
+ * @param input_file A readable stream.
+ *
+ * @note This function does not reset the start condition to @c INITIAL .
+ */
+ void yyrestart (FILE * input_file )
+{
+
+ if ( ! YY_CURRENT_BUFFER ){
+ yyensure_buffer_stack ();
+ YY_CURRENT_BUFFER_LVALUE =
+ yy_create_buffer(yyin,YY_BUF_SIZE );
+ }
+
+ yy_init_buffer(YY_CURRENT_BUFFER,input_file );
+ yy_load_buffer_state( );
+}
+
+/** Switch to a different input buffer.
+ * @param new_buffer The new input buffer.
+ *
+ */
+ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer )
+{
+
+ /* TODO. We should be able to replace this entire function body
+ * with
+ * yypop_buffer_state();
+ * yypush_buffer_state(new_buffer);
+ */
+ yyensure_buffer_stack ();
+ if ( YY_CURRENT_BUFFER == new_buffer )
+ return;
+
+ if ( YY_CURRENT_BUFFER )
+ {
+ /* Flush out information for old buffer. */
+ *(yy_c_buf_p) = (yy_hold_char);
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ YY_CURRENT_BUFFER_LVALUE = new_buffer;
+ yy_load_buffer_state( );
+
+ /* We don't actually know whether we did this switch during
+ * EOF (yywrap()) processing, but the only time this flag
+ * is looked at is after yywrap() is called, so it's safe
+ * to go ahead and always set it.
+ */
+ (yy_did_buffer_switch_on_eof) = 1;
+}
+
+static void yy_load_buffer_state (void)
+{
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+ (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
+ yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+ (yy_hold_char) = *(yy_c_buf_p);
+}
+
+/** Allocate and initialize an input buffer state.
+ * @param file A readable stream.
+ * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
+ *
+ * @return the allocated buffer state.
+ */
+ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size )
+{
+ YY_BUFFER_STATE b;
+
+ b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_buf_size = size;
+
+ /* yy_ch_buf has to be 2 characters longer than the size given because
+ * we need to put in 2 end-of-buffer characters.
+ */
+ b->yy_ch_buf = (char *) yyalloc(b->yy_buf_size + 2 );
+ if ( ! b->yy_ch_buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_is_our_buffer = 1;
+
+ yy_init_buffer(b,file );
+
+ return b;
+}
+
+/** Destroy the buffer.
+ * @param b a buffer created with yy_create_buffer()
+ *
+ */
+ void yy_delete_buffer (YY_BUFFER_STATE b )
+{
+
+ if ( ! b )
+ return;
+
+ if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
+ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
+
+ if ( b->yy_is_our_buffer )
+ yyfree((void *) b->yy_ch_buf );
+
+ yyfree((void *) b );
+}
+
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+
+/* Initializes or reinitializes a buffer.
+ * This function is sometimes called more than once on the same buffer,
+ * such as during a yyrestart() or at EOF.
+ */
+ static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file )
+
+{
+ int oerrno = errno;
+
+ yy_flush_buffer(b );
+
+ b->yy_input_file = file;
+ b->yy_fill_buffer = 1;
+
+ /* If b is the current buffer, then yy_init_buffer was _probably_
+ * called from yyrestart() or through yy_get_next_buffer.
+ * In that case, we don't want to reset the lineno or column.
+ */
+ if (b != YY_CURRENT_BUFFER){
+ b->yy_bs_lineno = 1;
+ b->yy_bs_column = 0;
+ }
+
+ b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+
+ errno = oerrno;
+}
+
+/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
+ * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
+ *
+ */
+ void yy_flush_buffer (YY_BUFFER_STATE b )
+{
+ if ( ! b )
+ return;
+
+ b->yy_n_chars = 0;
+
+ /* We always need two end-of-buffer characters. The first causes
+ * a transition to the end-of-buffer state. The second causes
+ * a jam in that state.
+ */
+ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+ b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+ b->yy_buf_pos = &b->yy_ch_buf[0];
+
+ b->yy_at_bol = 1;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ if ( b == YY_CURRENT_BUFFER )
+ yy_load_buffer_state( );
+}
+
+/** Pushes the new state onto the stack. The new state becomes
+ * the current state. This function will allocate the stack
+ * if necessary.
+ * @param new_buffer The new state.
+ *
+ */
+void yypush_buffer_state (YY_BUFFER_STATE new_buffer )
+{
+ if (new_buffer == NULL)
+ return;
+
+ yyensure_buffer_stack();
+
+ /* This block is copied from yy_switch_to_buffer. */
+ if ( YY_CURRENT_BUFFER )
+ {
+ /* Flush out information for old buffer. */
+ *(yy_c_buf_p) = (yy_hold_char);
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ /* Only push if top exists. Otherwise, replace top. */
+ if (YY_CURRENT_BUFFER)
+ (yy_buffer_stack_top)++;
+ YY_CURRENT_BUFFER_LVALUE = new_buffer;
+
+ /* copied from yy_switch_to_buffer. */
+ yy_load_buffer_state( );
+ (yy_did_buffer_switch_on_eof) = 1;
+}
+
+/** Removes and deletes the top of the stack, if present.
+ * The next element becomes the new top.
+ *
+ */
+void yypop_buffer_state (void)
+{
+ if (!YY_CURRENT_BUFFER)
+ return;
+
+ yy_delete_buffer(YY_CURRENT_BUFFER );
+ YY_CURRENT_BUFFER_LVALUE = NULL;
+ if ((yy_buffer_stack_top) > 0)
+ --(yy_buffer_stack_top);
+
+ if (YY_CURRENT_BUFFER) {
+ yy_load_buffer_state( );
+ (yy_did_buffer_switch_on_eof) = 1;
+ }
+}
+
+/* Allocates the stack if it does not exist.
+ * Guarantees space for at least one push.
+ */
+static void yyensure_buffer_stack (void)
+{
+ int num_to_alloc;
+
+ if (!(yy_buffer_stack)) {
+
+ /* First allocation is just for 2 elements, since we don't know if this
+ * scanner will even need a stack. We use 2 instead of 1 to avoid an
+ * immediate realloc on the next call.
+ */
+ num_to_alloc = 1;
+ (yy_buffer_stack) = (struct yy_buffer_state**)yyalloc
+ (num_to_alloc * sizeof(struct yy_buffer_state*)
+ );
+ if ( ! (yy_buffer_stack) )
+ YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );
+
+ memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
+
+ (yy_buffer_stack_max) = num_to_alloc;
+ (yy_buffer_stack_top) = 0;
+ return;
+ }
+
+ if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
+
+ /* Increase the buffer to prepare for a possible push. */
+ int grow_size = 8 /* arbitrary grow size */;
+
+ num_to_alloc = (yy_buffer_stack_max) + grow_size;
+ (yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc
+ ((yy_buffer_stack),
+ num_to_alloc * sizeof(struct yy_buffer_state*)
+ );
+ if ( ! (yy_buffer_stack) )
+ YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );
+
+ /* zero only the new slots.*/
+ memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
+ (yy_buffer_stack_max) = num_to_alloc;
+ }
+}
+
+/** Setup the input buffer state to scan directly from a user-specified character buffer.
+ * @param base the character buffer
+ * @param size the size in bytes of the character buffer
+ *
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size )
+{
+ YY_BUFFER_STATE b;
+
+ if ( size < 2 ||
+ base[size-2] != YY_END_OF_BUFFER_CHAR ||
+ base[size-1] != YY_END_OF_BUFFER_CHAR )
+ /* They forgot to leave room for the EOB's. */
+ return 0;
+
+ b = (YY_BUFFER_STATE) yyalloc(sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" );
+
+ b->yy_buf_size = size - 2; /* "- 2" to take care of EOB's */
+ b->yy_buf_pos = b->yy_ch_buf = base;
+ b->yy_is_our_buffer = 0;
+ b->yy_input_file = 0;
+ b->yy_n_chars = b->yy_buf_size;
+ b->yy_is_interactive = 0;
+ b->yy_at_bol = 1;
+ b->yy_fill_buffer = 0;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ yy_switch_to_buffer(b );
+
+ return b;
+}
+
+/** Setup the input buffer state to scan a string. The next call to yylex() will
+ * scan from a @e copy of @a str.
+ * @param yystr a NUL-terminated string to scan
+ *
+ * @return the newly allocated buffer state object.
+ * @note If you want to scan bytes that may contain NUL values, then use
+ * yy_scan_bytes() instead.
+ */
+YY_BUFFER_STATE yy_scan_string (yyconst char * yystr )
+{
+
+ return yy_scan_bytes(yystr,strlen(yystr) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to yylex() will
+ * scan from a @e copy of @a bytes.
+ * @param yybytes the byte buffer to scan
+ * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes.
+ *
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE yy_scan_bytes (yyconst char * yybytes, int _yybytes_len )
+{
+ YY_BUFFER_STATE b;
+ char *buf;
+ yy_size_t n;
+ int i;
+
+ /* Get memory for full buffer, including space for trailing EOB's. */
+ n = _yybytes_len + 2;
+ buf = (char *) yyalloc(n );
+ if ( ! buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" );
+
+ for ( i = 0; i < _yybytes_len; ++i )
+ buf[i] = yybytes[i];
+
+ buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
+
+ b = yy_scan_buffer(buf,n );
+ if ( ! b )
+ YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" );
+
+ /* It's okay to grow etc. this buffer, and we should throw it
+ * away when we're done.
+ */
+ b->yy_is_our_buffer = 1;
+
+ return b;
+}
+
+#ifndef YY_EXIT_FAILURE
+#define YY_EXIT_FAILURE 2
+#endif
+
+static void yy_fatal_error (yyconst char* msg )
+{
+ (void) fprintf( stderr, "%s\n", msg );
+ exit( YY_EXIT_FAILURE );
+}
+
+/* Redefine yyless() so it works in section 3 code. */
+
+#undef yyless
+#define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ int yyless_macro_arg = (n); \
+ YY_LESS_LINENO(yyless_macro_arg);\
+ yytext[yyleng] = (yy_hold_char); \
+ (yy_c_buf_p) = yytext + yyless_macro_arg; \
+ (yy_hold_char) = *(yy_c_buf_p); \
+ *(yy_c_buf_p) = '\0'; \
+ yyleng = yyless_macro_arg; \
+ } \
+ while ( 0 )
+
+/* Accessor methods (get/set functions) to struct members. */
+
+/** Get the current line number.
+ *
+ */
+int yyget_lineno (void)
+{
+
+ return yylineno;
+}
+
+/** Get the input stream.
+ *
+ */
+FILE *yyget_in (void)
+{
+ return yyin;
+}
+
+/** Get the output stream.
+ *
+ */
+FILE *yyget_out (void)
+{
+ return yyout;
+}
+
+/** Get the length of the current token.
+ *
+ */
+int yyget_leng (void)
+{
+ return yyleng;
+}
+
+/** Get the current token.
+ *
+ */
+
+char *yyget_text (void)
+{
+ return yytext;
+}
+
+/** Set the current line number.
+ * @param line_number
+ *
+ */
+void yyset_lineno (int line_number )
+{
+
+ yylineno = line_number;
+}
+
+/** Set the input stream. This does not discard the current
+ * input buffer.
+ * @param in_str A readable stream.
+ *
+ * @see yy_switch_to_buffer
+ */
+void yyset_in (FILE * in_str )
+{
+ yyin = in_str ;
+}
+
+void yyset_out (FILE * out_str )
+{
+ yyout = out_str ;
+}
+
+int yyget_debug (void)
+{
+ return yy_flex_debug;
+}
+
+void yyset_debug (int bdebug )
+{
+ yy_flex_debug = bdebug ;
+}
+
+static int yy_init_globals (void)
+{
+ /* Initialization is the same as for the non-reentrant scanner.
+ * This function is called from yylex_destroy(), so don't allocate here.
+ */
+
+ (yy_buffer_stack) = 0;
+ (yy_buffer_stack_top) = 0;
+ (yy_buffer_stack_max) = 0;
+ (yy_c_buf_p) = (char *) 0;
+ (yy_init) = 0;
+ (yy_start) = 0;
+
+/* Defined in main.c */
+#ifdef YY_STDINIT
+ yyin = stdin;
+ yyout = stdout;
+#else
+ yyin = (FILE *) 0;
+ yyout = (FILE *) 0;
+#endif
+
+ /* For future reference: Set errno on error, since we are called by
+ * yylex_init()
+ */
+ return 0;
+}
+
+/* yylex_destroy is for both reentrant and non-reentrant scanners. */
+int yylex_destroy (void)
+{
+
+ /* Pop the buffer stack, destroying each element. */
+ while(YY_CURRENT_BUFFER){
+ yy_delete_buffer(YY_CURRENT_BUFFER );
+ YY_CURRENT_BUFFER_LVALUE = NULL;
+ yypop_buffer_state();
+ }
+
+ /* Destroy the stack itself. */
+ yyfree((yy_buffer_stack) );
+ (yy_buffer_stack) = NULL;
+
+ /* Reset the globals. This is important in a non-reentrant scanner so the next time
+ * yylex() is called, initialization will occur. */
+ yy_init_globals( );
+
+ return 0;
+}
+
+/*
+ * Internal utility routines.
+ */
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char* s1, yyconst char * s2, int n )
+{
+ register int i;
+ for ( i = 0; i < n; ++i )
+ s1[i] = s2[i];
+}
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * s )
+{
+ register int n;
+ for ( n = 0; s[n]; ++n )
+ ;
+
+ return n;
+}
+#endif
+
+void *yyalloc (yy_size_t size )
+{
+ return (void *) malloc( size );
+}
+
+void *yyrealloc (void * ptr, yy_size_t size )
+{
+ /* The cast to (char *) in the following accommodates both
+ * implementations that use char* generic pointers, and those
+ * that use void* generic pointers. It works with the latter
+ * because both ANSI C and C++ allow castless assignment from
+ * any pointer type to void*, and deal with argument conversions
+ * as though doing an assignment.
+ */
+ return (void *) realloc( (char *) ptr, size );
+}
+
+void yyfree (void * ptr )
+{
+ free( (char *) ptr ); /* see yyrealloc() for (char *) cast */
+}
+
+#define YYTABLES_NAME "yytables"
+
+#line 70 "instrformats/instrformats.l"
diff --git a/src/runtime/c/teyjus/tables_gen/instrformats/y.tab.h b/src/runtime/c/teyjus/tables_gen/instrformats/y.tab.h
new file mode 100644
index 000000000..cff620e11
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/instrformats/y.tab.h
@@ -0,0 +1,104 @@
+
+/* A Bison parser, made by GNU Bison 2.4.1. */
+
+/* Skeleton interface for Bison's Yacc-like parsers in C
+
+ Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+ Free Software Foundation, Inc.
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see . */
+
+/* As a special exception, you may create a larger work that contains
+ part or all of the Bison parser skeleton and distribute that work
+ under terms of your choice, so long as that work isn't itself a
+ parser generator using the skeleton or a modified version thereof
+ as a parser skeleton. Alternatively, if you modify or redistribute
+ the parser skeleton itself, you may (at your option) remove this
+ special exception, which will cause the skeleton and the resulting
+ Bison output files to be licensed under the GNU General Public
+ License without this special exception.
+
+ This special exception was added by the Free Software Foundation in
+ version 2.2 of Bison. */
+
+
+/* Tokens. */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+ /* Put the tokens into the symbol table, so that GDB and other debuggers
+ know about them. */
+ enum yytokentype {
+ OPTYPES = 258,
+ INSTRCAT = 259,
+ INSTRUCTIONS = 260,
+ OPCODE = 261,
+ MAXOPERAND = 262,
+ CALL_I1_LEN = 263,
+ SEMICOLON = 264,
+ ERROR = 265,
+ LBRACKET = 266,
+ RBRACKET = 267,
+ ID = 268,
+ NUM = 269,
+ STRING = 270,
+ STRING2 = 271
+ };
+#endif
+/* Tokens. */
+#define OPTYPES 258
+#define INSTRCAT 259
+#define INSTRUCTIONS 260
+#define OPCODE 261
+#define MAXOPERAND 262
+#define CALL_I1_LEN 263
+#define SEMICOLON 264
+#define ERROR 265
+#define LBRACKET 266
+#define RBRACKET 267
+#define ID 268
+#define NUM 269
+#define STRING 270
+#define STRING2 271
+
+
+
+
+#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
+typedef union YYSTYPE
+{
+
+/* Line 1676 of yacc.c */
+#line 38 "instrformats/instrformats.y"
+
+ char* name;
+ char* text;
+ struct
+ {
+ int ival;
+ char* sval;
+ } isval;
+
+
+
+/* Line 1676 of yacc.c */
+#line 96 "instrformats/y.tab.h"
+} YYSTYPE;
+# define YYSTYPE_IS_TRIVIAL 1
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+#endif
+
+extern YYSTYPE yylval;
+
+
diff --git a/src/runtime/c/teyjus/tables_gen/pervasives/ccode.c b/src/runtime/c/teyjus/tables_gen/pervasives/ccode.c
new file mode 100644
index 000000000..dbdb047e5
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/pervasives/ccode.c
@@ -0,0 +1,1024 @@
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/***************************************************************************/
+/* ocamlcode.c. */
+/* This file defines auxiliary functions in making pervasives.h and */
+/* pervasives.c. */
+/* Since space and time efficiency is not an important concern in the */
+/* system source code generation phase, the code here is structured in the */
+/* way for the convenience of making changes on pervasive.mli{ml}. */
+/***************************************************************************/
+#include
+#include
+#include
+
+#include "ccode.h"
+#include "types.h"
+#include "../util/util.h" //to be modified
+
+/**************************************************************************/
+/* Functions for making various language constructs */
+/**************************************************************************/
+/* // */
+char* C_mkOneLineComments(char* comments)
+{
+ size_t length = strlen(comments) + 5;
+ char* commentsText = UTIL_mallocStr(length);
+
+ strcpy(commentsText, "// ");
+ strcat(commentsText, comments);
+
+ return commentsText;
+}
+
+/* = */
+char* C_mkAssign(char* varName, char* varValue)
+{
+ size_t length = strlen(varName) + strlen(varValue) + 5;
+ char* assign = UTIL_mallocStr(length);
+
+ strcpy(assign, varName);
+ strcat(assign, " = ");
+ strcat(assign, varValue);
+
+ return assign;
+}
+
+/* #define */
+char* C_mkDefine(char* macroName, char* macroValue)
+{
+ size_t length = strlen(macroName) + strlen(macroValue) + 10;
+ char* def = UTIL_mallocStr(length);
+
+ strcpy(def, "#define ");
+ strcat(def, macroName);
+ strcat(def, " ");
+ strcat(def, macroValue);
+
+ return def;
+}
+
+/* enum \n {\n } */
+char* C_mkEnum(char* typeName, char* body)
+{
+ size_t length = strlen(typeName) + strlen(body) + 15;
+ char* enumText = UTIL_mallocStr(length);
+
+ strcpy(enumText, "enum ");
+ strcat(enumText, typeName);
+ strcat(enumText, "\n{\n");
+ strcat(enumText, body);
+ strcat(enumText, "}");
+
+ return enumText;
+}
+
+/* typedef ; \n\n */
+char* C_mkTypeDef(char* typeStr, char* typeName)
+{
+ size_t length = strlen(typeStr) + strlen(typeName) + 15;
+ char* typeDefText = UTIL_mallocStr(length);
+
+ strcpy(typeDefText, "typedef ");
+ strcat(typeDefText, typeStr);
+ strcat(typeDefText, " ");
+ strcat(typeDefText, typeName);
+ strcat(typeDefText, ";\n\n");
+
+ return typeDefText;
+}
+
+/********************************************************************/
+/* Names */
+/********************************************************************/
+#define C_INDENT " "
+
+#define C_PREFIX "PERV_"
+#define C_SUFFIX "_INDEX"
+
+#define C_NUMKINDS "PERV_KIND_NUM"
+#define C_NUMTYSKELS "PERV_TY_SKEL_NUM"
+#define C_NUMCONSTS "PERV_CONST_NUM"
+
+#define C_TY_KINDIND "PERV_KindIndexType"
+#define C_TY_CONSTIND "PERV_ConstIndexType"
+
+
+/* PERV__INDEX */
+char* C_mkIndexName(char* name)
+{
+ char* nameUC = UTIL_upperCase(name);
+ size_t length = strlen(nameUC) + strlen(C_PREFIX) + strlen(C_SUFFIX);
+ char* indexName = UTIL_mallocStr(length);
+
+ strcpy(indexName, C_PREFIX);
+ strcat(indexName, nameUC); free(nameUC);
+ strcat(indexName, C_SUFFIX);
+
+ return indexName;
+}
+
+/* PERV_ */
+char* C_mkIndexName2(char* name)
+{
+ char* nameUC = UTIL_upperCase(name);
+ size_t length = strlen(nameUC) + strlen(C_PREFIX);
+ char* indexName = UTIL_mallocStr(length);
+
+ strcpy(indexName, C_PREFIX);
+ strcat(indexName, nameUC); free(nameUC);
+
+ return indexName;
+}
+
+/*
+ //comments \n
+ PERV__INDEX =
+*/
+char* C_mkIndex(char* name, char* indexNum, char* comments)
+{
+ char* commentText = (comments) ? C_mkOneLineComments(comments) : NULL;
+ char* varName = C_mkIndexName(name);
+ char* assign = C_mkAssign(varName, indexNum);
+ size_t length = ((commentText) ? strlen(commentText) + strlen(C_INDENT): 0)
+ + strlen(assign) + strlen(C_INDENT) + 5;
+ char* index = UTIL_mallocStr(length);
+
+ free(varName);
+ strcpy(index, C_INDENT);
+ if (commentText) {
+ strcat(index, commentText); strcat(index, "\n");
+ strcat(index, C_INDENT); free(commentText);
+ }
+ strcat(index, assign); free(assign);
+
+ return index;
+}
+
+/*
+ PERV_ =
+*/
+char* C_mkIndex2(char* name, char* indexNum)
+{
+ char* varName = C_mkIndexName2(name);
+ char* assign = C_mkAssign(varName, indexNum);
+ char* index = UTIL_mallocStr(strlen(assign) + strlen(C_INDENT));
+
+ free(varName);
+ strcpy(index, C_INDENT);
+ strcat(index, assign); free(assign);
+
+ return index;
+}
+
+/* // empty */
+char* C_mkEmptyComments()
+{
+ size_t length = strlen(C_INDENT) + 10;
+ char* text = UTIL_mallocStr(length);
+
+ strcpy(text, C_INDENT);
+ strcat(text, "// empty\n");
+
+ return text;
+}
+
+/********************************************************************/
+/* Kind relevant components */
+/********************************************************************/
+/***************************************************************/
+/* pervasives.h */
+/***************************************************************/
+#define C_NUMKINDS_COMMENTS "//total number of pervasive kinds\n"
+
+/*
+ //total number of pervasive kinds \n"
+ #define PERV_KIND_NUM \n
+*/
+char* C_mkNumKinds(char* num)
+{
+ char* def = C_mkDefine(C_NUMKINDS, num);
+ size_t length = strlen(def) + strlen(C_NUMKINDS_COMMENTS) + 5;
+ char* numKinds = UTIL_mallocStr(length);
+
+ strcpy(numKinds, C_NUMKINDS_COMMENTS);
+ strcat(numKinds, def); free(def);
+ strcat(numKinds, "\n\n");
+
+ return numKinds;
+}
+
+#define C_KINDINDEX_COMMENTS \
+"//indices for predefined sorts and type constructors\n"
+/*
+ //indices for predefined sorts and type constructors\n"
+ typedef enum PERV_KindIndexType \n
+ { } PERV_KindIndexType; \n
+*/
+char* C_mkKindIndexType(char* body)
+{
+ char* enumText = C_mkEnum(C_TY_KINDIND, body);
+ char* typeDefText = C_mkTypeDef(enumText, C_TY_KINDIND);
+ size_t length = strlen(typeDefText) + strlen(C_KINDINDEX_COMMENTS);
+ char* kindIndexType = UTIL_mallocStr(length);
+
+ strcpy(kindIndexType, C_KINDINDEX_COMMENTS);
+ strcat(kindIndexType, typeDefText);
+ free(enumText); free(typeDefText);
+
+ return kindIndexType;
+}
+
+//comments
+#define C_KIND_COMMENTS \
+"/****************************************************************************/\n/* PERVASIVE KIND */ \n/****************************************************************************/ \n"
+//PERV_KindData
+#define C_KINDDATA_TYPE_DEF \
+"//pervasive kind data type \ntypedef struct \n{ \n char *name; \n TwoBytes arity; \n} PERV_KindData; \n\n"
+
+//PERV_kindDataTab
+#define C_KINDDATATAB_DEC \
+"//pervasive kind data table (array) \nextern PERV_KindData PERV_kindDataTab[PERV_KIND_NUM]; \n\n"
+
+//PERV_genKindData
+#define C_GETKINDDATA_DEC \
+"//pervasive kind data access function \nPERV_KindData PERV_getKindData(int index); \n\n"
+
+//PERV_copyKindDataTab
+#define C_COPYKINDDATATAB_DEC \
+"//pervasive kind table copy function (used in module space initialization) \n//this functiion relies on the assumption that the pervasive kind data \n//has the same structure as that of the run-time kind symbol table entries. \nvoid PERV_copyKindDataTab(PERV_KindData* dst); \n\n"
+char* C_mkKindH(char* kindIndexType, char* numKinds)
+{
+ size_t length = strlen(C_KIND_COMMENTS) + strlen(kindIndexType) +
+ strlen(numKinds) + strlen(C_KINDDATA_TYPE_DEF) +
+ strlen(C_KINDDATATAB_DEC) + strlen(C_GETKINDDATA_DEC) +
+ strlen(C_COPYKINDDATATAB_DEC);
+ char* kindH = UTIL_mallocStr(length);
+
+ strcpy(kindH, C_KIND_COMMENTS);
+ strcat(kindH, kindIndexType);
+ strcat(kindH, numKinds);
+ strcat(kindH, C_KINDDATA_TYPE_DEF);
+ strcat(kindH, C_KINDDATATAB_DEC);
+ strcat(kindH, C_GETKINDDATA_DEC);
+ strcat(kindH, C_COPYKINDDATATAB_DEC);
+
+ return kindH;
+}
+
+/***************************************************************/
+/* pervasives.c */
+/***************************************************************/
+/*
+ //comments \n
+ {"", }
+*/
+char* C_mkKindTabEntry(char* name, char* arity, char* comments)
+{
+ char* commentText = (comments) ? C_mkOneLineComments(comments) : NULL;
+ size_t length = ((commentText) ? strlen(commentText) + strlen(C_INDENT): 0)
+ + strlen(name) + strlen(arity) + strlen(C_INDENT)*2 + 10;
+ char* entry = UTIL_mallocStr(length);
+
+ strcpy(entry, C_INDENT);
+ if (commentText) {
+ strcat(entry, commentText); strcat(entry, "\n");
+ strcat(entry, C_INDENT); free(commentText);
+ }
+ strcat(entry, "{\"");
+ strcat(entry, name);
+ strcat(entry, "\",");
+ strcat(entry, C_INDENT);
+ strcat(entry, arity);
+ strcat(entry, "}");
+
+ return entry;
+}
+
+#define C_KIND_TAB_BEG \
+"//pervasive kind data table (array) \nPERV_KindData PERV_kindDataTab[PERV_KIND_NUM] = { \n //name, arity \n"
+#define C_KIND_TAB_END "};\n\n"
+
+/*
+ //pervasive kind data table (array)
+ PERV_KindData PERV_kindDataTab[PERV_KIND_NUM] = { \n body \n};\n
+*/
+char* C_mkKindTab(char* body)
+{
+ size_t length = strlen(C_KIND_TAB_BEG) + strlen(C_KIND_TAB_END) + strlen(body);
+ char* kindTab = UTIL_mallocStr(length);
+
+ strcpy(kindTab, C_KIND_TAB_BEG);
+ strcat(kindTab, body);
+ strcat(kindTab, C_KIND_TAB_END);
+
+ return kindTab;
+}
+
+//PERV_getKindData
+#define C_GETKINDDATA_DEF \
+"PERV_KindData PERV_getKindData(int index) \n{ \n return PERV_kindDataTab[index]; \n} \n\n"
+//PERV_copyKindDataTab
+#define C_COPYKINDDATATAB_DEF \
+"void PERV_copyKindDataTab(PERV_KindData* dst) \n{ \n //this way of copy relies on the assumption that the pervasive kind data \n //has the same structure as that of the run-time kind symbol table entries.\n memcpy((void*)dst, (void*)PERV_kindDataTab, \n sizeof(PERV_KindData) * PERV_KIND_NUM); \n} \n\n"
+
+char* C_mkKindC(char* kindTab)
+{
+ size_t length = strlen(C_KIND_COMMENTS) + strlen(kindTab) +
+ strlen(C_GETKINDDATA_DEF) + strlen(C_COPYKINDDATATAB_DEF);
+ char* kindC = UTIL_mallocStr(length);
+
+ strcpy(kindC, C_KIND_COMMENTS);
+ strcat(kindC, kindTab);
+ strcat(kindC, C_GETKINDDATA_DEF);
+ strcat(kindC, C_COPYKINDDATATAB_DEF);
+
+ return kindC;
+}
+
+
+/*********************************************************************/
+/* Type Skeleton relevant components */
+/*********************************************************************/
+#define C_NUMTYSKELS_COMMENTS \
+"//total number of type skeletons needed for pervasive constants\n"
+
+
+/*
+ //total number of type skeletons needed for pervasive constants\n
+ #define PERV_TY_SKEL_NUM \n
+*/
+char* C_mkNumTySkels(char* num)
+{
+ char* def = C_mkDefine(C_NUMTYSKELS, num);
+ size_t length = strlen(def) + strlen(C_NUMTYSKELS_COMMENTS) + 5;
+ char* numTySkels = UTIL_mallocStr(length);
+
+ strcpy(numTySkels, C_NUMTYSKELS_COMMENTS);
+ strcat(numTySkels, def); free(def);
+ strcat(numTySkels, "\n\n");
+
+ return numTySkels;
+}
+
+//comments
+#define C_TYSKEL_COMMENTS \
+"/***************************************************************************/\n/* TYPE SKELETIONS FOR PERVASIVE CONSTANTS */ \n/****************************************************************************/\n\n"
+//PERV_TySkelData
+#define C_TYSKELDATA_TYPE_DEF \
+"//pervasive type skel data type \ntypedef DF_TypePtr PERV_TySkelData; \n\n"
+
+//PERV_TySkelTab
+#define C_TYSKELTAB_DEC \
+"//pervasive type skel table (array) \nextern PERV_TySkelData PERV_tySkelTab[PERV_TY_SKEL_NUM]; \n\n"
+
+//PERV_tySkelTabInit
+#define C_TYSKELTABINIT_DEC \
+"//pervasive type skeletons and type skeleton table initialization \n//Note that type skeltons have to be dynamically allocated, and so does the \n//info recorded in each entry of the pervasive type skeleton table \nvoid PERV_tySkelTabInit(); \n\n"
+
+//PERV_copyTySkelTab
+#define C_COPYTYSKELTAB_DEC \
+"//pervasive tyskel table copy function \nvoid PERV_copyTySkelTab(PERV_TySkelData* dst); \n\n"
+
+char* C_mkTySkelsH(char* numTySkels)
+{
+ size_t length = strlen(C_TYSKEL_COMMENTS) + strlen(numTySkels) +
+ strlen(C_TYSKELDATA_TYPE_DEF) + strlen(C_TYSKELTAB_DEC) +
+ strlen(C_TYSKELTABINIT_DEC) + strlen(C_COPYTYSKELTAB_DEC);
+ char* tySkelsH = UTIL_mallocStr(length);
+
+ strcpy(tySkelsH, C_TYSKEL_COMMENTS);
+ strcat(tySkelsH, numTySkels);
+ strcat(tySkelsH, C_TYSKELDATA_TYPE_DEF);
+ strcat(tySkelsH, C_TYSKELTAB_DEC);
+ strcat(tySkelsH, C_TYSKELTABINIT_DEC);
+ strcat(tySkelsH, C_COPYTYSKELTAB_DEC);
+
+ return tySkelsH;
+}
+
+/************************************************************************/
+/* pervasives.c */
+/************************************************************************/
+//manipulating each type skeleton
+#define MKSKVARTYPE_BEG " DF_mkSkelVarType(tySkelBase, "
+#define MKSORTTYPE_BEG " DF_mkSortType(tySkelBase, "
+#define MKATOMTYPE_END ");\n"
+#define MKARROWTYPE_BEG \
+" DF_mkArrowType(tySkelBase, (DF_TypePtr)(tySkelBase + "
+#define MKSTRTYPE_BEG \
+" DF_mkStrType(tySkelBase, (DF_TypePtr)(tySkelBase + "
+#define MKSTRFUNCTYPE_BEG " DF_mkStrFuncType(tySkelBase, "
+#define MKCOMPTYPE_END " * DF_TY_ATOMIC_SIZE));\n"
+#define TYSKELBASE_INC " tySkelBase += DF_TY_ATOMIC_SIZE;\n"
+
+static char* C_genTySkelSort(char* name)
+{
+ char* kindName = C_mkIndexName(name);
+ char* mytext = NULL;
+ mytext = UTIL_mallocStr(strlen(MKSORTTYPE_BEG) + strlen(MKATOMTYPE_END) +
+ strlen(kindName) + strlen(TYSKELBASE_INC));
+
+ strcpy(mytext, MKSORTTYPE_BEG);
+ strcat(mytext, kindName); free(kindName);
+ strcat(mytext, MKATOMTYPE_END);
+ strcat(mytext, TYSKELBASE_INC);
+ return mytext;
+}
+
+static char* C_genTySkelSkVar(char* index)
+{
+ char* mytext = NULL;
+ mytext = UTIL_mallocStr(strlen(MKSKVARTYPE_BEG) + strlen(MKATOMTYPE_END) +
+ strlen(index) + strlen(TYSKELBASE_INC));
+
+ strcpy(mytext, MKSKVARTYPE_BEG);
+ strcat(mytext, index);
+ strcat(mytext, MKATOMTYPE_END);
+ strcat(mytext, TYSKELBASE_INC);
+ return mytext;
+}
+
+static char* C_genTySkelFunc(char* name, char* arity)
+{
+ char* kindName = C_mkIndexName(name);
+ char* mytext = NULL;
+ mytext = UTIL_mallocStr(strlen(MKSTRFUNCTYPE_BEG) + strlen(kindName) +
+ strlen(arity) + strlen(MKATOMTYPE_END) +
+ strlen(TYSKELBASE_INC) + 5);
+
+ strcpy(mytext, MKSTRFUNCTYPE_BEG);
+ strcat(mytext, kindName); free(kindName);
+ strcat(mytext, ", ");
+ strcat(mytext, arity);
+ strcat(mytext, MKATOMTYPE_END);
+ strcat(mytext, TYSKELBASE_INC);
+ return mytext;
+}
+
+static char* C_genTySkelArrow(int argPosNum)
+{
+ char* argPos = UTIL_itoa(argPosNum);
+ char* mytext = NULL;
+ mytext = UTIL_mallocStr(strlen(MKARROWTYPE_BEG) + strlen(argPos) +
+ strlen(MKCOMPTYPE_END) + strlen(TYSKELBASE_INC));
+
+ strcpy(mytext, MKARROWTYPE_BEG);
+ strcat(mytext, argPos); free(argPos);
+ strcat(mytext, MKCOMPTYPE_END);
+ strcat(mytext, TYSKELBASE_INC);
+ return mytext;
+}
+
+static char* C_genTySkelStr(int argPosNum)
+{
+ char* argPos = UTIL_itoa(argPosNum);
+ char* mytext = NULL;
+ mytext = UTIL_mallocStr(strlen(MKSTRTYPE_BEG) + strlen(argPos) +
+ strlen(MKCOMPTYPE_END) + strlen(TYSKELBASE_INC));
+
+ strcpy(mytext, MKSTRTYPE_BEG);
+ strcat(mytext, argPos); free(argPos);
+ strcat(mytext, MKCOMPTYPE_END);
+ strcat(mytext, TYSKELBASE_INC);
+ return mytext;
+}
+
+//data structure used for breath-first traversal of type skels
+typedef struct Types
+{
+ int length;
+ TypeList types;
+} Types;
+
+int C_totalSpace = 0;
+
+static char* C_genOneTySkel(Types types)
+{
+ TypeList typeList = types.types;
+ int length = types.length;
+ char* mytext = NULL;
+
+ if (length) {
+ Type myType = typeList -> oneType;
+ TypeList remaining = typeList -> next;
+ char *mytext1 = NULL, *mytext2 = NULL;
+ free(typeList);
+ switch (myType -> tag){
+ case SORT:
+ {
+ mytext1 = C_genTySkelSort(myType->data.sort);
+ C_totalSpace++;
+ types.types = remaining;
+ types.length = length-1;
+ mytext2 = C_genOneTySkel(types);
+ break;
+ }
+ case SKVAR:
+ {
+ mytext1 = C_genTySkelSkVar(myType->data.skvar);
+ C_totalSpace++;
+ types.types = remaining;
+ types.length = length-1;
+ mytext2 = C_genOneTySkel(types);
+ break;
+ }
+ case FUNC:
+ {
+ mytext1 = C_genTySkelFunc(myType->data.func.name,
+ myType->data.func.arity);
+ C_totalSpace++;
+ types.types = remaining;
+ types.length = length -1;
+ mytext2 = C_genOneTySkel(types);
+ break;
+ }
+ case ARROW:
+ {
+ Type lop = myType->data.arrow.lop;
+ Type rop = myType->data.arrow.rop;
+ mytext1 = C_genTySkelArrow(length);
+ C_totalSpace++;
+ remaining = addItemToEnd(remaining, lop);
+ types.types = addItemToEnd(remaining, rop);
+ types.length = length+1;
+ mytext2 = C_genOneTySkel(types);
+ break;
+ }
+ case STR:
+ {
+ Type func = myType->data.str.functor;
+ TypeList args = myType->data.str.args;
+ int arity = myType -> data.str.arity;
+ mytext1 = C_genTySkelStr(length);
+ C_totalSpace++;
+ remaining = addItemToEnd(remaining, func);
+ types.types = append(remaining, args);
+ types.length = length + arity;
+ mytext2 = C_genOneTySkel(types);
+ break;
+ }
+ }
+ freeType(myType);
+ mytext = UTIL_mallocStr(strlen(mytext1) + strlen(mytext2));
+ strcpy(mytext, mytext1); free(mytext1);
+ strcat(mytext, mytext2); free(mytext2);
+ } else {
+ mytext = strdup("");
+ }
+ return mytext;
+}
+
+#define C_TYSKELS_PRE \
+"PERV_tySkelTab[tySkelInd] = (PERV_TySkelData)tySkelBase;\n tySkelInd++;\n"
+
+char* C_genTySkel(Type tyskel, char* comments)
+{
+ char* commentText = (comments) ? C_mkOneLineComments(comments) : NULL;
+ Types tyskels;
+ char* tyskelText1;
+ char* tyskelText2;
+ size_t length;
+
+ tyskels.length = 1;
+ tyskels.types = addItem(tyskel, NULL);
+ tyskelText1 = C_genOneTySkel(tyskels);
+
+ length = ((commentText) ? strlen(commentText) + strlen(C_INDENT): 0)
+ + strlen(tyskelText1) + strlen(C_TYSKELS_PRE) + strlen(C_INDENT) + 5;
+ tyskelText2 = UTIL_mallocStr(length);
+
+ strcpy(tyskelText2, C_INDENT);
+ if (commentText) {
+ strcat(tyskelText2, commentText); free(commentText);
+ strcat(tyskelText2, "\n");
+ }
+ strcat(tyskelText2, C_INDENT);
+ strcat(tyskelText2, C_TYSKELS_PRE);
+ strcat(tyskelText2, tyskelText1); free(tyskelText1);
+ strcat(tyskelText2, "\n");
+
+ return tyskelText2;
+}
+
+#define TYSKELTABINIT_BEG \
+"//pervasive type skeletons and type skeleton table initialization \n//The type skeletons are created in the memory of the system through malloc, \n//and addresses are entered into the pervasive type skeleton table. \nvoid PERV_tySkelTabInit() \n{ \n int tySkelInd = 0; //ts tab index\n"
+#define TYSKELTABINIT_END "}\n\n"
+
+#define TYSPACE_BEG " MemPtr tySkelBase = (MemPtr)EM_malloc(WORD_SIZE * "
+#define TYSPACE_END " ); //ts area\n\n"
+
+char* C_mkTySkelTabInit(char* body, int space)
+{
+ char* spaceText = UTIL_itoa(space * 2);
+ char* tabInit = UTIL_mallocStr(strlen(TYSKELTABINIT_BEG) +
+ strlen(TYSPACE_BEG) + strlen(spaceText) +
+ strlen(TYSPACE_END) + strlen(body) +
+ strlen(TYSKELTABINIT_END));
+ strcpy(tabInit, TYSKELTABINIT_BEG);
+ strcat(tabInit, TYSPACE_BEG);
+ strcat(tabInit, spaceText); free(spaceText);
+ strcat(tabInit, TYSPACE_END);
+ strcat(tabInit, body);
+ strcat(tabInit, TYSKELTABINIT_END);
+
+ return tabInit;
+}
+
+
+//PERV_tySkelTab
+#define TYSKELTAB_DEF \
+"//pervasive type skeleton table (array) \nPERV_TySkelData PERV_tySkelTab[PERV_TY_SKEL_NUM]; \n\n"
+
+//PERV_copyTySkelTab
+#define COPYTYSKELTAB_DEF \
+"void PERV_copyTySkelTab(PERV_TySkelData* dst) \n{ \n memcpy((void*)dst, (void*)PERV_tySkelTab, \n sizeof(PERV_TySkelData) * PERV_KIND_NUM); \n}\n\n"
+char* C_mkTySkelsC(char* tySkelTab)
+{
+ char* text = UTIL_mallocStr(strlen(C_TYSKEL_COMMENTS) +
+ strlen(TYSKELTAB_DEF) +
+ strlen(tySkelTab) +
+ strlen(COPYTYSKELTAB_DEF));
+ strcpy(text, C_TYSKEL_COMMENTS);
+ strcat(text, TYSKELTAB_DEF);
+ strcat(text, tySkelTab);
+ strcat(text, COPYTYSKELTAB_DEF);
+
+ return text;
+}
+
+/*********************************************************************/
+/* Constant relevant components */
+/*********************************************************************/
+#define C_NUMCONSTS_COMMENTS \
+"//total number pervasive constants\n"
+
+/*
+ //total number pervasive constants\n
+ #define PERV_CONST_NUM \n
+*/
+char* C_mkNumConsts(char* num)
+{
+ char* def = C_mkDefine(C_NUMCONSTS, num);
+ size_t length = strlen(def) + strlen(C_NUMCONSTS_COMMENTS) + 5;
+ char* numConsts = UTIL_mallocStr(length);
+
+ strcpy(numConsts, C_NUMCONSTS_COMMENTS);
+ strcat(numConsts, def); free(def);
+ strcat(numConsts, "\n\n");
+
+ return numConsts;
+}
+
+#define C_CONSTINDEX_COMMENTS \
+"//indices for predefined constants\n"
+
+char* C_mkConstIndexType(char* body)
+{
+ char* enumText = C_mkEnum(C_TY_CONSTIND, body);
+ char* typeDefText = C_mkTypeDef(enumText, C_TY_CONSTIND);
+ size_t length = strlen(typeDefText) + strlen(C_CONSTINDEX_COMMENTS);
+ char* constIndexType = UTIL_mallocStr(length);
+
+ strcpy(constIndexType, C_CONSTINDEX_COMMENTS);
+ strcat(constIndexType, typeDefText);
+ free(enumText); free(typeDefText);
+
+ return constIndexType;
+}
+
+//comments
+#define C_CONST_COMMENTS \
+"/***************************************************************************/ \n/* PERVASIVE CONSTANTS */ \n/***************************************************************************/\n\n"
+
+//PERV_ConstData
+#define C_CONSTDATA_TYPE \
+"//pervasive const data type \ntypedef struct \n{ \n char *name; \n TwoBytes typeEnvSize; \n TwoBytes tskTabIndex; //index to the type skeleton table \n TwoBytes neededness; //neededness (predicate constant) \n TwoBytes univCount; \n int precedence; \n int fixity; \n} PERV_ConstData; \n\n"
+
+//PERV_ConstDataTab
+#define C_CONSTDATA_TAB_DEC \
+"//pervasive const data table (array) \nextern PERV_ConstData PERV_constDataTab[PERV_CONST_NUM]; \n\n"
+
+//PERV_getConstData
+#define C_GETCONSTDATA_DEC \
+"//pervasive const data access function \nPERV_ConstData PERV_getConstData(int index); \n\n"
+
+//PERV_copyConstDataTab
+#define C_COPYCONSTDATATAB_DEC \
+"//pervasive const table copy function (used in module space initialization) \n//this functiion relies on the assumption that the pervasive kind data \n//has the same structure as that of the run-time kind symbol table entries. \nvoid PERV_copyConstDataTab(PERV_ConstData* dst); \n\n"
+
+//PERV_isLogicSymb PERV_isPredSymb
+#define C_ISLS_ISPS_DEC \
+"//functions used by the simulator for interpreted goals \nBoolean PERV_isLogicSymb(int index); \nBoolean PERV_isPredSymb(int index); \n\n"
+
+
+//PERV_logicSymb
+#define C_LOGICSYMB_DEC "PERV_LogicSymbTypes PERV_logicSymb(int index); \n\n"
+
+//PERV_predBuiltin
+#define C_PREDBUILTIN_DEC "int PERV_predBuiltin(int index); \n\n"
+
+char* C_mkConstH(char* constIndexType, char* numConsts, char* property)
+{
+ size_t length = strlen(C_CONST_COMMENTS) + strlen(constIndexType) +
+ strlen(numConsts) + strlen(C_CONSTDATA_TYPE) +
+ strlen(C_CONSTDATA_TAB_DEC) + strlen(C_GETCONSTDATA_DEC) +
+ strlen(C_COPYCONSTDATATAB_DEC) + strlen(property) +
+ strlen(C_ISLS_ISPS_DEC) + strlen(C_LOGICSYMB_DEC) +
+ strlen(C_PREDBUILTIN_DEC);
+ char* constH = UTIL_mallocStr(length);
+
+ strcpy(constH, C_CONST_COMMENTS);
+ strcat(constH, constIndexType);
+ strcat(constH, numConsts);
+ strcat(constH, C_CONSTDATA_TYPE);
+ strcat(constH, C_CONSTDATA_TAB_DEC);
+ strcat(constH, C_GETCONSTDATA_DEC);
+ strcat(constH, C_COPYCONSTDATATAB_DEC);
+ strcat(constH, property);
+ strcat(constH, C_ISLS_ISPS_DEC);
+ strcat(constH, C_LOGICSYMB_DEC);
+ strcat(constH, C_PREDBUILTIN_DEC);
+
+ return constH;
+}
+
+/***************************************************************/
+/* pervasives.c */
+/***************************************************************/
+//traslate precedence info into a string
+static char* C_mkPrec(OP_Prec prec)
+{
+ if (OP_precIsMax(prec)) return strdup("256");
+ else return UTIL_itoa(prec.data.prec);
+}
+//translate fixity info into a string
+static char* C_mkFixity(OP_Fixity fixity)
+{
+ switch (fixity){
+ case OP_INFIX : return strdup("OP_INFIX");
+ case OP_INFIXL : return strdup("OP_INFIXL");
+ case OP_INFIXR : return strdup("OP_INFIXR");
+ case OP_PREFIX : return strdup("OP_PREFIX");
+ case OP_PREFIXR : return strdup("OP_PREFIXR");
+ case OP_POSTFIX : return strdup("OP_POSTFIX");
+ case OP_POSTFIXL : return strdup("OP_POSTFIXL");
+ case OP_NONE : return strdup("OP_NONE");
+ default : return strdup("OP_NONE");
+ }
+}
+
+
+// { name, tesize, tst, (need), UC, prec, fixity }
+char* C_mkConstTabEntry(char* name, char* tesize, OP_Prec prec,
+ OP_Fixity fixity, char* tyskelInd, char* neededness,
+ char* comments)
+{
+ char* commentText = (comments) ? C_mkOneLineComments(comments) : NULL;
+ char* precText = C_mkPrec(prec);
+ char* fixityText = C_mkFixity(fixity);
+ size_t length = ((commentText) ? strlen(commentText) + strlen(C_INDENT): 0)
+ + strlen(name) + strlen(tesize) + strlen(tyskelInd)
+ + strlen(neededness) + strlen(precText) + strlen(fixityText)
+ + strlen(C_INDENT)*7 + 15;
+ char* entry = UTIL_mallocStr(length);
+
+ strcpy(entry, C_INDENT);
+ if (commentText) {
+ strcat(entry, commentText); strcat(entry, "\n");
+ strcat(entry, C_INDENT); free(commentText);
+ }
+ strcat(entry, "{\"");
+ strcat(entry, name);
+ strcat(entry, "\",");
+ strcat(entry, C_INDENT);
+ strcat(entry, tesize);
+ strcat(entry, ",");
+ strcat(entry, C_INDENT);
+ strcat(entry, tyskelInd);
+ strcat(entry, ",");
+ strcat(entry, C_INDENT);
+ strcat(entry, neededness);
+ strcat(entry, ",");
+ strcat(entry, C_INDENT);
+ strcat(entry, "0,");
+ strcat(entry, C_INDENT);
+ strcat(entry, precText); free(precText);
+ strcat(entry, ",");
+ strcat(entry, C_INDENT);
+ strcat(entry, fixityText); free(fixityText);
+ strcat(entry, "}");
+
+ return entry;
+}
+
+
+#define C_CONST_TAB_BEG \
+"//pervasive constant data table (array) \nPERV_ConstData PERV_constDataTab[PERV_CONST_NUM] = { \n //name, tesize, tst, neededness, UC, prec, fixity \n"
+#define C_CONST_TAB_END "};\n\n"
+
+/*
+ //pervasive const data table (array)
+ PERV_ConstData PERV_constDataTab[PERV_CONST_NUM] = { \n body \n};\n
+*/
+char* C_mkConstTab(char* body)
+{
+ size_t length = strlen(C_CONST_TAB_BEG) + strlen(C_CONST_TAB_END) +
+ strlen(body);
+ char* constTab = UTIL_mallocStr(length);
+
+ strcpy(constTab, C_CONST_TAB_BEG);
+ strcat(constTab, body);
+ strcat(constTab, C_CONST_TAB_END);
+
+ return constTab;
+}
+
+//PERV_getConstData
+#define C_GETCONSTDATA_DEF \
+"PERV_ConstData PERV_getConstData(int index) \n{ \n return PERV_constDataTab[index]; \n} \n\n"
+
+//PERV_copyConstDataTab
+#define C_COPYCONSTDATATAB_DEF \
+"void PERV_copyConstDataTab(PERV_ConstData* dst) \n{ \n //this way of copy relies on the assumption that the pervasive kind data \n //has the same structure as that of the run-time kind symbol table entries.\n memcpy((void*)dst, (void*)PERV_constDataTab, \n sizeof(PERV_ConstData) * PERV_CONST_NUM); \n} \n\n"
+
+//PERV_isLogicSymb
+#define C_ISLOGICSYMB_DEF \
+"Boolean PERV_isLogicSymb(int index) \n{ \n return ((index >= PERV_LSSTART) && (index <= PERV_LSEND)); \n}\n\n"
+
+//PERV_isPredSymb
+#define C_ISPREDSYMB_DEF \
+"Boolean PERV_isPredSymb(int index) \n{ \n return ((index >= PERV_PREDSTART) && (index <= PERV_PREDEND)); \n}\n\n"
+
+//PERV_logicSymb
+#define C_LOGICSYMB_DEF \
+"PERV_LogicSymbTypes PERV_logicSymb(int index) \n{ \n return ((PERV_LogicSymbTypes)(index - PERV_LSSTART)); \n}\n\n"
+
+//PERV_predBuiltin
+#define C_PREDBUILTIN_DEF \
+"int PERV_predBuiltin(int index) \n{ \n return (index - PERV_PREDSTART); \n}\n\n"
+
+char* C_mkConstC(char* constTab)
+{
+ size_t length = strlen(C_CONST_COMMENTS) + strlen(constTab) +
+ strlen(C_GETCONSTDATA_DEF) + strlen(C_COPYCONSTDATATAB_DEF) +
+ strlen(C_ISLOGICSYMB_DEF) + strlen(C_ISPREDSYMB_DEF) +
+ strlen(C_LOGICSYMB_DEF) + strlen(C_PREDBUILTIN_DEF);
+ char* constC = UTIL_mallocStr(length);
+
+ strcpy(constC, C_CONST_COMMENTS);
+ strcat(constC, constTab);
+ strcat(constC, C_GETCONSTDATA_DEF);
+ strcat(constC, C_COPYCONSTDATATAB_DEF);
+ strcat(constC, C_ISLOGICSYMB_DEF);
+ strcat(constC, C_ISPREDSYMB_DEF);
+ strcat(constC, C_LOGICSYMB_DEF);
+ strcat(constC, C_PREDBUILTIN_DEF);
+
+ return constC;
+}
+
+#define LOGICSYMBTYPE_DEC_BEG \
+"typedef enum PERV_LogicSymbTypes \n{\n"
+#define LOGICSYMBTYPE_DEC_END "} PERV_LogicSymbTypes;\n\n"
+
+char* C_mkLSTypeDec(char* body)
+{
+ size_t length = strlen(LOGICSYMBTYPE_DEC_BEG) + strlen(LOGICSYMBTYPE_DEC_END)
+ + strlen(body);
+ char* text = UTIL_mallocStr(length);
+
+ strcpy(text, LOGICSYMBTYPE_DEC_BEG);
+ strcat(text, body);
+ strcat(text, LOGICSYMBTYPE_DEC_END);
+
+ return text;
+}
+
+//PERV_LSSTART
+#define LSSTART_BEG "#define PERV_LSSTART "
+#define LSSTART_END " //begin of interpretable symbols\n"
+#define LSEND_BEG "#define PERV_LSEND "
+#define LSEND_END " //end of interpretable symbols\n"
+char* C_mkLSRange(char* start, char* end)
+{
+ char* range;
+ char* startInd = C_mkIndexName(start);
+ char* endInd = C_mkIndexName(end);
+ size_t length = strlen(startInd) + strlen(LSSTART_BEG) + strlen(LSSTART_END) +
+ strlen(endInd) + strlen(LSEND_BEG) + strlen(LSEND_END) + 5;
+
+ range = UTIL_mallocStr(length);
+ strcpy(range, LSSTART_BEG);
+ strcat(range, " ");
+ strcat(range, startInd); free(startInd);
+ strcat(range, LSSTART_END);
+ strcat(range, LSEND_BEG);
+ strcat(range, " ");
+ strcat(range, endInd); free(endInd);
+ strcat(range, LSEND_END);
+ strcat(range, "\n");
+
+ return range;
+}
+
+//PERV_PREDSTART
+#define PREDSTART_BEG "#define PERV_PREDSTART "
+#define PREDSTART_END " //begin of predicate symbols\n"
+#define PREDEND_BEG "#define PERV_PREDEND "
+#define PREDEND_END " //end of predicate symbols\n"
+
+char* C_mkPredRange(char* start, char* end)
+{
+ char* range;
+ char* startInd = C_mkIndexName(start);
+ char* endInd = C_mkIndexName(end);
+ size_t length = strlen(startInd) + strlen(PREDSTART_BEG) +
+ strlen(PREDSTART_END) + strlen(endInd) + strlen(PREDEND_BEG) +
+ strlen(PREDEND_END) + 5;
+
+ range = UTIL_mallocStr(length);
+ strcpy(range, PREDSTART_BEG);
+ strcat(range, " ");
+ strcat(range, startInd); free(startInd);
+ strcat(range, PREDSTART_END);
+ strcat(range, PREDEND_BEG);
+ strcat(range, " ");
+ strcat(range, endInd); free(endInd);
+ strcat(range, PREDEND_END);
+ strcat(range, "\n");
+
+ return range;
+}
+
+
+/*********************************************************************/
+/* fixed part of pervasives.h{c} */
+/*********************************************************************/
+#define C_COMMENTS_BEG_H \
+"/****************************************************************************/\n/* File pervasives.h. */ \n/****************************************************************************/\n\n"
+
+
+#define C_COMPDEF_BEG_H "#ifndef PERVASIVES_H\n#define PERVASIVES_H\n\n"
+#define C_COMPDEF_END_H "#endif //PERVASIVES_H\n"
+
+#define C_INCLUDE_H \
+"#include \"../simulator/mctypes.h\" //to be changed \n#include \"../simulator/dataformats.h\" //to be changed \n\n"
+
+char* C_mkFixedBegH()
+{
+ char* text = UTIL_mallocStr(strlen(C_COMMENTS_BEG_H) +
+ strlen(C_COMPDEF_BEG_H) +
+ strlen(C_INCLUDE_H));
+ strcpy(text, C_COMMENTS_BEG_H);
+ strcat(text, C_COMPDEF_BEG_H);
+ strcat(text, C_INCLUDE_H);
+ return text;
+}
+
+char* C_mkFixedEndH()
+{
+ char* text = strdup(C_COMPDEF_END_H);
+ return text;
+}
+
+#define C_COMMENTS_BEG_C \
+"/***************************************************************************/ \n/* File pervasives.c. */ \n/***************************************************************************/\n\n"
+
+#define C_COMPDEF_BEG_C "#ifndef PERVASIVES_C\n#define PERVASIVES_C\n\n"
+#define C_COMPDEF_END_C "#endif //PERVASIVES_C\n"
+
+#define C_INCLUDE_C \
+"#include \n#include \"pervasives.h\" \n#include \"../system/error.h\" //to be changed \n#include \"../system/operators.h\" //to be changed \n\n"
+
+char* C_mkFixedBegC()
+{
+ char* text = UTIL_mallocStr(strlen(C_COMMENTS_BEG_C) +
+ strlen(C_COMPDEF_BEG_C) +
+ strlen(C_INCLUDE_C));
+ strcpy(text, C_COMMENTS_BEG_C);
+ strcat(text, C_COMPDEF_BEG_C);
+ strcat(text, C_INCLUDE_C);
+ return text;
+}
+
+char* C_mkFixedEndC()
+{
+ char* text = strdup(C_COMPDEF_END_C);
+ return text;
+}
+
diff --git a/src/runtime/c/teyjus/tables_gen/pervasives/ccode.h b/src/runtime/c/teyjus/tables_gen/pervasives/ccode.h
new file mode 100644
index 000000000..7d5a781bb
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/pervasives/ccode.h
@@ -0,0 +1,80 @@
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+#include "types.h"
+#include "op.h"
+
+/*******************************************************************/
+/* commen structures */
+/*******************************************************************/
+/* // */
+char* C_mkOneLineComments(char* comments);
+/* // empty */
+char* C_mkEmptyComments();
+/*
+ //comments \n
+ PERV__INDEX =
+*/
+char* C_mkIndex(char* name, char* indexNum, char* comments);
+/*
+ PERV_ =
+*/
+char* C_mkIndex2(char* name, char* indexNum);
+
+/******************************************************************/
+/* kind relevant components */
+/******************************************************************/
+char* C_mkNumKinds(char* num);
+char* C_mkKindIndexType(char* body);
+char* C_mkKindH(char* indexType, char* kindNum);
+
+char* C_mkKindTabEntry(char* name, char* arity, char* comments);
+char* C_mkKindTab(char* body);
+char* C_mkKindC(char* kindTab);
+
+/******************************************************************/
+/* type skeleton relevant components */
+/******************************************************************/
+char* C_mkNumTySkels(char* num);
+char* C_mkTySkelsH(char* numTySkels);
+
+extern int C_totalSpace;
+char* C_genTySkel(Type tyskel, char* comments);
+char* C_mkTySkelTabInit(char* body, int space);
+char* C_mkTySkelsC(char* tySkelTab);
+
+/******************************************************************/
+/* constant relevant components */
+/******************************************************************/
+char* C_mkNumConsts(char* num);
+char* C_mkConstIndexType(char* body);
+char* C_mkConstH(char* constIndexType, char* numConsts, char* property);
+
+char* C_mkConstTabEntry(char* name, char* tesize, OP_Prec prec,
+ OP_Fixity fixity, char* tyskelInd, char* neededness,
+ char* comments);
+char* C_mkConstTab(char* body);
+char* C_mkConstC(char* constTab);
+
+
+char* C_mkLSTypeDec(char* body);
+char* C_mkLSRange(char* start, char* end);
+char* C_mkPredRange(char* start, char* end);
+
+char* C_mkFixedBegH();
+char* C_mkFixedEndH();
+char* C_mkFixedBegC();
+char* C_mkFixedEndC();
diff --git a/src/runtime/c/teyjus/tables_gen/pervasives/ocamlcode.c b/src/runtime/c/teyjus/tables_gen/pervasives/ocamlcode.c
new file mode 100644
index 000000000..261d4dfab
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/pervasives/ocamlcode.c
@@ -0,0 +1,1434 @@
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/***************************************************************************/
+/* ocamlcode.c. */
+/* This file defines auxiliary functions in making pervasive.mli and */
+/* pervasive.ml. */
+/* Since space and time efficiency is not an important concern in the */
+/* system source code generation phase, the code here is structured in the */
+/* way for the convenience of making changes on pervasive.mli{ml}. */
+/***************************************************************************/
+#include
+#include
+#include
+
+#include "ocamlcode.h"
+
+/***************************************************************************/
+/* Functions for making various language constructs */
+/***************************************************************************/
+/* Make a string of form . */
+static char* OC_mkDotStr(char* first, char* second)
+{
+ size_t length = strlen(first) + strlen(second) + 1;
+ char* ptr = UTIL_mallocStr(length+1);
+
+ strcpy(ptr, first);
+ strcat(ptr, ".");
+ strcat(ptr, second);
+
+ return ptr;
+}
+
+/*
+ (Some )
+*/
+char* OC_mkSome(char* info)
+{
+ size_t length = strlen(info) + 10;
+ char* rtptr = UTIL_mallocStr(length + 1);
+
+ strcpy(rtptr, "(Some ");
+ strcat(rtptr, info);
+ strcat(rtptr, ")");
+
+ return rtptr;
+}
+
+/*
+ (ref )
+*/
+char* OC_mkRef(char* info)
+{
+ size_t length = strlen(info) + 10;
+ char* rtptr = UTIL_mallocStr(length + 1);
+
+ strcpy(rtptr, "(ref ");
+ strcat(rtptr, info);
+ strcat(rtptr, ")");
+
+ return rtptr;
+}
+
+
+/* Make a variable definition:
+ let =
+*/
+static char* OC_mkVarDef(char* varName, char* defs)
+{
+ size_t length = strlen(varName) + strlen(defs) + 10;
+ char* vardef = UTIL_mallocStr(length + 1);
+
+ strcpy(vardef, "let ");
+ strcat(vardef, varName);
+ strcat(vardef, " = ");
+ strcat(vardef, defs);
+
+ return vardef;
+}
+
+/* Make a variable declaration:
+ val : "\n"
+*/
+static char* OC_mkVarDec(char* varName, char* varType)
+{
+ size_t length = strlen(varName) + strlen(varType) + 10;
+ char* vardec = UTIL_mallocStr(length + 1);
+
+ strcpy(vardec, "val ");
+ strcat(vardec, varName);
+ strcat(vardec, " : ");
+ strcat(vardec, varType);
+ strcat(vardec, "\n");
+
+ return vardec;
+}
+
+/* Make arrow type:
+ ->
+*/
+static char* OC_mkArrowType(char* ty1, char* ty2)
+{
+ size_t length = strlen(ty1) + strlen(ty2) + 5;
+ char* arrowType = UTIL_mallocStr(length);
+
+ strcpy(arrowType, ty1);
+ strcat(arrowType, " -> ");
+ strcat(arrowType, ty2);
+ return arrowType;
+}
+
+
+/**************************************************************************/
+/* Names from other modules */
+/**************************************************************************/
+/********************************************************/
+/* Fixities */
+/********************************************************/
+#define INFIX "Absyn.Infix"
+#define INFIXL "Absyn.Infixl"
+#define INFIXR "Absyn.Infixr"
+#define PREFIX "Absyn.Prefix"
+#define PREFIXR "Absyn.Prefixr"
+#define POSTFIX "Absyn.Postfix"
+#define POSTFIXL "Absyn.Postfixl"
+#define NOFIXITY "Absyn.NoFixity"
+
+#define MAXPREC "maxPrec + 1"
+
+/********************************************************/
+/* module names */
+/********************************************************/
+#define ABSYN "Absyn"
+#define SYMBOL "Symbol"
+#define ERRORMSG "Errormsg"
+#define TABLE "Table"
+
+/********************************************************/
+/* types */
+/********************************************************/
+//absyn
+#define TY_KIND "akind"
+#define TY_CONST "aconstant"
+#define TY_TERM "aterm"
+#define TY_TYABBREV "atypeabbrev"
+//table
+#define TY_SYMTAB "SymbolTable.t"
+
+/********************************************************/
+/* value constructors */
+/********************************************************/
+//absyn
+#define VCTR_KIND "Kind"
+#define VCTR_KINDTYPE "PervasiveKind"
+#define VCTR_CONSTANT "Constant"
+#define VCTR_PERVCONST "PervasiveConstant"
+#define VCTR_TYSKEL "Skeleton"
+#define VCTR_APPTYPE "ApplicationType"
+#define VCTR_ARROWTYPE "ArrowType"
+#define VCTR_SKELVARTYPE "SkeletonVarType"
+#define VCTR_BUILTIN "Builtin"
+
+//errormsg
+#define VCTR_NULLPOS "none"
+
+//symbol
+#define VCTR_SYMBOL "symbol"
+#define VCTR_SYMBOL_ALIAS "symbolAlias"
+
+//table
+#define VCTR_EMPTYTAB "SymbolTable.empty"
+
+/********************************************************/
+/* functions */
+/********************************************************/
+//table
+#define FUNC_ADD "add"
+//absyn
+#define FUNC_MAKETYSETVAR "makeTypeSetVariable"
+
+/***************************************************************************/
+/* Local names */
+/***************************************************************************/
+#define BUILDPERVKIND "buildPervasiveKinds"
+#define BUILDPERVCONST "buildPervasiveConstants"
+
+#define PERVKIND "pervasiveKinds"
+#define PERVCONST "pervasiveConstants"
+#define PERVTYABBR "pervasiveTypeAbbrevs"
+
+#define KVAR_PREFIX "k"
+#define CVAR_POSTFIX "Constant"
+#define TSKVAR_PREFIX "tyskel"
+#define TAB "t"
+
+#define IS "is"
+#define SETVARIR "tysetvarIR"
+#define SETVARIRS "tysetvarIRS"
+#define OVERLOADTYSKEL1 "overloadTySkel1"
+#define OVERLOADTYSKEL2 "overloadTySkel2"
+#define OVERLOADTYSKEL3 "overloadTySkel3"
+
+/***************************************************************************/
+/* Functions for making program components */
+/***************************************************************************/
+/*
+ (Symbol.symbol "")
+*/
+static char* OC_mkSymbol(char* name)
+{
+ char* symbolCtr = OC_mkDotStr(SYMBOL, VCTR_SYMBOL);
+ size_t length = strlen(symbolCtr) + strlen(name) + 10;
+ char* rtptr= UTIL_mallocStr(length + 1);
+
+ strcpy(rtptr, "(");
+ strcat(rtptr, symbolCtr); free(symbolCtr);
+ strcat(rtptr, " \"");
+ strcat(rtptr, name);
+ strcat(rtptr, "\")");
+ return rtptr;
+}
+
+/*
+ (Symbol.symbolAlias "" "")
+*/
+static char* OC_mkSymbolAlias(char *name, char *printName)
+{
+ char* symbolCtr = OC_mkDotStr(SYMBOL, VCTR_SYMBOL_ALIAS);
+ size_t length = strlen(symbolCtr) + strlen(name) + strlen(printName) + 10;
+ char* rtptr= UTIL_mallocStr(length + 1);
+
+ strcpy(rtptr, "(");
+ strcat(rtptr, symbolCtr); free(symbolCtr);
+ strcat(rtptr, " \"");
+ strcat(rtptr, name);
+ strcat(rtptr, "\" \"");
+ strcat(rtptr, printName);
+ strcat(rtptr, "\")");
+ return rtptr;
+}
+
+/* let t = Table.add (Symbol.symbol "") t in\n
+ */
+char* OC_mkTabEntry(char* name, char* varName)
+{
+ char* entry;
+ char* tableAdd = OC_mkDotStr(TABLE, FUNC_ADD);
+ char* symbol = OC_mkSymbol(name);
+ size_t length = strlen(tableAdd) + strlen(symbol) + strlen(varName) +
+ strlen(TAB) + 15;
+ char* def = UTIL_mallocStr(length + 1);
+
+ strcpy(def, tableAdd); free(tableAdd);
+ strcat(def, " ");
+ strcat(def, symbol); free(symbol);
+ strcat(def, " ");
+ strcat(def, varName);
+ strcat(def, " ");
+ strcat(def, TAB);
+ strcat(def, " in\n ");
+
+ entry = OC_mkVarDef(TAB, def); free(def);
+ return entry;
+}
+
+/* let t = Table.SymbolTable.empty in \n*/
+static char* OC_mkTabInit()
+{
+ char* init;
+ char* emptyTab = OC_mkDotStr(TABLE, VCTR_EMPTYTAB);
+ size_t length = strlen(emptyTab) + 10;
+ char* def = UTIL_mallocStr(length + 1);
+
+ strcpy(def, emptyTab); free(emptyTab);
+ strcat(def, " in\n ");
+
+ init = OC_mkVarDef(TAB, def); free(def);
+
+ return init;
+}
+
+/* let = function () ->\n
+ let t = Table.SymbolTable.empty in t\n\n */
+static char* OC_mkBuildTabFunc(char* funcName, char* entries)
+{
+ char* func;
+ char* inits = OC_mkTabInit();
+ size_t length = strlen(entries) + strlen(TAB) + strlen(inits) + 30;
+ char* def = UTIL_mallocStr(length + 1);
+
+ strcpy(def, "function () ->\n ");
+ strcat(def, inits); free(inits);
+ strcat(def, entries);
+ strcat(def, TAB);
+ strcat(def, "\n\n");
+
+ func = OC_mkVarDef(funcName, def); free(def);
+
+ return func;
+}
+
+/* let = ()\n\n */
+static char* OC_mkTab(char* tabName, char* buildFuncName)
+{
+ char* tab;
+ size_t length = strlen(buildFuncName) + 10;
+ char* def = UTIL_mallocStr(length + 1);
+
+ strcpy(def, buildFuncName);
+ strcat(def, " ()\n\n");
+
+ tab = OC_mkVarDef(tabName, def); free(def);
+
+ return tab;
+}
+
+/* val = Absyn. Table.SymbolTable.t\n */
+static char* OC_mkTabDec(char* tabName, char* typeName)
+{
+ char* dec;
+ char* symbolTab = OC_mkDotStr(TABLE, TY_SYMTAB);
+ char* myType = OC_mkDotStr(ABSYN, typeName);
+ size_t length = strlen(symbolTab) + strlen(myType) + 5;
+ char* typedec = UTIL_mallocStr(length + 1);
+
+ strcpy(typedec, myType); free(myType);
+ strcat(typedec, " ");
+ strcat(typedec, symbolTab); free(symbolTab);
+ strcat(typedec, "\n");
+
+ dec = OC_mkVarDec(tabName, typedec); free(typedec);
+
+ return dec;
+}
+
+/****************************************************************************/
+/* functions for making pervasive kind relevant components */
+/****************************************************************************/
+/* k */
+char* OC_mkKVarName(char* name)
+{
+ return UTIL_appendStr(KVAR_PREFIX, name);
+}
+
+/* is */
+char* OC_mkIsKindFuncName(char* name)
+{
+ return UTIL_appendStr(IS, name);
+}
+
+/* val : Absyn.akind \n*/
+char* OC_mkKindVarDec(char* kindVarName)
+{
+ char* kindType = OC_mkDotStr(ABSYN, TY_KIND);
+ char* dec = OC_mkVarDec(kindVarName, kindType);
+ free(kindType);
+ return dec;
+}
+
+/* val : Absyn.akind -> bool */
+char* OC_mkIsKindFuncDec(char* funcName)
+{
+ char* kindType = OC_mkDotStr(ABSYN, TY_KIND);
+ char* arrowType = OC_mkArrowType(kindType, "bool");
+ char* dec = OC_mkVarDec(funcName, arrowType);
+ free(kindType); free(arrowType);
+ return dec;
+}
+
+/* let tm = tm == */
+char* OC_mkIsKindFuncDef(char* funcName, char* kindVarName)
+{
+ char* funchead = UTIL_mallocStr(strlen(funcName) + 3);
+ char* defbody = UTIL_mallocStr(strlen(kindVarName) + 10);
+ char* def;
+
+ strcpy(funchead, funcName);
+ strcat(funchead, " tm");
+
+ strcpy(defbody, "(tm == ");
+ strcat(defbody, kindVarName);
+ strcat(defbody, ")");
+
+ def = OC_mkVarDef(funchead, defbody); free(funchead); free(defbody);
+ return def;
+}
+
+/*Kind variable definition:
+ let = Absyn.PervasiveKind(Symbol.symbol "",
+ (Some ), ref offset, Errormsg.none)
+*/
+char* OC_mkKindVar(char* varName, char* kindName, char* arity, char* offset)
+{
+ char* kindvar;
+ char* ctr = OC_mkDotStr(ABSYN, VCTR_KIND);
+ char* symbol = OC_mkSymbol(kindName);
+ char* nargs = OC_mkSome(arity);
+ char* index = OC_mkRef(offset);
+ char* ktype = OC_mkDotStr(ABSYN, VCTR_KINDTYPE);
+ char* pos = OC_mkDotStr(ERRORMSG, VCTR_NULLPOS);
+ size_t length = strlen(ctr) + strlen(symbol) + strlen(nargs) +
+ strlen(index) + strlen(ktype) + strlen(pos) + 10;
+
+ char* def = UTIL_mallocStr(length + 1);
+
+ strcpy(def, ctr); free(ctr);
+ strcat(def, "(");
+ strcat(def, symbol); free(symbol);
+ strcat(def, ", ");
+ strcat(def, nargs); free(nargs);
+ strcat(def, ", ");
+ strcat(def, index); free(index);
+ strcat(def, ", ");
+ strcat(def, ktype); free(ktype);
+ strcat(def, ", ");
+ strcat(def, pos); free(pos);
+ strcat(def, ")");
+
+ kindvar = OC_mkVarDef(varName, def); free(def);
+ return kindvar;
+}
+
+/* let buildPervasiveKinds =
+ function () ->\n \n \n\n */
+char* OC_mkBuildKTabFunc(char* entries)
+{
+ return OC_mkBuildTabFunc(BUILDPERVKIND, entries);
+}
+
+/****************************************************************************/
+/* functions for making pervasive type skeleton components */
+/****************************************************************************/
+/* Absyn.SkeletonVarType(ref )
+ */
+static char* genTySkelVar(char* ind)
+{
+ char* ctr = OC_mkDotStr(ABSYN, VCTR_SKELVARTYPE);
+ char* ref = OC_mkRef(ind);
+ size_t length = strlen(ctr) + strlen(ref) + 5;
+ char* skelVar = UTIL_mallocStr(length + 1);
+
+ strcpy(skelVar, ctr); free(ctr);
+ strcat(skelVar, "(");
+ strcat(skelVar, ref); free(ref);
+ strcat(skelVar, ")");
+
+ return skelVar;
+}
+
+/* Absyn.ArrowType(, )
+ */
+static char* genTySkelArrow(char* type1, char* type2)
+{
+ char* ctr = OC_mkDotStr(ABSYN, VCTR_ARROWTYPE);
+ size_t length = strlen(ctr) + strlen(type1) + strlen(type2) + 5;
+ char* arrowtype = UTIL_mallocStr(length + 1);
+
+ strcpy(arrowtype, ctr); free(ctr);
+ strcat(arrowtype, "(");
+ strcat(arrowtype, type1);
+ strcat(arrowtype, ", ");
+ strcat(arrowtype, type2);
+ strcat(arrowtype, ")");
+
+ return arrowtype;
+}
+
+/* Absyn.AppType(k, )
+ */
+static char* genTySkelApp(char* sortName, char* args)
+{
+ char* ctr = OC_mkDotStr(ABSYN, VCTR_APPTYPE);
+ char* sortVar = OC_mkKVarName(sortName);
+ size_t length = strlen(ctr) + strlen(sortVar) + strlen(args) + 5;
+ char* apptype = UTIL_mallocStr(length + 1);
+
+ strcpy(apptype, ctr); free(ctr);
+ strcat(apptype, "(");
+ strcat(apptype, sortVar); free(sortVar);
+ strcat(apptype, ", ");
+ strcat(apptype, args);
+ strcat(apptype, ")");
+
+ return apptype;
+}
+
+/* Absyn.AppType(k, [])
+ */
+static char* genTySkelSort(char* sortName)
+{
+ return genTySkelApp(sortName, "[]");
+}
+
+//forward declaration
+char* OC_genTySkel(Type args);
+
+static char* OC_genTySkelArgs(TypeList args)
+{
+ size_t length;
+ char* mytext1 = NULL;
+ char* mytext = NULL;
+ char* oneTypeText = NULL;
+ Type oneType = args -> oneType;
+
+ args = args -> next;
+ mytext1 = OC_genTySkel(oneType);
+
+ while (args) {
+ oneType = args -> oneType;
+ args = args -> next;
+ oneTypeText = OC_genTySkel(oneType);
+
+ length = strlen(mytext1) + strlen(oneTypeText) + 5;
+ mytext = UTIL_mallocStr(length + 1);
+ strcpy(mytext, mytext1); free(mytext1);
+ strcat(mytext, " :: ");
+ strcat(mytext, oneTypeText); free(oneTypeText);
+ mytext1 = mytext;
+ }
+ length = strlen(mytext1) + 10;
+ mytext = UTIL_mallocStr(length + 1);
+ strcpy(mytext, "(");
+ strcat(mytext, mytext1); free(mytext1);
+ strcat(mytext, " :: [])");
+
+ return mytext;
+}
+
+char* OC_genTySkel(Type tyskel)
+{
+ char* mytext1;
+ char* mytext2;
+ char* mytext3;
+
+ switch(tyskel -> tag) {
+ case SORT:
+ {
+ mytext1 = genTySkelSort(tyskel -> data.sort);
+ return mytext1;
+ }
+ case SKVAR:
+ {
+ mytext1 = genTySkelVar(tyskel -> data.skvar);
+ return mytext1;
+ }
+ case STR:
+ {
+ mytext1 = OC_genTySkelArgs(tyskel -> data.str.args);
+ mytext2 = genTySkelApp((tyskel -> data.str.functor)->data.func.name,
+ mytext1);
+ free(mytext1);
+ return mytext2;
+ }
+ case ARROW:
+ {
+ mytext1 = OC_genTySkel(tyskel -> data.arrow.lop);
+ mytext2 = OC_genTySkel(tyskel -> data.arrow.rop);
+ mytext3 = genTySkelArrow(mytext1, mytext2);
+ free(mytext1); free(mytext2);
+ return mytext3;
+ }
+ default:
+ return strdup("");
+ }
+}
+
+/* tyskel */
+char* OC_mkTySkelVarName(char* number)
+{
+ return UTIL_appendStr(TSKVAR_PREFIX, number);
+}
+
+/* Type Skeleton variable definition:
+ let = Some(Absyn.Skeleton(, ref None, ref false))
+*/
+char* OC_mkTYSkelVar(char* varName, char* tySkel)
+{
+ char* tyskelvar;
+ char* ctr = OC_mkDotStr(ABSYN, VCTR_TYSKEL);
+ char* index = OC_mkRef("None");
+ char* adjust = OC_mkRef("false");
+ size_t length = strlen(ctr) + strlen(index) + strlen(adjust) +
+ strlen(tySkel) + 15;
+ char* def = UTIL_mallocStr(length + 1);
+ char* somedef;
+
+ strcpy(def, "(");
+ strcat(def, ctr); free(ctr);
+ strcat(def, "(");
+ strcat(def, tySkel);
+ strcat(def, ", ");
+ strcat(def, index); free(index);
+ strcat(def, ", ");
+ strcat(def, adjust); free(adjust);
+ strcat(def, "))");
+
+ somedef = OC_mkSome(def); free(def);
+ tyskelvar = OC_mkVarDef(varName, somedef); free(somedef);
+
+ return tyskelvar;
+}
+
+
+static char* OC_mkTypeSetVar(char* defaultty, char* arglist, char* tyName)
+{
+ char* setVar;
+ char* func = OC_mkDotStr(ABSYN, FUNC_MAKETYSETVAR);
+ char* def = UTIL_mallocStr(strlen(func) + strlen(arglist) + strlen(defaultty) + 2);
+ strcpy(def, func); free(func);
+ strcat(def, " ");
+ strcat(def, defaultty);
+ strcat(def, " ");
+ strcat(def, arglist);
+
+ setVar = OC_mkVarDef(tyName, def); free(def);
+ return setVar;
+}
+
+/*********************************************/
+/* generate tyskels for overloaded constants */
+/*********************************************/
+static char* OC_mkTySkelRef(char* tySkel)
+{
+ char* ctr = OC_mkDotStr(ABSYN, VCTR_TYSKEL);
+ char* index = OC_mkRef("None");
+ char* adjust = OC_mkRef("false");
+ size_t length = strlen(ctr) + strlen(index) + strlen(adjust) +
+ strlen(tySkel) + 15;
+ char* def = UTIL_mallocStr(length + 1);
+ char* somedef;
+ char* ref;
+
+ strcpy(def, "(");
+ strcat(def, ctr); free(ctr);
+ strcat(def, "(");
+ strcat(def, tySkel);
+ strcat(def, ", ");
+ strcat(def, index); free(index);
+ strcat(def, ", ");
+ strcat(def, adjust); free(adjust);
+ strcat(def, "))");
+
+ somedef = OC_mkSome(def); free(def);
+ ref = OC_mkRef(somedef); free(somedef);
+ return ref;
+}
+
+char* OC_mkFixedTySkels(char* tySkels)
+{
+ char *text;
+ char* setvarIntReal =
+ OC_mkTypeSetVar("(Absyn.ApplicationType(kint,[]))",
+ "(Absyn.ApplicationType(kint,[]) :: Absyn.ApplicationType(kreal,[]) :: [])", SETVARIR);
+ char* setvarIntRealStr =
+ OC_mkTypeSetVar("(Absyn.ApplicationType(kint,[]))",
+ "(Absyn.ApplicationType(kint,[]) :: Absyn.ApplicationType(kreal,[]) :: Absyn.ApplicationType(kstring, []) :: [])", SETVARIRS);
+ char *tyskelBody, *tyskelBody2;
+ char *tyskel, *tyskelText;
+
+ text = UTIL_appendStr(tySkels, setvarIntReal); free(setvarIntReal);
+ tySkels = UTIL_appendStr(text, "\n"); free(text);
+
+ tyskelBody = genTySkelArrow(SETVARIR, SETVARIR);
+ tyskelText = OC_mkTySkelRef(tyskelBody);
+ tyskel = OC_mkVarDef(OVERLOADTYSKEL1, tyskelText); free(tyskelText);
+ text = UTIL_appendStr(tySkels, tyskel); free(tyskel);
+ tySkels = UTIL_appendStr(text, "\n"); free(text);
+
+ tyskelBody2 = genTySkelArrow(SETVARIR, tyskelBody); free(tyskelBody);
+ tyskelText = OC_mkTySkelRef(tyskelBody2); free(tyskelBody2);
+ tyskel = OC_mkVarDef(OVERLOADTYSKEL2, tyskelText); free(tyskelText);
+ text = UTIL_appendStr(tySkels, tyskel); free(tyskel);
+ tySkels = UTIL_appendStr(text, "\n\n"); free(text);
+
+ text = UTIL_appendStr(tySkels, setvarIntRealStr); free(setvarIntRealStr);
+ tySkels = UTIL_appendStr(text, "\n"); free(text);
+
+ tyskelBody = genTySkelArrow(SETVARIRS, "Absyn.ApplicationType(kbool, [])");
+ tyskelBody2 = genTySkelArrow(SETVARIRS, tyskelBody); free(tyskelBody);
+ tyskelText = OC_mkTySkelRef(tyskelBody2); free(tyskelBody2);
+ tyskel = OC_mkVarDef(OVERLOADTYSKEL3, tyskelText); free(tyskelText);
+ text = UTIL_appendStr(tySkels, tyskel); free(tyskel);
+ tySkels = UTIL_appendStr(text, "\n\n"); free(text);
+
+ return tySkels;
+}
+
+/****************************************************************************/
+/* functions for making pervasive constants components */
+/****************************************************************************/
+/* Constant */
+char* OC_mkCVarName(char* name)
+{
+ return UTIL_appendStr(name, CVAR_POSTFIX);
+}
+/* isConstant */
+char* OC_mkIsConstFuncName(char* name)
+{
+ return UTIL_appendStr(IS, name);
+}
+
+/* val : Absyn.aconstant \n*/
+char* OC_mkConstVarDec(char* constVarName)
+{
+ char* constType = OC_mkDotStr(ABSYN, TY_CONST);
+ char* dec = OC_mkVarDec(constVarName, constType);
+ free(constType);
+ return dec;
+}
+
+/* val : Absyn.aconstant -> bool */
+char* OC_mkIsConstFuncDec(char* funcName)
+{
+ char* constType = OC_mkDotStr(ABSYN, TY_CONST);
+ char* arrowType = OC_mkArrowType(constType, "bool");
+ char* dec = OC_mkVarDec(funcName, arrowType);
+ free(constType); free(arrowType);
+ return dec;
+}
+
+
+/* let tm = tm == */
+char* OC_mkIsConstFuncDef(char* funcName, char* constVarName)
+{
+ char* funchead = UTIL_mallocStr(strlen(funcName) + 3);
+ char* defbody = UTIL_mallocStr(strlen(constVarName) + 10);
+ char* def;
+
+ strcpy(funchead, funcName);
+ strcat(funchead, " tm");
+
+ strcpy(defbody, "(tm == ");
+ strcat(defbody, constVarName);
+ strcat(defbody, ")");
+
+ def = OC_mkVarDef(funchead, defbody); free(funchead); free(defbody);
+ return def;
+}
+
+/* (ref fixity) */
+static char* OC_mkFixity(OP_Fixity fixity)
+{
+ switch (fixity){
+ case OP_INFIX : return OC_mkRef(strdup(INFIX));
+ case OP_INFIXL : return OC_mkRef(strdup(INFIXL));
+ case OP_INFIXR : return OC_mkRef(strdup(INFIXR));
+ case OP_PREFIX : return OC_mkRef(strdup(PREFIX));
+ case OP_PREFIXR : return OC_mkRef(strdup(PREFIXR));
+ case OP_POSTFIX : return OC_mkRef(strdup(POSTFIX));
+ case OP_POSTFIXL : return OC_mkRef(strdup(POSTFIXL));
+ case OP_NONE : return OC_mkRef(strdup(NOFIXITY));
+ default : return OC_mkRef(strdup(NOFIXITY));
+ }
+}
+
+/* (ref prec) */
+static char* OC_mkPrec(OP_Prec prec)
+{
+ char* precNum;
+ char* precText;
+ if (OP_precIsMax(prec)) {
+ char* temp = OC_mkDotStr(ABSYN, MAXPREC);
+ precNum = UTIL_mallocStr(strlen(temp) + 2);
+ strcpy(precNum, "(");
+ strcat(precNum, temp);
+ strcat(precNum, ")");
+ } else precNum = UTIL_itoa(prec.data.prec);
+ precText = OC_mkRef(precNum); free(precNum);
+ return precText;
+}
+
+/* (ref true/false ) */
+static char* OC_mkRefBool(UTIL_Bool value)
+{
+ if (value) return OC_mkRef("true");
+ else return OC_mkRef("false");
+}
+
+static char* OC_mkRefInt(int value)
+{
+ char* valueText = UTIL_itoa(value);
+ char* text = OC_mkRef(valueText);
+ free(valueText);
+ return text;
+}
+
+static char* OC_mkCodeInfo(OP_Code codeInfo)
+{
+ char* code;
+ char* ref;
+ if (OP_codeInfoIsNone(codeInfo)) {
+ code = strdup("None");
+ } else {
+ char* codeInd = UTIL_itoa(codeInfo);
+ char* ctr = OC_mkDotStr(ABSYN, VCTR_BUILTIN);
+ char* codeText = UTIL_mallocStr(strlen(codeInd) + strlen(ctr) + 10);
+ strcpy(codeText, "(");
+ strcat(codeText, ctr); free(ctr);
+ strcat(codeText, "(");
+ strcat(codeText, codeInd); free(codeInd);
+ strcat(codeText, "))");
+ code = OC_mkSome(codeText); free(codeText);
+ }
+ ref = OC_mkRef(code); free(code);
+ return ref;
+}
+
+static char* OC_mkConstCat(UTIL_Bool redef)
+{
+ char* ctr = OC_mkDotStr(ABSYN,VCTR_PERVCONST);
+ char* boolValue;
+ char* cat;
+ char* ref;
+
+ if (redef) boolValue = strdup("true");
+ else boolValue = strdup("false");
+
+ cat = UTIL_mallocStr(strlen(ctr) + strlen(boolValue) + 10);
+ strcpy(cat, "(");
+ strcat(cat, ctr); free(ctr);
+ strcat(cat, "(");
+ strcat(cat, boolValue); free(boolValue);
+ strcat(cat, "))");
+
+ ref = OC_mkRef(cat); free(cat);
+ return ref;
+}
+
+static char* OC_mkSkelNeededness(int tyenvsize)
+{
+ char* length = UTIL_itoa(tyenvsize);
+ char* some;
+ char* ref;
+ char* init = UTIL_mallocStr(strlen(length) + 20);
+ strcpy(init, "(Array.make ");
+ strcat(init, length); free(length);
+ strcat(init, " true)");
+
+ some = OC_mkSome(init); free(init);
+ ref = OC_mkRef(some); free(some);
+ return ref;
+}
+
+static char* OC_mkNeededness(int neededness, int tyenvsize)
+{
+ char* length = UTIL_itoa(tyenvsize);
+ char* init;
+ char* some;
+ char* ref;
+
+ if (neededness == tyenvsize) {
+ init = UTIL_mallocStr(strlen(length) + 20);
+ strcpy(init, "(Array.make ");
+ strcat(init, length); free(length);
+ strcat(init, " true)");
+ } else {
+ char* num = UTIL_itoa(neededness);
+ init = UTIL_mallocStr(strlen(length) + strlen(num) + 60);
+ strcpy(init, "(Array.init ");
+ strcat(init, length); free(length);
+ strcat(init, " (fun x -> if x >= ");
+ strcat(init, num); free(num);
+ strcat(init, " then false else true))");
+ }
+ some = OC_mkSome(init); free(init);
+ ref = OC_mkRef(some); free(some);
+ return ref;
+}
+
+
+static char* OC_mkConstVarText(char* constName, char* fixity, char* prec,
+ char* typrev, char* tyskel, char* tyenvsize,
+ char* skelneededness, char* neededness, char* codeinfo,
+ char* constcat, char* varname, char* offset,
+ char* printName)
+{
+ char* constVar;
+ char* ctr = OC_mkDotStr(ABSYN, VCTR_CONSTANT);
+ char* symbol = OC_mkSymbolAlias(constName, printName);
+ char* refFalse = OC_mkRef("false");
+ char* refTrue = OC_mkRef("true");
+ char* index = OC_mkRef(offset);
+ char* pos = OC_mkDotStr(ERRORMSG, VCTR_NULLPOS);
+
+ size_t length = strlen(ctr) + strlen(symbol) + strlen(fixity) +
+ strlen(prec) + strlen(typrev) + strlen(tyskel) + strlen(tyenvsize) +
+ strlen(skelneededness) + strlen(neededness) + strlen(codeinfo) +
+ strlen(constcat) + strlen(index) + strlen(pos) + strlen(refFalse) * 6 + 35;
+ char* def = UTIL_mallocStr(length);
+
+ strcpy(def, ctr); free(ctr);
+ strcat(def, "(");
+ strcat(def, symbol); free(symbol);
+ strcat(def, ", ");
+ strcat(def, fixity);
+ strcat(def, ", ");
+ strcat(def, prec);
+ strcat(def, ", ");
+ strcat(def, refFalse);
+ strcat(def, ", ");
+ strcat(def, refFalse);
+ strcat(def, ", ");
+ strcat(def, refTrue); free(refTrue); /* no defs */
+ strcat(def, ", ");
+ strcat(def, refFalse);
+ strcat(def, ", ");
+ strcat(def, typrev);
+ strcat(def, ", ");
+ strcat(def, refFalse); free(refFalse);
+ strcat(def, ", ");
+ strcat(def, tyskel);
+ strcat(def, ", ");
+ strcat(def, tyenvsize);
+ strcat(def, ", ");
+ strcat(def, skelneededness);
+ strcat(def, ", ");
+ strcat(def, neededness);
+ strcat(def, ", ");
+ strcat(def, codeinfo);
+ strcat(def, ", ");
+ strcat(def, constcat);
+ strcat(def, ", ");
+ strcat(def, index); free(index);
+ strcat(def, ", ");
+ strcat(def, pos); free(pos);
+ strcat(def, ")");
+
+ constVar = OC_mkVarDef(varname, def); free(def);
+ return constVar;
+}
+
+/* Constant variable definition :
+ let = Absyn.Constant(Symbol.symbolAlias "" "",
+ ref , ref , ref false, ref false, ref false, ref false,
+ ref false, ref , ref false, ref ,
+ ref , ref (Some ),
+ ref (Some ), ref ,
+ ref , ref 0, Errormsg.none)
+*/
+char* OC_mkConstVar(char* constName, OP_Fixity fixity, OP_Prec prec,
+ UTIL_Bool typrev, char* tySkel, int tyenvsize,
+ int neededness, OP_Code codeInfo, UTIL_Bool reDef,
+ char* varName, char* offset, char* printName)
+{
+ char* constVar;
+ char* fixityText = OC_mkFixity(fixity);
+ char* precText = OC_mkPrec(prec);
+ char* typrevText = OC_mkRefBool(typrev);
+ char* tySkelText = OC_mkRef(tySkel);
+ char* tyenvsizeText = OC_mkRefInt(tyenvsize);
+ char* skelneedednessText = OC_mkSkelNeededness(tyenvsize);
+ char* needednessText = OC_mkNeededness(neededness, tyenvsize);
+ char* codeInfoText = OC_mkCodeInfo(codeInfo);
+ char* constCatText = OC_mkConstCat(reDef);
+
+ constVar = OC_mkConstVarText(constName, fixityText, precText,
+ typrevText, tySkelText, tyenvsizeText,
+ skelneedednessText, needednessText, codeInfoText,
+ constCatText, varName, offset, printName);
+
+ free(fixityText); free(precText); free(typrevText); free(tySkelText);
+ free(tyenvsizeText); free(skelneedednessText); free(needednessText);
+ free(codeInfoText); free(constCatText);
+
+ return constVar;
+}
+
+#define GENERICAPPLY "genericApplyConstant"
+#define OVERLOADUMINUS "overloadUMinusConstant"
+#define OVERLOADABS "overloadAbsConstant"
+#define OVERLOADPLUS "overloadPlusConstant"
+#define OVERLOADMINUS "overloadMinusConstant"
+#define OVERLOADTIME "overloadTimeConstant"
+#define OVERLOADLT "overloadLTConstant"
+#define OVERLOADGT "overloadGTConstant"
+#define OVERLOADLE "overloadLEConstant"
+#define OVERLOADGE "overloadGEConstant"
+
+static char* OC_mkOverLoadConstVar(char* name, char* fixity, char* prec,
+ char* tyskel, char* varName)
+{
+ char* constVar;
+ constVar = OC_mkConstVarText(name, fixity, prec, "ref true", tyskel,
+ "ref 0", "ref(Some(Array.make 0 true))", "ref None", "ref None",
+ "ref(Absyn.PervasiveConstant(false))",
+ varName, "0", name);
+ return constVar;
+}
+
+/* generate fixed constants */
+char* OC_mkGenericConstVar(char* varList)
+{
+ char* text;
+ char* constVar;
+
+ constVar = OC_mkConstVarText(" apply", "ref Absyn.Infixl",
+ "ref (Absyn.maxPrec + 2)", "ref false",
+ "ref(Some(Absyn.Skeleton(Absyn.ErrorType, ref None, ref false)))",
+ "ref 0", "ref(Some(Array.make 0 true))", "ref None", "ref None",
+ "ref(Absyn.PervasiveConstant(false))", GENERICAPPLY, "0",
+ " apply");
+ text = UTIL_appendStr(varList, constVar); free(constVar);
+ varList = UTIL_appendStr(text, "\n\n"); free(text);
+
+ constVar = OC_mkOverLoadConstVar("~", "ref Absyn.Prefix",
+ "ref (Absyn.maxPrec + 1)", OVERLOADTYSKEL1,
+ OVERLOADUMINUS);
+ text = UTIL_appendStr(varList, constVar); free(constVar);
+ varList = UTIL_appendStr(text, "\n\n"); free(text);
+
+
+ constVar = OC_mkConstVarText("abs", "ref Absyn.NoFixity",
+ "ref 0", "ref true",
+ OVERLOADTYSKEL1,
+ "ref 0", "ref(Some(Array.make 0 true))",
+ "ref None", "ref None",
+ "ref(Absyn.PervasiveConstant(true))",
+ OVERLOADABS, "0", "abs");
+
+ text = UTIL_appendStr(varList, constVar); free(constVar);
+ varList = UTIL_appendStr(text, "\n\n"); free(text);
+
+
+ constVar = OC_mkOverLoadConstVar("+", "ref Absyn.Infixl", "ref 150",
+ OVERLOADTYSKEL2, OVERLOADPLUS);
+ text = UTIL_appendStr(varList, constVar); free(constVar);
+ varList = UTIL_appendStr(text, "\n\n"); free(text);
+
+ constVar = OC_mkOverLoadConstVar("-", "ref Absyn.Infixl", "ref 150",
+ OVERLOADTYSKEL2, OVERLOADMINUS);
+ text = UTIL_appendStr(varList, constVar); free(constVar);
+ varList = UTIL_appendStr(text, "\n\n"); free(text);
+
+ constVar = OC_mkOverLoadConstVar("*", "ref Absyn.Infixl", "ref 160",
+ OVERLOADTYSKEL2, OVERLOADTIME);
+ text = UTIL_appendStr(varList, constVar); free(constVar);
+ varList = UTIL_appendStr(text, "\n\n"); free(text);
+
+ constVar = OC_mkOverLoadConstVar("<", "ref Absyn.Infix", "ref 130",
+ OVERLOADTYSKEL3, OVERLOADLT);
+ text = UTIL_appendStr(varList, constVar); free(constVar);
+ varList = UTIL_appendStr(text, "\n\n"); free(text);
+
+ constVar = OC_mkOverLoadConstVar(">", "ref Absyn.Infix", "ref 130",
+ OVERLOADTYSKEL3, OVERLOADGT);
+ text = UTIL_appendStr(varList, constVar); free(constVar);
+ varList = UTIL_appendStr(text, "\n\n"); free(text);
+
+ constVar = OC_mkOverLoadConstVar("<", "ref Absyn.Infix", "ref 130",
+ OVERLOADTYSKEL3, OVERLOADLE);
+ text = UTIL_appendStr(varList, constVar); free(constVar);
+ varList = UTIL_appendStr(text, "\n\n"); free(text);
+
+ constVar = OC_mkOverLoadConstVar(">=", "ref Absyn.Infix", "ref 130",
+ OVERLOADTYSKEL3, OVERLOADGE);
+ text = UTIL_appendStr(varList, constVar); free(constVar);
+ varList = UTIL_appendStr(text, "\n\n"); free(text);
+ return varList;
+}
+
+/* generate fixed constants decs */
+char* OC_mkGenericConstVarDec(char* decList)
+{
+ char* text;
+ char* dec;
+
+ dec = OC_mkConstVarDec(GENERICAPPLY);
+ text = UTIL_appendStr(decList, dec); free(decList); free(dec);
+ decList = text;
+
+ dec = OC_mkConstVarDec(OVERLOADUMINUS);
+ text = UTIL_appendStr(decList, dec); free(decList); free(dec);
+ decList = text;
+
+
+ dec = OC_mkConstVarDec(OVERLOADABS);
+ text = UTIL_appendStr(decList, dec); free(decList); free(dec);
+ decList = text;
+
+
+ dec = OC_mkConstVarDec(OVERLOADPLUS);
+ text = UTIL_appendStr(decList, dec); free(decList); free(dec);
+ decList = text;
+
+ dec = OC_mkConstVarDec(OVERLOADMINUS);
+ text = UTIL_appendStr(decList, dec); free(decList); free(dec);
+ decList = text;
+
+ dec = OC_mkConstVarDec(OVERLOADTIME);
+ text = UTIL_appendStr(decList, dec); free(decList); free(dec);
+ decList = text;
+
+ dec = OC_mkConstVarDec(OVERLOADLT);
+ text = UTIL_appendStr(decList, dec); free(decList); free(dec);
+ decList = text;
+
+ dec = OC_mkConstVarDec(OVERLOADGT);
+ text = UTIL_appendStr(decList, dec); free(decList); free(dec);
+ decList = text;
+
+ dec = OC_mkConstVarDec(OVERLOADLE);
+ text = UTIL_appendStr(decList, dec); free(decList); free(dec);
+ decList = text;
+
+ dec = OC_mkConstVarDec(OVERLOADGE);
+ text = UTIL_appendStr(decList, dec); free(decList); free(dec);
+ decList = text;
+
+ return decList;
+}
+
+
+/* generate fixed constants entry in buildConstant function */
+char* OC_mkGenericConstTabEntry(char* entries)
+{
+ char* text;
+ char* tabEntry;
+
+ tabEntry = OC_mkTabEntry("~", OVERLOADUMINUS);
+ text = UTIL_appendStr(entries, tabEntry);
+ free(tabEntry); free(entries);
+ entries = text;
+
+
+ tabEntry = OC_mkTabEntry("abs", OVERLOADABS);
+ text = UTIL_appendStr(entries, tabEntry);
+ free(tabEntry); free(entries);
+ entries = text;
+
+
+ tabEntry = OC_mkTabEntry("+", OVERLOADPLUS);
+ text = UTIL_appendStr(entries, tabEntry);
+ free(tabEntry); free(entries);
+ entries = text;
+
+ tabEntry = OC_mkTabEntry("-", OVERLOADMINUS);
+ text = UTIL_appendStr(entries, tabEntry);
+ free(tabEntry); free(entries);
+ entries = text;
+
+ tabEntry = OC_mkTabEntry("*", OVERLOADTIME);
+ text = UTIL_appendStr(entries, tabEntry);
+ free(tabEntry); free(entries);
+ entries = text;
+
+ tabEntry = OC_mkTabEntry("<", OVERLOADLT);
+ text = UTIL_appendStr(entries, tabEntry);
+ free(tabEntry); free(entries);
+ entries = text;
+
+ tabEntry = OC_mkTabEntry(">", OVERLOADGT);
+ text = UTIL_appendStr(entries, tabEntry);
+ free(tabEntry); free(entries);
+ entries = text;
+
+ tabEntry = OC_mkTabEntry("<=", OVERLOADLE);
+ text = UTIL_appendStr(entries, tabEntry);
+ free(tabEntry); free(entries);
+ entries = text;
+
+ tabEntry = OC_mkTabEntry(">=", OVERLOADGE);
+ text = UTIL_appendStr(entries, tabEntry);
+ free(tabEntry); free(entries);
+ entries = text;
+
+ return entries;
+}
+
+/* let buildPervasiveKinds =
+ function () ->\n \n \n\n */
+char* OC_mkBuildCTabFunc(char* entries)
+{
+ return OC_mkBuildTabFunc(BUILDPERVCONST, entries);
+}
+
+/* make generaic const is function decs */
+char* OC_mkGenericConstFuncDecs(char* funcDefs)
+{
+ char* funcName;
+ char* def;
+ char* text;
+
+ funcName = OC_mkIsConstFuncName(GENERICAPPLY);
+ def = OC_mkIsConstFuncDec(funcName); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = text;
+
+ funcName = OC_mkIsConstFuncName(OVERLOADUMINUS);
+ def = OC_mkIsConstFuncDec(funcName); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = text;
+
+
+ funcName = OC_mkIsConstFuncName(OVERLOADABS);
+ def = OC_mkIsConstFuncDec(funcName); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = text;
+
+
+ funcName = OC_mkIsConstFuncName(OVERLOADPLUS);
+ def = OC_mkIsConstFuncDec(funcName); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = text;
+
+ funcName = OC_mkIsConstFuncName(OVERLOADMINUS);
+ def = OC_mkIsConstFuncDec(funcName); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = text;
+
+ funcName = OC_mkIsConstFuncName(OVERLOADTIME);
+ def = OC_mkIsConstFuncDec(funcName); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = text;
+
+ funcName = OC_mkIsConstFuncName(OVERLOADLT);
+ def = OC_mkIsConstFuncDec(funcName); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = text;
+
+ funcName = OC_mkIsConstFuncName(OVERLOADGT);
+ def = OC_mkIsConstFuncDec(funcName); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = text;
+
+ funcName = OC_mkIsConstFuncName(OVERLOADLE);
+ def = OC_mkIsConstFuncDec(funcName); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = text;
+
+ funcName = OC_mkIsConstFuncName(OVERLOADGE);
+ def = OC_mkIsConstFuncDec(funcName); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = text;
+
+ return funcDefs;
+}
+
+
+/* make generaic const is function defs */
+char* OC_mkGenericConstFuncDefs(char* funcDefs)
+{
+ char* funcName;
+ char* def;
+ char* text;
+
+ funcName = OC_mkIsConstFuncName(GENERICAPPLY);
+ def = OC_mkIsConstFuncDef(funcName, GENERICAPPLY); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
+
+
+ funcName = OC_mkIsConstFuncName(OVERLOADUMINUS);
+ def = OC_mkIsConstFuncDef(funcName, OVERLOADUMINUS); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
+
+
+ funcName = OC_mkIsConstFuncName(OVERLOADABS);
+ def = OC_mkIsConstFuncDef(funcName, OVERLOADABS); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
+
+
+ funcName = OC_mkIsConstFuncName(OVERLOADPLUS);
+ def = OC_mkIsConstFuncDef(funcName, OVERLOADPLUS); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
+
+ funcName = OC_mkIsConstFuncName(OVERLOADMINUS);
+ def = OC_mkIsConstFuncDef(funcName, OVERLOADMINUS); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
+
+ funcName = OC_mkIsConstFuncName(OVERLOADTIME);
+ def = OC_mkIsConstFuncDef(funcName, OVERLOADTIME); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
+
+ funcName = OC_mkIsConstFuncName(OVERLOADLT);
+ def = OC_mkIsConstFuncDef(funcName, OVERLOADLT); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
+
+ funcName = OC_mkIsConstFuncName(OVERLOADGT);
+ def = OC_mkIsConstFuncDef(funcName, OVERLOADGT); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
+
+ funcName = OC_mkIsConstFuncName(OVERLOADLE);
+ def = OC_mkIsConstFuncDef(funcName, OVERLOADLE); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
+
+ funcName = OC_mkIsConstFuncName(OVERLOADGE);
+ def = OC_mkIsConstFuncDef(funcName, OVERLOADGE); free(funcName);
+ text = UTIL_appendStr(funcDefs, def); free(def); free(funcDefs);
+ funcDefs = UTIL_appendStr(text, "\n\n"); free(text);
+
+ return funcDefs;
+}
+
+char* OC_mkCompare(char* name)
+{
+ char* text = UTIL_mallocStr(strlen(name) + 15);
+ strcpy(text, "(const == ");
+ strcat(text, name);
+ strcat(text, ")");
+ return text;
+}
+
+
+char* OC_mkOr(char* operandl, char* operandr)
+{
+ char* text = UTIL_mallocStr(strlen(operandl) + strlen(operandr) + 5);
+ strcpy(text, operandl);
+ strcat(text, " || ");
+ strcat(text, operandr);
+
+ return text;
+}
+
+
+#define PERV_REGCLOB_DEF_BEG "let regClobberingPerv const = \n if ("
+#define PERV_REGCLOB_DEF_END ") then true else false \n\n"
+char* OC_mkRegClobFunc(char* body)
+{
+ char* text = UTIL_mallocStr(strlen(PERV_REGCLOB_DEF_BEG) + strlen(body) +
+ strlen(PERV_REGCLOB_DEF_END));
+ strcpy(text, PERV_REGCLOB_DEF_BEG);
+ strcat(text, body);
+ strcat(text, PERV_REGCLOB_DEF_END);
+
+ return text;
+}
+
+#define PERV_BCK_DEF_BEG "let backtrackablePerv const = \n if ("
+#define PERV_BCK_DEF_END ") then true else false \n\n"
+char* OC_mkBackTrackFunc(char* body)
+{
+ char* text = UTIL_mallocStr(strlen(PERV_BCK_DEF_BEG) + strlen(body) +
+ strlen(PERV_BCK_DEF_END));
+ strcpy(text, PERV_BCK_DEF_BEG);
+ strcat(text, body);
+ strcat(text, PERV_BCK_DEF_END);
+
+ return text;
+}
+
+
+
+/*****************************************************************************/
+/* functions for making the fixed part of pervasive.mli */
+/*****************************************************************************/
+#define TERM_DECS \
+"val implicationTerm : Absyn.aterm\nval andTerm : Absyn.aterm\n"
+
+#define PERV_FUNC_DECS \
+"val isPerv : Absyn.aconstant -> bool \nval regClobberingPerv : Absyn.aconstant -> bool \nval backtrackablePerv : Absyn.aconstant -> bool\n"
+
+/*
+ val pervasiveKinds : Absyn.akind Table.SymbolTable.t
+ val pervasiveConstants : Absyn.aconstant Table.SymbolTable.t
+ val pervasiveTypeAbbrevs : Absyn.atypeabbrev Table.SymbolTable.t
+*/
+char* OC_mkFixedMLI()
+{
+ char* kindDec = OC_mkTabDec(PERVKIND, TY_KIND);
+ char* constDec = OC_mkTabDec(PERVCONST, TY_CONST);
+ char* tyabbrDec = OC_mkTabDec(PERVTYABBR, TY_TYABBREV);
+ size_t length = strlen(kindDec) + strlen(constDec) + strlen(tyabbrDec) +
+ strlen(TERM_DECS) + strlen(PERV_FUNC_DECS) + 10;
+ char* decs = UTIL_mallocStr(length + 1);
+
+ strcpy(decs, kindDec); free(kindDec);
+ strcat(decs, constDec); free(constDec);
+ strcat(decs, tyabbrDec); free(tyabbrDec);
+ strcat(decs, "\n");
+ strcat(decs, TERM_DECS);
+ strcat(decs, "\n");
+ strcat(decs, PERV_FUNC_DECS);
+ strcat(decs, "\n");
+
+ return decs;
+}
+
+/*****************************************************************************/
+/* functions for making the fixed part of pervasive.ml */
+/*****************************************************************************/
+#define TERM_DEFS \
+"let andTerm = Absyn.ConstantTerm(andConstant, [], false, Errormsg.none) \nlet implicationTerm = Absyn.ConstantTerm(implConstant, [], false, Errormsg.none)\n"
+
+#define PERV_ISPERV_DEF \
+"let isPerv const = \n let constCat = Absyn.getConstantType(const) in \n match constCat with \n Absyn.PervasiveConstant(_) -> true \n | _ -> false \n"
+
+/*
+ let pervasiveKinds = buildPervasiveKinds ()
+ let pervasiveConstants = buildPervasiveConstants ()
+ let pervasiveTypeAbbrevs = Table.SymbolTable.empty
+*/
+char* OC_mkFixedML()
+{
+ char* kindDef = OC_mkTab(PERVKIND, BUILDPERVKIND);
+ char* constDef = OC_mkTab(PERVCONST, BUILDPERVCONST);
+ char* emptyTab = OC_mkDotStr(TABLE, VCTR_EMPTYTAB);
+ char* tyabbrDef = OC_mkVarDef(PERVTYABBR, emptyTab);
+ size_t length = strlen(kindDef) + strlen(constDef) + strlen(tyabbrDef) +
+ strlen(TERM_DEFS) + strlen(PERV_ISPERV_DEF) + 10;
+ char* defs = UTIL_mallocStr(length + 1);
+
+ free(emptyTab);
+ strcpy(defs, kindDef); free(kindDef);
+ strcat(defs, constDef); free(constDef);
+ strcat(defs, tyabbrDef); free(tyabbrDef);
+ strcat(defs, "\n\n");
+ strcat(defs, TERM_DEFS);
+ strcat(defs, "\n");
+ strcat(defs, PERV_ISPERV_DEF);
+ strcat(defs, "\n");
+
+ return defs;
+}
diff --git a/src/runtime/c/teyjus/tables_gen/pervasives/ocamlcode.h b/src/runtime/c/teyjus/tables_gen/pervasives/ocamlcode.h
new file mode 100644
index 000000000..8b2ba062b
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/pervasives/ocamlcode.h
@@ -0,0 +1,152 @@
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+/***************************************************************************/
+/* ocamlcode.h{c}. */
+/* These files contain usful macros and auxiliary functions for generating */
+/* the pervasive.mli and pervasive.ml. */
+/* The parts of the ocaml files that are independent to the pervasives.in */
+/* also reside here. */
+/* The length macros for string macros defined here may be larger than the */
+/* extra lengthes of corresponding strings. This is ok because space and */
+/* time efficiency are not of concern in generating system files. */
+/***************************************************************************/
+#include "types.h"
+#include "op.h"
+#include "../util/util.h"
+
+/***************************************************************************/
+/* Functions for making program components */
+/***************************************************************************/
+/* let t = Table.add (Symbol.symbol "") t in\n
+*/
+char* OC_mkTabEntry(char* name, char* varName);
+
+
+/****************************************************************************/
+/* functions for making pervasive kind relevant components */
+/****************************************************************************/
+/* k */
+char* OC_mkKVarName(char* name);
+/* is */
+char* OC_mkIsKindFuncName(char* name);
+/* val : Absyn.akind \n*/
+char* OC_mkKindVarDec(char* kindVarName);
+/* val : Absyn.akind -> bool */
+char* OC_mkIsKindFuncDec(char* funcName);
+/* let tm = tm == */
+char* OC_mkIsKindFuncDef(char* funcName, char* kindVarName);
+
+
+/* let = Absyn.PervasiveKind(Symbol.symbol "",
+ (Some ), ref offset, Errormsg.none)
+*/
+char* OC_mkKindVar(char* varName, char* kindName, char* arity, char* offset);
+
+/* let buildPervasiveKinds =
+ function () ->\n \n \n\n */
+char* OC_mkBuildKTabFunc(char* entries);
+
+/****************************************************************************/
+/* functions for making pervasive type skeleton components */
+/****************************************************************************/
+/* generating code for type skeleton */
+char* OC_genTySkel(Type tyskel);
+
+/* tyskel */
+char* OC_mkTySkelVarName(char* number);
+
+/* Type Skeleton variable definition:
+ let = Some(Absyn.Skeleton(, ref None, ref false))
+*/
+char* OC_mkTYSkelVar(char* varName, char* tySkel);
+
+/* generate tyskels for overloaded constants */
+char* OC_mkFixedTySkels(char* tySkels);
+
+
+/****************************************************************************/
+/* functions for making pervasive constants components */
+/****************************************************************************/
+/* Constant */
+char* OC_mkCVarName(char* name);
+/* is */
+char* OC_mkIsConstFuncName(char* name);
+
+/* val : Absyn.aconstant \n*/
+char* OC_mkConstVarDec(char* constVarName);
+
+/* Constant variable definition :
+ let = Absyn.Constant(Symbol.symbolAlias "" "",
+ ref ,
+ ref , ref false, ref false, ref false, ref false,
+ ref false, ref , ref false, ref ,
+ ref , ref (Some ), ref ,
+ ref , ref offset, Errormsg.none)
+*/
+char* OC_mkConstVar(char* constName, OP_Fixity fixity, OP_Prec prec,
+ UTIL_Bool typrev, char* tySkel, int tyenvsize,
+ int neededness, OP_Code codeInfo, UTIL_Bool reDef,
+ char* varName, char* offset, char* printName);
+
+/* val : Absyn.aconstant -> bool */
+char* OC_mkIsConstFuncDec(char* funcName);
+
+/* let tm = tm == */
+char* OC_mkIsConstFuncDef(char* funcName, char* constVarName);
+
+/* generate fixed constants */
+char* OC_mkGenericConstVar(char* varList);
+/* generate fixed constants decs */
+char* OC_mkGenericConstVarDec(char* decList);
+
+/* generate fixed constants entry in buildConstant function */
+char* OC_mkGenericConstTabEntry(char* entries);
+/* let buildPervasiveKinds =
+ function () ->\n \n \n\n */
+char* OC_mkBuildCTabFunc(char* entries);
+
+/* make generaic const is function decs */
+char* OC_mkGenericConstFuncDecs(char* funcDefs);
+/* make generaic const is function defs */
+char* OC_mkGenericConstFuncDefs(char* funcDefs);
+
+
+char* OC_mkCompare(char* name);
+char* OC_mkOr(char* operandl, char* operandr);
+
+char* OC_mkRegClobFunc(char* body);
+char* OC_mkBackTrackFunc(char* body);
+
+/*****************************************************************************/
+/* functions for making the fixed part of pervasive.mli */
+/*****************************************************************************/
+/*
+ val pervasiveKinds : Absyn.akind Table.SymbolTable.t
+ val pervasiveConstants : Absyn.aconstant Table.SymbolTable.t
+ val pervasiveTypeAbbrevs : Absyn.atypeabbrev Table.SymbolTable.t
+*/
+char* OC_mkFixedMLI();
+
+/*****************************************************************************/
+/* functions for making the fixed part of pervasive.ml */
+/*****************************************************************************/
+/*
+ let pervasiveKinds = buildPervasiveKinds ()
+ let pervasiveConstants = buildPervasiveConstants ()
+ let pervasiveTypeAbbrevs = Table.SymbolTable.empty
+*/
+char* OC_mkFixedML();
diff --git a/src/runtime/c/teyjus/tables_gen/pervasives/op.c b/src/runtime/c/teyjus/tables_gen/pervasives/op.c
new file mode 100644
index 000000000..583063e49
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/pervasives/op.c
@@ -0,0 +1,80 @@
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+#include
+#include
+#include "../util/util.h"
+#include "op.h"
+
+OP_Prec OP_mkPrecMin1()
+{
+ OP_Prec prec;
+ prec.cat = OP_PREC;
+ prec.data.prec = -1;
+
+ return prec;
+}
+
+OP_Prec OP_mkPrecMin2()
+{
+ OP_Prec prec;
+ prec.cat = OP_PREC;
+ prec.data.prec = -2;
+
+ return prec;
+}
+
+OP_Prec OP_mkPrec(int precedence)
+{
+ OP_Prec prec;
+ prec.cat = OP_PREC;
+ prec.data.prec = precedence ;
+
+ return prec;
+}
+
+OP_Prec OP_mkPrecMax()
+{
+ OP_Prec prec;
+ prec.cat = OP_PREC_NAME;
+ prec.data.name = strdup("MAX");
+ return prec;
+}
+
+int OP_precIsMax(OP_Prec prec)
+{
+ if ((prec.cat == OP_PREC_NAME) && (strcmp(prec.data.name, "MAX") == 0))
+ return 1;
+ return 0;
+}
+
+
+OP_Code OP_mkCodeInfoNone()
+{
+ return -1;
+}
+
+OP_Code OP_mkCodeInfo(int ind)
+{
+ return ind;
+}
+
+int OP_codeInfoIsNone(OP_Code code)
+{
+ return (code < 0);
+}
+
+
diff --git a/src/runtime/c/teyjus/tables_gen/pervasives/op.h b/src/runtime/c/teyjus/tables_gen/pervasives/op.h
new file mode 100644
index 000000000..37456c897
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/pervasives/op.h
@@ -0,0 +1,58 @@
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+#ifndef OP_H
+#define OP_H
+
+//fixity type
+typedef enum {
+ OP_INFIX, OP_INFIXL, OP_INFIXR, OP_PREFIX, OP_PREFIXR, OP_POSTFIX,
+ OP_POSTFIXL, OP_NONE
+} OP_Fixity;
+
+typedef enum {
+ OP_PREC, OP_PREC_NAME
+} OP_PrecTypeCat;
+
+//precedence type
+typedef struct
+{
+ OP_PrecTypeCat cat;
+ union
+ {
+ int prec;
+ char* name;
+ } data;
+} OP_Prec;
+
+OP_Prec OP_mkPrecMin1();
+OP_Prec OP_mkPrecMin2();
+OP_Prec OP_mkPrec(int prec);
+OP_Prec OP_mkPrecMax();
+
+int OP_precIsMax(OP_Prec prec);
+
+
+//code info type
+typedef int OP_Code;
+
+OP_Code OP_mkCodeInfoNone();
+OP_Code OP_mkCodeInfo(int ind);
+
+int OP_codeInfoIsNone(OP_Code code);
+
+#endif
+
diff --git a/src/runtime/c/teyjus/tables_gen/pervasives/pervasives.in b/src/runtime/c/teyjus/tables_gen/pervasives/pervasives.in
new file mode 100644
index 000000000..2a332da91
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/pervasives/pervasives.in
@@ -0,0 +1,404 @@
+/% input file for pervasives files generation %/
+
+/% section I: pervasive kinds %/
+ /% number of pervasive kinds %/
+ KIND 7
+ /% kind data table %/
+ /% index name index_name arity %/
+ /* int */
+ 0 int int 0 ;;
+ /* real */
+ 1 real real 0 ;;
+ /* bool */
+ 2 o bool 0 ;;
+ /* string */
+ 3 string string 0 ;;
+ /* list type constructor */
+ 4 list list 1 ;;
+ /* in_stream */
+ 5 in_stream instream 0 ;;
+ /* out_stream */
+ 6 out_stream outstream 0
+
+/% section II: pervasive constants and their type skeletons %/
+ /% section II.I : type skeletion and constant declarations %/
+
+ /% number of pervasive constants %/
+ CONST 94
+ /% number of type skeletons %/
+ TYPE SKEL 42
+
+ /% type skeleton and constant data table %/
+ /% type skeleton format:
+ [comments]
+ TYPE index type %/
+ /% constant format:
+ index name indname tesize neededness typerv redef prec fixity codeinfo
+ %/
+
+ /* A */
+ TYPE 0 #0
+ /* for unnamed universal constants (Note: tesize should be 0)*/
+ 85 univ 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
+ ;;
+
+ /* (list A) */
+ TYPE 1 (@ list 1 [#0])
+ /* nil */
+ 89 nil nil 0 1 0 TRUE FALSE 0 NOFIXITY NOCODE
+ ;;
+
+
+ /* A->(list A)->(list A) */
+ TYPE 2 #0 -> (@ list 1 [#0]) -> (@ list 1 [#0])
+ /* cons */
+ 93 :: cons 0 1 0 TRUE FALSE 140 INFIXR NOCODE
+ ;;
+
+ /* int */
+ TYPE 3 int
+ /* integer constant */
+ 90 intc 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
+ ;;
+
+ /* real */
+ TYPE 4 real
+ /* real constant */
+ 91 realc 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
+ ;;
+
+ /* string */
+ TYPE 5 string
+ /* string constant */
+ 92 strc 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
+ ;;
+
+ /* o (type of proposition)*/
+ TYPE 6 bool
+ /* true proposition */
+ 4 true true 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
+ /* cut predicate */
+ 5 ! cut 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
+ /* fail predicate */
+ 6 fail fail 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
+ /* halt the system */
+ 9 halt halt 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
+ /* return to top level */
+ 10 stop stop 0 0 0 TRUE FALSE 0 NOFIXITY NOCODE
+ ;;
+
+ /* int -> int */
+ TYPE 7 int -> int
+ /* unary minus on integers */
+ 56 %i~ intuminus 0 0 0 TRUE FALSE MAX PREFIX NOCODE -
+ /* modulus */
+ 61 mod mod 0 0 0 TRUE TRUE 160 INFIXL NOCODE
+ /* integer abs */
+ 63 %iabs iabs 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE abs
+ ;;
+
+ /* int -> int -> int */
+ TYPE 8 int -> int -> int
+ /* addition on integers */
+ 57 %i+ intplus 0 0 0 TRUE FALSE 150 INFIXL NOCODE +
+ /* subtraction on integers */
+ 58 %i- intminus 0 0 0 TRUE FALSE 150 INFIXL NOCODE -
+ /* mutiplication on integers */
+ 59 %i* intmult 0 0 0 TRUE FALSE 160 INFIXL NOCODE *
+ /* integer division */
+ 60 div intdiv 0 0 0 TRUE FALSE 160 INFIXL NOCODE
+ ;;
+
+ /* int -> int -> o */
+ TYPE 9 int -> int -> bool
+ /* less than on integers */
+ 19 %i< intlss 0 0 0 TRUE FALSE 130 INFIX 4 <
+ /* greater than on integers */
+ 20 %i> intgrt 0 0 0 TRUE FALSE 130 INFIX 5 >
+ /* less than or eq on integers */
+ 21 %i<= intleq 0 0 0 TRUE FALSE 130 INFIX 6 <=
+ /* greater than or eq on integers*/
+ 22 %i>= intgeq 0 0 0 TRUE FALSE 130 INFIX 7 >=
+ /* time predicate */
+ 51 time time 0 0 0 TRUE TRUE 0 NOFIXITY 36
+ ;;
+
+ /* int -> real */
+ TYPE 10 int -> real
+ /* coercion to real */
+ 62 int_to_real itor 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ ;;
+
+ /* real -> int */
+ TYPE 11 real -> int
+ /* floor function */
+ 74 floor floor 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ /* ceiling function */
+ 75 ceil ceil 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ /* truncation */
+ 76 truncate trunc 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ ;;
+
+ /* real -> real */
+ TYPE 12 real -> real
+ /* unary minus on real */
+ 64 %r~ realuminus 0 0 0 TRUE FALSE MAX PREFIX NOCODE -
+ /* square root */
+ 69 sqrt sqrt 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ /* sine */
+ 70 sin sin 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ /* cosine */
+ 71 cos cos 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ /* arc tan */
+ 72 arctan arctan 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ /* natural log */
+ 73 ln log 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ /* real abs */
+ 77 %rabs rabs 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE rabs
+ ;;
+
+ /* real -> string */
+ TYPE 13 real -> string
+ /* real to string */
+ 84 real_to_string rtos 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ ;;
+
+ /* real -> real -> real */
+ TYPE 14 real -> real -> real
+ /* addition on reals */
+ 65 %r+ realplus 0 0 0 TRUE FALSE 150 INFIXL NOCODE +
+ /* subtraction on reals */
+ 66 %r- realminus 0 0 0 TRUE FALSE 150 INFIXL NOCODE -
+ /* multiplication on reals */
+ 67 %r* realmult 0 0 0 TRUE FALSE 160 INFIXL NOCODE *
+ /* division */
+ 68 / realdiv 0 0 0 TRUE FALSE 160 INFIXL NOCODE
+ ;;
+
+ /* real -> real -> o */
+ TYPE 15 real -> real -> bool
+ /* less than in reals */
+ 23 %r< reallss 0 0 0 TRUE FALSE 130 INFIX 8 <
+ /* greater than on reals */
+ 24 %r> realgrt 0 0 0 TRUE FALSE 130 INFIX 9 >
+ /* less than or eq on reals */
+ 25 %r<= realleq 0 0 0 TRUE FALSE 130 INFIX 10 <=
+ /* greater than or eq on reals */
+ 26 %r>= realgeq 0 0 0 TRUE FALSE 130 INFIX 11 >=
+ ;;
+
+ /* string -> int */
+ TYPE 16 string -> int
+ /* string length */
+ 79 size slen 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ /* ord function */
+ 81 string_to_int stoi 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ ;;
+
+ /* int -> string */
+ TYPE 17 int -> string
+ /* chr function */
+ 80 chr itochr 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ /* int to string */
+ 83 int_to_string itostr 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ ;;
+
+ /* string -> string -> string */
+ TYPE 18 string -> string -> string
+ /* string concatination */
+ 78 ^ scat 0 0 0 TRUE TRUE 150 INFIXL NOCODE
+ ;;
+
+ /* string -> string -> o */
+ TYPE 19 string -> string -> bool
+ /* less than on strings */
+ 27 %s< strlss 0 0 0 TRUE TRUE 130 INFIX 12 <
+ /* greater than on strings */
+ 28 %s> strgrt 0 0 0 TRUE TRUE 130 INFIX 13 >
+ /* less than or eq on strings */
+ 29 %s<= strleq 0 0 0 TRUE TRUE 130 INFIX 14 <=
+ /* greater than or eq on strings */
+ 30 %s>= strgeq 0 0 0 TRUE TRUE 130 INFIX 15 >=
+ /* getenv predicate; needed? */
+ 49 getenv getenv 0 0 0 TRUE TRUE 0 NOFIXITY 34
+ ;;
+
+ /* string -> int -> int -> string */
+ TYPE 20 string -> int -> int -> string
+ /* substring */
+ 82 substring substr 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ ;;
+
+ /* o -> o -> o */
+ TYPE 21 bool -> bool -> bool
+ /* logical and */
+ 0 , and 0 0 0 TRUE FALSE 110 INFIXL NOCODE
+ /* logical or */
+ 1 ; or 0 0 0 TRUE FALSE 100 INFIXL NOCODE
+ /* another logical and */
+ 8 & ampand 0 0 0 TRUE FALSE 120 INFIXR NOCODE
+ /* Prolog if; needed? */
+ 11 :- colondash 0 0 0 TRUE FALSE 0 INFIXL NOCODE
+ /* implication; needed? */
+ 12 => impl 0 0 0 TRUE FALSE 130 INFIXR NOCODE
+ ;;
+
+ /* (A -> o) -> o */
+ TYPE 22 (#0 -> bool) -> bool
+ /* existential quantifier */
+ 2 sigma some 1 1 1 FALSE FALSE 0 NOFIXITY NOCODE
+ /* universal quantifier */
+ 3 pi all 1 1 1 FALSE FALSE 0 NOFIXITY NOCODE
+ ;;
+
+ /* A -> A -> o */
+ TYPE 23 #0 -> #0 -> bool
+ /* is */
+ 16 is is 1 1 1 FALSE FALSE 130 INFIX 1
+ /* equality (unify) predicate */
+ 18 = eq 1 1 1 FALSE FALSE 130 INFIX 3
+ ;;
+
+ /* in_stream */
+ TYPE 24 instream
+ /* std_in */
+ 86 std_in stdin 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ ;;
+
+ /* out_stream */
+ TYPE 25 outstream
+ /* std_out */
+ 87 std_out stdout 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ /* std_err */
+ 88 std_err stderr 0 0 0 TRUE TRUE 0 NOFIXITY NOCODE
+ ;;
+
+ /* string -> in_stream -> o */
+ TYPE 26 string -> instream -> bool
+ /* open_in */
+ 31 open_in openin 0 0 0 TRUE TRUE 0 NOFIXITY 16
+ /* open_string */
+ 36 open_string openstr 0 0 0 TRUE TRUE 0 NOFIXITY 21
+ ;;
+
+ /* string -> out_stream -> o */
+ TYPE 27 string -> outstream -> bool
+ /* open_out */
+ 32 open_out openout 0 0 0 TRUE TRUE 0 NOFIXITY 17
+ /* open_append */
+ 33 open_append openapp 0 0 0 TRUE TRUE 0 NOFIXITY 18
+ ;;
+
+ /* in_stream -> o */
+ TYPE 28 instream -> bool
+ /* close_in */
+ 34 close_in closein 0 0 0 TRUE TRUE 0 NOFIXITY 19
+ /* eof */
+ 41 eof eof 0 0 0 TRUE TRUE 0 NOFIXITY 26
+ ;;
+
+ /* out_stream -> o */
+ TYPE 29 outstream -> bool
+ /* close_out */
+ 35 close_out closeout 0 0 0 TRUE TRUE 0 NOFIXITY 20
+ /* flush */
+ 42 flush flush 0 0 0 TRUE TRUE 0 NOFIXITY 27
+ ;;
+
+ /* A -> string -> o */
+ TYPE 30 #0 -> string -> bool
+ /* term_to_string */
+ 46 term_to_string termtostr 1 1 0 FALSE TRUE 0 NOFIXITY 31
+ ;;
+
+ /* string -> A -> o */
+ TYPE 31 string -> #0 -> bool
+ /* string_to_term */
+ 47 string_to_term strtoterm 1 1 1 FALSE TRUE 0 NOFIXITY 32
+ ;;
+
+ /* out_stream -> string -> o */
+ TYPE 32 outstream -> string -> bool
+ /* output */
+ 38 output output 0 0 0 TRUE TRUE 0 NOFIXITY 23
+ ;;
+
+ /* in_stream -> int -> string -> o */
+ TYPE 33 instream -> int -> string -> bool
+ /* input */
+ 37 input input 0 0 0 TRUE TRUE 0 NOFIXITY 22
+ ;;
+
+ /* in_stream -> string -> o */
+ TYPE 34 instream -> string -> bool
+ /* input_line */
+ 39 input_line inputline 0 0 0 TRUE TRUE 0 NOFIXITY 24
+ /* lookahead */
+ 40 lookahead lookahead 0 0 0 TRUE TRUE 0 NOFIXITY 25
+ ;;
+
+ /* string -> o */
+ TYPE 35 string -> bool
+ /* print */
+ 43 print print 0 0 0 TRUE TRUE 0 NOFIXITY 28
+ ;;
+
+ /* A -> o */
+ TYPE 36 #0 -> bool
+ /* read */
+ 44 read read 1 1 1 FALSE TRUE 0 NOFIXITY 29
+ ;;
+
+ /* out_stream -> A -> o */
+ TYPE 37 outstream -> #0 -> bool
+ /* printterm */
+ 45 printterm printterm 1 1 0 FALSE TRUE 0 NOFIXITY 30
+ ;;
+
+ /* in_stream -> A -> o */
+ TYPE 38 instream -> #0 -> bool
+ /* readterm */
+ 48 readterm readterm 1 1 1 FALSE TRUE 0 NOFIXITY 33
+ ;;
+
+ /* o -> o */
+ TYPE 39 bool -> bool
+ /* solve; used by code generator */
+ 15 solve solve 0 0 0 TRUE FALSE 0 NOFIXITY 0
+ /* not */
+ 17 not not 0 0 0 TRUE FALSE 0 NOFIXITY 2
+ ;;
+
+ /* string -> int -> in_stream -> out_stream -> o */
+ TYPE 40 string -> int -> instream -> outstream -> bool
+ /* open_socket predicate */
+ 50 open_socket opensocket 0 0 0 FALSE TRUE 0 NOFIXITY 35
+ ;;
+
+ /* string -> int -> o */
+ TYPE 41 string -> int -> bool
+ /* system predicate */
+ 52 system system 0 0 0 FALSE TRUE 0 NOFIXITY 37
+
+ /% pervasive constant classification %/
+ LOGIC SYMBOL 11
+ LS_START and LS_END stop
+ /% logic symbol types %/
+ 0 and
+ 1 or
+ 2 some
+ 3 all
+ 4 l_true
+ 5 cut
+ 6 fail
+ 7 eq
+ 8 ampand
+ 9 halt
+ 10 stop
+
+ PRED SYMBOL 37
+ PRED_START solve PRED_END system
+
+ REGCL solve not getenv strtoterm readterm read is lookahead input inputline
+
+ BACKTRACK eq
diff --git a/src/runtime/c/teyjus/tables_gen/pervasives/pervasives.l b/src/runtime/c/teyjus/tables_gen/pervasives/pervasives.l
new file mode 100644
index 000000000..e046a63c0
--- /dev/null
+++ b/src/runtime/c/teyjus/tables_gen/pervasives/pervasives.l
@@ -0,0 +1,96 @@
+%{
+//////////////////////////////////////////////////////////////////////////////
+// This file is part of Teyjus. //
+// //
+// Teyjus is free software: you can redistribute it and/or modify //
+// it under the terms of the GNU General Public License as published by //
+// the Free Software Foundation, either version 3 of the License, or //
+// (at your option) any later version. //
+// //
+// Teyjus is distributed in the hope that it will be useful, //
+// but WITHOUT ANY WARRANTY; without even the implied warranty of //
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
+// GNU General Public License for more details. //
+// //
+// You should have received a copy of the GNU General Public License //
+// along with Teyjus. If not, see . //
+//////////////////////////////////////////////////////////////////////////////
+
+#include "../util/util.h"
+#include "op.h"
+#include "types.h"
+#include "y.tab.h"
+#include
+#include
+
+static int commentLev = 0;
+%}
+
+LETTER [A-Za-z]
+DIGIT [0-9]
+SYMBOL "_"|"+"|"-"|"*"|"/"|"!"|"~"|"@"|"$"|"%"|"^"|"&"|"*"|"<"|">"|"="|"'"|";"|":"|","
+
+ID ({LETTER}|{SYMBOL})({LETTER}|{DIGIT}|{SYMBOL})*
+NUM {DIGIT}+
+WSPACE [ \t]+
+STRING [^*/]+
+
+%x COMMENT C_COMMENT
+
+/* Some versions of lex require an explicit positions argument */
+%p 10000
+
+%%
+"\n" {continue; }
+"KIND" {return KIND; }
+"CONST" {return CONST; }
+"TYPE SKEL" {return TYSKEL; }
+"TYPE" {return TYPE; }
+"->" {return TYARROW; }
+"@" {return TYAPP; }
+"[" {return LBRACKET; }
+"]" {return RBRACKET; }
+"(" {return LPAREN; }
+")" {return RPAREN; }
+"t," {return COMMA; }
+"#" {return POUND; }
+";;" {return SEMICOLON; }
+"INFIX" {return INFIX; }
+"INFIXL" {return INFIXL; }
+"INFIXR" {return INFIXR; }
+"PREFIX" {return PREFIX; }
+"PREFIXR" {return PREFIXR; }
+"POSTFIX" {return POSTFIX; }
+"POSTFIXL" {return POSTFIXL; }
+