#include #include #include #include "util.h" #include "print.h" #include "eval.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 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 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) { SIGERR(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) { SIGERR(ERR(predicate)); } if (TYPE(predicate) == boolObject && BOOL(predicate) == 0) { TYPE(result) = nilObject; } else { result = eval(copyObject(CAR(CDR(parameters))), currentEnv); } if (TYPE(result) == errorObject) { SIGERR(ERR(result)); } break; case 3: predicate = eval(copyObject(CAR(parameters)), currentEnv); if (TYPE(predicate) == errorObject) { SIGERR(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) { SIGERR(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 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; } 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 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; }