From 75b9ad436e3f13299f3b9819ca283814794f8a0f Mon Sep 17 00:00:00 2001 From: kappa Date: Sun, 10 Feb 2019 22:21:20 +0100 Subject: [PATCH] =?UTF-8?q?=D0=9E=D0=BC=D0=BE=D0=B3=D1=83=D1=9B=D0=B5?= =?UTF-8?q?=D0=BD=D0=BE=20=D0=B4=D0=B5=D1=84=D0=B8=D0=BD=D0=B8=D1=81=D0=B0?= =?UTF-8?q?=D1=9A=D0=B5=20=D1=84=D1=83=D0=BD=D0=BA=D1=86=D0=B8=D1=98=D0=B0?= =?UTF-8?q?=20=D1=81=D0=B0=20=D0=BF=D1=80=D0=BE=D0=B8=D0=B7=D0=B2=D0=BE?= =?UTF-8?q?=D1=99=D0=BD=D0=B8=D0=BC=20=D0=B1=D1=80=D0=BE=D1=98=D0=B5=D0=BC?= =?UTF-8?q?=20=D0=B0=D1=80=D0=B3=D1=83=D0=BC=D0=B5=D0=BD=D0=B0=D1=82=D0=B0?= =?UTF-8?q?,=20=D0=B7=D0=BD=D0=B0=D1=82=D0=BD=D0=BE=20=D0=BF=D1=80=D0=BE?= =?UTF-8?q?=D1=88=D0=B8=D1=80=D0=B5=D0=BD=D0=B0=20=D1=81=D1=82=D0=B0=D0=BD?= =?UTF-8?q?=D0=B4=D0=B0=D1=80=D0=B4=D0=BD=D0=B0=20=D0=B1=D0=B8=D0=B1=D0=BB?= =?UTF-8?q?=D0=B8=D0=BE=D1=82=D0=B5=D0=BA=D0=B0,=20=D0=B8=D1=82=D0=B4.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Makefile | 22 +++-- cirilisp.c | 21 ++++- eval.c | 75 +++++++++++++++--- internals.c | 225 +++++++++++++++++++++++++++++++++++++++++++--------- internals.h | 13 +++ print.c | 1 + util.c | 12 +++ util.h | 4 + инит.ћ | 3 +- 9 files changed, 319 insertions(+), 57 deletions(-) diff --git a/Makefile b/Makefile index 44fc035..c6a7d21 100644 --- a/Makefile +++ b/Makefile @@ -16,7 +16,8 @@ LDFLAGS = -lm -lc CC = cc C_SRC = cirilisp.c read.c eval.c print.c util.c internals.c -TCH_SRC = инит.ћ +L_SRC = инит.ћ +INC = util.h read.h eval.h print.h internals.h OBJ = $(C_SRC:.c=.o) all: cirilisp @@ -24,17 +25,26 @@ all: cirilisp .c.o: $(CC) -c $(CPPFLAGS) $(CFLAGS) $< -$(OBJ): util.h read.h eval.h print.h internals.h $(TCH_SRC) +$(OBJ): $(INC) $(L_SRC) -cirilisp: $(OBJ) $(TCH_SRC) +cirilisp: $(OBJ) $(L_SRC) $(CC) -o $@ $(OBJ) $(LDFLAGS) clean: -rm -f cirilisp $(OBJ) cirilisp-$(VERSION).tar.gz +# штампа садржај свих фајлова са изворним кодом, користи се за бројање линија, +# значајних линија, итд. +concat: + @cat $(C_SRC) $(INC) $(L_SRC) Makefile + +# филтрира дати улаз и штампа само "значајне" линије кода +sloc: + @grep -v "^[[:space:]]*[{}]\{0,1\}[;\\]\{0,1\}$$" + dist: clean mkdir -p cirilisp-$(VERSION) - cp -r Makefile util.h read.h eval.h print.h $(C_SRC) cirilisp-$(VERSION) + cp -r Makefile $(INC) $(C_SRC) $(L_SRC) cirilisp-$(VERSION) tar -cf cirilisp-$(VERSION).tar cirilisp-$(VERSION) gzip cirilisp-$(VERSION).tar rm -rf cirilisp-$(VERSION) @@ -44,7 +54,7 @@ install: all mkdir -p $(DESTDIR)$(LIBPREFIX)/cirilisp cp -f cirilisp $(DESTDIR)$(PREFIX)/bin chmod 755 $(DESTDIR)$(PREFIX)/bin/cirilisp - cp -f $(TCH_SRC) $(DESTDIR)$(LIBPREFIX)/cirilisp + cp -f $(L_SRC) $(DESTDIR)$(LIBPREFIX)/cirilisp # mkdir -p $(DESTDIR)$(MANPREFIX)/man1 # sed "s/VERSION/$(VERSION)/g" < cirilisp.1 > $(DESTDIR)$(MANPREFIX)/man1/dwm.1 # chmod 644 $(DESTDIR)$(MANPREFIX)/man1/cirilisp.1 @@ -54,4 +64,4 @@ uninstall: rm -rf $(DESTDIR)$(LIBPREFIX)/cirilisp # rm -f $(DESTDIR)$(MANPREFIX)/man1/cirilisp.1 -.PHONY: all clean dist install uninstall +.PHONY: all clean dist install uninstall concat sloc diff --git a/cirilisp.c b/cirilisp.c index 190b623..01361ae 100644 --- a/cirilisp.c +++ b/cirilisp.c @@ -15,8 +15,9 @@ int load(char *pathname) { return 0; } - while (TYPE(eval(read("", stream), globalEnv)) != EOFObject) - ; + object exp; + while (TYPE(exp = eval(read("", stream), globalEnv)) != EOFObject) + deleteObject(exp); eofStatus = 0; fclose(stream); return 1; @@ -45,7 +46,20 @@ void init() addSymbolInternal("ламбда", &lambdaInt, 1); addSymbolInternal("<", &lessInt, 0); addSymbolInternal(">", &greaterInt, 0); + addSymbolInternal("=", &eqNumInt, 0); addSymbolInternal("ако", &ifInt, 1); + addSymbolInternal("нил?", &nilQInt, 0); + addSymbolInternal("конс?", &consQInt, 0); + addSymbolInternal("број?", &numberQInt, 0); + addSymbolInternal("симбол?", &symbolQInt, 0); + addSymbolInternal("процедура?", &procedureQInt, 0); + addSymbolInternal("булски?", &boolQInt, 0); + addSymbolInternal("ниска?", &stringQInt, 0); + addSymbolInternal("карактер?", &charQInt, 0); + addSymbolInternal("листа?", &listQInt, 0); + addSymbolInternal("листа", &listInt, 0); + addSymbolInternal("конс", &consInt, 0); + addSymbolInternal("јед?", &eqvQInt, 0); if (!load("/usr/local/lib/cirilisp/инит.ћ")) { @@ -58,7 +72,8 @@ void init() int main(int argc, char **argv) { init(); - while (print(eval(read("ШКЉ> ", stdin), globalEnv))); + while (print(eval(read("ШКЉ> ", stdin), globalEnv))) + ; printf("\nДостигнут крај улазног тока.\nЗбогом и дођите нам опет!\n"); return 0; diff --git a/eval.c b/eval.c index a741a3c..1c0aef5 100644 --- a/eval.c +++ b/eval.c @@ -23,12 +23,20 @@ object eval(object input, env currentEnv) { if (!properList(input)) { + deleteObject(input); SIGERR(improperListError); } else { int regularEvalOrder = 1; CAR(input) = eval(CAR(input), currentEnv); + if (TYPE(CAR(input)) == errorObject) + { + result = copyObject(CAR(input)); + deleteObject(input); + SIGERR(ERR(result)); + } + if (TYPE(CAR(input)) == procedureObject && PROC_TYPE(CAR(input)) == builtinProc && PROC_SPECIAL(CAR(input))) @@ -76,6 +84,56 @@ object eval(object input, env currentEnv) return result; } +int bindArgs(object parameters, object args, env newEnv) +/* на почетку извршавања функције, везује прослеђене параметре, за симболе у + * дефиницији функције, везивање се врши у новонасталом окружењу, уколико је + * параметри нису правилни за дате аргументе, враћа 0, уколико нема грешке + * враћа 1 */ +{ + if (properList(args)) + /* уколико је листа аргумената правилна, број аргумената је одређен */ + { + if (listLength(parameters) != listLength(args)) + { + return 0; + } + else + { + object *currentArg = &args; + object *currentParam = ¶meters; + while (TYPE(*currentArg) != nilObject) + { + addSymbolVariable(SYM(CAR(*currentArg)), + CAR(*currentParam), newEnv); + currentArg = &CDR(*currentArg); + currentParam = &CDR(*currentParam); + } + return 1; + } + } + else + /* у супротном, број аргумената је само ограничен одоздо */ + { + if (improperListLength(args) - 1 > listLength(parameters)) + { + return 0; + } + else + { + object *currentArg = &args; + object *currentParam = ¶meters; + while (TYPE(*currentArg) == consObject) + { + addSymbolVariable(SYM(CAR(*currentArg)), + CAR(*currentParam), newEnv); + currentArg = &CDR(*currentArg); + currentParam = &CDR(*currentParam); + } + return 1; + } + } +} + object apply(object procedure, object parameters, env currentEnv) { object result; @@ -108,21 +166,16 @@ object apply(object procedure, object parameters, env currentEnv) object args = copyObject(PROC_COMP_ARGS(procedure)); object body = copyObject(PROC_COMP_BODY(procedure)); env definitionEnv = PROC_COMP_ENV(procedure); - if (listLength(parameters) != listLength(args)) + + env procEnv = createEnvironment(definitionEnv); + if (!bindArgs(parameters, args, procEnv)) { + deleteObject(args); + deleteObject(body); + removeEnvironment(procEnv); SIGERR(argumentNumberError); } - env procEnv = createEnvironment(definitionEnv); - object *currentArg = &args; - object *currentParam = ¶meters; - while (TYPE(*currentArg) != nilObject) - { - addSymbolVariable(SYM(CAR(*currentArg)), CAR(*currentParam), - procEnv); - currentArg = &CDR(*currentArg); - currentParam = &CDR(*currentParam); - } object *currentSubProc = &body; while (TYPE(*currentSubProc) != nilObject) { diff --git a/internals.c b/internals.c index cdbf1c3..e0008a6 100644 --- a/internals.c +++ b/internals.c @@ -1,9 +1,12 @@ #include +#include #include "util.h" #include "eval.h" int allNums(object list) +/* проверава да ли је објекат листа чији је сваки члан број, претпоставља да је + * објекат валидна листа */ { object *currentCell = &list; while (TYPE(*currentCell) != nilObject) @@ -18,9 +21,11 @@ int allNums(object list) } int allSyms(object list) +/* проверава да ли је дати објекат симбол, или листа (правилна или крња), чији + * је сваки члан симбол */ { object *currentCell = &list; - while (TYPE(*currentCell) != nilObject) + while (TYPE(*currentCell) == consObject) { if (TYPE(CAR(*currentCell)) != symbolObject) { @@ -28,11 +33,16 @@ int allSyms(object list) } currentCell = &CDR(*currentCell); } - return 1; + switch (TYPE(*currentCell)) + { + case symbolObject: + case nilObject: + return 1; + default: + return 0; + } } - - object addInt(object parameters) { object result; @@ -200,7 +210,7 @@ object quoteInt(object parameters) int validArgumentList(object list) { - if (!properList(list) || !allSyms(list)) + if (!allSyms(list)) { return 0; } @@ -208,10 +218,10 @@ int validArgumentList(object list) { int allUniqueSyms = 1; object *currentSymbol1 = &list; - while (TYPE(*currentSymbol1) != nilObject) + while (TYPE(*currentSymbol1) == consObject) { object *currentSymbol2 = &CDR(*currentSymbol1); - while (TYPE(*currentSymbol2) != nilObject) + while (TYPE(*currentSymbol2) == consObject) { if (!strcmp(SYM(CAR(*currentSymbol1)), SYM(CAR(*currentSymbol2)))) @@ -221,6 +231,13 @@ int validArgumentList(object list) } currentSymbol2 = &CDR(*currentSymbol2); } + if (TYPE(*currentSymbol2) == symbolObject && + !strcmp(SYM(*currentSymbol2), + SYM(CAR(*currentSymbol1)))) + { + allUniqueSyms = 0; + goto breakloop; + } currentSymbol1 = &CDR(*currentSymbol1); } breakloop: @@ -311,7 +328,10 @@ object defineInt(object parameters, env currentEnv) return result; } -object lessInt(object parameters) +object cmpMultiple(object parameters, int flag) +/* проверава помоћу cmp функције у util.h хедеру, да ли је дата листа, листа + * строго опадајућих, једнаких, или строго растућих бројева, у зависности од + * тога да ли је "flag" 1, 0 или -1 респективно */ { if (!allNums(parameters)) { @@ -327,7 +347,7 @@ object lessInt(object parameters) object *current = ¶meters; while (TYPE(CDR(*current)) != nilObject) { - if (cmp(CAR(*current), CAR(CDR(*current))) >= 0) + if (cmp(CAR(*current), CAR(CDR(*current))) != flag) { resultInt = 0; break; @@ -341,34 +361,19 @@ object lessInt(object parameters) return result; } +object lessInt(object parameters) +{ + return cmpMultiple(parameters, -1); +} + +object eqNumInt(object parameters) +{ + return cmpMultiple(parameters, 0); +} + object greaterInt(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; + return cmpMultiple(parameters, 1); } object ifInt(object parameters, env currentEnv) @@ -385,7 +390,7 @@ object ifInt(object parameters, env currentEnv) if (TYPE(predicate) == boolObject && BOOL(predicate) == 0) { - TYPE(result) = unspecifiedObject; + TYPE(result) = nilObject; } else { @@ -427,3 +432,151 @@ object ifInt(object parameters, env currentEnv) 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 listInt(object parameters) +{ + object result; + result = copyObject(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 eqvQInt(object parameters) +{ + if (listLength(parameters) != 2) + { + SIGERR(argumentNumberError); + } + object result; + TYPE(result) = boolObject; + BOOL(result) = 0; + 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) = CHAR(CAR(parameters)) == + CHAR(CAR(CDR(parameters))); + break; + case consObject: + case procedureObject: + default: + BOOL(result) = 0; + break; + } + } + return result; +} diff --git a/internals.h b/internals.h index 54bc6dd..1b6cc36 100644 --- a/internals.h +++ b/internals.h @@ -12,4 +12,17 @@ object lambdaInt(object parameters); object defineInt(object parameters); object lessInt(object parameters); object greaterInt(object parameters); +object eqNumInt(object parameters); object ifInt(object parameters); +object nilQInt(object parameters); +object consQInt(object parameters); +object numberQInt(object parameters); +object symbolQInt(object parameters); +object procedureQInt(object parameters); +object boolQInt(object parameters); +object stringQInt(object parameters); +object charQInt(object parameters); +object listQInt(object parameters); +object listInt(object parameters); +object consInt(object parameters); +object eqvQInt(object parameters); diff --git a/print.c b/print.c index 803e8cc..c31871e 100644 --- a/print.c +++ b/print.c @@ -36,6 +36,7 @@ int print(object input) printValue(input); printf("\n\n"); } + deleteObject(input); return 1; } diff --git a/util.c b/util.c index e5c9536..012450e 100644 --- a/util.c +++ b/util.c @@ -146,6 +146,18 @@ int listLength(object list) return i; } +int improperListLength(object list) +{ + object *current = &list; + int i = 1; + while (TYPE(*current) == consObject) + { + current = &CDR(*current); + ++i; + } + return i; +} + void deleteObject(object input) { if (TYPE(input) == symbolObject && SYM(input) != NULL) diff --git a/util.h b/util.h index 38f478d..79e7e70 100644 --- a/util.h +++ b/util.h @@ -179,6 +179,10 @@ object referVariable(char *symbol, env currentEnv); int properList(object list); int listLength(object list); +int improperListLength(object list); +/* уколико објекат није конс, враћа 1, уколико јесте, враћа дужину крње листе + * укључујући задњи члан, уколико је дата правилна листа, нил се и даље рачуна + * као члан */ void deleteObject(object input); object copyObject(object input); diff --git a/инит.ћ b/инит.ћ index 2a42a53..258f917 100644 --- a/инит.ћ +++ b/инит.ћ @@ -1 +1,2 @@ -(дефиниши (= а б) (ако (> а б) #л (ако (< а б) #л #и))) +(дефиниши (не предикат) + (ако предикат #л #и))