Added strictness annotations

6 files changed, 39 insertions, 14 deletions

diff --git a/interpreter/eval.c b/interpreter/eval.c
index 1b28200..bdcca2f 100644
--- a/interpreter/eval.c
+++ b/interpreter/eval.c
@@ -17,6 +17,7 @@ void free_rules_until(fuspel* new, fuspel* old) {
 typedef struct replacements {
 	char* what;
 	expression* with;
+	unsigned is_strict;
 	struct replacements* rest;
 } replacements;
 
@@ -42,18 +43,23 @@ void replace(char* name, expression* new, expression* expr) {
 	}
 }
 
-void replace_all(replacements* repls, expression* expr) {
+void replace_all(fuspel* rules, replacements* repls, expression* expr) {
 	while (repls) {
+		if (repls->is_strict) {
+			repls->with = eval(rules, repls->with);
+		}
 		replace(repls->what, repls->with, expr);
 		repls = repls->rest;
 	}
 }
 
-replacements* push_replacement(char* what, expression* with, replacements* rest) {
+replacements* push_replacement(char* what, expression* with,
+		unsigned is_strict, replacements* rest) {
 	replacements* new = my_calloc(1, sizeof(replacements));
 	new->what = what;
 	new->with = my_calloc(1, sizeof(expression));
 	cpy_expression(new->with, with);
+	new->is_strict = is_strict;
 	new->rest = rest;
 	return new;
 }
@@ -80,7 +86,8 @@ unsigned match_expr(fuspel* rules, expression* to_match, expression* expr,
 
 	switch (to_match->kind) {
 		case EXPR_NAME:
-			*repls = push_replacement(to_match->var1, expr, *repls);
+			*repls = push_replacement(
+					to_match->var1, expr, to_match->is_strict, *repls);
 			return 1;
 		case EXPR_INT:
 			matches = eq_expression(to_match, expr);
@@ -195,6 +202,11 @@ expression* append_to_app(expression* app, expression* from, unsigned char n) {
 	return app;
 }
 
+unsigned is_code_app(expression* expr) {
+	for (; expr->kind == EXPR_APP; expr = expr->var1);
+	return expr->kind == EXPR_CODE;
+}
+
 expression* eval_code(fuspel* rules, expression* expr) {
 	expression *root, *result, **args;
 	Code_1* f1; Code_2* f2;
@@ -202,7 +214,7 @@ expression* eval_code(fuspel* rules, expression* expr) {
 	unsigned char args_len;
 
 	for (root = expr; root->kind == EXPR_APP; root = root->var1);
-	if (root->kind != EXPR_CODE) {
+	if (root->kind != EXPR_CODE || !root->var1) {
 		return NULL;
 	}
 
@@ -244,7 +256,6 @@ expression* eval_code(fuspel* rules, expression* expr) {
 }
 
 expression* eval_rnf(fuspel* rules, expression* expr) {
-	expression* code_result;
 	expression* result = my_calloc(1, sizeof(expression));
 
 	fuspel* _rules = rules;
@@ -261,10 +272,9 @@ expression* eval_rnf(fuspel* rules, expression* expr) {
 
 		case EXPR_NAME:
 		case EXPR_APP:
-			code_result = eval_code(rules, expr);
-			if (code_result) {
+			if (is_code_app(expr)) {
 				my_free(result);
-				result = code_result;
+				result = eval_code(rules, expr);
 				break;
 			}
 
@@ -276,7 +286,7 @@ expression* eval_rnf(fuspel* rules, expression* expr) {
 					result = append_to_app(result, expr, skip_args);
 					old_result = result;
 					cpy_expression(result, &_rules->rule.rhs);
-					replace_all(*repls, result);
+					replace_all(rules, *repls, result);
 					free_replacements(*repls);
 					my_free(repls);
 					result = eval_rnf(rules, old_result);
@@ -303,7 +313,6 @@ expression* eval(fuspel* rules, expression* expr) {
 	expression *e1, *e2;
 	fuspel* _rules = rules;
 	expression* result = my_calloc(1, sizeof(expression));
-	expression* code_result;
 	replacements** repls = my_calloc(1, sizeof(replacements*));
 
 	switch (expr->kind) {
@@ -323,10 +332,9 @@ expression* eval(fuspel* rules, expression* expr) {
 
 		case EXPR_NAME:
 		case EXPR_APP:
-			code_result = eval_code(rules, expr);
-			if (code_result) {
+			if (is_code_app(expr)) {
 				my_free(result);
-				result = code_result;
+				result = eval_code(rules, expr);
 				break;
 			}
 
@@ -336,7 +344,7 @@ expression* eval(fuspel* rules, expression* expr) {
 								rules, &_rules->rule, expr, repls)) >= 0) {
 					expression *old_result;
 					cpy_expression(result, &_rules->rule.rhs);
-					replace_all(*repls, result);
+					replace_all(rules, *repls, result);
 					result = append_to_app(result, expr, skip_args);
 					old_result = result;
 					result = eval(rules, result);
diff --git a/interpreter/lex.c b/interpreter/lex.c
index bd64349..8208248 100644
--- a/interpreter/lex.c
+++ b/interpreter/lex.c
@@ -62,6 +62,7 @@ token_list* lex(token_list* list, char* input) {
 			case ']': list->elem.kind = TOKEN_CLOSE_SQ;  break;
 			case '=': list->elem.kind = TOKEN_EQUALS;    break;
 			case ',': list->elem.kind = TOKEN_COMMA;     break;
+			case '!': list->elem.kind = TOKEN_STRICT;    break;
 			case 'c':
 				if (input[1] == 'o' && input[2] == 'd' && input[3] == 'e' &&
 						is_space_char(input[4])) {
diff --git a/interpreter/parse.c b/interpreter/parse.c
index 4c5ba99..77ce731 100644
--- a/interpreter/parse.c
+++ b/interpreter/parse.c
@@ -19,6 +19,12 @@ token_list* parse_name(char** name, token_list* list) {
 
 token_list* parse_simple_expression(expression* expr, token_list* list) {
 	expression* _expr;
+
+	if (list->elem.kind == TOKEN_STRICT) {
+		expr->is_strict = 1;
+		list = list->rest;
+	}
+
 	switch (list->elem.kind) {
 		case TOKEN_INT:
 			expr->kind = EXPR_INT;
diff --git a/interpreter/print.c b/interpreter/print.c
index c60c190..3f17475 100644
--- a/interpreter/print.c
+++ b/interpreter/print.c
@@ -15,6 +15,7 @@ void print_token(token* tk) {
 		case TOKEN_CLOSE_SQ:  c = ']'; break;
 		case TOKEN_EQUALS:    c = '='; break;
 		case TOKEN_COMMA:     c = ','; break;
+		case TOKEN_STRICT:    c = '!'; break;
 		case TOKEN_CODE:
 			printf("code ");
 			return;
@@ -37,6 +38,12 @@ void print_token_list(token_list* list) {
 }
 
 void print_expression(expression* expr) {
+	if (!expr)
+		return;
+
+	if (expr->is_strict)
+		printf("!");
+
 	switch (expr->kind) {
 		case EXPR_INT:
 			printf("%d", *((int*) expr->var1));
diff --git a/interpreter/syntax.c b/interpreter/syntax.c
index 1722761..6c6367f 100644
--- a/interpreter/syntax.c
+++ b/interpreter/syntax.c
@@ -32,6 +32,7 @@ unsigned char len_arg_list(arg_list* list) {
 void cpy_expression(expression* dst, expression* src) {
 	free_expression(dst);
 	dst->kind = src->kind;
+	dst->is_strict = src->is_strict;
 	switch (dst->kind) {
 		case EXPR_INT:
 			dst->var1 = my_calloc(1, sizeof(int));
diff --git a/interpreter/syntax.h b/interpreter/syntax.h
index 89242ac..e2accd4 100644
--- a/interpreter/syntax.h
+++ b/interpreter/syntax.h
@@ -12,6 +12,7 @@ typedef enum {
 	TOKEN_CLOSE_P,   /* ) */
 	TOKEN_COMMA,     /* , */
 	TOKEN_COLON,     /* : */
+	TOKEN_STRICT,    /* ! */
 	TOKEN_CODE,      /* code */
 	TOKEN_NAME,
 	TOKEN_INT
@@ -43,6 +44,7 @@ typedef enum {
 
 typedef struct {
 	expr_kind kind;
+	unsigned is_strict;
 	void* var1;
 	void* var2;
 } expression;