#include #include #include #include #include "util.h" #include "read.h" #include "eval.h" #include "print.h" int allNums(object list) /* проверава да ли је објекат листа чији је сваки члан број, претпоставља да је * објекат валидна листа */ { object *currentCell = &list; while (TYPE(*currentCell) != nilObject) { if (TYPE(CAR(*currentCell)) != numberObject) { return 0; } currentCell = &CDR(*currentCell); } return 1; } int allStrings(object list) { object *currentCell = &list; while (TYPE(*currentCell) != nilObject) { if (TYPE(CAR(*currentCell)) != stringObject) { return 0; } currentCell = &CDR(*currentCell); } return 1; } int allSyms(object list) /* проверава да ли је дати објекат симбол, или листа (правилна или крња), чији * је сваки члан симбол */ { object *currentCell = &list; while (TYPE(*currentCell) == consObject) { if (TYPE(CAR(*currentCell)) != symbolObject) { return 0; } currentCell = &CDR(*currentCell); } switch (TYPE(*currentCell)) { case symbolObject: case nilObject: return 1; default: return 0; } } object addInt(object parameters) { object result; TYPE(result) = numberObject; if (!allNums(parameters)) { SIGERR(typeError); } else if (listLength(parameters) == 0) { result = longlongToNumber(0LL); } else { object first, rest; first = CAR(parameters); rest = addInt(CDR(parameters)); result = plusNum(first, rest); } return result; } object subtractInt(object parameters) { object result; TYPE(result) = numberObject; if (!allNums(parameters)) { SIGERR(typeError); } else if (listLength(parameters) == 0) { SIGERR(argumentNumberError); } else if (listLength(parameters) == 1) { result = minusNum(CAR(parameters)); } else { result = plusNum(CAR(parameters), minusNum(addInt(CDR(parameters)))); } return result; } object multiplyInt(object parameters) { object result; TYPE(result) = numberObject; if (!allNums(parameters)) { SIGERR(typeError); } else if (listLength(parameters) == 0) { result = longlongToNumber(1LL); } else { object first, rest; first = CAR(parameters); rest = multiplyInt(CDR(parameters)); result = timesNum(first,rest); } return result; } object divideInt(object parameters) { object result; TYPE(result) = numberObject; if (!allNums(parameters)) { SIGERR(typeError); } else if (listLength(parameters) == 0) { SIGERR(argumentNumberError); } else if (listLength(parameters) == 1) { result = inverseNum(CAR(parameters)); } else { object check = inverseNum(multiplyInt(CDR(parameters))); if (TYPE(check) != errorObject) { result = timesNum(CAR(parameters), inverseNum(multiplyInt(CDR(parameters)))); } else { result = check; } result = shortenFractionNum(result); } return result; } object exactToInexactInt(object parameters) { object result; if (listLength(parameters) != 1) { SIGERR(argumentNumberError); } else if (TYPE(CAR(parameters)) != numberObject) { SIGERR(typeError); } else { result = exactToInexactNum(CAR(parameters)); } return result; } object inexactToExactInt(object parameters) { object result; if (listLength(parameters) != 1) { SIGERR(argumentNumberError); } else if (TYPE(CAR(parameters)) != numberObject) { SIGERR(typeError); } else { result = inexactToExactNum(CAR(parameters)); } return result; } object fractionPart(object parameters, int part) { if (listLength(parameters) != 1) { SIGERR(argumentNumberError); } if (TYPE(CAR(parameters)) != numberObject || NUM_TYPE(CAR(parameters)) != fractionNum) { SIGERR(typeError); } object result; TYPE(result) = numberObject; NUM_TYPE(result) = fractionNum; NUM_DENOM(result) = 1; NUM_NUMER(result) = !part ? NUM_NUMER(CAR(parameters)) : NUM_DENOM(CAR(parameters)); return result; } object numeratorInt(object parameters) { return fractionPart(parameters, 0); } object denominatorInt(object parameters) { return fractionPart(parameters, 1); } object quoteInt(object parameters) { object result; if (listLength(parameters) != 1) { SIGERR(argumentNumberError); } else { result = copyObject(CAR(parameters)); } return result; } int validArgumentList(object list) { if (!allSyms(list)) { return 0; } else { int allUniqueSyms = 1; object *currentSymbol1 = &list; while (TYPE(*currentSymbol1) == consObject) { object *currentSymbol2 = &CDR(*currentSymbol1); while (TYPE(*currentSymbol2) == consObject) { if (!strcmp(SYM(CAR(*currentSymbol1)), SYM(CAR(*currentSymbol2)))) { allUniqueSyms = 0; goto breakloop; } currentSymbol2 = &CDR(*currentSymbol2); } if (TYPE(*currentSymbol2) == symbolObject && !strcmp(SYM(*currentSymbol2), SYM(CAR(*currentSymbol1)))) { allUniqueSyms = 0; goto breakloop; } currentSymbol1 = &CDR(*currentSymbol1); } breakloop: return allUniqueSyms; } } object lambdaInt(object parameters, env currentEnv) { object result; if (listLength(parameters) < 2) { SIGERR(argumentNumberError); } else if (!validArgumentList(CAR(parameters))) { SIGERR(typeError); } else { TYPE(result) = procedureObject; PROC(result) = createProcedure(); PROC_TYPE(result) = compoundProc; PROC_SPECIAL(result) = 0; PROC_COMP_ARGS(result) = copyObject(CAR(parameters)); PROC_COMP_BODY(result) = copyObject(CDR(parameters)); PROC_COMP_ENV(result) = currentEnv; } return result; } object defineInt(object parameters, env currentEnv) { object result, value; if (listLength(parameters) == 0) { SIGERR(argumentNumberError); } else if (TYPE(CAR(parameters)) == symbolObject) { if (listLength(parameters) == 2) { result = copyObject(CAR(parameters)); value = Eval(copyObject(CAR(CDR(parameters))), currentEnv); if (TYPE(value) == errorObject) { CPYERR(ERR(value)); } addSymbolVariable(SYM(result), value, currentEnv); } else { SIGERR(argumentNumberError); } } else if (TYPE(CAR(parameters)) == consObject) { if (listLength(parameters) >= 2) { if (allSyms(CAR(parameters))) { result = copyObject(CAR(CAR(parameters))); object args = copyObject(CDR(CAR(parameters))); deleteObject(CAR(parameters)); CAR(parameters) = copyObject(args); deleteObject(args); object proc = lambdaInt(parameters, currentEnv); addSymbolVariable(SYM(result), proc, currentEnv); } else { SIGERR(typeError); } } else { SIGERR(argumentNumberError); } } else { SIGERR(typeError); } return result; } object defineMacroInt(object parameters, env currentEnv) { object result; if (listLength(parameters) < 2) { SIGERR(argumentNumberError); } else if (TYPE(CAR(parameters)) != consObject) { SIGERR(typeError); } else { if (allSyms(CAR(parameters))) { result = copyObject(CAR(CAR(parameters))); object args = copyObject(CDR(CAR(parameters))); deleteObject(CAR(parameters)); CAR(parameters) = copyObject(args); deleteObject(args); object proc = lambdaInt(parameters, currentEnv); PROC_SPECIAL(proc) = 1; addSymbolVariable(SYM(result), proc, currentEnv); } else { SIGERR(typeError); } } return result; } object cmpMultiple(object parameters, int flag) /* проверава помоћу cmp функције у util.h хедеру, да ли је дата листа, листа * строго опадајућих, једнаких, или строго растућих бројева, у зависности од * тога да ли је "flag" 1, 0 или -1 респективно */ { if (!allNums(parameters)) { SIGERR(typeError); } if (listLength(parameters) == 0 || listLength(parameters) == 1) { return intToBool(1); } int resultInt = 1; object *current = ¶meters; while (TYPE(CDR(*current)) != nilObject) { if (cmp(CAR(*current), CAR(CDR(*current))) != flag) { resultInt = 0; break; } current = &CDR(*current); } object result; TYPE(result) = boolObject; BOOL(result) = resultInt; return result; } object lessInt(object parameters) { return cmpMultiple(parameters, -1); } object eqNumInt(object parameters) { return cmpMultiple(parameters, 0); } object greaterInt(object parameters) { return cmpMultiple(parameters, 1); } object ifInt(object parameters, env currentEnv) { object predicate, result; switch (listLength(parameters)) { case 2: predicate = Eval(copyObject(CAR(parameters)), currentEnv); if (TYPE(predicate) == errorObject) { CPYERR(ERR(predicate)); } if (TYPE(predicate) == boolObject && BOOL(predicate) == 0) { TYPE(result) = nilObject; } else { result = Eval(copyObject(CAR(CDR(parameters))), currentEnv); } if (TYPE(result) == errorObject) { CPYERR(ERR(result)); } break; case 3: predicate = Eval(copyObject(CAR(parameters)), currentEnv); if (TYPE(predicate) == errorObject) { CPYERR(ERR(predicate)); } if (TYPE(predicate) == boolObject && BOOL(predicate) == 0) { result = Eval(copyObject(CAR(CDR(CDR(parameters)))), currentEnv); } else { result = Eval(copyObject(CAR(CDR(parameters))), currentEnv); } if (TYPE(result) == errorObject) { CPYERR(ERR(result)); } break; default: SIGERR(argumentNumberError); } return result; } object checkType(object parameters, dataType type) { if (listLength(parameters) != 1) { SIGERR(argumentNumberError); } object result; TYPE(result) = boolObject; BOOL(result) = (type == TYPE(CAR(parameters))); return result; } object nilQInt(object parameters) { return checkType(parameters, nilObject); } object consQInt(object parameters) { return checkType(parameters, consObject); } object numberQInt(object parameters) { return checkType(parameters, numberObject); } object checkNumType(object parameters, numType type) { if (listLength(parameters) != 1) { SIGERR(argumentNumberError); } object result; TYPE(result) = boolObject; BOOL(result) = TYPE(CAR(parameters)) == numberObject && (NUM_TYPE(CAR(parameters)) == type ? 1 : 0); return result; } object fractionQInt(object parameters) { return checkNumType(parameters, fractionNum); } object realQInt(object parameters) { return checkNumType(parameters, realNum); } object symbolQInt(object parameters) { return checkType(parameters, symbolObject); } object procedureQInt(object parameters) { return checkType(parameters, procedureObject); } object boolQInt(object parameters) { return checkType(parameters, boolObject); } object stringQInt(object parameters) { return checkType(parameters, stringObject); } object charQInt(object parameters) { return checkType(parameters, charObject); } object listQInt(object parameters) { if (listLength(parameters) != 1) { SIGERR(argumentNumberError); } object result; TYPE(result) = boolObject; BOOL(result) = properList(CAR(parameters)); return result; } int validAppendArgs(object parameters) { int length = listLength(parameters); if (length == 0 || length == 1) { return 1; } else if (!properList(CAR(parameters))) { return 0; } else { return validAppendArgs(CDR(parameters)); } } object appendAux(object parameters) { object result; if (listLength(parameters) == 0) { TYPE(result) = nilObject; } else if (listLength(parameters) == 1) { result = copyObject(CAR(parameters)); } else { object rest = appendAux(CDR(parameters)); result = copyObject(CAR(parameters)); object *end = &result; while (TYPE(*end) != nilObject) { end = &CDR(*end); } *end = rest; } return result; } object appendInt(object parameters) { if (!validAppendArgs(parameters)) { SIGERR(typeError); } return appendAux(parameters); } object consInt(object parameters) { if (listLength(parameters) != 2) { SIGERR(argumentNumberError); } object result; TYPE(result) = consObject; CONS(result) = malloc(sizeof(cons)); CAR(result) = copyObject(CAR(parameters)); CDR(result) = copyObject(CAR(CDR(parameters))); return result; } object cellElement(object parameters, int part) /* враћа car или cdr (сар или сдр) датог конс објекта у зависности од тога да * ли је part 0 или нешто друго (1) */ { if (listLength(parameters) != 1) { SIGERR(argumentNumberError); } if (TYPE(CAR(parameters)) != consObject) { SIGERR(typeError); } return !part ? copyObject(CAR(CAR(parameters))) : copyObject(CDR(CAR(parameters))); } object carInt(object parameters) { return cellElement(parameters, 0); } object cdrInt(object parameters) { return cellElement(parameters, 1); } object eqvQInt(object parameters) { if (listLength(parameters) != 2) { SIGERR(argumentNumberError); } object result; TYPE(result) = boolObject; BOOL(result) = 1; if (TYPE(CAR(parameters)) != TYPE(CAR(CDR(parameters)))) { BOOL(result) = 0; } else { switch (TYPE(CAR(parameters))) { case numberObject: if (NUM_TYPE(CAR(parameters)) != NUM_TYPE(CAR(CDR(parameters)))) { BOOL(result) = 0; } switch (NUM_TYPE(CAR(parameters))) { case fractionNum: BOOL(result) = NUM_NUMER(CAR(parameters)) == NUM_NUMER(CAR(CDR(parameters))) && NUM_DENOM(CAR(parameters)) == NUM_DENOM(CAR(CDR(parameters))); break; case realNum: BOOL(result) = NUM_REAL(CAR(parameters)) == NUM_REAL(CAR(CDR(parameters))); break; } break; case symbolObject: BOOL(result) = !strcmp(SYM(CAR(parameters)), SYM(CAR(CDR(parameters)))); break; case boolObject: BOOL(result) = !BOOL(CAR(parameters)) == !BOOL(CAR(CDR(parameters))); break; case stringObject: BOOL(result) = !strcmp(STR(CAR(parameters)), STR(CAR(CDR(parameters)))); break; case charObject: BOOL(result) = CHR(CAR(parameters)) == CHR(CAR(CDR(parameters))); break; case nilObject: BOOL(result) = 1; break; case consObject: case procedureObject: default: BOOL(result) = 0; break; } } return result; } object applyInt(object parameters, env currentEnv) { if (listLength(parameters) != 2) { SIGERR(argumentNumberError); } if (!properList(CAR(CDR(parameters))) || TYPE(CAR(parameters)) != procedureObject) { SIGERR(typeError); } return apply(CAR(parameters), CAR(CDR(parameters)), currentEnv); } object displayInt(object parameters) { if (listLength(parameters) != 1) { SIGERR(argumentNumberError); } if (TYPE(CAR(parameters)) == stringObject) { printf("%s", STR(CAR(parameters))); } else if (TYPE(CAR(parameters)) == charObject) { putwchar(CHR(CAR(parameters))); } else { SIGERR(typeError); } return copyObject(CAR(parameters)); } object printInt(object parameters) { if (listLength(parameters) != 1) { SIGERR(argumentNumberError); } printValue(CAR(parameters)); return copyObject(CAR(parameters)); } object readInt(object parameters) { if (listLength(parameters) != 0) { SIGERR(argumentNumberError); } return Read("", stdin); } object beginInt(object parameters) { object last; if (listLength(parameters) == 0) { TYPE(last) = nilObject; } else { object *current = ¶meters; while (TYPE(CDR(*current)) != nilObject) { current = &CDR(*current); } last = copyObject(CAR(*current)); } return last; } object throwInt(object parameters) { if (listLength(parameters) != 1) { SIGERR(argumentNumberError); } if (TYPE(CAR(parameters)) != stringObject) { SIGERR(typeError); } object result; TYPE(result) = errorObject; ERR(result) = malloc((strlen(STR(CAR(parameters))) + 1) * sizeof(char)); strcpy(ERR(result), STR(CAR(parameters))); return result; } object makeStrInt(object parameters) { object result; if (listLength(parameters) != 2) { SIGERR(argumentNumberError); } if (TYPE(CAR(parameters)) != numberObject || !integer(CAR(parameters)) || TYPE(CAR(CDR(parameters))) != charObject) { SIGERR(typeError); } TYPE(result) = stringObject; if (CHR(CAR(CDR(parameters))) == L'\0') { STR(result) = malloc(sizeof(char)); STR(result)[0] = '\0'; return result; } STR(result) = malloc((MB_CUR_MAX * NUM_NUMER(CAR(parameters)) + 1) * sizeof(char)); if (STR(result) == NULL) { SIGERR(outOfMemoryError); } int i, index; for (i = 0, index = 0; i < NUM_NUMER(CAR(parameters)); ++i, index += wctomb(STR(result) + index, CHR(CAR(CDR(parameters))))) ; STR(result)[index] = '\0'; return result; } object charInt(object parameters) { object result; if (listLength(parameters) != 2) { SIGERR(argumentNumberError); } if (TYPE(CAR(parameters)) != stringObject || TYPE(CAR(CDR(parameters))) != numberObject || !integer(CAR(CDR(parameters)))) { SIGERR(typeError); } TYPE(result) = charObject; char *mbs = STR(CAR(parameters)); int index = NUM_NUMER(CAR(CDR(parameters))), current = 0; for (current = 0; current < index && *mbs != '\0'; mbs += mblen(mbs, MB_CUR_MAX), ++current) ; mbtowc(&CHR(result), mbs, MB_CUR_MAX); return result; } object strLengthInt(object parameters) { object result; if (listLength(parameters) != 1) { SIGERR(argumentNumberError); } if (TYPE(CAR(parameters)) != stringObject) { SIGERR(typeError); } TYPE(result) = numberObject; NUM_TYPE(result) = fractionNum; NUM_DENOM(result) = 1; wchar_t current; int i = 0, length = 0; int cLength; do { cLength = mbtowc(¤t, &STR(CAR(parameters))[i], MB_CUR_MAX); i += cLength; ++length; } while (current != L'\0'); length -= 1; /* одузима се дужина нул карактера */ NUM_NUMER(result) = length; return result; } object catInt(object parameters) { if (!allStrings(parameters)) { SIGERR(typeError); } object result; TYPE(result) = stringObject; int stringLength = 0; object *current = ¶meters; while (TYPE(*current) != nilObject) { stringLength += strlen(STR(CAR(*current))); current = &CDR(*current); } STR(result) = malloc((stringLength + 1) * sizeof(char)); STR(result)[0] = '\0'; current = ¶meters; while (TYPE(*current) != nilObject) { strcat(STR(result), STR(CAR(*current))); current = &CDR(*current); } return result; }