From a257cd21cd0cfe2c531845a60b56911e9ddc0521 Mon Sep 17 00:00:00 2001 From: kappa Date: Tue, 29 Jan 2019 00:07:33 +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=B5=D1=84=D0=B5=D0=BA=D1=82=D0=B8=D0=B2=D0=BD?= =?UTF-8?q?=D0=BE=20=D0=B4=D0=B5=D1=84=D0=B8=D0=BD=D0=B8=D1=81=D0=B0=D1=9A?= =?UTF-8?q?=D0=B5=20=D1=84=D1=83=D0=BD=D0=BA=D1=86=D0=B8=D1=98=D0=B0?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Makefile | 6 ++-- eval.c | 4 ++- init.c | 1 + internals.c | 90 ++++++++++++++++++++++++++++++++++++++++++++++++----- internals.h | 1 + print.c | 5 +++ symtable.c | 17 +++------- util.c | 26 ++++++++++++++-- util.h | 2 ++ 9 files changed, 126 insertions(+), 26 deletions(-) diff --git a/Makefile b/Makefile index 462167f..26423f1 100644 --- a/Makefile +++ b/Makefile @@ -1,15 +1,15 @@ # cirilisp - компајлер за ћирилични дијалекат лиспа # ћирилисп верзија -VERSION = 0.5 +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 -O1 +# CFLAGS = -g -std=c99 -pedantic -Wall -O0 +CFLAGS = -std=c99 -pedantic -Wall -O1 LDFLAGS = -lm -lc CC = cc diff --git a/eval.c b/eval.c index 188bd0d..525e4cc 100644 --- a/eval.c +++ b/eval.c @@ -3,6 +3,7 @@ #include #include "util.h" +#include "internals.h" #include "symtable.h" object apply(object function, object parameters); @@ -79,10 +80,11 @@ object apply(object procedure, object parameters) return result; } - object(*f)() = PROC_BUILTIN(procedure); if (PROC_TYPE(procedure) == builtinProc) { + object(*f)() = PROC_BUILTIN(procedure); result = f(parameters); + return result; } diff --git a/init.c b/init.c index 17bf6d7..7a1f36f 100644 --- a/init.c +++ b/init.c @@ -25,4 +25,5 @@ void init() addSymbolInternal("дефиниши", &define); addSymbolInternal("тачно->нетачно", &exactToInexact); addSymbolInternal("нетачно->тачно", &inexactToExact); + addSymbolInternal("ламбда", &lambda); } diff --git a/internals.c b/internals.c index 7f935ed..9871488 100644 --- a/internals.c +++ b/internals.c @@ -2,7 +2,7 @@ #include "util.h" #include "eval.h" -int allNumbers(object list) +int allNums(object list) { object *currentCell = &list; while (TYPE(*currentCell) != nilObject) @@ -16,12 +16,26 @@ int allNumbers(object list) return 1; } +int allSyms(object list) +{ + object *currentCell = &list; + while (TYPE(*currentCell) != nilObject) + { + if (TYPE(CAR(*currentCell)) != symbolObject) + { + return 0; + } + currentCell = &CDR(*currentCell); + } + return 1; +} + object add(object parameters) { object result; TYPE(result) = numberObject; - if (!allNumbers(parameters)) + if (!allNums(parameters)) { TYPE(result) = errorObject; ERR(result) = typeError; @@ -47,7 +61,7 @@ object subtract(object parameters) object result; TYPE(result) = numberObject; - if (!allNumbers(parameters)) + if (!allNums(parameters)) { TYPE(result) = errorObject; ERR(result) = typeError; @@ -75,7 +89,7 @@ object multiply(object parameters) object result; TYPE(result) = numberObject; - if (!allNumbers(parameters)) + if (!allNums(parameters)) { TYPE(result) = errorObject; ERR(result) = typeError; @@ -101,7 +115,7 @@ object divide(object parameters) object result; TYPE(result) = numberObject; - if (!allNumbers(parameters)) + if (!allNums(parameters)) { TYPE(result) = errorObject; ERR(result) = typeError; @@ -192,19 +206,79 @@ object quote(object parameters) return result; } +object lambda(object parameters) +{ + object result; + if (listLength(parameters) < 2) + { + TYPE(result) = errorObject; + ERR(result) = argumentNumberError; + } + else if (!(TYPE(CAR(parameters)) == consObject && + allSyms(CAR(parameters)))) + { + TYPE(result) = errorObject; + ERR(result) = typeError; + } + else + { + TYPE(result) = procedureObject; + PROC(result) = createProcedure(); + PROC_TYPE(result) = compoundProc; + PROC_COMP_ARGS(result) = copyObject(CAR(parameters)); + PROC_COMP_BODY(result) = copyObject(CDR(parameters)); + } + + return result; +} + object define(object parameters) { object result; - if (listLength(parameters) != 2) + if (listLength(parameters) == 0) { TYPE(result) = errorObject; ERR(result) = argumentNumberError; } else if (TYPE(CAR(parameters)) == symbolObject) { - result = copyObject(CAR(parameters)); - addSymbolVariable(SYM(result), + if (listLength(parameters) == 2) + { + result = copyObject(CAR(parameters)); + addSymbolVariable(SYM(result), eval(copyObject(CAR(CDR(parameters))))); + } + else + { + TYPE(result) = errorObject; + ERR(result) = argumentNumberError; + } + } + else if (TYPE(CAR(parameters)) == consObject) + { + if (listLength(parameters) >= 2) + { + 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 = lambda(parameters); + addSymbolVariable(SYM(result), proc); + } + else + { + TYPE(result) = errorObject; + ERR(result) = typeError; + } + } + else + { + TYPE(result) = errorObject; + ERR(result) = argumentNumberError; + } } else { diff --git a/internals.h b/internals.h index b986afc..9f51f03 100644 --- a/internals.h +++ b/internals.h @@ -9,3 +9,4 @@ object exactToInexact(object parameters); object inexactToExact(object parameters); object quote(object parameters); object define(object parameters); +object lambda(object parameters); diff --git a/print.c b/print.c index 128e3fe..582d145 100644 --- a/print.c +++ b/print.c @@ -54,6 +54,11 @@ void printValue(object input) { printf("<процедура:%s>", PROC_TYPE(input) == builtinProc ? "уграђена" : "сложена"); + if (PROC_TYPE(input) == compoundProc) + { + printValue(PROC_COMP_ARGS(input)); + printValue(PROC_COMP_BODY(input)); + } } else if (TYPE(input) == symbolObject) { diff --git a/symtable.c b/symtable.c index ad755d1..10334ef 100644 --- a/symtable.c +++ b/symtable.c @@ -80,19 +80,12 @@ int createTable() void removeTableAux(entry **table) { - free((*table)->name); - deleteObject((*table)->value); - if ((*table)->left != NULL) + if ((*table) != NULL) { + free((*table)->name); + deleteObject((*table)->value); removeTableAux(&(*table)->left); - free((*table)->left); - (*table)->left = NULL; - } - if ((*table)->right != NULL) - { removeTableAux(&(*table)->right); - free((*table)->right); - (*table)->right = NULL; } } @@ -123,7 +116,7 @@ void addSymbolInternal(char *symbol, object (*function)()) } TYPE((*e)->value) = procedureObject; - PROC((*e)->value) = malloc(sizeof(procedure)); + PROC((*e)->value) = createProcedure(); PROC_TYPE((*e)->value) = builtinProc; PROC_BUILTIN((*e)->value) = function; (*e)->name = malloc(sizeof(char) * (strlen(symbol) + 1)); @@ -189,7 +182,7 @@ object referVariableAux(int index, char *symbol) } else { - result = (*e)->value; + result = copyObject((*e)->value); } return result; diff --git a/util.c b/util.c index c355876..4598e6c 100644 --- a/util.c +++ b/util.c @@ -5,14 +5,15 @@ #include "util.h" -#define SPECIALFORMSNUM 2 +#define SPECIALFORMSNUM 3 int isSpecialForm(char *symbol) { int result = 0; char *specialForms[] = { "навод", - "дефиниши" + "дефиниши", + "ламбда" }; for (int i = 0; i < SPECIALFORMSNUM; ++i) @@ -98,6 +99,22 @@ object copyObject(object input) CAR(result) = copyObject(CAR(input)); CDR(result) = copyObject(CDR(input)); } + else if (TYPE(input) == procedureObject) + { + PROC(result) = malloc(sizeof(procedure)); + PROC_TYPE(result) = PROC_TYPE(input); + if (PROC_TYPE(result) == builtinProc) + { + PROC_BUILTIN(result) = PROC_BUILTIN(input); + } + else + { + PROC_COMP_ARGS(result) = + copyObject(PROC_COMP_ARGS(input)); + PROC_COMP_BODY(result) = + copyObject(PROC_COMP_BODY(input)); + } + } return result; } @@ -300,3 +317,8 @@ object inverseNum(object a) return result; } + +procedure *createProcedure() +{ + return malloc(sizeof(procedure)); +} diff --git a/util.h b/util.h index c93169b..9bd2b3a 100644 --- a/util.h +++ b/util.h @@ -121,3 +121,5 @@ object plusNum(object a, object b); object minusNum(object a); object timesNum(object a, object b); object inverseNum(object a); + +procedure *createProcedure();