Омогућено дефинисање функција са произвољним бројем аргумената, знатно проширена стандардна библиотека, итд.
This commit is contained in:
parent
d86e1ba7c0
commit
75b9ad436e
22
Makefile
22
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
|
||||
|
|
21
cirilisp.c
21
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;
|
||||
|
|
75
eval.c
75
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)
|
||||
{
|
||||
|
|
225
internals.c
225
internals.c
|
@ -1,9 +1,12 @@
|
|||
#include <string.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
#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;
|
||||
}
|
||||
|
|
13
internals.h
13
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);
|
||||
|
|
1
print.c
1
print.c
|
@ -36,6 +36,7 @@ int print(object input)
|
|||
printValue(input);
|
||||
printf("\n\n");
|
||||
}
|
||||
deleteObject(input);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
|
12
util.c
12
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)
|
||||
|
|
4
util.h
4
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);
|
||||
|
||||
|
|
Loading…
Reference in a new issue