kayprish/cirilisp
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Имплементиран модел окружења

Browse source
This commit is contained in:
kappa 2019-02-05 16:35:05 +01:00
parent 93969f9588
commit 9edd06a2d5
10 changed files with 205 additions and 255 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
Makefile
View file

@ -7,14 +7,15 @@ VERSION = 0.7
PREFIX = /usr/local
# флегови за C компајлер и линкер
CPPFLAGS = -D_POSIX_C_SOURCE=200809L
# CFLAGS = -g -std=c99 -pedantic -Wall -O0
CFLAGS = -std=c99 -pedantic -Wall -O2
# CPPFLAGS = -D_POSIX_C_SOURCE=200809L
CPPFLAGS =
CFLAGS = -g -std=c99 -pedantic -Wall -O0
# CFLAGS = -std=c99 -pedantic -Wall -O2
LDFLAGS = -lm -lc
CC = cc
SRC = cirilisp.c read.c eval.c print.c util.c symtable.c internals.c init.c
SRC = cirilisp.c read.c eval.c print.c util.c internals.c init.c
OBJ = $(SRC:.c=.o)
all: cirilisp
@ -22,7 +23,7 @@ all: cirilisp
.c.o:
$(CC) -c $(CPPFLAGS) $(CFLAGS) $<
$(OBJ): util.h read.h eval.h print.h symtable.h internals.h init.h
$(OBJ): util.h read.h eval.h print.h internals.h init.h
cirilisp: $(OBJ)
$(CC) -o $@ $(OBJ) $(LDFLAGS)

2
cirilisp.c
View file

@ -8,6 +8,6 @@ int main(int argc, char **argv)
init();
for (;;)
{
print(eval(read("ШКЉ> ")));
print(eval(read("ШКЉ> "), globalEnv));
}
}

44
eval.c
View file

@ -4,17 +4,16 @@
#include "util.h"
#include "internals.h"
#include "symtable.h"
object apply(object function, object parameters);
object apply(object function, object parameters, env currentEnv);
object eval(object input)
object eval(object input, env currentEnv)
{
object result;
if (TYPE(input) == symbolObject)
{
result = referVariable(SYM(input));
result = referVariable(SYM(input), currentEnv);
}
else if (TYPE(input) == consObject)
{
@ -30,7 +29,7 @@ object eval(object input)
isSpecialForm(SYM(CAR(input))))
{
specialForm = 1;
CAR(input) = eval(CAR(input));
CAR(input) = eval(CAR(input), currentEnv);
}
object *currentCell = &input;
@ -40,9 +39,11 @@ object eval(object input)
while (TYPE(*currentCell) != nilObject)
{
CAR(*currentCell) =
eval(CAR(*currentCell));
eval(CAR(*currentCell),
currentEnv);
if (TYPE(CAR(*currentCell)) == errorObject)
if (TYPE(CAR(*currentCell)) ==
errorObject)
{
noErrors = 0;
TYPE(result) = errorObject;
@ -56,7 +57,8 @@ object eval(object input)
if (noErrors)
{
result = apply(CAR(input), CDR(input));
result = apply(CAR(input), CDR(input),
currentEnv);
}
}
}
@ -69,7 +71,7 @@ object eval(object input)
return result;
}
object apply(object procedure, object parameters)
object apply(object procedure, object parameters, env currentEnv)
{
object result;
@ -83,13 +85,21 @@ object apply(object procedure, object parameters)
if (PROC_TYPE(procedure) == builtinProc)
{
object(*f)() = PROC_BUILTIN(procedure);
if (f == define || f == lambda)
{
result = f(parameters, currentEnv);
}
else
{
result = f(parameters);
}
return result;
}
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))
{
TYPE(result) = errorObject;
@ -97,26 +107,20 @@ object apply(object procedure, object parameters)
return result;
}
if (!createTable())
{
deleteObject(args);
deleteObject(body);
TYPE(result) = errorObject;
ERR(result) = maxRecursionDepthError;
return result;
}
env procEnv = createEnvironment(definitionEnv);
object *currentArg = &args;
object *currentParam = &parameters;
while (TYPE(*currentArg) != nilObject)
{
addSymbolVariable(SYM(CAR(*currentArg)), CAR(*currentParam));
addSymbolVariable(SYM(CAR(*currentArg)), CAR(*currentParam),
procEnv);
currentArg = &CDR(*currentArg);
currentParam = &CDR(*currentParam);
}
object *currentSubProc = &body;
while (TYPE(*currentSubProc) != nilObject)
{
CAR(*currentSubProc) = eval(CAR(*currentSubProc));
CAR(*currentSubProc) = eval(CAR(*currentSubProc), procEnv);
if (TYPE(CDR(*currentSubProc)) == nilObject)
{
result = CAR(*currentSubProc);
@ -125,7 +129,7 @@ object apply(object procedure, object parameters)
}
deleteObject(args);
deleteObject(body);
removeTable();
removeEnvironment(procEnv);
return result;
}

2
eval.h
View file

@ -1,3 +1,3 @@
#pragma once
object eval(object input);
object eval(object input, env currentEnv);

3
init.c
View file

@ -2,7 +2,6 @@
#include <stdio.h>
#include <stdlib.h>
#include "symtable.h"
#include "internals.h"
void init()
@ -16,7 +15,7 @@ void init()
/* Омогућава библиотекама коришћеним у интерпретеру да протумаче српску
* ћирилицу */
createTableStack(1000);
globalEnv = createEnvironment(NULL);
addSymbolInternal("+", &add);
addSymbolInternal("-", &subtract);
addSymbolInternal("*", &multiply);

17
internals.c
View file

@ -1,6 +1,5 @@
#include <string.h>
#include "symtable.h"
#include "util.h"
#include "eval.h"
@ -33,6 +32,7 @@ int allSyms(object list)
}
/*
object ifStatement(object parameters)
{
*/
@ -243,7 +243,7 @@ breakloop:
}
}
object lambda(object parameters)
object lambda(object parameters, env currentEnv)
{
object result;
if (listLength(parameters) < 2)
@ -263,13 +263,13 @@ object lambda(object parameters)
PROC_TYPE(result) = compoundProc;
PROC_COMP_ARGS(result) = copyObject(CAR(parameters));
PROC_COMP_BODY(result) = copyObject(CDR(parameters));
PROC_COMP_TABLE(result) = currentTable;
PROC_COMP_ENV(result) = currentEnv;
}
return result;
}
object define(object parameters)
object define(object parameters, env currentEnv)
{
object result;
if (listLength(parameters) == 0)
@ -283,7 +283,9 @@ object define(object parameters)
{
result = copyObject(CAR(parameters));
addSymbolVariable(SYM(result),
eval(copyObject(CAR(CDR(parameters)))));
eval(copyObject(CAR(CDR(parameters))),
currentEnv),
currentEnv);
}
else
{
@ -302,8 +304,9 @@ object define(object parameters)
deleteObject(CAR(parameters));
CAR(parameters) = copyObject(args);
deleteObject(args);
object proc = lambda(parameters);
addSymbolVariable(SYM(result), proc);
object proc = lambda(parameters, currentEnv);
addSymbolVariable(SYM(result), proc,
currentEnv);
}
else
{

194
symtable.c
View file

@ -1,194 +0,0 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "util.h"
#include "symtable.h"
typedef struct entry
{
char *name;
object value;
struct entry *left;
struct entry *right;
} entry;
/* овај тип служи за имплементирање табеле симбола који помажу да се стварају
* променљиве и процедуре у ћирилиспу */
entry **tables = NULL;
#define GLOBALTABLE tables[0]
int currentTable = 0;
#define STACKMAX 1000
/* динамички алоцирани стек табела симбола, где tables[0] означава глобалну
* табелу симбола, а сваки наредни члан означава табелу која постоји у
* контексту друге, већ постојеће. на пример, уколико имамо процедуру "ф" која
* у себи дефиинише и извршава процедуру "г", током извршавања "г", tables[0],
* [1] и [2] ће редом означавати: глобалну табелу, табелу процедуре "ф" и
* табелу процедуре "г", када је "г" евалуирано и ток контроле се пребацује на
* "ф", tables[2] се брише као и сви симболи дефинисани у њој */
entry **findEntry(entry **current, char *symbol)
{
int cond;
if (*current == NULL)
{
return current;
}
else if ((cond = strcmp(symbol, (*current)->name)) < 0)
{
return findEntry(&(*current)->left, symbol);
}
else if (cond > 0)
{
return findEntry(&(*current)->right, symbol);
}
else
{
return current;
}
/* случај у којем тражени симбол не постоји у табели, и случај у којем
* је он нађен враћају вредност на исти начин, али су гране тока
* одвојене ради читљивости */
}
void freeEntry(entry **current)
{
free((*current)->name);
deleteObject((*current)->value);
}
void createTableStack(int size)
{
tables = malloc(size * sizeof(entry *));
tables[0] = NULL;
currentTable = 0;
}
int createTable()
{
if (currentTable >= STACKMAX)
{
return 0;
}
else
{
tables[++currentTable] = NULL;
return 1;
}
}
void removeTableAux(entry **table)
{
if ((*table) != NULL)
{
free((*table)->name);
deleteObject((*table)->value);
removeTableAux(&(*table)->left);
removeTableAux(&(*table)->right);
}
}
int removeTable()
{
if (currentTable <= 0)
{
return 0;
}
else
{
removeTableAux(&tables[currentTable--]);
return 1;
}
}
void addSymbolInternal(char *symbol, object (*function)())
{
entry **e = findEntry(&GLOBALTABLE, symbol);
if (*e != NULL)
{
freeEntry(e);
}
else
{
*e = malloc(sizeof(entry));
}
TYPE((*e)->value) = procedureObject;
PROC((*e)->value) = createProcedure();
PROC_TYPE((*e)->value) = builtinProc;
PROC_BUILTIN((*e)->value) = function;
(*e)->name = malloc(sizeof(char) * (strlen(symbol) + 1));
strcpy((*e)->name, symbol);
(*e)->left = (*e)->right = NULL;
}
void addSymbolVariable(char *symbol, object variable)
{
entry **e = findEntry(&tables[currentTable], symbol);
if (*e != NULL)
{
freeEntry(e);
}
else
{
*e = malloc(sizeof(entry));
}
(*e)->value = copyObject(variable);
(*e)->name = malloc(sizeof(char) * (strlen(symbol) + 1));
strcpy((*e)->name, symbol);
(*e)->left = (*e)->right = NULL;
}
int symbolExistsAux(int index, char *symbol)
{
entry **e = findEntry(&tables[index], symbol);
if (*e == NULL)
{
if (index != 0)
{
return symbolExistsAux(index - 1, symbol);
}
return 0;
}
else
{
return 1;
}
}
int symbolExists(char *symbol)
{
return symbolExistsAux(currentTable, symbol);
}
object referVariableAux(int index, char *symbol)
{
object result;
entry **e = findEntry(&tables[index], symbol);
if (*e == NULL)
{
if (index != 0)
{
return referVariableAux(index - 1, symbol);
}
TYPE(result) = errorObject;
ERR(result) = unrecognizedSymbolError;
}
else
{
result = copyObject((*e)->value);
}
return result;
}
object referVariable(char *symbol)
{
return referVariableAux(currentTable, symbol);
}

19
symtable.h
View file

@ -1,19 +0,0 @@
#pragma once
#include "util.h"
void createTableStack(int size);
int createTable();
int removeTable();
void addSymbolInternal(char *symbol, object (*function)());
void addSymbolVariable(char *symbol, object variable);
/* функције помоћу којих се дефинишу нове променљиве: addSymbolVariable се
* позива током корисничких дефиниција у програму, док се addSymbolInternal
* користи у init.c да би се дефинисале "уграђене" процедуре */
int symbolExists(char *symbol);
/* враћа 1 уколико симбол постоји и 0 у супротном */
object referVariable(char *symbol);
/* враћа вредност на коју се односи име симбола у табели */

119
util.c
View file

@ -5,6 +5,124 @@
#include "util.h"
entry **findEntry(entry **current, char *symbol)
{
int cond;
if (*current == NULL)
{
return current;
}
else if ((cond = strcmp(symbol, (*current)->name)) < 0)
{
return findEntry(&(*current)->left, symbol);
}
else if (cond > 0)
{
return findEntry(&(*current)->right, symbol);
}
else
{
return current;
}
/* случај у којем тражени симбол не постоји у табели, и случај у којем
* је он нађен враћају вредност на исти начин, али су гране тока
* одвојене ради читљивости */
}
void freeEntry(entry **current)
{
free((*current)->name);
deleteObject((*current)->value);
}
env createEnvironment(env enclosing)
{
env result = malloc(sizeof(frame));
result->table = NULL;
result->enclosing = enclosing;
return result;
}
void removeTable(entry **table)
{
if ((*table) != NULL)
{
removeTable(&(*table)->left);
removeTable(&(*table)->right);
freeEntry(table);
free(*table);
*table = NULL;
}
}
void removeEnvironment(env input)
{
removeTable(&input->table);
free(input);
}
void addSymbolInternal(char *symbol, object (*function)())
{
entry **e = findEntry(&globalEnv->table, symbol);
if (*e != NULL)
{
freeEntry(e);
}
else
{
*e = malloc(sizeof(entry));
}
TYPE((*e)->value) = procedureObject;
PROC((*e)->value) = createProcedure();
PROC_TYPE((*e)->value) = builtinProc;
PROC_BUILTIN((*e)->value) = function;
(*e)->name = malloc(sizeof(char) * (strlen(symbol) + 1));
strcpy((*e)->name, symbol);
(*e)->left = (*e)->right = NULL;
}
void addSymbolVariable(char *symbol, object variable, env currentEnv)
{
entry **e = findEntry(&currentEnv->table, symbol);
if (*e != NULL)
{
freeEntry(e);
}
else
{
*e = malloc(sizeof(entry));
}
(*e)->value = copyObject(variable);
(*e)->name = malloc(sizeof(char) * (strlen(symbol) + 1));
strcpy((*e)->name, symbol);
(*e)->left = (*e)->right = NULL;
}
object referVariable(char *symbol,env currentEnv)
{
entry **e = findEntry(&currentEnv->table, symbol);
if (*e == NULL)
{
if (currentEnv->enclosing == NULL)
{
SIGERR(unrecognizedSymbolError);
}
else
{
return referVariable(symbol, currentEnv->enclosing);
}
}
else
{
return copyObject((*e)->value);
}
}
#define SPECIALFORMSNUM 3
int isSpecialForm(char *symbol)
{
@ -112,6 +230,7 @@ object copyObject(object input)
copyObject(PROC_COMP_ARGS(input));
PROC_COMP_BODY(result) =
copyObject(PROC_COMP_BODY(input));
PROC_COMP_ENV(result) = PROC_COMP_ENV(input);
}
break;
case boolObject:

45
util.h
View file

@ -26,7 +26,7 @@
#define PROC_BUILTIN(x) ((x).value.proc->value.builtin)
#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_TABLE(x) ((x).value.proc->value.compound.table)
#define PROC_COMP_ENV(x) ((x).value.proc->value.compound.environment)
#define NUM(x) ((x).value.num)
#define NUM_TYPE(x) ((x).value.num.type)
@ -75,6 +75,10 @@ typedef enum
compoundProc
} procType;
typedef struct entry entry;
typedef struct frame frame;
typedef frame *env;
typedef struct number number;
typedef struct object object;
typedef struct cons cons;
@ -116,6 +120,22 @@ struct cons
object cdr;
};
struct entry
{
char *name;
object value;
struct entry *left;
struct entry *right;
};
/* овај тип служи за имплементирање табеле симбола који помажу да се стварају
* променљиве и процедуре у ћирилиспу */
struct frame
{
entry *table;
env enclosing;
};
struct procedure
{
procType type;
@ -126,19 +146,36 @@ struct procedure
{
object args;
object body;
int table;
env environment;
} compound;
} value;
};
env globalEnv;
/******************************* функције везане за окружења */
env createEnvironment(env enclosing);
void removeEnvironment(env input);
void addSymbolInternal(char *symbol, object (*function)());
void addSymbolVariable(char *symbol, object variable, env currentEnv);
/* функције помоћу којих се дефинишу нове променљиве: addSymbolVariable се
* позива током корисничких дефиниција у програму, док се addSymbolInternal
* користи у init.c да би се дефинисале "уграђене" процедуре */
int symbolExists(char *symbol, env currentEnv);
/* враћа 1 уколико симбол постоји и 0 у супротном */
object referVariable(char *symbol, env currentEnv);
/* враћа вредност на коју се односи име симбола у табели */
/******************************* */
int isSpecialForm(char *symbol);
int properList(object list);
int listLength(object list);
void deleteObject(object input);
object copyObject(object input);
object list
object longlongToNumber(long long int input);
object shortenFractionNum(object a);
object exactToInexactNum(object a);