#include #include "util.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) != nilObject) { if (TYPE(CAR(*currentCell)) != symbolObject) { return 0; } currentCell = &CDR(*currentCell); } return 1; } object add(object parameters) { object result; TYPE(result) = numberObject; if (!allNums(parameters)) { TYPE(result) = errorObject; ERR(result) = typeError; } else if (listLength(parameters) == 0) { result = longlongToNumber(0LL); } else { object first, rest; first = CAR(parameters); rest = add(CDR(parameters)); result = plusNum(first, rest); } return result; } object subtract(object parameters) { object result; TYPE(result) = numberObject; if (!allNums(parameters)) { TYPE(result) = errorObject; ERR(result) = typeError; } else if (listLength(parameters) == 0) { TYPE(result) = errorObject; ERR(result) = argumentNumberError; } else if (listLength(parameters) == 1) { result = minusNum(CAR(parameters)); } else { result = plusNum(CAR(parameters), minusNum(add(CDR(parameters)))); } return result; } object multiply(object parameters) { object result; TYPE(result) = numberObject; if (!allNums(parameters)) { TYPE(result) = errorObject; ERR(result) = typeError; } else if (listLength(parameters) == 0) { result = longlongToNumber(1LL); } else { object first, rest; first = CAR(parameters); rest = multiply(CDR(parameters)); result = timesNum(first,rest); } return result; } object divide(object parameters) { object result; TYPE(result) = numberObject; if (!allNums(parameters)) { TYPE(result) = errorObject; ERR(result) = typeError; } else if (listLength(parameters) == 0) { TYPE(result) = errorObject; ERR(result) = argumentNumberError; } else if (listLength(parameters) == 1) { result = inverseNum(CAR(parameters)); } else { object check = inverseNum(multiply(CDR(parameters))); if (TYPE(check) != errorObject) { result = timesNum(CAR(parameters), inverseNum(multiply(CDR(parameters)))); } else { result = check; } result = shortenFractionNum(result); } return result; } object exactToInexact(object parameters) { object result; if (listLength(parameters) != 1) { TYPE(result) = errorObject; ERR(result) = argumentNumberError; } else if (TYPE(CAR(parameters)) != numberObject) { TYPE(result) = errorObject; ERR(result) = typeError; } else { result = exactToInexactNum(CAR(parameters)); } return result; } object inexactToExact(object parameters) { object result; if (listLength(parameters) != 1) { TYPE(result) = errorObject; ERR(result) = argumentNumberError; } else if (TYPE(CAR(parameters)) != numberObject) { TYPE(result) = errorObject; ERR(result) = typeError; } else { result = inexactToExactNum(CAR(parameters)); } return result; } object quote(object parameters) { object result; if (listLength(parameters) != 1) { TYPE(result) = errorObject; ERR(result) = argumentNumberError; } else { result = copyObject(CAR(parameters)); } return result; } int validArgumentList(object list) { if (!properList(list) || !allSyms(list)) { return 0; } else { int allUniqueSyms = 1; object *currentSymbol1 = &list; while (TYPE(*currentSymbol1) != nilObject) { object *currentSymbol2 = &CDR(*currentSymbol1); while (TYPE(*currentSymbol2) != nilObject) { if (!strcmp(SYM(CAR(*currentSymbol1)), SYM(CAR(*currentSymbol2)))) { allUniqueSyms = 0; goto breakloop; } currentSymbol2 = &CDR(*currentSymbol2); } currentSymbol1 = &CDR(*currentSymbol1); } breakloop: return allUniqueSyms; } } object lambda(object parameters, env currentEnv) { object result; if (listLength(parameters) < 2) { TYPE(result) = errorObject; ERR(result) = argumentNumberError; } else if (!validArgumentList(CAR(parameters))) { TYPE(result) = errorObject; ERR(result) = typeError; } else { TYPE(result) = procedureObject; PROC(result) = createProcedure(); PROC_TYPE(result) = compoundProc; PROC_COMP_ARGS(result) = copyObject(CAR(parameters)); PROC_COMP_BODY(result) = copyObject(CDR(parameters)); PROC_COMP_ENV(result) = currentEnv; } return result; } object define(object parameters, env currentEnv) { object result; if (listLength(parameters) == 0) { TYPE(result) = errorObject; ERR(result) = argumentNumberError; } else if (TYPE(CAR(parameters)) == symbolObject) { if (listLength(parameters) == 2) { result = copyObject(CAR(parameters)); addSymbolVariable(SYM(result), eval(copyObject(CAR(CDR(parameters))), currentEnv), currentEnv); } else { TYPE(result) = errorObject; ERR(result) = 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 = lambda(parameters, currentEnv); addSymbolVariable(SYM(result), proc, currentEnv); } else { TYPE(result) = errorObject; ERR(result) = typeError; } } else { TYPE(result) = errorObject; ERR(result) = argumentNumberError; } } else { TYPE(result) = errorObject; ERR(result) = typeError; } return result; } object less(object parameters) { 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))) >= 0) { resultInt = 0; break; } current = &CDR(*current); } object result; TYPE(result) = boolObject; BOOL(result) = resultInt; return result; } object greater(object parameters) { 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))) <= 0) { resultInt = 0; break; } current = &CDR(*current); } object result; TYPE(result) = boolObject; BOOL(result) = resultInt; return result; } object ifStatement(object parameters, env currentEnv) { object predicate, result; switch (listLength(parameters)) { case 2: predicate = eval(CAR(parameters), currentEnv); if (TYPE(predicate) == boolObject && BOOL(predicate) == 0) { TYPE(result) = unspecifiedObject; } else { result = eval(copyObject(CAR(CDR(parameters))), currentEnv); } break; case 3: predicate = eval(CAR(parameters), currentEnv); if (TYPE(predicate) == boolObject && BOOL(predicate) == 0) { result = eval(copyObject(CAR(CDR(CDR(parameters)))), currentEnv); } else { result = eval(copyObject(CAR(CDR(parameters))), currentEnv); } break; default: SIGERR(argumentNumberError); } return result; }