diff --git a/src/runtime/c/teyjus/loader/searchtab.h b/src/runtime/c/teyjus/loader/searchtab.h
deleted file mode 100644
index 6559443e1..000000000
--- a/src/runtime/c/teyjus/loader/searchtab.h
+++ /dev/null
@@ -1,44 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index a1b4da273..000000000
--- a/src/runtime/c/teyjus/simulator/abstmachine.c
+++ /dev/null
@@ -1,617 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index c43fdb4f7..000000000
--- a/src/runtime/c/teyjus/simulator/abstmachine.h
+++ /dev/null
@@ -1,346 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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/builtins/builtins.h b/src/runtime/c/teyjus/simulator/builtins/builtins.h
deleted file mode 100644
index bac897678..000000000
--- a/src/runtime/c/teyjus/simulator/builtins/builtins.h
+++ /dev/null
@@ -1,132 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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 builtins.h. This files defines the indexes of the builtin table, and */
-/* provides signature for the function indexing into the builtin table and */
-/* invokes the appropriate function. */
-/*****************************************************************************/
-
-#ifndef BUILTINS_H
-#define BUILTINS_H
-
-#include "../../system/error.h"
-
-/***********************************************************************/
-/* Builtin Dispatch Table Index */
-/***********************************************************************/
-typedef enum
-{
- BI_SOLVE = 0,
- BI_EVAL = 1,
- BI_NOT = 2,
- BI_UNIFY = 3,
- // comparison operations
- BI_INT_LT = 4,
- BI_INT_GT = 5,
- BI_INT_LE = 6,
- BI_INT_GE = 7,
- BI_FLOAT_LT = 8,
- BI_FLOAT_GT = 9,
- BI_FLOAT_LE = 10,
- BI_FLOAT_GE = 11,
- BI_STR_LT = 12,
- BI_STR_GT = 13,
- BI_STR_LE = 14,
- BI_STR_GE = 15,
- //IO
- BI_IO_OPEN_IN = 16,
- BI_IO_OPEN_OUT = 17,
- BI_IO_OPEN_APP = 18,
- BI_IO_CLOSE_IN = 19,
- BI_IO_CLOSE_OUT = 20,
- BI_IO_OPEN_STR = 21,
- BI_IO_INPUT = 22,
- BI_IO_OUTPUT = 23,
- BI_IO_INPUT_LINE = 24,
- BI_IO_LOOKAHEAD = 25,
- BI_IO_EOF = 26,
- BI_IO_FLUSH = 27,
- BI_IO_PRINT = 28,
- BI_IO_READ = 29,
- BI_IO_PRINTTERM = 30,
- BI_IO_TERM_TO_STR = 31,
- BI_IO_STR_TO_TERM = 32,
- BI_IO_READTERM = 33,
- BI_IO_GETENV = 34,
- BI_IO_OPEN_SOCKET = 35,
- BI_UNIX_TIME = 36,
- BI_SYSTEM = 37
-} BI_BuiltinTabIndex;
-
-/*****************************************************************************/
-/* Dispatching function for the builtin table */
-/*****************************************************************************/
-void BI_dispatch(int number);
-
-/* builtin index "register"*/
-extern BI_BuiltinTabIndex BI_number;
-
-/***************************######********************************************
- * ERROR INFORMATION
- *********************************######**************************************/
-
-#define BI_NUM_ERROR_MESSAGES 28
-enum
-{
- BI_ERROR = BI_FIRST_ERR_INDEX,
- BI_ERROR_TERM,
- BI_ERROR_NOT_IMPLEMENTED,
- BI_ERROR_FVAR_CAP,
- BI_ERROR_TYFVAR_CAP,
- BI_ERROR_DIV_BY_ZERO,
- BI_ERROR_NEG_SQRT,
- BI_ERROR_NEG_LOG,
- BI_ERROR_CONST_IND,
- BI_ERROR_FLEX_HEAD, /* takes term */
- BI_ERROR_ILLEGAL_ARG, /* takes term */
- BI_ERROR_EVAL_TYPE,
- BI_ERROR_ILLEGAL_STREAM,
- BI_ERROR_FLEX_GOAL,
- BI_ERROR_NON_VAR_TERM, /* takes term */
- BI_ERROR_INDEX_OUT_OF_BOUNDS,
- BI_ERROR_NEGATIVE_VALUE,
- BI_ERROR_UNBOUND_VARIABLE, /* takes string indicating desired arg. */
- BI_ERROR_NON_STREAM_TERM, /* takes term */
- BI_ERROR_STREAM_ALREADY_CLOSED,
- BI_ERROR_CANNOT_OPEN_STREAM, /* takes filename */
- BI_ERROR_STREAM, /* takes term (stream) */
- BI_ERROR_READING_STREAM, /* takes term (stream) */
- BI_ERROR_WRITING_STREAM, /* takes term (stream) */
- BI_ERROR_FLUSHING_STREAM, /* takes term (stream) */
- BI_ERROR_OPENING_STRING, /* takes string */
- BI_ERROR_INTEGER_EXPECTED, /* takes term */
- BI_ERROR_SUBSTRING
-};
-
-
-
-/***************************######********************************************
- * Initialization
- *********************************######**************************************/
-void BI_init();
-
-#endif //BUILTINS_H
diff --git a/src/runtime/c/teyjus/simulator/dataformats.c b/src/runtime/c/teyjus/simulator/dataformats.c
deleted file mode 100644
index ecc1ce5c0..000000000
--- a/src/runtime/c/teyjus/simulator/dataformats.c
+++ /dev/null
@@ -1,711 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 3905cd8c2..000000000
--- a/src/runtime/c/teyjus/simulator/dataformats.h
+++ /dev/null
@@ -1,417 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 44a941f23..000000000
--- a/src/runtime/c/teyjus/simulator/hnorm.c
+++ /dev/null
@@ -1,1128 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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 = NULL;
-
- 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 = NULL;
- 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 = NULL;
- 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
deleted file mode 100644
index d57a7349f..000000000
--- a/src/runtime/c/teyjus/simulator/hnorm.h
+++ /dev/null
@@ -1,42 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 05eb43af8..000000000
--- a/src/runtime/c/teyjus/simulator/hnormlocal.c
+++ /dev/null
@@ -1,597 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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 = NULL; //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 {
- 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 = NULL; // 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
deleted file mode 100644
index 0a123c581..000000000
--- a/src/runtime/c/teyjus/simulator/hnormlocal.h
+++ /dev/null
@@ -1,75 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 4ffcf5478..000000000
--- a/src/runtime/c/teyjus/simulator/hopu.c
+++ /dev/null
@@ -1,1693 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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; //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;
- 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
deleted file mode 100644
index 1ea26b00c..000000000
--- a/src/runtime/c/teyjus/simulator/hopu.h
+++ /dev/null
@@ -1,85 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 21d19f81e..000000000
--- a/src/runtime/c/teyjus/simulator/instraccess.h
+++ /dev/null
@@ -1,300 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 1647ee5b1..000000000
--- a/src/runtime/c/teyjus/simulator/io-datastructures.c
+++ /dev/null
@@ -1,53 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 217a0f04e..000000000
--- a/src/runtime/c/teyjus/simulator/io-datastructures.h
+++ /dev/null
@@ -1,66 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index aed27b5e2..000000000
--- a/src/runtime/c/teyjus/simulator/mcstring.c
+++ /dev/null
@@ -1,116 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index f1004c8e9..000000000
--- a/src/runtime/c/teyjus/simulator/mcstring.h
+++ /dev/null
@@ -1,67 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index b964599bc..000000000
--- a/src/runtime/c/teyjus/simulator/mctypes.h
+++ /dev/null
@@ -1,54 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index cedc63147..000000000
--- a/src/runtime/c/teyjus/simulator/printterm.c
+++ /dev/null
@@ -1,814 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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;
- }
- default:
- 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;
- }
- }
- default:
- 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_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);
- 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 = 0;
- int prec = 0;
-
- 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
deleted file mode 100644
index d6814b5ab..000000000
--- a/src/runtime/c/teyjus/simulator/printterm.h
+++ /dev/null
@@ -1,62 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 4567bb092..000000000
--- a/src/runtime/c/teyjus/simulator/simdispatch.c
+++ /dev/null
@@ -1,160 +0,0 @@
-/***************************************************************************/
-/* */
-/* 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
deleted file mode 100644
index 2a5f1475c..000000000
--- a/src/runtime/c/teyjus/simulator/simdispatch.h
+++ /dev/null
@@ -1,37 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index b6de2acea..000000000
--- a/src/runtime/c/teyjus/simulator/siminit.c
+++ /dev/null
@@ -1,275 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 0dd8fa749..000000000
--- a/src/runtime/c/teyjus/simulator/siminit.h
+++ /dev/null
@@ -1,33 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 3f66fbf04..000000000
--- a/src/runtime/c/teyjus/simulator/siminstr.c
+++ /dev/null
@@ -1,1846 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index d0521fb99..000000000
--- a/src/runtime/c/teyjus/simulator/siminstr.h
+++ /dev/null
@@ -1,248 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 3e7d70292..000000000
--- a/src/runtime/c/teyjus/simulator/siminstrlocal.c
+++ /dev/null
@@ -1,583 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index e5a938261..000000000
--- a/src/runtime/c/teyjus/simulator/siminstrlocal.h
+++ /dev/null
@@ -1,99 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 6d9b8645b..000000000
--- a/src/runtime/c/teyjus/simulator/simulator.c
+++ /dev/null
@@ -1,62 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 5aed0b67e..000000000
--- a/src/runtime/c/teyjus/simulator/simulator.h
+++ /dev/null
@@ -1,32 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 3938e134e..000000000
--- a/src/runtime/c/teyjus/simulator/trail.c
+++ /dev/null
@@ -1,141 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 675392b4b..000000000
--- a/src/runtime/c/teyjus/simulator/trail.h
+++ /dev/null
@@ -1,80 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 653ccbd9b..000000000
--- a/src/runtime/c/teyjus/simulator/types.c
+++ /dev/null
@@ -1,194 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 9cbd0e535..000000000
--- a/src/runtime/c/teyjus/simulator/types.h
+++ /dev/null
@@ -1,47 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 2db993270..000000000
--- a/src/runtime/c/teyjus/system/error.h
+++ /dev/null
@@ -1,170 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index b35078ad8..000000000
--- a/src/runtime/c/teyjus/system/memory.h
+++ /dev/null
@@ -1,222 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index cf0fa00fd..000000000
--- a/src/runtime/c/teyjus/system/message.h
+++ /dev/null
@@ -1,76 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 9f016ef5b..000000000
--- a/src/runtime/c/teyjus/system/operators.h
+++ /dev/null
@@ -1,91 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index ec24fb474..000000000
--- a/src/runtime/c/teyjus/system/stream.h
+++ /dev/null
@@ -1,90 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 77dd04d92..000000000
--- a/src/runtime/c/teyjus/system/tjsignal.h
+++ /dev/null
@@ -1,41 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 00c92caa2..000000000
--- a/src/runtime/c/teyjus/tables/README
+++ /dev/null
@@ -1,27 +0,0 @@
- 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
deleted file mode 100644
index 183eb1875..000000000
--- a/src/runtime/c/teyjus/tables/instructions.c
+++ /dev/null
@@ -1,292 +0,0 @@
-/****************************************************************************/
-/* */
-/* 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
deleted file mode 100644
index 2ced4e85d..000000000
--- a/src/runtime/c/teyjus/tables/instructions.h
+++ /dev/null
@@ -1,480 +0,0 @@
-/****************************************************************************/
-/* 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
deleted file mode 100644
index 4c2b3ad4c..000000000
--- a/src/runtime/c/teyjus/tables/pervasives.c
+++ /dev/null
@@ -1,810 +0,0 @@
-/***************************************************************************/
-/* 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
deleted file mode 100644
index 48a96964c..000000000
--- a/src/runtime/c/teyjus/tables/pervasives.h
+++ /dev/null
@@ -1,326 +0,0 @@
-/****************************************************************************/
-/* 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
deleted file mode 100644
index 4e518572f..000000000
--- a/src/runtime/c/teyjus/tables/pervinit.c
+++ /dev/null
@@ -1,152 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 666b88776..000000000
--- a/src/runtime/c/teyjus/tables/pervinit.h
+++ /dev/null
@@ -1,73 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 3f1a2faaf..000000000
--- a/src/runtime/c/teyjus/tables_gen/Makefile
+++ /dev/null
@@ -1,30 +0,0 @@
-all: instrformats/gen pervasives/gen
- (cd instrformats; ./gen)
- (cd pervasives; ./gen)
-
-instrformats/gen: instrformats/y.tab.o instrformats/lex.yy.o \
- instrformats/instrgen-c.o instrformats/instrgen-haskell.o \
- util/util.o
- gcc -o instrformats/gen $^ -lm
-
-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
deleted file mode 100644
index 28e43ab1b..000000000
--- a/src/runtime/c/teyjus/tables_gen/instrformats/instrformats.l
+++ /dev/null
@@ -1,69 +0,0 @@
-%{
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 3613eb686..000000000
--- a/src/runtime/c/teyjus/tables_gen/instrformats/instrformats.y
+++ /dev/null
@@ -1,282 +0,0 @@
-%{
-//////////////////////////////////////////////////////////////////////////////
-//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-haskell.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);
- ocSpitInstructionHS(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
deleted file mode 100644
index 1cfddddfb..000000000
--- a/src/runtime/c/teyjus/tables_gen/instrformats/instrformats_32.in
+++ /dev/null
@@ -1,346 +0,0 @@
-{
-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
deleted file mode 100644
index 3aaebdf48..000000000
--- a/src/runtime/c/teyjus/tables_gen/instrformats/instrformats_64.in
+++ /dev/null
@@ -1,346 +0,0 @@
-{
-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
deleted file mode 100644
index 394f85d9e..000000000
--- a/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-c.c
+++ /dev/null
@@ -1,650 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index 0c1c6b6fd..000000000
--- a/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-c.h
+++ /dev/null
@@ -1,70 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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-haskell.c b/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-haskell.c
deleted file mode 100644
index 71e65fe79..000000000
--- a/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-haskell.c
+++ /dev/null
@@ -1,845 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//Copyright 2012
-// Krasimir Angelov
-//////////////////////////////////////////////////////////////////////////////
-
-/*************************************************************************/
-/* functions for generating Haskell Instructions.hs */
-/*************************************************************************/
-#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");
- 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 PUT_PREFIX "put"
-#define GET_PREFIX "get"
-#define DISPLAY_PREFIX "display"
-#define INDENT " "
-#define INDENT2 " "
-#define PUT "putWord"
-#define GET "getWord"
-#define DISPLAY "pp"
-#define INSCAT_PREFIX1 "inscat"
-#define INSCAT_PREFIX2 "Inscat"
-#define INS_PREFIX "Ins_"
-
-static char* HS_mkVarDef(char* varName, char* varType, char* defs)
-{
- size_t length = strlen(varName) + strlen(defs) + strlen(varType) + 10;
- char* vardef = UTIL_mallocStr(length);
-
- strcpy(vardef, varName);
- strcat(vardef, " = ");
- strcat(vardef, defs);
- strcat(vardef, " :: ");
- strcat(vardef, varType);
- strcat(vardef, "\n");
-
- return vardef;
-}
-
-static char* HS_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* HS_mkFunc(char* funcName, char* arg, char* body)
-{
- size_t length = strlen(funcName) + strlen(arg) + strlen(body) + 20;
- char* func = UTIL_mallocStr(length);
-
- strcpy(func, funcName);
- strcat(func, " ");
- strcat(func, arg);
- strcat(func, " = ");
- strcat(func, body);
- strcat(func, "\n");
-
- return func;
-}
-
-static char* HS_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* HS_mkValueCtr(char* ctrName, char* types)
-{
- size_t length = strlen(ctrName) + strlen(types) + 10;
- char* ctr = UTIL_mallocStr(length);
-
- strcpy(ctr, ctrName);
- strcat(ctr, " ");
- strcat(ctr, types);
- return ctr;
-}
-
-static char* HS_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* HS_mkCase(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* HS_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* HS_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* HS_mkStrConcat(char* prev, char* new)
-{
- size_t length = strlen(prev) + strlen(new) + 25;
- char* str = UTIL_mallocStr(length);
-
- strcpy(str, "(");
- strcat(str, prev);
- strcat(str, ") ++ \", \" ++ (");
- strcat(str, new);
- strcat(str, ")");
-
- return str;
-}
-
-
-static char* HS_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* HS_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);
-
- return app;
-}
-
-static char* HS_mkDO(char* varName, char* def)
-{
- size_t length = strlen(varName) + strlen(def) + 20;
- char* str = UTIL_mallocStr(length);
-
- strcpy(str, INDENT);
- strcat(str, varName);
- strcat(str, " <- ");
- strcat(str, def);
- strcat(str, "\n");
-
- return str;
-}
-
-/**************************************************************************/
-/* type definitions */
-/**************************************************************************/
-static char* typeDefs;
-
-void ocgenInclude(char* include)
-{
- typeDefs = include;
-}
-
-/**************************************************************************/
-/* operand types */
-/**************************************************************************/
-static char* opTypes;
-static char* opSizes;
-static char* writeFuncs;
-static char* readFuncs;
-
-static char* ocgenWriteOpFunc(char* typeName, char* compType, int numBytes)
-{
- char* funcName = UTIL_appendStr(PUT_PREFIX, typeName);
- char* numBitsText = UTIL_itoa(numBytes*8);
- char* funcBody = UTIL_mallocStr(strlen(PUT)+strlen(numBitsText)+20);
- char* func;
-
- if (strcmp(typeName, "F") == 0) {
- strcpy(funcBody, "putFloat");
- strcat(funcBody, numBitsText);
-
- if (numBytes > 1)
- strcat(funcBody, "be");
- } else if (strcmp(typeName, "C") == 0 || strcmp(typeName, "K") == 0) {
- strcpy(funcBody, "put");
- } else {
- strcpy(funcBody, PUT);
- strcat(funcBody, numBitsText);
-
- if (numBytes > 1)
- strcat(funcBody, "be");
-
- strcat(funcBody, " . fromIntegral");
- }
-
- free(numBitsText);
-
- func = HS_mkFunc(funcName, "", funcBody);
- free(funcName);
- free(funcBody);
- return func;
-}
-
-static char* ocgenReadOpFunc(char* typeName, char* compType, int numBytes)
-{
- char* funcName = UTIL_appendStr(GET_PREFIX, typeName);
- char* numBitsText = UTIL_itoa(numBytes*8);
- char* funcBody = UTIL_mallocStr(strlen(GET)+strlen(numBitsText)+30);
- char* func;
-
- if (strcmp(typeName, "F") == 0) {
- strcpy(funcBody, "getFloat");
- strcat(funcBody, numBitsText);
-
- if (numBytes > 1)
- strcat(funcBody, "be");
- } else if (strcmp(typeName, "C") == 0 || strcmp(typeName, "K") == 0) {
- strcpy(funcBody, "get");
- } else {
- strcpy(funcBody, "fmap fromIntegral $ ");
- strcat(funcBody, GET);
- strcat(funcBody, numBitsText);
-
- if (numBytes > 1)
- strcat(funcBody, "be");
- }
-
- free(numBitsText);
-
- func = HS_mkFunc(funcName, "", funcBody);
- free(funcName);
- free(funcBody);
- return func;
-}
-
-void ocgenOpType(char* typeName, int numBytes, char* compType)
-{
- char* myCompType =
- (strcmp(compType, "int") == 0) ? "Int" :
- (strcmp(compType, "float") == 0) ? "Float" :
- (strcmp(compType, "aconstant") == 0) ? "AConstant" :
- (strcmp(compType, "akind") == 0) ? "AKind" :
- (strcmp(compType, "intref") == 0) ? "IntRef" :
- NULL;
-
- /* generate type declarations*/
- char* myTypeName = UTIL_appendStr(typeName, TYPE_SUFFIX);
- char* myOpType = HS_mkTypeDec(myTypeName, myCompType);
- 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* myName = UTIL_lowerCase(typeName);
- char* mySizeName = UTIL_appendStr(myName, SIZE_SUFFIX);
- char* size = UTIL_itoa((int)(pow(2,(numBytes * 8))-1));
- char* myOpSize = HS_mkVarDef(mySizeName, "Int", size);
- char* myopSizes = addStr(opSizes, myOpSize);
-
- free(myName); free(mySizeName); free(size); free(myOpSize);
- free(opSizes);
- opSizes = myopSizes;
- }
- free(myTypeName);
- 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)(pow(2,(numBytes * 8))-1));
- char* myOpCodeSize = HS_mkVarDef(mySizeName, "Int", size);
- char* myopSizes = addLine(opSizes, myOpCodeSize);
- 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(opSizes); free(myOpCodeSize);
- free(writeFuncs); free(func);
- free(readFuncs); free(readFunc);
- opSizes = myopSizes;
- writeFuncs = myWriteFuncs;
- readFuncs = myReadFuncs;
-}
-
-static char* opHS;
-
-void ocgenOps()
-{
- char* wordSizeName = "wordSize";
- char* wordSize = UTIL_itoa(sizeof(void*));
- char* wordSizeHS = HS_mkVarDef(wordSizeName, "Int", wordSize);
- char* text;
-
- free(wordSize);
- opHS = addLine(NULL, wordSizeHS); free(wordSizeHS);
- text = addLine(opHS, opSizes); free(opSizes); free(opHS);
-
- opHS = addLine(text, opTypes); free(opTypes); free(text);
-
- text = addLine(opHS, writeFuncs); free(writeFuncs); free(opHS);
- opHS = addLine(text, readFuncs); free(readFuncs); free(text);
-}
-
-/****************************************************************************/
-/* 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 *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
- myOpName = UTIL_appendStr(opName, TYPE_SUFFIX);
- if (instrCatType) {
- myinstrCatType = HS_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 = HS_mkArgList(argList, myArg); free(argList);
- argList = myArgList;
- } else argList = myArg;
-
- //write function
- myFuncName = UTIL_appendStr(PUT_PREFIX, opName);
- myFuncCall = UTIL_mallocStr(strlen(myFuncName) + strlen(myArg) + 5);
- strcpy(myFuncCall, myFuncName); free(myFuncName);
- strcat(myFuncCall, " ");
- strcat(myFuncCall, myArg);
- if (instrCatWriteFunc) {
- myinstrCatWriteFunc = HS_mkFuncSeq(instrCatWriteFunc, myFuncCall);
- free(instrCatWriteFunc);
- instrCatWriteFunc = myinstrCatWriteFunc;
- free(myFuncCall);
- } else instrCatWriteFunc = myFuncCall;
-
- //read function
- myFuncName = UTIL_appendStr(GET_PREFIX, opName);
- myReadBody = HS_mkDO(myArg, myFuncName); free(myFuncName);
- 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 = HS_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) {
- char* instrCatType2 = UTIL_mallocStr(strlen(instrCatType) + 3);
- strcpy(instrCatType2, "(");
- strcat(instrCatType2, instrCatType);
- strcat(instrCatType2, ")");
-
- myCatName = UTIL_appendStr(INSCAT_PREFIX2, catName);
- myInstrCatType = HS_mkTypeDec(myCatName, instrCatType2);
- myInstrCatTypes = addStr(instrCatTypes, myInstrCatType);
-
- myArgs = UTIL_mallocStr(strlen(argList) + 5);
- strcpy(myArgs, "(");
- strcat(myArgs, argList);
- strcat(myArgs, ")");
-
- /* write function */
- myWriteFuncName = UTIL_appendStr(PUT_PREFIX, catName);
- myWriteFunc = HS_mkFunc(myWriteFuncName, myArgs, instrCatWriteFunc);
- myInstrCatWriteFuncs = addStr(instrCatWriteFuncs, myWriteFunc);
-
- /* read function */
- myReadFuncName = UTIL_appendStr(GET_PREFIX, catName);
- temp = UTIL_appendStr(INDENT, "return ");
- myArgs2 = UTIL_appendStr(temp, myArgs); free(temp);
- temp = UTIL_appendStr(instrCatReadFunc, myArgs2); free(myArgs2);
- myReadFuncBody= UTIL_appendStr("do\n", temp); free(temp);
- myReadFunc = HS_mkFunc(myReadFuncName, "", myReadFuncBody);
- myInstrCatReadFuncs = addStr(instrCatReadFuncs, myReadFunc);
-
- /* display function */
- myDisplayFuncName = UTIL_appendStr(DISPLAY_PREFIX, catName);
- myDisplayFunc = HS_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_PREFIX1, varName);
- char* varDef = HS_mkVarDef(myVarName, "Int", numBytes);
- char* myInstrCatLength = addStr(instrCatLength, varDef);
-
- free(myVarName); free(varDef); free(instrCatLength);
- instrCatLength = myInstrCatLength;
-}
-
-static char* instrCat;
-
-void ocgenInstrCat()
-{
- char* text = instrCatTypes;
- char* text2 = addLine(text, "\n");
-
- text = addLine(text2, instrCatWriteFuncs);
- free(instrCatWriteFuncs); free(text2);
-
- text2 = addLine(text, instrCatReadFuncs);
- free(instrCatReadFuncs); free(text);
-
- text = addLine(text2, instrCatDisplayFuncs);
- free(instrCatDisplayFuncs); free(text2);
-
- instrCat = addLine(text, instrCatLength);
- free(text); free(instrCatLength);
-}
-
-/****************************************************************************/
-/* instructions */
-/****************************************************************************/
-#define GETSIZE_PREFIX "getSize_"
-#define PUTOPCODE "putopcode "
-
-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, *tmp;
-
- if (strcmp(insCat, "X") == 0) {
- readArgs = strdup("");
- ins = myInsName;
- } else {
- readArgs = UTIL_mallocStr(strlen(GET_PREFIX) +
- strlen(insCat) +
- 20);
- strcpy(readArgs, GET_PREFIX);
- strcat(readArgs, insCat);
- strcat(readArgs, " >>= \\x -> ");
-
- ins = UTIL_mallocStr(strlen(readArgs) + strlen(myInsName) + 10);
- strcpy(ins, myInsName);
- strcat(ins, " x");
- }
-
- returnValue = UTIL_mallocStr(strlen(readArgs) +
- strlen(ins) +
- strlen(myInsLength) +
- 20);
- strcpy(returnValue, readArgs);
- strcat(returnValue, "return (");
- strcat(returnValue, ins);
- strcat(returnValue, ", ");
- strcat(returnValue, myInsLength);
- strcat(returnValue, ")");
-
- free(readArgs);
-
- char *tmp2 = " ";
- tmp = addStr(tmp2, opcode);
- tmp2 = addStr(tmp, " -> "); free(tmp);
- tmp = addStr(tmp2, returnValue); free(tmp2);
- tmp2 = addStr(tmp, "\n"); free(tmp);
- tmp = tmp2;
- 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 = HS_mkArrow(pattern, returnValue);
- free(returnValue);
-
- if (insDisplayFuncBody) {
- myDisplayFuncBody = HS_mkCase(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_PREFIX2, insCat);
- myValueCtr = HS_mkValueCtr(myInsName, myCatName); free(myCatName);
- }
- if (instructionTypes) {
- myInstrTypes = HS_mkDisjValueCtrs(instructionTypes, myValueCtr);
- free(instructionTypes);
- instructionTypes = myInstrTypes;
- } else instructionTypes = myValueCtr;
-
- /* write function body */
- myWriteOpCodeFunc = UTIL_appendStr(PUTOPCODE, opcode);
- if (strcmp(insCat, "X") == 0) {
- myPattern = strdup(myInsName);
- myfuncBody = myWriteOpCodeFunc;
- } else {
- char* myWriteArgsName = UTIL_appendStr(PUT_PREFIX, insCat);
- char* myWriteArgs = UTIL_mallocStr(strlen(myWriteArgsName) + 5);
- myPattern = HS_mkStructure(myInsName, "arg");
- strcpy(myWriteArgs, myWriteArgsName); free(myWriteArgsName);
- strcat(myWriteArgs, " arg");
- myfuncBody = HS_mkFuncSeq(myWriteOpCodeFunc, myWriteArgs);
- free(myWriteArgs);
- }
- myFunc = HS_mkArrow(myPattern, myfuncBody);
- free(myfuncBody);
- if (insWriteFuncBody) {
- myInsWriteFuncBody = HS_mkCase(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_PREFIX1, insLength);
- mySizeDef = HS_mkVarDef(myInsSizeName, "Int", myInsLength);
- free(myInsSizeName);
-
- mySizeDefs = addStr(insSizesDef, mySizeDef);
- free(insSizesDef); free(mySizeDef);
-
- insSizesDef = mySizeDefs;
-
- ocgenReadFuncBody(opcode, myInsName, myInsLength, insCat, last);
- ocgenDisplayFuncBody(myPattern, insName, myInsLength, insCat);
-
- free(myInsName); free(myInsLength); free(myPattern);
-}
-
-#define INSTRTYPE_HEAD "data Instruction\n = "
-
-#define INSTWRITEFUNC_DEF_HEAD "putInstruction :: Instruction -> Put\n" \
- "putInstruction inst =\n" \
- " case inst of\n"
-
-#define INSTREADFUNC_DEF_HEAD "getInstruction :: Get (Instruction,Int)\n" \
- "getInstruction = do\n" \
- " opcode <- getopcode\n" \
- " case opcode of\n"
-
-#define INSTDISPLAYFUNC_DEF_HEAD \
- "showInstruction :: Instruction -> (String, Int)\n" \
- "showInstruction inst =\n" \
- " case inst of\n"
-
-static char* instrHS;
-
-void ocgenInstr()
-{
- char* text = UTIL_appendStr(INSTRTYPE_HEAD, instructionTypes);
- char* text2 = UTIL_appendStr(text, "\n\n");
-
- free(instructionTypes); free(text);
-
- text = addLine(text2, insSizesDef); free(text2); free(insSizesDef);
- text2 = addStr(text, INSTWRITEFUNC_DEF_HEAD); free(text);
- instrHS = addStr(text2, insWriteFuncBody);
- free(text2); free(insWriteFuncBody);
- text = addStr(instrHS, "\n\n"); free(instrHS);
- text2 = addStr(text, INSTREADFUNC_DEF_HEAD); free(text);
- instrHS = addStr(text2, insReadFuncBody);
- free(text2); free(insReadFuncBody);
- text = addStr(instrHS, "\n\n"); free(instrHS);
- text2 = addStr(text, INSTDISPLAYFUNC_DEF_HEAD); free(text);
- instrHS = addStr(text2, insDisplayFuncBody);
- free(text2); free(insDisplayFuncBody);
-}
-
-/****************************************************************************/
-/* dump files */
-/****************************************************************************/
-/* dump files */
-void ocSpitInstructionHS(char * root)
-{
- FILE* outFile;
-
- char * loc_path = "../../../compiler/GF/Compile/Instructions.hs";
- char * filename = malloc(strlen(root) + strlen(loc_path)+1);
- strcpy(filename, root);
- strcat(filename, loc_path);
-
- outFile = UTIL_fopenW(filename);
- fputs("module GF.Compile.Instructions where\n", outFile);
- fputs("\n", outFile);
- fputs("import Data.IORef\n", outFile);
- fputs("import Data.Binary\n", outFile);
- fputs("import Data.Binary.Put\n", outFile);
- fputs("import Data.Binary.Get\n", outFile);
- fputs("import Data.Binary.IEEE754\n", outFile);
- fputs("import PGF.CId\n", outFile);
- fputs("import PGF.Binary\n", outFile);
- fputs("\n", outFile);
- fputs("type IntRef = Int\n", outFile);
- fputs("type AConstant = CId\n", outFile);
- fputs("type AKind = CId\n", outFile);
- fputs("\n", outFile);
- fputs("ppE = undefined\n", outFile);
- fputs("ppF = undefined\n", outFile);
- fputs("ppL = undefined\n", outFile);
- fputs("ppC = undefined\n", outFile);
- fputs("ppN = undefined\n", outFile);
- fputs("ppR = undefined\n", outFile);
- fputs("ppK = undefined\n", outFile);
- fputs("ppS = undefined\n", outFile);
- fputs("ppI = undefined\n", outFile);
- fputs("ppI1 = undefined\n", outFile);
- fputs("ppIT = undefined\n", outFile);
- fputs("ppCE = undefined\n", outFile);
- fputs("ppMT = undefined\n", outFile);
- fputs("ppHT = undefined\n", outFile);
- fputs("ppSEG = undefined\n", outFile);
- fputs("ppBVT = undefined\n", outFile);
- fputs("\n", outFile);
-
- fputs(opHS, outFile); free(opHS);
- fputs(instrCat, outFile); free(instrCat);
- fputs("\n\n", outFile);
- fputs(instrHS, outFile); free(instrHS);
- free(typeDefs);
-
- UTIL_fclose(outFile);
- free(filename);
-}
diff --git a/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-haskell.h b/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-haskell.h
deleted file mode 100644
index 58cdd02b7..000000000
--- a/src/runtime/c/teyjus/tables_gen/instrformats/instrgen-haskell.h
+++ /dev/null
@@ -1,47 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-//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
deleted file mode 100644
index d8be9c390..000000000
--- a/src/runtime/c/teyjus/tables_gen/instrformats/lex.yy.c
+++ /dev/null
@@ -1,1977 +0,0 @@
-#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
deleted file mode 100644
index cff620e11..000000000
--- a/src/runtime/c/teyjus/tables_gen/instrformats/y.tab.h
+++ /dev/null
@@ -1,104 +0,0 @@
-
-/* 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
deleted file mode 100644
index dbdb047e5..000000000
--- a/src/runtime/c/teyjus/tables_gen/pervasives/ccode.c
+++ /dev/null
@@ -1,1024 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-// 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
deleted file mode 100644
index 7d5a781bb..000000000
--- a/src/runtime/c/teyjus/tables_gen/pervasives/ccode.h
+++ /dev/null
@@ -1,80 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-// 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
deleted file mode 100644
index 261d4dfab..000000000
--- a/src/runtime/c/teyjus/tables_gen/pervasives/ocamlcode.c
+++ /dev/null
@@ -1,1434 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-// 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
deleted file mode 100644
index 8b2ba062b..000000000
--- a/src/runtime/c/teyjus/tables_gen/pervasives/ocamlcode.h
+++ /dev/null
@@ -1,152 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-// 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
deleted file mode 100644
index 583063e49..000000000
--- a/src/runtime/c/teyjus/tables_gen/pervasives/op.c
+++ /dev/null
@@ -1,80 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-// 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
deleted file mode 100644
index 37456c897..000000000
--- a/src/runtime/c/teyjus/tables_gen/pervasives/op.h
+++ /dev/null
@@ -1,58 +0,0 @@
-//////////////////////////////////////////////////////////////////////////////
-// 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
deleted file mode 100644
index 2a332da91..000000000
--- a/src/runtime/c/teyjus/tables_gen/pervasives/pervasives.in
+++ /dev/null
@@ -1,404 +0,0 @@
-/% 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
deleted file mode 100644
index e046a63c0..000000000
--- a/src/runtime/c/teyjus/tables_gen/pervasives/pervasives.l
+++ /dev/null
@@ -1,96 +0,0 @@
-%{
-//////////////////////////////////////////////////////////////////////////////
-// 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; }
-