Browse Source

refactoring

master
Gabriel Pariat 3 years ago
parent
commit
2a361278cb
  1. 12
      implementations/c/src/cons.c
  2. 2
      implementations/c/src/evaluator.c
  3. 43
      implementations/c/src/lisp.c
  4. 38
      implementations/c/src/lisp.h
  5. 14
      implementations/c/src/reader.c
  6. BIN
      implementations/c/tests/check_ptlisp.log
  7. 2
      implementations/c/tests/cons-test.c
  8. 54
      implementations/c/tests/lisp-test.c
  9. 2
      implementations/c/tests/reader-test.c

12
implementations/c/src/cons.c

@ -17,18 +17,22 @@ Pointer reduce_fn(Pointer args, Pointer env) {
return previous; return previous;
} }
Pointer cons_fn(Pointer args) { Pointer cons_fn(Pointer args, Pointer env) {
(void) env;
return cons(CAR(args), CAR(CDR(args))); return cons(CAR(args), CAR(CDR(args)));
} }
Pointer car_fn(Pointer args) { Pointer car_fn(Pointer args, Pointer env) {
(void) env;
return CAR(CAR(args)); return CAR(CAR(args));
} }
Pointer cdr_fn(Pointer args) { Pointer cdr_fn(Pointer args, Pointer env) {
(void) env;
return CDR(CAR(args)); return CDR(CAR(args));
} }
Pointer list_fn(Pointer args) { Pointer list_fn(Pointer args, Pointer env) {
(void) env;
return args; return args;
} }

2
implementations/c/src/evaluator.c

@ -43,7 +43,7 @@ Pointer eval(Pointer data, Pointer env) {
} }
if (type == NATIVE_FUNC) { if (type == NATIVE_FUNC) {
return NATIVE_FUNC(op)(params); return NATIVE_FUNC(op)(params, env);
} }
if (type == FUNC) { if (type == FUNC) {

43
implementations/c/src/lisp.c

@ -31,15 +31,17 @@ Pointer func(Pointer code, Pointer env) {
return fn; return fn;
} }
/** OPERATIONS **/ /** FUNCTIONS **/
Pointer add_fn(Pointer args) { Pointer add_fn(Pointer args, Pointer env) {
(void) env;
Pointer result = number(0); Pointer result = number(0);
REDUCE(args, result; NUMBER(result) += NUMBER(CAR(args)), result); REDUCE(args, result; NUMBER(result) += NUMBER(CAR(args)), result);
return result; return result;
} }
Pointer sub_fn(Pointer args) { Pointer sub_fn(Pointer args, Pointer env) {
(void) env;
Pointer first = CAR(args); Pointer first = CAR(args);
Pointer rest = CDR(args); Pointer rest = CDR(args);
if (first == NIL) return UNDEFINED; // Empty args if (first == NIL) return UNDEFINED; // Empty args
@ -49,13 +51,15 @@ Pointer sub_fn(Pointer args) {
return result; return result;
} }
Pointer mul_fn(Pointer args) { Pointer mul_fn(Pointer args, Pointer env) {
(void) env;
Pointer result = number(1); Pointer result = number(1);
REDUCE(args, result; NUMBER(result) *= NUMBER(CAR(args)), result); REDUCE(args, result; NUMBER(result) *= NUMBER(CAR(args)), result);
return result; return result;
} }
Pointer div_fn(Pointer args) { Pointer div_fn(Pointer args, Pointer env) {
(void) env;
Pointer first = CAR(args); Pointer first = CAR(args);
Pointer rest = CDR(args); Pointer rest = CDR(args);
if (first == NIL) return UNDEFINED; // Empty args if (first == NIL) return UNDEFINED; // Empty args
@ -65,20 +69,23 @@ Pointer div_fn(Pointer args) {
return result; return result;
} }
Pointer pow_fn(Pointer args) { Pointer pow_fn(Pointer args, Pointer env) {
(void) env;
Pointer a = CAR(args); Pointer a = CAR(args);
Pointer b = CAR(CDR(args)); Pointer b = CAR(CDR(args));
if (a == NIL || b == NIL) return UNDEFINED; // Arguments missing. if (a == NIL || b == NIL) return UNDEFINED; // Arguments missing.
return number(pow(NUMBER(a), NUMBER(b))); return number(pow(NUMBER(a), NUMBER(b)));
} }
Pointer sqrt_fn(Pointer args) { Pointer sqrt_fn(Pointer args, Pointer env) {
(void) env;
Pointer a = CAR(args); Pointer a = CAR(args);
if (a == NIL) return UNDEFINED; // Arguments missing. if (a == NIL) return UNDEFINED; // Arguments missing.
return number(sqrt(NUMBER(a))); return number(sqrt(NUMBER(a)));
} }
Pointer logand_fn(Pointer args) { Pointer logand_fn(Pointer args, Pointer env) {
(void) env;
Pointer result = number(-1l); Pointer result = number(-1l);
REDUCE(args, REDUCE(args,
result; NUMBER(result) = (long) NUMBER(result) & (long) NUMBER(CAR(args)), result; NUMBER(result) = (long) NUMBER(result) & (long) NUMBER(CAR(args)),
@ -86,7 +93,8 @@ Pointer logand_fn(Pointer args) {
return result; return result;
} }
Pointer logor_fn(Pointer args) { Pointer logor_fn(Pointer args, Pointer env) {
(void) env;
Pointer result = number(0); Pointer result = number(0);
REDUCE(args, REDUCE(args,
result; NUMBER(result) = (long) NUMBER(result) | (long) NUMBER(CAR(args)), result; NUMBER(result) = (long) NUMBER(result) | (long) NUMBER(CAR(args)),
@ -94,7 +102,8 @@ Pointer logor_fn(Pointer args) {
return result; return result;
} }
Pointer logxor_fn(Pointer args) { Pointer logxor_fn(Pointer args, Pointer env) {
(void) env;
Pointer result = number(0); Pointer result = number(0);
REDUCE(args, REDUCE(args,
result; NUMBER(result) = (long) NUMBER(result) ^ (long) NUMBER(CAR(args)), result; NUMBER(result) = (long) NUMBER(result) ^ (long) NUMBER(CAR(args)),
@ -102,7 +111,8 @@ Pointer logxor_fn(Pointer args) {
return result; return result;
} }
Pointer lognot_fn(Pointer args) { Pointer lognot_fn(Pointer args, Pointer env) {
(void) env;
Pointer a = CAR(args); Pointer a = CAR(args);
if (a == NIL) return UNDEFINED; // Arguments missing. if (a == NIL) return UNDEFINED; // Arguments missing.
return number(~(long) NUMBER(a)); return number(~(long) NUMBER(a));
@ -164,7 +174,8 @@ Pointer or_fn(Pointer args, Pointer env) {
return NIL; return NIL;
} }
Pointer not_fn(Pointer args) { Pointer not_fn(Pointer args, Pointer env) {
(void) env;
return CAR(args) == NIL ? T : NIL; return CAR(args) == NIL ? T : NIL;
} }
@ -187,6 +198,9 @@ Pointer fn_fn(Pointer args, Pointer env) {
return func(args, env); return func(args, env);
} }
#define SET_FUNC(s, fn) environment_set(NIL, symbol1(s), native_func(fn))
#define SET_FORM(s, fn) environment_set(NIL, symbol1(s), special_form(fn))
void init(void) { void init(void) {
memory_init(16); memory_init(16);
symbol_init(); symbol_init();
@ -194,8 +208,9 @@ void init(void) {
environment_init(); environment_init();
environment_set(NIL, STANDARD_INPUT, stream(stdin)); environment_set(NIL, STANDARD_INPUT, stream(stdin));
environment_set(NIL, STANDARD_OUTPUT, stream(stdout)); environment_set(NIL, STANDARD_OUTPUT, stream(stdout));
Pointer add = symbol1("+"); SET_FUNC("+", add_fn);
environment_set(NIL, add, native_func(add_fn)); SET_FUNC("-", sub_fn);
SET_FUNC("*", mul_fn);
} }
void repl(void) { void repl(void) {

38
implementations/c/src/lisp.h

@ -74,11 +74,9 @@ typedef struct {
} Table; } Table;
/* CHANGER POUR TABLEAU DE FONCTIONS */ /* CHANGER POUR TABLEAU DE FONCTIONS */
typedef Pointer (*NativeFunc)(Pointer params); typedef Pointer (*NativeFunc)(Pointer params, Pointer env);
typedef Pointer (*SpecialForm)(Pointer params, Pointer env); typedef Pointer (*SpecialForm)(Pointer params, Pointer env);
/* FIN A RETRAVAILLER! */
typedef FILE* Stream; typedef FILE* Stream;
typedef union { typedef union {
@ -172,36 +170,36 @@ Pointer special_form(SpecialForm func);
Pointer character(Char c); Pointer character(Char c);
Pointer stream(FILE* s); Pointer stream(FILE* s);
/* OPERATIONS */ /* FUNCTIONS */
Pointer eval_fn(Pointer args, Pointer env); Pointer eval_fn(Pointer args, Pointer env);
Pointer cons_fn(Pointer args); Pointer cons_fn(Pointer args, Pointer env);
Pointer car_fn(Pointer args); Pointer car_fn(Pointer args, Pointer env);
Pointer cdr_fn(Pointer args); Pointer cdr_fn(Pointer args, Pointer env);
Pointer reduce_fn(Pointer args, Pointer env); Pointer reduce_fn(Pointer args, Pointer env);
Pointer add_fn(Pointer args); Pointer add_fn(Pointer args, Pointer env);
Pointer list_fn(Pointer args); Pointer list_fn(Pointer args, Pointer env);
Pointer sub_fn(Pointer args); Pointer sub_fn(Pointer args, Pointer env);
Pointer mul_fn(Pointer args); Pointer mul_fn(Pointer args, Pointer env);
Pointer div_fn(Pointer args); Pointer div_fn(Pointer args, Pointer env);
Pointer pow_fn(Pointer args); Pointer pow_fn(Pointer args, Pointer env);
Pointer sqrt_fn(Pointer args); Pointer sqrt_fn(Pointer args, Pointer env);
Pointer logand_fn(Pointer args); Pointer logand_fn(Pointer args, Pointer env);
Pointer logor_fn(Pointer args); Pointer logor_fn(Pointer args, Pointer env);
Pointer logxor_fn(Pointer args); Pointer logxor_fn(Pointer args, Pointer env);
Pointer lognot_fn(Pointer args); Pointer lognot_fn(Pointer args, Pointer env);
Pointer if_fn(Pointer args, Pointer env); Pointer if_fn(Pointer args, Pointer env);
Pointer let_fn(Pointer args, Pointer env); Pointer let_fn(Pointer args, Pointer env);
Pointer quote_fn(Pointer args, Pointer env); Pointer quote_fn(Pointer args, Pointer env);
Pointer and_fn(Pointer args, Pointer env); Pointer and_fn(Pointer args, Pointer env);
Pointer or_fn(Pointer args, Pointer env); Pointer or_fn(Pointer args, Pointer env);
Pointer not_fn(Pointer args); Pointer not_fn(Pointer args, Pointer env);
Pointer def_fn(Pointer args, Pointer env); Pointer def_fn(Pointer args, Pointer env);
Pointer set_fn(Pointer args, Pointer env); Pointer set_fn(Pointer args, Pointer env);
Pointer fn_fn(Pointer args, Pointer env); Pointer fn_fn(Pointer args, Pointer env);
Pointer peek_char_fn(Pointer args, Pointer env); Pointer peek_char_fn(Pointer args, Pointer env);
Pointer read_char_fn(Pointer args, Pointer env); Pointer read_char_fn(Pointer args, Pointer env);
Pointer read_fn(Pointer args, Pointer env); Pointer read_fn(Pointer args, Pointer env);
Pointer set_reader_macro_fn(Pointer args); Pointer set_reader_macro_fn(Pointer args, Pointer env);
Pointer read_char_macro_fn(Pointer args, Pointer env); Pointer read_char_macro_fn(Pointer args, Pointer env);
Pointer read_list_macro_fn(Pointer args, Pointer env); Pointer read_list_macro_fn(Pointer args, Pointer env);
Pointer read_right_paren_macro_fn(Pointer args, Pointer env); Pointer read_right_paren_macro_fn(Pointer args, Pointer env);

14
implementations/c/src/reader.c

@ -107,15 +107,14 @@ Pointer read_fn(Pointer args, Pointer env) {
: STREAM(streamPtr); : STREAM(streamPtr);
double num = 0; double num = 0;
Pointer macro; Pointer macro;
int pos;
Char c = peek_char(T, stream); Char c = peek_char(T, stream);
if (feof(stream)) return NIL; if (feof(stream)) return NIL;
macro = table_get(READTABLE, c); macro = table_get(READTABLE, c);
if (macro != UNDEFINED) { if (macro != UNDEFINED) {
switch(memory_get(macro)->type) { switch(memory_get(macro)->type) {
case SPECIAL_FORM: case NATIVE_FUNC:
return SPECIAL_FORM(macro)(LIST(streamPtr, character(get_utf8(stream))), env); return NATIVE_FUNC(macro)(LIST(streamPtr, character(get_utf8(stream))), env);
case FUNC: case FUNC:
return eval_fn(LIST(macro, streamPtr, character(get_utf8(stream))), env); return eval_fn(LIST(macro, streamPtr, character(get_utf8(stream))), env);
default: break; default: break;
@ -144,7 +143,8 @@ Pointer set_reader_macro(Pointer c, Pointer fn) {
return T; return T;
} }
Pointer set_reader_macro_fn(Pointer args) { Pointer set_reader_macro_fn(Pointer args, Pointer env) {
(void) env;
return set_reader_macro(CAR(args), CAR(CDR (args))); return set_reader_macro(CAR(args), CAR(CDR (args)));
} }
@ -254,9 +254,9 @@ Pointer read_right_paren_macro_fn(Pointer args, Pointer env) {
void reader_init(void) { void reader_init(void) {
buffer = string(NULL, 0); buffer = string(NULL, 0);
READTABLE = table(1); READTABLE = table(1);
READTABLE = table_set(READTABLE, '(', special_form(read_list_macro_fn)); READTABLE = table_set(READTABLE, '(', native_func(read_list_macro_fn));
READTABLE = table_set(READTABLE, ')', special_form(read_list_macro_fn)); READTABLE = table_set(READTABLE, ')', native_func(read_list_macro_fn));
READTABLE = table_set(READTABLE, '\\', special_form(read_char_macro_fn)); READTABLE = table_set(READTABLE, '\\', native_func(read_char_macro_fn));
/* GLOBALS = table_set(GLOBALS, */ /* GLOBALS = table_set(GLOBALS, */
/* symbol("*standard-input*", sizeof("*standard-input*")), */ /* symbol("*standard-input*", sizeof("*standard-input*")), */
/* stream(stdin)); */ /* stream(stdin)); */

BIN
implementations/c/tests/check_ptlisp.log

Binary file not shown.

2
implementations/c/tests/cons-test.c

@ -9,7 +9,7 @@ START_TEST(cons_new_test) {
END_TEST END_TEST
START_TEST(cons_car_nil_test) { START_TEST(cons_car_nil_test) {
ck_assert_uint_eq(car_fn(NIL), NIL); ck_assert_uint_eq(car_fn(NIL, NIL), NIL);
} }
END_TEST END_TEST

54
implementations/c/tests/lisp-test.c

@ -1,127 +1,127 @@
#include "ptlisp-test.h" #include "ptlisp-test.h"
START_TEST(addition_zero_args_test) { START_TEST(addition_zero_args_test) {
ck_assert_double_eq(NUMBER(add_fn(NIL)), 0); ck_assert_double_eq(NUMBER(add_fn(NIL, NIL)), 0);
} }
END_TEST END_TEST
START_TEST(addition_one_args_test) { START_TEST(addition_one_args_test) {
ck_assert_double_eq(NUMBER(add_fn(LIST(number(69)))), 69); ck_assert_double_eq(NUMBER(add_fn(LIST(number(69)), NIL)), 69);
} }
END_TEST END_TEST
START_TEST(addition_many_args_test) { START_TEST(addition_many_args_test) {
ck_assert_double_eq(NUMBER(add_fn(LIST(number(69), number(420)))), 489); ck_assert_double_eq(NUMBER(add_fn(LIST(number(69), number(420)), NIL)), 489);
} }
END_TEST END_TEST
START_TEST(substraction_zero_args_test) { START_TEST(substraction_zero_args_test) {
ck_assert_uint_eq(sub_fn(NIL), UNDEFINED); ck_assert_uint_eq(sub_fn(NIL, NIL), UNDEFINED);
} }
END_TEST END_TEST
START_TEST(substraction_one_args_test) { START_TEST(substraction_one_args_test) {
ck_assert_double_eq(NUMBER(sub_fn(LIST(number(69)))), -69); ck_assert_double_eq(NUMBER(sub_fn(LIST(number(69)), NIL)), -69);
} }
END_TEST END_TEST
START_TEST(substraction_many_args_test) { START_TEST(substraction_many_args_test) {
ck_assert_double_eq(NUMBER(sub_fn(LIST(number(69), number(420)))), -351); ck_assert_double_eq(NUMBER(sub_fn(LIST(number(69), number(420)), NIL)), -351);
} }
END_TEST END_TEST
START_TEST(multiplication_zero_args_test) { START_TEST(multiplication_zero_args_test) {
ck_assert_double_eq(NUMBER(mul_fn(NIL)), 1); ck_assert_double_eq(NUMBER(mul_fn(NIL, NIL)), 1);
} }
END_TEST END_TEST
START_TEST(multiplication_one_args_test) { START_TEST(multiplication_one_args_test) {
ck_assert_double_eq(NUMBER(mul_fn(LIST(number(69)))), 69); ck_assert_double_eq(NUMBER(mul_fn(LIST(number(69)), NIL)), 69);
} }
END_TEST END_TEST
START_TEST(multiplication_many_args_test) { START_TEST(multiplication_many_args_test) {
ck_assert_double_eq(NUMBER(mul_fn(LIST(number(69), number(420)))), 28980); ck_assert_double_eq(NUMBER(mul_fn(LIST(number(69), number(420)), NIL)), 28980);
} }
END_TEST END_TEST
START_TEST(div_zero_args_test) { START_TEST(div_zero_args_test) {
ck_assert_double_eq(div_fn(NIL), UNDEFINED); ck_assert_double_eq(div_fn(NIL, NIL), UNDEFINED);
} }
END_TEST END_TEST
START_TEST(div_one_args_test) { START_TEST(div_one_args_test) {
ck_assert_double_eq(NUMBER(div_fn(LIST(number(69)))), 1.0 / 69.0); ck_assert_double_eq(NUMBER(div_fn(LIST(number(69)), NIL)), 1.0 / 69.0);
} }
END_TEST END_TEST
START_TEST(div_many_args_test) { START_TEST(div_many_args_test) {
ck_assert_double_eq(NUMBER(div_fn(LIST(number(69), number(420)))), 69.0 / 420.0); ck_assert_double_eq(NUMBER(div_fn(LIST(number(69), number(420)), NIL)), 69.0 / 420.0);
} }
END_TEST END_TEST
START_TEST(pow_test) { START_TEST(pow_test) {
ck_assert_double_eq(NUMBER(pow_fn(LIST(number(69), number(3)))), pow(69.0, 3.0)); ck_assert_double_eq(NUMBER(pow_fn(LIST(number(69), number(3)), NIL)), pow(69.0, 3.0));
} }
END_TEST END_TEST
START_TEST(sqrt_test) { START_TEST(sqrt_test) {
ck_assert_double_eq(NUMBER(sqrt_fn(LIST(number(69)))), sqrt(69.0)); ck_assert_double_eq(NUMBER(sqrt_fn(LIST(number(69)), NIL)), sqrt(69.0));
} }
END_TEST END_TEST
START_TEST(logand_zero_args_test) { START_TEST(logand_zero_args_test) {
ck_assert_double_eq(NUMBER(logand_fn(NIL)), -1l); ck_assert_double_eq(NUMBER(logand_fn(NIL, NIL)), -1l);
} }
END_TEST END_TEST
START_TEST(logand_one_args_test) { START_TEST(logand_one_args_test) {
ck_assert_double_eq(NUMBER(logand_fn(LIST(number(69)))), -1l & 69l); ck_assert_double_eq(NUMBER(logand_fn(LIST(number(69)), NIL)), -1l & 69l);
} }
END_TEST END_TEST
START_TEST(logand_many_args_test) { START_TEST(logand_many_args_test) {
ck_assert_double_eq(NUMBER(logand_fn(LIST(number(69), number(420)))), 69l & 420l); ck_assert_double_eq(NUMBER(logand_fn(LIST(number(69), number(420)), NIL)), 69l & 420l);
} }
END_TEST END_TEST
START_TEST(logor_zero_args_test) { START_TEST(logor_zero_args_test) {
ck_assert_double_eq(NUMBER(logor_fn(NIL)), 0l); ck_assert_double_eq(NUMBER(logor_fn(NIL, NIL)), 0l);
} }
END_TEST END_TEST
START_TEST(logor_one_args_test) { START_TEST(logor_one_args_test) {
ck_assert_double_eq(NUMBER(logor_fn(LIST(number(69)))), 0l | 69l); ck_assert_double_eq(NUMBER(logor_fn(LIST(number(69)), NIL)), 0l | 69l);
} }
END_TEST END_TEST
START_TEST(logor_many_args_test) { START_TEST(logor_many_args_test) {
ck_assert_double_eq(NUMBER(logor_fn(LIST(number(69), number(420)))), 69l | 420l); ck_assert_double_eq(NUMBER(logor_fn(LIST(number(69), number(420)), NIL)), 69l | 420l);
} }
END_TEST END_TEST
START_TEST(logxor_zero_args_test) { START_TEST(logxor_zero_args_test) {
ck_assert_double_eq(NUMBER(logxor_fn(NIL)), 0l); ck_assert_double_eq(NUMBER(logxor_fn(NIL, NIL)), 0l);
} }
END_TEST END_TEST
START_TEST(logxor_one_args_test) { START_TEST(logxor_one_args_test) {
ck_assert_double_eq(NUMBER(logxor_fn(LIST(number(69)))), 0l ^ 69l); ck_assert_double_eq(NUMBER(logxor_fn(LIST(number(69)), NIL)), 0l ^ 69l);
} }
END_TEST END_TEST
START_TEST(logxor_many_args_test) { START_TEST(logxor_many_args_test) {
ck_assert_double_eq(NUMBER(logxor_fn(LIST(number(69), number(420)))), 69l ^ 420l); ck_assert_double_eq(NUMBER(logxor_fn(LIST(number(69), number(420)), NIL)), 69l ^ 420l);
} }
END_TEST END_TEST
START_TEST(lognot_zero_args_test) { START_TEST(lognot_zero_args_test) {
ck_assert_double_eq(lognot_fn(NIL), UNDEFINED); ck_assert_double_eq(lognot_fn(NIL, NIL), UNDEFINED);
} }
END_TEST END_TEST
START_TEST(lognot_one_args_test) { START_TEST(lognot_one_args_test) {
ck_assert_double_eq(NUMBER(lognot_fn(LIST(number(69)))), ~69l); ck_assert_double_eq(NUMBER(lognot_fn(LIST(number(69)), NIL)), ~69l);
} }
END_TEST END_TEST
@ -179,8 +179,8 @@ START_TEST(or_test) {
END_TEST END_TEST
START_TEST(not_test) { START_TEST(not_test) {
ck_assert_double_eq(not_fn(LIST(NIL)), T); ck_assert_double_eq(not_fn(LIST(NIL), NIL), T);
ck_assert_uint_eq(not_fn(LIST(T)), NIL); ck_assert_uint_eq(not_fn(LIST(T), NIL), NIL);
} }
END_TEST END_TEST

2
implementations/c/tests/reader-test.c

@ -56,7 +56,7 @@ START_TEST(set_reader_macro_test) {
} END_TEST } END_TEST
START_TEST(set_reader_macro_fn_test) { START_TEST(set_reader_macro_fn_test) {
ck_assert_uint_eq(set_reader_macro_fn(LIST(69, 420)), T); ck_assert_uint_eq(set_reader_macro_fn(LIST(69, 420), NIL), T);
/* ck_assert_uint_eq(table_get(READTABLE, 69), 420); */ /* ck_assert_uint_eq(table_get(READTABLE, 69), 420); */
} END_TEST } END_TEST

Loading…
Cancel
Save