/* Given the argument list, parse it into ArgList format. */
ArgList ParseArgList(VyObj list){
int num = CountParams(list);
Param* params = VyMalloc(sizeof(Param) * num);
int i;
/* Each element of the list is either a parameter or an argument mode setting symbol...
* Check if it sets the argument type (?, ~, or ..), and if it doesn't, parse it as a parameter
*/
VyObj opt_arg_set = CreateSymbol("?");
VyObj rest_arg_set = CreateSymbol("..");
bool opt, rest;
opt = rest = false;
int param_num = 0;
int arg_list_len = ListLen(list);
for(i = 0; i < arg_list_len; i++){
VyObj next = ListGet(UNWRAP(list, VyCons), i);
if(ObjEq(next, opt_arg_set)){
opt = true;
}
else if(ObjEq(next, rest_arg_set)){
opt = rest = true;
}
else {
params[param_num] = ParseParam(next, opt, rest);
param_num++;
}
}
ArgList args = {num_params: num, params: params};
return args;
}
const char *GetLogicalName(
UDFContext *context,
const char *defaultLogicalName)
{
Environment *theEnv = context->environment;
const char *logicalName;
UDFValue theArg;
if (! UDFNextArgument(context,ANY_TYPE_BITS,&theArg))
{ return NULL; }
if (CVIsType(&theArg,LEXEME_BITS) ||
CVIsType(&theArg,INSTANCE_NAME_BIT))
{
logicalName = theArg.lexemeValue->contents;
if ((strcmp(logicalName,"t") == 0) || (strcmp(logicalName,"T") == 0))
{ logicalName = defaultLogicalName; }
}
else if (CVIsType(&theArg,FLOAT_BIT))
{
logicalName = CreateSymbol(theEnv,FloatToString(theEnv,theArg.floatValue->contents))->contents;
}
else if (CVIsType(&theArg,INTEGER_BIT))
{
logicalName = CreateSymbol(theEnv,LongIntegerToString(theEnv,theArg.integerValue->contents))->contents;
}
else
{ logicalName = NULL; }
return(logicalName);
}
/* Parse a parameter. Currently only supports normal ones. */
Param ParseParam(VyObj param, bool opt, bool rest){
VyObj default_val = None();
if(opt){
if(IsType(param, TypeCons)){
VyObj name = ListGet(UNWRAP(param, VyCons), 0);
default_val = ListGet(UNWRAP(param, VyCons), 0);
param = name;
}
}
Param p = {optional: opt,
rest: rest,
default_value: default_val,
name: UNWRAP(param, VySymbol)};
return p;
}
/* Find how many actual parameters there are */
int CountParams(VyObj list){
int count = 0;
while(!IsNil(list)){
if(!ObjEq(Car(list), CreateSymbol("?")) &&
!ObjEq(Car(list), CreateSymbol("..")))
count++;
list = Cdr(list);
}
return count;
}
/*********************************************************
NAME : SlotDefaultValue
DESCRIPTION : Determines the default value for
the specified slot of the specified class
INPUTS : 1) The class
2) The slot name
RETURNS : True if slot default value is set,
false otherwise
SIDE EFFECTS : Slot default value evaluated - dynamic
defaults will cause any side effects
NOTES : None
*********************************************************/
bool SlotDefaultValue(
Defclass *theDefclass,
const char *slotName,
CLIPSValue *theValue)
{
SlotDescriptor *sd;
bool rv;
UDFValue result;
UDFValue *tmpPtr;
Environment *theEnv = theDefclass->header.env;
theValue->value = FalseSymbol(theEnv);
if ((sd = LookupSlot(theEnv,theDefclass,slotName,true)) == NULL)
{ return false; }
if (sd->noDefault)
{
theValue->value = CreateSymbol(theEnv,"?NONE");
return true;
}
if (sd->dynamicDefault)
{
rv = EvaluateAndStoreInDataObject(theEnv,sd->multiple,
(Expression *) sd->defaultValue,
&result,true);
NormalizeMultifield(theEnv,&result);
theValue->value = result.value;
return rv;
}
tmpPtr = (UDFValue *) sd->defaultValue;
theValue->value = tmpPtr->value;
return true;
}
/**********************************************************************
NAME : SlotDefaultValueCommand
DESCRIPTION : Determines the default avlue for the specified slot
of the specified class
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : H/L Syntax : (slot-default-value <class> <slot>)
**********************************************************************/
void SlotDefaultValueCommand(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
Defclass *theDefclass;
SlotDescriptor *sd;
returnValue->lexemeValue = FalseSymbol(theEnv);
sd = CheckSlotExists(context,"slot-default-value",&theDefclass,true,true);
if (sd == NULL)
return;
if (sd->noDefault)
{
returnValue->lexemeValue = CreateSymbol(theEnv,"?NONE");
return;
}
if (sd->dynamicDefault)
EvaluateAndStoreInDataObject(theEnv,sd->multiple,
(Expression *) sd->defaultValue,
returnValue,true);
else
GenCopyMemory(UDFValue,1,returnValue,sd->defaultValue);
}
void DefglobalSetSymbol(
Defglobal *theDefglobal,
const char *value)
{
CLIPSValue cv;
cv.lexemeValue = CreateSymbol(theDefglobal->header.env,value);
DefglobalSetValue(theDefglobal,&cv);
}
void CreateSymbols(){
SymbolFn = CreateSymbol("fn");
SymbolFalse = CreateSymbol("false");
SymbolIf = CreateSymbol("if");
SymbolSetvar = CreateSymbol("setvar");
SymbolWhile = CreateSymbol("while");
SymbolNil = CreateSymbol("nil");
SymbolQuote = CreateSymbol("quote");
}
std::string IExtSymbolInterFace::GetDescription()
{
Display::IExtSymbolPtr newSymbol = CreateSymbol();
if (newSymbol == NULL)
{
return "";
}
std::string symbolDescription = newSymbol->GetDescription();
return symbolDescription;
}
std::string IExtSymbolInterFace::GetSymbolName()
{
Display::IExtSymbolPtr newSymbol = CreateSymbol();
if (newSymbol == NULL)
{
return "";
}
std::string symbolName = newSymbol->GetSymbolName();
return symbolName;
}
/****************************************************
NAME : SetupFactQuery
DESCRIPTION : Initializes fact query H/L
functions and parsers
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Sets up kernel functions and parsers
NOTES : None
****************************************************/
void SetupFactQuery(
Environment *theEnv)
{
AllocateEnvironmentData(theEnv,FACT_QUERY_DATA,sizeof(struct factQueryData),NULL);
#if RUN_TIME
FactQueryData(theEnv)->QUERY_DELIMITER_SYMBOL = FindSymbolHN(theEnv,QUERY_DELIMITER_STRING,SYMBOL_BIT);
#endif
#if ! RUN_TIME
FactQueryData(theEnv)->QUERY_DELIMITER_SYMBOL = CreateSymbol(theEnv,QUERY_DELIMITER_STRING);
IncrementLexemeCount(FactQueryData(theEnv)->QUERY_DELIMITER_SYMBOL);
AddUDF(theEnv,"(query-fact)","f",0,UNBOUNDED,NULL,GetQueryFact,"GetQueryFact",NULL);
AddUDF(theEnv,"(query-fact-slot)","*",0,UNBOUNDED,NULL,GetQueryFactSlot,"GetQueryFactSlot",NULL);
AddUDF(theEnv,"any-factp","b",0,UNBOUNDED,NULL,AnyFacts,"AnyFacts",NULL);
AddUDF(theEnv,"find-fact","m",0,UNBOUNDED,NULL,QueryFindFact,"QueryFindFact",NULL);
AddUDF(theEnv,"find-all-facts","m",0,UNBOUNDED,NULL,QueryFindAllFacts,"QueryFindAllFacts",NULL);
AddUDF(theEnv,"do-for-fact","*",0,UNBOUNDED,NULL,QueryDoForFact,"QueryDoForFact",NULL);
AddUDF(theEnv,"do-for-all-facts","*",0,UNBOUNDED,NULL,QueryDoForAllFacts,"QueryDoForAllFacts",NULL);
AddUDF(theEnv,"delayed-do-for-all-facts","*",0,UNBOUNDED,NULL,DelayedQueryDoForAllFacts,"DelayedQueryDoForAllFacts",NULL);
#endif
AddFunctionParser(theEnv,"any-factp",FactParseQueryNoAction);
AddFunctionParser(theEnv,"find-fact",FactParseQueryNoAction);
AddFunctionParser(theEnv,"find-all-facts",FactParseQueryNoAction);
AddFunctionParser(theEnv,"do-for-fact",FactParseQueryAction);
AddFunctionParser(theEnv,"do-for-all-facts",FactParseQueryAction);
AddFunctionParser(theEnv,"delayed-do-for-all-facts",FactParseQueryAction);
}
void
ReadNames (long nextname, long endnames)
{
char scope, symtype;
long value;
symbol *foundsymbol;
do
{
scope = fgetc (z80asmfile);
symtype = fgetc (z80asmfile); /* type of name */
value = ReadLong (z80asmfile); /* read symbol (long) integer */
ReadName (); /* read symbol name */
nextname += 1 + 1 + 4 + 1 + strlen (line);
switch (symtype)
{
case 'A':
symtype = SYMADDR | SYMDEFINED;
value += modulehdr->first->origin + CURRENTMODULE->startoffset; /* Absolute address */
break;
case 'C':
symtype = SYMDEFINED;
break;
}
switch (scope)
{
case 'L':
if ((foundsymbol = FindSymbol (line, CURRENTMODULE->localroot)) == NULL)
{
foundsymbol = CreateSymbol (line, value, symtype | SYMLOCAL, CURRENTMODULE);
if (foundsymbol != NULL)
insert (&CURRENTMODULE->localroot, foundsymbol, (int (*)()) cmpidstr);
}
else
{
foundsymbol->symvalue = value;
foundsymbol->type |= symtype | SYMLOCAL;
foundsymbol->owner = CURRENTMODULE;
redefinedmsg ();
}
break;
case 'G':
if ((foundsymbol = FindSymbol (line, globalroot)) == NULL)
{
foundsymbol = CreateSymbol (line, value, symtype | SYMXDEF, CURRENTMODULE);
if (foundsymbol != NULL)
insert (&globalroot, foundsymbol, (int (*)()) cmpidstr);
}
else
{
foundsymbol->symvalue = value;
foundsymbol->type |= symtype | SYMXDEF;
foundsymbol->owner = CURRENTMODULE;
redefinedmsg ();
}
break;
case 'X':
if ((foundsymbol = FindSymbol (line, globalroot)) == NULL)
{
foundsymbol = CreateSymbol (line, value, symtype | SYMXDEF | SYMDEF, CURRENTMODULE);
if (foundsymbol != NULL)
insert (&globalroot, foundsymbol, (int (*)()) cmpidstr);
}
else
{
foundsymbol->symvalue = value;
foundsymbol->type |= symtype | SYMXDEF | SYMDEF;
foundsymbol->owner = CURRENTMODULE;
redefinedmsg ();
}
break;
}
}
while (nextname < endnames);
}
void CreateMainModule(
Environment *theEnv,
void *context)
{
Defmodule *newDefmodule;
struct moduleItem *theItem;
unsigned int i;
struct defmoduleItemHeader *theHeader;
/*=======================================*/
/* Allocate the defmodule data structure */
/* and name it the MAIN module. */
/*=======================================*/
newDefmodule = get_struct(theEnv,defmodule);
newDefmodule->header.name = CreateSymbol(theEnv,"MAIN");
IncrementLexemeCount(newDefmodule->header.name);
newDefmodule->header.whichModule = NULL;
newDefmodule->header.next = NULL;
newDefmodule->header.ppForm = NULL;
newDefmodule->importList = NULL;
newDefmodule->exportList = NULL;
newDefmodule->header.bsaveID = 0L;
newDefmodule->header.usrData = NULL;
newDefmodule->header.constructType = DEFMODULE;
newDefmodule->header.env = theEnv;
/*==================================*/
/* Initialize the array for storing */
/* the module's construct lists. */
/*==================================*/
if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL;
else
{
newDefmodule->itemsArray = (struct defmoduleItemHeader **)
gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems);
for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems;
(i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL);
i++, theItem = theItem->next)
{
if (theItem->allocateFunction == NULL)
{ newDefmodule->itemsArray[i] = NULL; }
else
{
newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *)
(*theItem->allocateFunction)(theEnv);
theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i];
theHeader->theModule = newDefmodule;
theHeader->firstItem = NULL;
theHeader->lastItem = NULL;
}
}
}
/*=======================================*/
/* Add the module to the list of modules */
/* and make it the current module. */
/*=======================================*/
#if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT
SetNumberOfDefmodules(theEnv,1);
#endif
DefmoduleData(theEnv)->LastDefmodule = newDefmodule;
DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule;
SetCurrentModule(theEnv,newDefmodule);
}
