Омогућено дефинисање функција са произвољним бројем аргумената, знатно проширена стандардна библиотека, итд.
This commit is contained in:
parent
d86e1ba7c0
commit
75b9ad436e
22
Makefile
22
Makefile
|
@ -16,7 +16,8 @@ LDFLAGS = -lm -lc
|
||||||
CC = cc
|
CC = cc
|
||||||
|
|
||||||
C_SRC = cirilisp.c read.c eval.c print.c util.c internals.c
|
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)
|
OBJ = $(C_SRC:.c=.o)
|
||||||
|
|
||||||
all: cirilisp
|
all: cirilisp
|
||||||
|
@ -24,17 +25,26 @@ all: cirilisp
|
||||||
.c.o:
|
.c.o:
|
||||||
$(CC) -c $(CPPFLAGS) $(CFLAGS) $<
|
$(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)
|
$(CC) -o $@ $(OBJ) $(LDFLAGS)
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
-rm -f cirilisp $(OBJ) cirilisp-$(VERSION).tar.gz
|
-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
|
dist: clean
|
||||||
mkdir -p cirilisp-$(VERSION)
|
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)
|
tar -cf cirilisp-$(VERSION).tar cirilisp-$(VERSION)
|
||||||
gzip cirilisp-$(VERSION).tar
|
gzip cirilisp-$(VERSION).tar
|
||||||
rm -rf cirilisp-$(VERSION)
|
rm -rf cirilisp-$(VERSION)
|
||||||
|
@ -44,7 +54,7 @@ install: all
|
||||||
mkdir -p $(DESTDIR)$(LIBPREFIX)/cirilisp
|
mkdir -p $(DESTDIR)$(LIBPREFIX)/cirilisp
|
||||||
cp -f cirilisp $(DESTDIR)$(PREFIX)/bin
|
cp -f cirilisp $(DESTDIR)$(PREFIX)/bin
|
||||||
chmod 755 $(DESTDIR)$(PREFIX)/bin/cirilisp
|
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
|
# mkdir -p $(DESTDIR)$(MANPREFIX)/man1
|
||||||
# sed "s/VERSION/$(VERSION)/g" < cirilisp.1 > $(DESTDIR)$(MANPREFIX)/man1/dwm.1
|
# sed "s/VERSION/$(VERSION)/g" < cirilisp.1 > $(DESTDIR)$(MANPREFIX)/man1/dwm.1
|
||||||
# chmod 644 $(DESTDIR)$(MANPREFIX)/man1/cirilisp.1
|
# chmod 644 $(DESTDIR)$(MANPREFIX)/man1/cirilisp.1
|
||||||
|
@ -54,4 +64,4 @@ uninstall:
|
||||||
rm -rf $(DESTDIR)$(LIBPREFIX)/cirilisp
|
rm -rf $(DESTDIR)$(LIBPREFIX)/cirilisp
|
||||||
# rm -f $(DESTDIR)$(MANPREFIX)/man1/cirilisp.1
|
# rm -f $(DESTDIR)$(MANPREFIX)/man1/cirilisp.1
|
||||||
|
|
||||||
.PHONY: all clean dist install uninstall
|
.PHONY: all clean dist install uninstall concat sloc
|
||||||
|
|
21
cirilisp.c
21
cirilisp.c
|
@ -15,8 +15,9 @@ int load(char *pathname)
|
||||||
{
|
{
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
while (TYPE(eval(read("", stream), globalEnv)) != EOFObject)
|
object exp;
|
||||||
;
|
while (TYPE(exp = eval(read("", stream), globalEnv)) != EOFObject)
|
||||||
|
deleteObject(exp);
|
||||||
eofStatus = 0;
|
eofStatus = 0;
|
||||||
fclose(stream);
|
fclose(stream);
|
||||||
return 1;
|
return 1;
|
||||||
|
@ -45,7 +46,20 @@ void init()
|
||||||
addSymbolInternal("ламбда", &lambdaInt, 1);
|
addSymbolInternal("ламбда", &lambdaInt, 1);
|
||||||
addSymbolInternal("<", &lessInt, 0);
|
addSymbolInternal("<", &lessInt, 0);
|
||||||
addSymbolInternal(">", &greaterInt, 0);
|
addSymbolInternal(">", &greaterInt, 0);
|
||||||
|
addSymbolInternal("=", &eqNumInt, 0);
|
||||||
addSymbolInternal("ако", &ifInt, 1);
|
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/инит.ћ"))
|
if (!load("/usr/local/lib/cirilisp/инит.ћ"))
|
||||||
{
|
{
|
||||||
|
@ -58,7 +72,8 @@ void init()
|
||||||
int main(int argc, char **argv)
|
int main(int argc, char **argv)
|
||||||
{
|
{
|
||||||
init();
|
init();
|
||||||
while (print(eval(read("ШКЉ> ", stdin), globalEnv)));
|
while (print(eval(read("ШКЉ> ", stdin), globalEnv)))
|
||||||
|
;
|
||||||
printf("\nДостигнут крај улазног тока.\nЗбогом и дођите нам опет!\n");
|
printf("\nДостигнут крај улазног тока.\nЗбогом и дођите нам опет!\n");
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
|
|
75
eval.c
75
eval.c
|
@ -23,12 +23,20 @@ object eval(object input, env currentEnv)
|
||||||
{
|
{
|
||||||
if (!properList(input))
|
if (!properList(input))
|
||||||
{
|
{
|
||||||
|
deleteObject(input);
|
||||||
SIGERR(improperListError);
|
SIGERR(improperListError);
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
int regularEvalOrder = 1;
|
int regularEvalOrder = 1;
|
||||||
CAR(input) = eval(CAR(input), currentEnv);
|
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 &&
|
if (TYPE(CAR(input)) == procedureObject &&
|
||||||
PROC_TYPE(CAR(input)) == builtinProc &&
|
PROC_TYPE(CAR(input)) == builtinProc &&
|
||||||
PROC_SPECIAL(CAR(input)))
|
PROC_SPECIAL(CAR(input)))
|
||||||
|
@ -76,6 +84,56 @@ object eval(object input, env currentEnv)
|
||||||
return result;
|
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 apply(object procedure, object parameters, env currentEnv)
|
||||||
{
|
{
|
||||||
object result;
|
object result;
|
||||||
|
@ -108,21 +166,16 @@ object apply(object procedure, object parameters, env currentEnv)
|
||||||
object args = copyObject(PROC_COMP_ARGS(procedure));
|
object args = copyObject(PROC_COMP_ARGS(procedure));
|
||||||
object body = copyObject(PROC_COMP_BODY(procedure));
|
object body = copyObject(PROC_COMP_BODY(procedure));
|
||||||
env definitionEnv = PROC_COMP_ENV(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);
|
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;
|
object *currentSubProc = &body;
|
||||||
while (TYPE(*currentSubProc) != nilObject)
|
while (TYPE(*currentSubProc) != nilObject)
|
||||||
{
|
{
|
||||||
|
|
225
internals.c
225
internals.c
|
@ -1,9 +1,12 @@
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
#include <stdlib.h>
|
||||||
|
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "eval.h"
|
#include "eval.h"
|
||||||
|
|
||||||
int allNums(object list)
|
int allNums(object list)
|
||||||
|
/* проверава да ли је објекат листа чији је сваки члан број, претпоставља да је
|
||||||
|
* објекат валидна листа */
|
||||||
{
|
{
|
||||||
object *currentCell = &list;
|
object *currentCell = &list;
|
||||||
while (TYPE(*currentCell) != nilObject)
|
while (TYPE(*currentCell) != nilObject)
|
||||||
|
@ -18,9 +21,11 @@ int allNums(object list)
|
||||||
}
|
}
|
||||||
|
|
||||||
int allSyms(object list)
|
int allSyms(object list)
|
||||||
|
/* проверава да ли је дати објекат симбол, или листа (правилна или крња), чији
|
||||||
|
* је сваки члан симбол */
|
||||||
{
|
{
|
||||||
object *currentCell = &list;
|
object *currentCell = &list;
|
||||||
while (TYPE(*currentCell) != nilObject)
|
while (TYPE(*currentCell) == consObject)
|
||||||
{
|
{
|
||||||
if (TYPE(CAR(*currentCell)) != symbolObject)
|
if (TYPE(CAR(*currentCell)) != symbolObject)
|
||||||
{
|
{
|
||||||
|
@ -28,11 +33,16 @@ int allSyms(object list)
|
||||||
}
|
}
|
||||||
currentCell = &CDR(*currentCell);
|
currentCell = &CDR(*currentCell);
|
||||||
}
|
}
|
||||||
return 1;
|
switch (TYPE(*currentCell))
|
||||||
|
{
|
||||||
|
case symbolObject:
|
||||||
|
case nilObject:
|
||||||
|
return 1;
|
||||||
|
default:
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
object addInt(object parameters)
|
object addInt(object parameters)
|
||||||
{
|
{
|
||||||
object result;
|
object result;
|
||||||
|
@ -200,7 +210,7 @@ object quoteInt(object parameters)
|
||||||
|
|
||||||
int validArgumentList(object list)
|
int validArgumentList(object list)
|
||||||
{
|
{
|
||||||
if (!properList(list) || !allSyms(list))
|
if (!allSyms(list))
|
||||||
{
|
{
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
@ -208,10 +218,10 @@ int validArgumentList(object list)
|
||||||
{
|
{
|
||||||
int allUniqueSyms = 1;
|
int allUniqueSyms = 1;
|
||||||
object *currentSymbol1 = &list;
|
object *currentSymbol1 = &list;
|
||||||
while (TYPE(*currentSymbol1) != nilObject)
|
while (TYPE(*currentSymbol1) == consObject)
|
||||||
{
|
{
|
||||||
object *currentSymbol2 = &CDR(*currentSymbol1);
|
object *currentSymbol2 = &CDR(*currentSymbol1);
|
||||||
while (TYPE(*currentSymbol2) != nilObject)
|
while (TYPE(*currentSymbol2) == consObject)
|
||||||
{
|
{
|
||||||
if (!strcmp(SYM(CAR(*currentSymbol1)),
|
if (!strcmp(SYM(CAR(*currentSymbol1)),
|
||||||
SYM(CAR(*currentSymbol2))))
|
SYM(CAR(*currentSymbol2))))
|
||||||
|
@ -221,6 +231,13 @@ int validArgumentList(object list)
|
||||||
}
|
}
|
||||||
currentSymbol2 = &CDR(*currentSymbol2);
|
currentSymbol2 = &CDR(*currentSymbol2);
|
||||||
}
|
}
|
||||||
|
if (TYPE(*currentSymbol2) == symbolObject &&
|
||||||
|
!strcmp(SYM(*currentSymbol2),
|
||||||
|
SYM(CAR(*currentSymbol1))))
|
||||||
|
{
|
||||||
|
allUniqueSyms = 0;
|
||||||
|
goto breakloop;
|
||||||
|
}
|
||||||
currentSymbol1 = &CDR(*currentSymbol1);
|
currentSymbol1 = &CDR(*currentSymbol1);
|
||||||
}
|
}
|
||||||
breakloop:
|
breakloop:
|
||||||
|
@ -311,7 +328,10 @@ object defineInt(object parameters, env currentEnv)
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
object lessInt(object parameters)
|
object cmpMultiple(object parameters, int flag)
|
||||||
|
/* проверава помоћу cmp функције у util.h хедеру, да ли је дата листа, листа
|
||||||
|
* строго опадајућих, једнаких, или строго растућих бројева, у зависности од
|
||||||
|
* тога да ли је "flag" 1, 0 или -1 респективно */
|
||||||
{
|
{
|
||||||
if (!allNums(parameters))
|
if (!allNums(parameters))
|
||||||
{
|
{
|
||||||
|
@ -327,7 +347,7 @@ object lessInt(object parameters)
|
||||||
object *current = ¶meters;
|
object *current = ¶meters;
|
||||||
while (TYPE(CDR(*current)) != nilObject)
|
while (TYPE(CDR(*current)) != nilObject)
|
||||||
{
|
{
|
||||||
if (cmp(CAR(*current), CAR(CDR(*current))) >= 0)
|
if (cmp(CAR(*current), CAR(CDR(*current))) != flag)
|
||||||
{
|
{
|
||||||
resultInt = 0;
|
resultInt = 0;
|
||||||
break;
|
break;
|
||||||
|
@ -341,34 +361,19 @@ object lessInt(object parameters)
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
object lessInt(object parameters)
|
||||||
|
{
|
||||||
|
return cmpMultiple(parameters, -1);
|
||||||
|
}
|
||||||
|
|
||||||
|
object eqNumInt(object parameters)
|
||||||
|
{
|
||||||
|
return cmpMultiple(parameters, 0);
|
||||||
|
}
|
||||||
|
|
||||||
object greaterInt(object parameters)
|
object greaterInt(object parameters)
|
||||||
{
|
{
|
||||||
if (!allNums(parameters))
|
return cmpMultiple(parameters, 1);
|
||||||
{
|
|
||||||
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 ifInt(object parameters, env currentEnv)
|
object ifInt(object parameters, env currentEnv)
|
||||||
|
@ -385,7 +390,7 @@ object ifInt(object parameters, env currentEnv)
|
||||||
|
|
||||||
if (TYPE(predicate) == boolObject && BOOL(predicate) == 0)
|
if (TYPE(predicate) == boolObject && BOOL(predicate) == 0)
|
||||||
{
|
{
|
||||||
TYPE(result) = unspecifiedObject;
|
TYPE(result) = nilObject;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
|
@ -427,3 +432,151 @@ object ifInt(object parameters, env currentEnv)
|
||||||
|
|
||||||
return result;
|
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;
|
||||||
|
}
|
||||||
|
|
13
internals.h
13
internals.h
|
@ -12,4 +12,17 @@ object lambdaInt(object parameters);
|
||||||
object defineInt(object parameters);
|
object defineInt(object parameters);
|
||||||
object lessInt(object parameters);
|
object lessInt(object parameters);
|
||||||
object greaterInt(object parameters);
|
object greaterInt(object parameters);
|
||||||
|
object eqNumInt(object parameters);
|
||||||
object ifInt(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);
|
||||||
|
|
1
print.c
1
print.c
|
@ -36,6 +36,7 @@ int print(object input)
|
||||||
printValue(input);
|
printValue(input);
|
||||||
printf("\n\n");
|
printf("\n\n");
|
||||||
}
|
}
|
||||||
|
deleteObject(input);
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
12
util.c
12
util.c
|
@ -146,6 +146,18 @@ int listLength(object list)
|
||||||
return i;
|
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)
|
void deleteObject(object input)
|
||||||
{
|
{
|
||||||
if (TYPE(input) == symbolObject && SYM(input) != NULL)
|
if (TYPE(input) == symbolObject && SYM(input) != NULL)
|
||||||
|
|
4
util.h
4
util.h
|
@ -179,6 +179,10 @@ object referVariable(char *symbol, env currentEnv);
|
||||||
|
|
||||||
int properList(object list);
|
int properList(object list);
|
||||||
int listLength(object list);
|
int listLength(object list);
|
||||||
|
int improperListLength(object list);
|
||||||
|
/* уколико објекат није конс, враћа 1, уколико јесте, враћа дужину крње листе
|
||||||
|
* укључујући задњи члан, уколико је дата правилна листа, нил се и даље рачуна
|
||||||
|
* као члан */
|
||||||
void deleteObject(object input);
|
void deleteObject(object input);
|
||||||
object copyObject(object input);
|
object copyObject(object input);
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue