static LispObject LispGetStack(struct LispStack *s, LispObject symbol)
{
int i;
struct StackFrame *stack = s->stack;
CHECK_SYMBOL(symbol);
for (i = s->stackPointer - 1; i >= 0; i--) {
int r = SymbolEqual(symbol, stack[i].name);
if (r) {
return stack[i].value;
}
}
return Qnil;
}
/* BalsaTypeParseFromString : parse a Balsa type in the Breeze format
from a string skipping whitespace. Returns the pointer to the first
character beyond the end of the first type defn. in the string or NULL
on error, puts it's result in *type only on success.
index is used for error reporting and should usually be set to 0 */
const char *BalsaTypeParseFromString (const char *string, unsigned index, BalsaType ** type)
{
const char *stringPtr = SkipWS (string);
const char *newStringPtr;
BalsaType *ret = NULL;
unsigned symbolLength;
#define EXPECTING(thing) do { \
fprintf (stderr, "%s:%d: expecting " thing " at `%s' index %d (%c)\n", \
__func__, __LINE__, string, (int) (stringPtr - string), *stringPtr); \
return NULL; \
} while (0)
stringPtr = SkipWS (stringPtr);
if (*stringPtr == '(') /* ) */
{
const char *symbolPtr = stringPtr + 1;
bool isAlias;
symbolLength = SymbolLength (symbolPtr);
stringPtr = SkipWS (symbolPtr + symbolLength);
isAlias = SymbolEqual (symbolPtr, "alias-type", symbolLength);
if (isAlias || SymbolEqual (symbolPtr, "named-type", symbolLength))
{
char *typeName;
if (*stringPtr != '"')
EXPECTING ("`\"'");
stringPtr++;
symbolLength = SymbolLength (stringPtr);
typeName = malloc (symbolLength + 1);
strncpy (typeName, stringPtr, symbolLength);
typeName[symbolLength] = '\0';
stringPtr += symbolLength;
if (*stringPtr != '"')
EXPECTING ("`\"'");
stringPtr = SkipWS (stringPtr + 1);
ret = BalsaLookupInternedType (typeName);
if (!ret)
{
stringPtr -= symbolLength + 1; /* Report error at start of name */
EXPECTING ("valid type name");
}
if (isAlias)
ret = BalsaTypeAlias (NULL, ret);
free (typeName);
} else if (SymbolEqual (symbolPtr, "numeric-type", symbolLength))
{
symbolLength = SymbolLength (stringPtr);
bool isSigned = SymbolEqual (stringPtr, "#t", symbolLength);
unsigned length;
if (!isSigned && !SymbolEqual (stringPtr, "#f", symbolLength))
EXPECTING ("signedness");
stringPtr = SkipWS (stringPtr + symbolLength);
symbolLength = SymbolLength (stringPtr);
if (!isdigit (*stringPtr))
EXPECTING ("bitwise type length");
length = strtoul (stringPtr, NULL, 10);
stringPtr = stringPtr + symbolLength;
ret = NewBalsaType (BalsaNumericType, NULL, (isSigned ? -length : length));
} else if (SymbolEqual (symbolPtr, "enumeration-type", symbolLength))
{
symbolLength = SymbolLength (stringPtr);
bool isSigned = SymbolEqual (stringPtr, "#t", symbolLength);
unsigned length;
BalsaList *elementNames = NULL;
BalsaList *elementValues = NULL;
if (!isSigned && !SymbolEqual (stringPtr, "#f", symbolLength))
EXPECTING ("signedness");
stringPtr = SkipWS (stringPtr + symbolLength);
symbolLength = SymbolLength (stringPtr);
if (!isdigit (*stringPtr))
EXPECTING ("bitwise type length");
length = strtoul (stringPtr, NULL, 10);
stringPtr = SkipWS (stringPtr + symbolLength);
ret = NewBalsaType (BalsaEnumerationType, NULL, (isSigned ? -length : length));
while (*stringPtr != ')')
{
bool elementIsNegate = false;
char *elementName;
FormatData *elementValue;
if (*stringPtr != '(')
EXPECTING ("`('");
stringPtr = SkipWS (stringPtr + 1);
if (*stringPtr != '"')
EXPECTING ("`\"'");
stringPtr++;
symbolLength = SymbolLength (stringPtr);
if (!(isalnum (*stringPtr) || *stringPtr == '_'))
EXPECTING ("element name");
elementName = malloc (symbolLength + 1);
strncpy (elementName, stringPtr, symbolLength);
elementName[symbolLength] = '\0';
stringPtr += symbolLength;
if (*stringPtr != '"')
EXPECTING ("`\"'");
stringPtr = SkipWS (stringPtr + 1);
/* Parse a multi-precision (possibly negative) integer */
if (*stringPtr == '-')
{
elementIsNegate = true;
stringPtr++;
}
symbolLength = SymbolLength (stringPtr);
elementValue = FormatDataParseUInt (stringPtr, 10);
if (!elementValue)
EXPECTING ("element type");
if (elementIsNegate)
{
FormatData *negElementValue = elementValue;
elementValue = FormatDataNegate (negElementValue, length);
DeleteFormatData (negElementValue);
}
stringPtr = SkipWS (stringPtr + symbolLength);
elementNames = NewBalsaList (elementName, elementNames);
elementValues = NewBalsaList (elementValue, elementValues);
if (*stringPtr != ')')
EXPECTING ("`)'");
stringPtr = SkipWS (stringPtr + 1);
}
elementNames = BalsaListReverse (elementNames);
elementValues = BalsaListReverse (elementValues);
ret->info.enumeration.elementNames = (char **) BalsaListToArray (elementNames, &(ret->info.enumeration.elementCount));
ret->info.enumeration.elementValues = (FormatData **) BalsaListToArray (elementValues, NULL);
BalsaListDelete (elementNames);
BalsaListDelete (elementValues);
} else if (SymbolEqual (symbolPtr, "record-type", symbolLength))
{
unsigned length;
BalsaList *elementNames = NULL;
BalsaList *elementTypes = NULL;
symbolLength = SymbolLength (stringPtr);
if (!isdigit (*stringPtr))
EXPECTING ("bitwise type length");
length = strtoul (stringPtr, NULL, 10);
stringPtr = SkipWS (stringPtr + symbolLength);
ret = NewBalsaType (BalsaRecordType, NULL, length);
while (*stringPtr != ')')
{
char *elementName;
BalsaType *elementType;
if (*stringPtr != '(')
EXPECTING ("`('");
stringPtr = SkipWS (stringPtr + 1);
if (*stringPtr != '"')
EXPECTING ("`\"'");
stringPtr++;
symbolLength = SymbolLength (stringPtr);
if (!(isalnum (*stringPtr) || *stringPtr == '_'))
EXPECTING ("element name");
elementName = malloc (symbolLength + 1);
strncpy (elementName, stringPtr, symbolLength);
elementName[symbolLength] = '\0';
stringPtr += symbolLength;
if (*stringPtr != '"')
EXPECTING ("`\"'");
stringPtr = SkipWS (stringPtr + 1);
newStringPtr = BalsaTypeParseFromString (stringPtr, index + (unsigned) (stringPtr - string), &elementType);
if (!newStringPtr)
EXPECTING ("element type");
stringPtr = SkipWS (newStringPtr);
elementNames = NewBalsaList (elementName, elementNames);
elementTypes = NewBalsaList (elementType, elementTypes);
if (*stringPtr != ')')
EXPECTING ("`)'");
stringPtr = SkipWS (stringPtr + 1);
}
elementNames = BalsaListReverse (elementNames);
elementTypes = BalsaListReverse (elementTypes);
ret->info.record.elementNames = (char **) BalsaListToArray (elementNames, &(ret->info.record.elementCount));
ret->info.record.elementTypes = (BalsaType **) BalsaListToArray (elementTypes, NULL);
BalsaListDelete (elementNames);
BalsaListDelete (elementTypes);
} else if (SymbolEqual (symbolPtr, "array-type", symbolLength))
{
BalsaType *elementType;
BalsaType *boundingType;
int lowIndex;
unsigned elementCount;
newStringPtr = BalsaTypeParseFromString (stringPtr, index + (unsigned) (stringPtr - string), &elementType);
if (!newStringPtr)
EXPECTING ("element type");
stringPtr = SkipWS (newStringPtr);
symbolLength = SymbolLength (stringPtr);
if (!isdigit (*stringPtr) && *stringPtr != '-')
EXPECTING ("low index");
lowIndex = strtoul (stringPtr, NULL, 10);
stringPtr = SkipWS (stringPtr + symbolLength);
symbolLength = SymbolLength (stringPtr);
if (!isdigit (*stringPtr))
EXPECTING ("element count");
elementCount = strtoul (stringPtr, NULL, 10);
stringPtr = SkipWS (stringPtr + symbolLength);
ret = NewBalsaType (BalsaArrayType, NULL, elementCount * ABS (elementType->size));
ret->info.array.elementCount = elementCount;
ret->info.array.elementType = elementType;
ret->info.array.boundingType = boundingType;
ret->info.array.lowIndex = lowIndex;
} else if (SymbolEqual (symbolPtr, "builtin-type", symbolLength))
{
ret = NewBalsaType (BalsaBuiltinType, NULL, 64);
} else
{
stringPtr = symbolPtr;
EXPECTING ("*-type");
}
/* ( */ if (*stringPtr != ')')
/* ( */ EXPECTING ("`)'");
stringPtr++;
} else
EXPECTING ("`('"); /* ) */
#undef EXPECTING
if (type)
*type = ret;
return stringPtr;
}
