diff --git a/Makefile b/Makefile index 344170d..bdde11a 100644 --- a/Makefile +++ b/Makefile @@ -9,8 +9,8 @@ LIBPREFIX = $(PREFIX)/lib # флегови за C компајлер и линкер CPPFLAGS = -D_POSIX_C_SOURCE=200200L -DDESTDIR=\"$(DESTDIR)\" -# CFLAGS = -g -std=c99 -pedantic -Wall -O0 -CFLAGS = -std=c99 -pedantic -Wall -O3 +CFLAGS = -g -std=c99 -pedantic -Wall -O0 +# CFLAGS = -std=c99 -pedantic -Wall -O3 LDFLAGS = -lm -lc CC = cc diff --git a/cirilisp.c b/cirilisp.c index 66b8460..419b4cf 100644 --- a/cirilisp.c +++ b/cirilisp.c @@ -40,7 +40,8 @@ void init() addSymbolInternal("*", &multiplyInt, 0); addSymbolInternal("/", ÷Int, 0); addSymbolInternal("навод", "eInt, 1); - addSymbolInternal("дефиниши", &defineInt, 1); + addSymbolInternal("опиши", &defineInt, 1); + addSymbolInternal("опиши-складњу", &defineMacroInt, 1); addSymbolInternal("тачно->нетачно", &exactToInexactInt, 0); addSymbolInternal("нетачно->тачно", &inexactToExactInt, 0); addSymbolInternal("ламбда", &lambdaInt, 1); @@ -62,6 +63,9 @@ void init() addSymbolInternal("сдр", &cdrInt, 0); addSymbolInternal("јед?", &eqvQInt, 0); addSymbolInternal("примени", &applyInt, 0); + addSymbolInternal("прикажи", &displayInt, 0); + addSymbolInternal("штампај", &printInt, 0); + addSymbolInternal("почни", &beginInt, 0); if (!load(DESTDIR"/usr/local/lib/cirilisp/инит.ћ")) { diff --git a/eval.c b/eval.c index 09098ca..07932f4 100644 --- a/eval.c +++ b/eval.c @@ -7,7 +7,7 @@ #include "eval.h" int currentRecursionDepth = 0; -#define MAXRECURSIONDEPTH 1000 +int maxRecursionDepth = 10000; object apply(object function, object parameters, env currentEnv); @@ -37,8 +37,7 @@ object eval(object input, env currentEnv) SIGERR(ERR(result)); } - if (TYPE(CAR(input)) == procedureObject && - PROC_TYPE(CAR(input)) == builtinProc && + if (TYPE(CAR(input)) == procedureObject && PROC_SPECIAL(CAR(input))) { regularEvalOrder = 0; @@ -73,6 +72,13 @@ object eval(object input, env currentEnv) result = apply(CAR(input), CDR(input), currentEnv); } + + if (TYPE(CAR(input)) == procedureObject && + PROC_SPECIAL(CAR(input)) && + PROC_TYPE(CAR(input)) == compoundProc) + { + result = eval(result, currentEnv); + } } } else @@ -161,7 +167,7 @@ object apply(object procedure, object parameters, env currentEnv) return result; } - if (++currentRecursionDepth > MAXRECURSIONDEPTH) + if (++currentRecursionDepth > maxRecursionDepth) { --currentRecursionDepth; SIGERR(maxRecursionDepthError); diff --git a/internals.c b/internals.c index ada9fff..e7f20b5 100644 --- a/internals.c +++ b/internals.c @@ -1,7 +1,9 @@ #include +#include #include #include "util.h" +#include "print.h" #include "eval.h" int allNums(object list) @@ -261,6 +263,7 @@ object lambdaInt(object parameters, env currentEnv) 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; @@ -328,6 +331,39 @@ object defineInt(object parameters, env currentEnv) 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 хедеру, да ли је дата листа, листа * строго опадајућих, једнаких, или строго растућих бројева, у зависности од @@ -616,3 +652,55 @@ object applyInt(object parameters, env currentEnv) } 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; +} diff --git a/internals.h b/internals.h index a421eef..37dcb06 100644 --- a/internals.h +++ b/internals.h @@ -10,6 +10,7 @@ object inexactToExactInt(object parameters); object quoteInt(object parameters); object lambdaInt(object parameters, env currentEnv); object defineInt(object parameters, env currentEnv); +object defineMacroInt(object parameters, env currentEnv); object lessInt(object parameters); object greaterInt(object parameters); object eqNumInt(object parameters); @@ -28,3 +29,6 @@ object carInt(object parameters); object cdrInt(object parameters); object eqvQInt(object parameters); object applyInt(object parameters, env currentEnv); +object displayInt(object parameters); +object printInt(object parameters); +object beginInt(object parameters); diff --git a/print.h b/print.h index f6ce465..42bcb62 100644 --- a/print.h +++ b/print.h @@ -1,3 +1,4 @@ #pragma once int print(object input); +void printValue(object input); diff --git a/read.c b/read.c index a372023..d71eeaa 100644 --- a/read.c +++ b/read.c @@ -272,7 +272,8 @@ object dispatchedChar(wint_t c, FILE *stream) else { unscanwc(c, stream); - while ((c = scanwc(stream)) != WEOF && !iswspace(c)) + while ((c = scanwc(stream)) != WEOF && + isConstituent(c)) { if (i + 1 >= bufferSize) { @@ -280,6 +281,7 @@ object dispatchedChar(wint_t c, FILE *stream) } buffer[i++] = c; } + unscanwc(c, stream); buffer[i] = L'\0'; n = wcslen(buffer); if (n == 1) diff --git a/util.c b/util.c index 012450e..ee4a945 100644 --- a/util.c +++ b/util.c @@ -104,7 +104,7 @@ void addSymbolVariable(char *symbol, object variable, env currentEnv) (*e)->left = (*e)->right = NULL; } -object referVariable(char *symbol,env currentEnv) +object referVariable(char *symbol, env currentEnv) { entry **e = findEntry(¤tEnv->table, symbol); if (*e == NULL) @@ -211,10 +211,10 @@ object copyObject(object input) case procedureObject: PROC(result) = malloc(sizeof(procedure)); PROC_TYPE(result) = PROC_TYPE(input); + PROC_SPECIAL(result) = PROC_SPECIAL(input); if (PROC_TYPE(result) == builtinProc) { PROC_BUILTIN(result) = PROC_BUILTIN(input); - PROC_SPECIAL(result) = PROC_SPECIAL(input); } else { diff --git a/util.h b/util.h index 79e7e70..7e4d884 100644 --- a/util.h +++ b/util.h @@ -23,8 +23,8 @@ #define PROC(x) ((x).value.proc) #define PROC_TYPE(x) ((x).value.proc->type) +#define PROC_SPECIAL(x) ((x).value.proc->isSpecialForm) #define PROC_BUILTIN(x) ((x).value.proc->value.builtin.pointer) -#define PROC_SPECIAL(x) ((x).value.proc->value.builtin.isSpecialForm) #define PROC_COMP_ARGS(x) ((x).value.proc->value.compound.args) #define PROC_COMP_BODY(x) ((x).value.proc->value.compound.body) #define PROC_COMP_ENV(x) ((x).value.proc->value.compound.environment) @@ -136,18 +136,21 @@ struct entry struct frame { entry *table; +/* Макрои у табели се налазе као конс структуре где је car форма маркоа + * представљена у листи (м а1 а2 . остало) а cdr је дефиниција макроа + * представљена као симболички израз */ env enclosing; }; struct procedure { procType type; + int isSpecialForm; union { struct { object (*pointer)(object); - int isSpecialForm; } builtin; struct { @@ -170,9 +173,6 @@ void addSymbolVariable(char *symbol, object variable, env currentEnv); * позива током корисничких дефиниција у програму, док се addSymbolInternal * користи у init.c да би се дефинисале "уграђене" процедуре */ -int symbolExists(char *symbol, env currentEnv); -/* враћа 1 уколико симбол постоји и 0 у супротном */ - object referVariable(char *symbol, env currentEnv); /* враћа вредност на коју се односи име симбола у табели */ /******************************* */ diff --git a/инит.ћ b/инит.ћ index 3a501ff..9c941f2 100644 --- a/инит.ћ +++ b/инит.ћ @@ -1,8 +1,32 @@ -(дефиниши (није предикат) +(опиши (саар џ) (сар (сар џ))) +(опиши (садр џ) (сар (сдр џ))) +(опиши (сдар џ) (сдр (сар џ))) +(опиши (сддр џ) (сдр (сдр џ))) + +(опиши (није предикат) (ако предикат #л #и)) -(дефиниши нил ()) +(опиши нил ()) -(дефиниши истинито #и) (дефиниши лажно #л) +(опиши истинито #и) (опиши лажно #л) -(дефиниши (листа . арг) арг) +(опиши (листа . арг) арг) + +(опиши-складњу (и . предикати) + (ако (нил? предикати) #и + (ако (нил? (сдр предикати)) + (сар предикати) + (листа 'ако (сар предикати) + (примени и (сдр предикати)) + #л)))) + +(опиши-складњу (или . предикати) + (ако (нил? предикати) #л + (ако (нил? (сдр предикати)) + (сар предикати) + (листа 'ако (није (сар предикати)) + (примени или (сдр предикати)) + (сар предикати))))) + +#|(опиши-складњу (услов . клаузе) + (|#