felix/slime
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

everything broke, we'll make cMacros now

Browse Source
This commit is contained in:
fumfar hiwi
2020-01-15 14:28:06 +01:00
parent b83a479533
commit f12994cbfe
11 changed files with 636 additions and 638 deletions
Download Patch File Download Diff File Expand all files Collapse all files
bin/tests/sicp.slime
+192 -193
View File
@@ -1,9 +1,9 @@
(define (abs x) ;; (define (abs x)
(cond ((< x 0) (- x)) ;; (cond ((< x 0) (- x))
(else x))) ;; (else x)))
(assert (= (abs 1) 1)) ;; (assert (= (abs 1) 1))
(assert (= (abs (- 2)) 2)) ;; (assert (= (abs (- 2)) 2))
(define (abs x) (define (abs x)
@@ -11,113 +11,113 @@
(- x) (- x)
x)) x))
(assert (= (abs 12) 12)) ;; (assert (= (abs 12) 12))
(assert (= (abs (- 32)) 32)) ;; (assert (= (abs (- 32)) 32))
(define (>= x y) ;; (define (>= x y)
(or (> x y) ;; (or (> x y)
(= x y))) ;; (= x y)))
(assert (>= 2 2)) ;; (assert (>= 2 2))
(assert (>= 3 2)) ;; (assert (>= 3 2))
(assert (not (>= 1 2))) ;; (assert (not (>= 1 2)))
(assert (not (>= 12 44))) ;; (assert (not (>= 12 44)))
(define (>= x y) ;; (define (>= x y)
(not (< x y))) ;; (not (< x y)))
(assert (>= 2 2)) ;; (assert (>= 2 2))
(assert (>= 3 2)) ;; (assert (>= 3 2))
(assert (not (>= 1 2))) ;; (assert (not (>= 1 2)))
(assert (not (>= 12 44))) ;; (assert (not (>= 12 44)))
(define (a-plus-abs-b a b) ;; (define (a-plus-abs-b a b)
((if (> b 0) + -) a b)) ;; ((if (> b 0) + -) a b))
(assert (= (a-plus-abs-b 1 2) 3)) ;; (assert (= (a-plus-abs-b 1 2) 3))
(assert (= (a-plus-abs-b 1 -2) 3)) ;; (assert (= (a-plus-abs-b 1 -2) 3))
(define (square x) (* x x)) (define (square x) (* x x))
(define (cube x) (* x x x)) (define (cube x) (* x x x))
(assert (= ((lambda (x y z) ;; (assert (= ((lambda (x y z)
(+ x y (square z))) ;; (+ x y (square z)))
1 2 3) ;; 1 2 3)
12)) ;; 12))
;;; -------------------- ;; ;;; --------------------
;;; newtons method ;; ;;; newtons method
;;; -------------------- ;; ;;; --------------------
(define tolerance 0.001) ;; (define tolerance 0.001)
(define (square x) ;; (define (square x)
(* x x)) ;; (* x x))
(define (average x y) (define (average x y)
(/ (+ x y) 2)) (/ (+ x y) 2))
(define (improve guess x) ;; (define (improve guess x)
(average guess (/ x guess))) ;; (average guess (/ x guess)))
(define (good-enough? guess x) ;; (define (good-enough? guess x)
(< (abs (- (square guess) x)) tolerance)) ;; (< (abs (- (square guess) x)) tolerance))
(define (sqrt-iter guess x) ;; (define (sqrt-iter guess x)
(if (good-enough? guess x) ;; (if (good-enough? guess x)
guess ;; guess
(sqrt-iter (improve guess x) x))) ;; (sqrt-iter (improve guess x) x)))
(define (sqrt x) ;; (define (sqrt x)
(sqrt-iter 1.0 x)) ;; (sqrt-iter 1.0 x))
(define (sqrt2 x) ;; (define (sqrt2 x)
(define (good-enough? guess x) ;; (define (good-enough? guess x)
(< (abs (- (square guess) x)) 0.001)) ;; (< (abs (- (square guess) x)) 0.001))
(define (improve guess x) ;; (define (improve guess x)
(average guess (/ x guess))) ;; (average guess (/ x guess)))
(define (sqrt-iter guess x) ;; (define (sqrt-iter guess x)
(if (good-enough? guess x) ;; (if (good-enough? guess x)
guess ;; guess
(sqrt-iter (improve guess x) x))) ;; (sqrt-iter (improve guess x) x)))
(sqrt-iter 1.0 x)) ;; (sqrt-iter 1.0 x))
(define (sqrt3 x) ;; (define (sqrt3 x)
(define (good-enough? guess) ;; (define (good-enough? guess)
(< (abs (- (square guess) x)) 0.001)) ;; (< (abs (- (square guess) x)) 0.001))
(define (improve guess) ;; (define (improve guess)
(average guess (/ x guess))) ;; (average guess (/ x guess)))
(define (sqrt-iter guess) ;; (define (sqrt-iter guess)
(if (good-enough? guess) ;; (if (good-enough? guess)
guess ;; guess
(sqrt-iter (improve guess)))) ;; (sqrt-iter (improve guess))))
(sqrt-iter 1.0)) ;; (sqrt-iter 1.0))
(assert (< (abs (- 3 (sqrt 9))) tolerance)) ;; (assert (< (abs (- 3 (sqrt 9))) tolerance))
(assert (< (abs (- 4 (sqrt 16))) tolerance)) ;; (assert (< (abs (- 4 (sqrt 16))) tolerance))
(assert (not (< (abs (- 4 (sqrt 15))) tolerance))) ;; (assert (not (< (abs (- 4 (sqrt 15))) tolerance)))
(assert (< (abs (- 3 (sqrt2 9))) tolerance)) ;; (assert (< (abs (- 3 (sqrt2 9))) tolerance))
(assert (< (abs (- 4 (sqrt2 16))) tolerance)) ;; (assert (< (abs (- 4 (sqrt2 16))) tolerance))
(assert (not (< (abs (- 4 (sqrt2 15))) tolerance))) ;; (assert (not (< (abs (- 4 (sqrt2 15))) tolerance)))
(assert (< (abs (- 3 (sqrt3 9))) tolerance)) ;; (assert (< (abs (- 3 (sqrt3 9))) tolerance))
(assert (< (abs (- 4 (sqrt3 16))) tolerance)) ;; (assert (< (abs (- 4 (sqrt3 16))) tolerance))
(assert (not (< (abs (- 4 (sqrt3 15))) tolerance))) ;; (assert (not (< (abs (- 4 (sqrt3 15))) tolerance)))
;;; ----------------- ;; ;;; -----------------
;;; factorial ;; ;;; factorial
;;; ----------------- ;; ;;; -----------------
(define (factorial n) (define (factorial n)
(if (= n 1) (if (= n 1)
@@ -158,45 +158,45 @@
(assert (= (A 3 1) 13)) (assert (= (A 3 1) 13))
;;; --------------- ;; ;;; ---------------
;;; Fibonacci ;; ;;; Fibonacci
;;; --------------- ;; ;;; ---------------
(define (fib n) ;; (define (fib n)
(cond ((= n 0) 0) ;; (cond ((= n 0) 0)
((= n 1) 1) ;; ((= n 1) 1)
(else (+ (fib (- n 1)) (fib (- n 2)))))) ;; (else (+ (fib (- n 1)) (fib (- n 2))))))
(define (fib2 n) ;; (define (fib2 n)
(fib-iter 1 0 n)) ;; (fib-iter 1 0 n))
(define (fib-iter a b count) ;; (define (fib-iter a b count)
(if (= count 0) ;; (if (= count 0)
b ;; b
(fib-iter (+ a b) a (- count 1)))) ;; (fib-iter (+ a b) a (- count 1))))
(assert (= (fib 2) 1)) ;; (assert (= (fib 2) 1))
(assert (= (fib 3) 2)) ;; (assert (= (fib 3) 2))
(assert (= (fib 4) 3)) ;; (assert (= (fib 4) 3))
(assert (= (fib 5) 5)) ;; (assert (= (fib 5) 5))
(assert (= (fib 6) 8)) ;; (assert (= (fib 6) 8))
(assert (= (fib2 2) 1)) ;; (assert (= (fib2 2) 1))
(assert (= (fib2 3) 2)) ;; (assert (= (fib2 3) 2))
(assert (= (fib2 4) 3)) ;; (assert (= (fib2 4) 3))
(assert (= (fib2 5) 5)) ;; (assert (= (fib2 5) 5))
(assert (= (fib2 6) 8)) ;; (assert (= (fib2 6) 8))
;;; ------------------ ;; ;;; ------------------
;;; count change ;; ;;; count change
;;; ------------------ ;; ;;; ------------------
;; (define (count-change amount) ;; (define (count-change amount)
;; (define (cc amount kinds-of-coins) ;; (define (cc amount kinds-of-coins)
;; (cond ((= amount 0) 1) ;; (cond ((= amount 0) 1)
;; ((or (< amount 0) (= kinds-of-coins 0)) 0) ;; ((or (< amount 0) (= kinds-of-coins 0)) 0)
;; (else (+ (cc amount (- kinds-of-coins 1)) ;; (else (+ (cc amount (- kinds-of-coins 1))
;; (cc (- amount (first-denomination kinds-of-coins)) kinds-of-coins))))) ;; (cc (- amount (first-denomination kinds-of-coins)) kinds-of-coins)))))
;; (define (first-denomination kinds-of-coins) ;; (define (first-denomination kinds-of-coins)
;; (cond ((= kinds-of-coins 1) 1) ;; (cond ((= kinds-of-coins 1) 1)
@@ -209,133 +209,132 @@
;; (assert (= (count-change 100) 292)) ;; (assert (= (count-change 100) 292))
;;; -------------------- ;; ;;; --------------------
;;; exponentiation ;; ;;; exponentiation
;;; -------------------- ;; ;;; --------------------
(define (expt b n) ;; (define (expt b n)
(if (= n 0) ;; (if (= n 0)
1 ;; 1
(* b (expt b (- n 1))))) ;; (* b (expt b (- n 1)))))
(define (expt2 b n) ;; (define (expt2 b n)
(define (expt-iter b counter product) ;; (define (expt-iter b counter product)
(if (= counter 0) ;; (if (= counter 0)
product ;; product
(expt-iter b (- counter 1) (* b product)))) ;; (expt-iter b (- counter 1) (* b product))))
(expt-iter b n 1)) ;; (expt-iter b n 1))
(define (fast-expt b n) ;; (define (fast-expt b n)
(define (even? n) ;; (define (even? n)
(= (% n 2) 0)) ;; (= (% n 2) 0))
(cond ((= n 0) 1) ;; (cond ((= n 0) 1)
((even? n) (square (fast-expt b (/ n 2)))) ;; ((even? n) (square (fast-expt b (/ n 2))))
(else (* b (fast-expt b (- n 1)))))) ;; (else (* b (fast-expt b (- n 1))))))
(assert (= (expt 1 2) 1)) ;; (assert (= (expt 1 2) 1))
(assert (= (expt 2 2) 4)) ;; (assert (= (expt 2 2) 4))
(assert (= (expt 2 3) 8)) ;; (assert (= (expt 2 3) 8))
(assert (= (expt2 1 2) 1)) ;; (assert (= (expt2 1 2) 1))
(assert (= (expt2 2 2) 4)) ;; (assert (= (expt2 2 2) 4))
(assert (= (expt2 2 3) 8)) ;; (assert (= (expt2 2 3) 8))
(assert (= (fast-expt 1 2) 1)) ;; (assert (= (fast-expt 1 2) 1))
(assert (= (fast-expt 2 2) 4)) ;; (assert (= (fast-expt 2 2) 4))
(assert (= (fast-expt 2 3) 8)) ;; (assert (= (fast-expt 2 3) 8))
;;; ---------- ;; ;;; ----------
;;; gcd ;; ;;; gcd
;;; ---------- ;; ;;; ----------
(define (gcd a b) ;; (define (gcd a b)
(if (= b 0) ;; (if (= b 0)
a ;; a
(gcd b (% a b)))) ;; (gcd b (% a b))))
(assert (= (gcd 40 6) 2)) ;; (assert (= (gcd 40 6) 2))
(assert (= (gcd 13 4) 1)) ;; (assert (= (gcd 13 4) 1))
;;; ---------- ;; ;;; ----------
;;; primes ;; ;;; primes
;;; ---------- ;; ;;; ----------
(define (smallest-divisor n) ;; (define (smallest-divisor n)
(find-divisor n 2)) ;; (find-divisor n 2))
(define (find-divisor n test-divisor) ;; (define (find-divisor n test-divisor)
(cond ((> (square test-divisor) n) n) ;; (cond ((> (square test-divisor) n) n)
((divides? test-divisor n) test-divisor) ;; ((divides? test-divisor n) test-divisor)
(else (find-divisor n (+ test-divisor 1))))) ;; (else (find-divisor n (+ test-divisor 1)))))
(define (divides? a b) ;; (define (divides? a b)
(= (% b a) 0)) ;; (= (% b a) 0))
(define (prime? n) ;; (define (prime? n)
(= n (smallest-divisor n))) ;; (= n (smallest-divisor n)))
(assert (prime? 13)) ;; (assert (prime? 13))
(assert (prime? 11)) ;; (assert (prime? 11))
(assert (not (prime? 12))) ;; (assert (not (prime? 12)))
;;; ---------------------- ;;; ----------------------
;;; simple integral ;;; simple integral
;;; ---------------------- ;;; ----------------------
(define (sum term a next b) ;; (define (sum term a next b)
(if (> a b) ;; (if (> a b)
0 ;; 0
(+ (term a) (sum term (next a) next b)))) ;; (+ (term a) (sum term (next a) next b))))
(define (integral f a b dx) ;; (define (integral f a b dx)
(define (add-dx x) (+ x dx)) ;; (define (add-dx x) (+ x dx))
(* (sum f (+ a (/ dx 2.0)) add-dx b) dx)) ;; (* (sum f (+ a (/ dx 2.0)) add-dx b) dx))
(define (pi-sum a b) ;; (define (pi-sum a b)
(define (pi-term x) (/ 1.0 (* x (+ x 2)))) ;; (define (pi-term x) (/ 1.0 (* x (+ x 2))))
(define (pi-next x) (+ x 4)) ;; (define (pi-next x) (+ x 4))
(sum pi-term a pi-next b)) ;; (sum pi-term a pi-next b))
(assert (< (abs (- (* 8 (pi-sum 1 100)) 3.121595)) 0.0001)) ;; (assert (< (abs (- (* 8 (pi-sum 1 100)) 3.121595)) 0.0001))
(assert (< (abs (- (integral cube 0 1 0.02) 0.249950)) 0.0001)) ;; (assert (< (abs (- (integral cube 0 1 0.02) 0.249950)) 0.0001))
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
;; F(x,y) = x(1 + xy)^2 + y(1 − y) + (1 + xy)(1 − y) ;; F(x,y) = x(1 + xy)^2 + y(1 − y) + (1 + xy)(1 − y)
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
(define (f x y) ;; (define (f x y)
(let ((a (+ 1 (* x y))) ;; (let ((a (+ 1 (* x y)))
(b (- 1 y))) ;; (b (- 1 y)))
(+ (* x (square a)) ;; (+ (* x (square a))
(* y b) ;; (* y b)
(* a b)))) ;; (* a b))))
(assert (= (f 0 0) 1)) ;; (assert (= (f 0 0) 1))
(assert (= (f 1 1) 4)) ;; (assert (= (f 1 1) 4))
;;; --------------- ;; ;;; ---------------
;;; find zero ;; ;;; find zero
;;; --------------- ;; ;;; ---------------
(define (positive? x) (< 0 x)) ;; (define (positive? x) (< 0 x))
(define (negative? x) (< x 0)) ;; (define (negative? x) (< x 0))
(define (search f neg-point pos-point) ;; (define (search f neg-point pos-point)
(let ((midpoint (average neg-point pos-point))) ;; (let ((midpoint (average neg-point pos-point)))
(if (close-enough? neg-point pos-point) ;; (if (close-enough? neg-point pos-point)
midpoint ;; midpoint
(let ((test-value (f midpoint))) ;; (let ((test-value (f midpoint)))
(cond ((positive? test-value) (search f neg-point midpoint)) ;; (cond ((positive? test-value) (search f neg-point midpoint))
((negative? test-value) (search f midpoint pos-point)) ;; ((negative? test-value) (search f midpoint pos-point))
(else midpoint)))))) ;; (else midpoint))))))
(define (close-enough? x y) (< (abs (- x y)) 0.001)) ;; (define (close-enough? x y) (< (abs (- x y)) 0.001))
(assert (close-enough? (search (lambda (x) (- 1 (square x))) -3 3) -1))
;; (assert (close-enough? (search (lambda (x) (- 1 (square x))) -3 3) -1))
build.bat
+2 -2
View File
@@ -7,7 +7,7 @@ set exeName=slime.exe
taskkill /F /IM %exeName% > NUL 2> NUL taskkill /F /IM %exeName% > NUL 2> NUL
echo ---------- Compiling ---------- echo ---------- Compiling ----------
call timecmd cl ^ call cl ^
../src/main.cpp^ ../src/main.cpp^
/I../3rd/ ^ /I../3rd/ ^
/D_PROFILING /D_DEBUG ^ /D_PROFILING /D_DEBUG ^
@@ -25,7 +25,7 @@ if %errorlevel% == 0 (
echo. echo.
echo ---- Running Tests ---- echo ---- Running Tests ----
echo. echo.
call timecmd slime.exe --run-tests call slime.exe --run-tests
) else ( ) else (
echo. echo.
echo Fuckin' ell echo Fuckin' ell
src/eval.cpp
+351 -363
View File
@@ -10,22 +10,14 @@ namespace Slime {
{ {
profile_this(); profile_this();
bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction; bool is_c_function = function->value.function->is_c;
Environment* new_env; Environment* new_env = Memory::create_child_environment(function->value.function->parent_environment);
Arguments* arg_spec; Arguments* arg_spec = &function->value.function->args;
// NOTE(Felix): Step 1. // NOTE(Felix): Step 1.
// - setting the parent environment // - setting the parent environment
// - setting the arg_spec // - setting the arg_spec
// - potentially evaluating the arguments // - potentially evaluating the arguments
if (is_c_function) {
new_env = Memory::create_child_environment(get_root_environment());
arg_spec = &function->value.cFunction->args;
} else {
new_env = Memory::create_child_environment(function->value.function->parent_environment);
arg_spec = &function->value.function->args;
}
if (arg_count == 0) { if (arg_count == 0) {
return new_env; return new_env;
} }
@@ -145,7 +137,8 @@ namespace Slime {
} }
// if not set it and then add it to the array list // if not set it and then add it to the array list
try_void sym = Memory::get_symbol(next_arg->value.symbol); Lisp_Object* key = next_arg;
try_void sym = Memory::get_symbol(key->value.symbol);
next_arg = cs->data[++arg_start]; next_arg = cs->data[++arg_start];
--arg_count; --arg_count;
@@ -157,7 +150,7 @@ namespace Slime {
Memory::copy_lisp_object_except_pairs(next_arg)); Memory::copy_lisp_object_except_pairs(next_arg));
} }
read_in_keywords.append(next_arg); read_in_keywords.append(key);
++read_obligatory_keywords_count; ++read_obligatory_keywords_count;
// overstep both for next one // overstep both for next one
@@ -243,256 +236,257 @@ namespace Slime {
return new_env; return new_env;
} }
proc create_extended_environment_for_function_application(
Lisp_Object* unevaluated_arguments,
Lisp_Object* function,
bool should_evaluate) -> Environment*
{
profile_this();
bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
Environment* new_env;
Lisp_Object* arguments = unevaluated_arguments;
Arguments* arg_spec;
// NOTE(Felix): Step 1. // proc create_extended_environment_for_function_application(
// - setting the parent environment // Lisp_Object* unevaluated_arguments,
// - setting the arg_spec // Lisp_Object* function,
// - potentially evaluating the arguments // bool should_evaluate) -> Environment*
if (is_c_function) { // {
new_env = Memory::create_child_environment(get_root_environment()); // profile_this();
arg_spec = &function->value.cFunction->args; // bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
} else { // Environment* new_env;
new_env = Memory::create_child_environment(function->value.function->parent_environment); // Lisp_Object* arguments = unevaluated_arguments;
arg_spec = &function->value.function->args; // Arguments* arg_spec;
}
if (should_evaluate) {
try arguments = eval_arguments(arguments);
}
// NOTE(Felix): Even though we will return the environment at the // // NOTE(Felix): Step 1.
// end, for defining symbols here for the parameters, it has to be // // - setting the parent environment
// on the envi stack. // // - setting the arg_spec
push_environment(new_env); // // - potentially evaluating the arguments
defer { // if (is_c_function) {
pop_environment(); // new_env = Memory::create_child_environment(get_root_environment());
}; // arg_spec = &function->value.cFunction->args;
// } else {
// new_env = Memory::create_child_environment(function->value.function->parent_environment);
// arg_spec = &function->value.function->args;
// }
// if (should_evaluate) {
// try arguments = eval_arguments(arguments);
// }
// // NOTE(Felix): Even though we will return the environment at the
// // end, for defining symbols here for the parameters, it has to be
// // on the envi stack.
// push_environment(new_env);
// defer {
// pop_environment();
// };
// NOTE(Felix): Step 2. // // NOTE(Felix): Step 2.
// Reading the argument spec and fill in the environment // // Reading the argument spec and fill in the environment
// for the function call // // for the function call
Lisp_Object* sym, *val; // used as temp storage to use `try` // Lisp_Object* sym, *val; // used as temp storage to use `try`
Array_List<Lisp_Object*> read_in_keywords; // Array_List<Lisp_Object*> read_in_keywords;
read_in_keywords.alloc(); // read_in_keywords.alloc();
defer { // defer {
read_in_keywords.dealloc(); // read_in_keywords.dealloc();
}; // };
int obligatory_keywords_count = 0; // int obligatory_keywords_count = 0;
int read_obligatory_keywords_count = 0; // int read_obligatory_keywords_count = 0;
proc read_positional_args = [&]() -> void { // proc read_positional_args = [&]() -> void {
for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) { // for (int i = 0; i < arg_spec->positional.symbols.next_index; ++i) {
if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) { // if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
create_parsing_error("Wrong number of arguments."); // create_parsing_error("Wrong number of arguments.");
return; // return;
} // }
// NOTE(Felix): We have to copy all the arguments, // // NOTE(Felix): We have to copy all the arguments,
// otherwise we change the program code. XXX(Felix): T C // // otherwise we change the program code. XXX(Felix): T C
// functions we pass by reference... // // functions we pass by reference...
sym = arg_spec->positional.symbols.data[i]; // sym = arg_spec->positional.symbols.data[i];
if (is_c_function) { // if (is_c_function) {
define_symbol(sym, arguments->value.pair.first); // define_symbol(sym, arguments->value.pair.first);
} else { // } else {
define_symbol( // define_symbol(
sym, // sym,
Memory::copy_lisp_object_except_pairs(arguments->value.pair.first)); // Memory::copy_lisp_object_except_pairs(arguments->value.pair.first));
} // }
arguments = arguments->value.pair.rest; // arguments = arguments->value.pair.rest;
} // }
}; // };
proc read_keyword_args = [&]() -> void { // proc read_keyword_args = [&]() -> void {
// keyword arguments: use all given ones and keep track of the // // keyword arguments: use all given ones and keep track of the
// added ones (array list), if end of parameters in encountered or // // added ones (array list), if end of parameters in encountered or
// something that is not a keyword is encountered or a keyword // // something that is not a keyword is encountered or a keyword
// that is not recognized is encoutered, jump out of the loop. // // that is not recognized is encoutered, jump out of the loop.
if (arguments == Memory::nil) // if (arguments == Memory::nil)
return; // return;
// find out how many keyword args we /have/ to read // // find out how many keyword args we /have/ to read
for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { // for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) {
if (arg_spec->keyword.values.data[i] == nullptr) // if (arg_spec->keyword.values.data[i] == nullptr)
++obligatory_keywords_count; // ++obligatory_keywords_count;
else // else
break; // break;
} // }
while (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) { // while (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
// check if this one is even an accepted keyword // // check if this one is even an accepted keyword
bool accepted = false; // bool accepted = false;
for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { // for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) {
if (arguments->value.pair.first == arg_spec->keyword.keywords.data[i]) // if (arguments->value.pair.first == arg_spec->keyword.keywords.data[i])
{ // {
accepted = true; // accepted = true;
break; // break;
} // }
} // }
if (!accepted) { // if (!accepted) {
// NOTE(Felix): if we are actually done with all the // // NOTE(Felix): if we are actually done with all the
// necessary keywords then we have to count the rest // // necessary keywords then we have to count the rest
// as :rest here, instead od always creating an error // // as :rest here, instead od always creating an error
// (special case with default variables) // // (special case with default variables)
if (read_obligatory_keywords_count == obligatory_keywords_count) // if (read_obligatory_keywords_count == obligatory_keywords_count)
return; // return;
create_generic_error( // create_generic_error(
"The function does not take the keyword argument ':%s'\n" // "The function does not take the keyword argument ':%s'\n"
"and not all required keyword arguments have been read\n" // "and not all required keyword arguments have been read\n"
"in to potentially count it as the rest argument.", // "in to potentially count it as the rest argument.",
&(arguments->value.pair.first->value.symbol->data)); // &(arguments->value.pair.first->value.symbol->data));
return; // return;
} // }
// check if it was already read in // // check if it was already read in
for (int i = 0; i < read_in_keywords.next_index; ++i) { // for (int i = 0; i < read_in_keywords.next_index; ++i) {
if (arguments->value.pair.first == read_in_keywords.data[i]) // if (arguments->value.pair.first == read_in_keywords.data[i])
{ // {
// NOTE(Felix): if we are actually done with all the // // NOTE(Felix): if we are actually done with all the
// necessary keywords then we have to count the rest // // necessary keywords then we have to count the rest
// as :rest here, instead od always creating an error // // as :rest here, instead od always creating an error
// (special case with default variables) // // (special case with default variables)
if (read_obligatory_keywords_count == obligatory_keywords_count) // if (read_obligatory_keywords_count == obligatory_keywords_count)
return; // return;
create_generic_error( // create_generic_error(
"The function already read the keyword argument ':%s'", // "The function already read the keyword argument ':%s'",
&(arguments->value.pair.first->value.symbol->data)); // &(arguments->value.pair.first->value.symbol->data));
return; // return;
} // }
} // }
// okay so we found a keyword that has to be read in and was // // okay so we found a keyword that has to be read in and was
// not already read in, is there a next element to actually // // not already read in, is there a next element to actually
// set it to? // // set it to?
if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) { // if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) {
create_generic_error( // create_generic_error(
"Attempting to set the keyword argument ':%s', but no value was supplied.", // "Attempting to set the keyword argument ':%s', but no value was supplied.",
&(arguments->value.pair.first->value.symbol->data)); // &(arguments->value.pair.first->value.symbol->data));
return; // return;
} // }
// if not set it and then add it to the array list // // if not set it and then add it to the array list
try_void sym = Memory::get_symbol(arguments->value.pair.first->value.symbol); // try_void sym = Memory::get_symbol(arguments->value.pair.first->value.symbol);
// NOTE(Felix): It seems we do not need to evaluate the argument here... // // NOTE(Felix): It seems we do not need to evaluate the argument here...
if (is_c_function) { // if (is_c_function) {
try_void define_symbol(sym, arguments->value.pair.rest->value.pair.first); // try_void define_symbol(sym, arguments->value.pair.rest->value.pair.first);
} else { // } else {
try_void define_symbol( // try_void define_symbol(
sym, // sym,
Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first)); // Memory::copy_lisp_object_except_pairs(arguments->value.pair.rest->value.pair.first));
} // }
read_in_keywords.append(arguments->value.pair.first); // read_in_keywords.append(arguments->value.pair.first);
++read_obligatory_keywords_count; // ++read_obligatory_keywords_count;
// overstep both for next one // // overstep both for next one
arguments = arguments->value.pair.rest->value.pair.rest; // arguments = arguments->value.pair.rest->value.pair.rest;
if (arguments == Memory::nil) { // if (arguments == Memory::nil) {
break; // break;
} // }
} // }
}; // };
proc check_keyword_args = [&]() -> void { // proc check_keyword_args = [&]() -> void {
// check if all necessary keywords have been read in // // check if all necessary keywords have been read in
for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) { // for (int i = 0; i < arg_spec->keyword.values.next_index; ++i) {
auto defined_keyword = arg_spec->keyword.keywords.data[i]; // auto defined_keyword = arg_spec->keyword.keywords.data[i];
bool was_set = false; // bool was_set = false;
for (int j = 0; j < read_in_keywords.next_index; ++j) { // for (int j = 0; j < read_in_keywords.next_index; ++j) {
if (read_in_keywords.data[j] == defined_keyword) { // if (read_in_keywords.data[j] == defined_keyword) {
was_set = true; // was_set = true;
break; // break;
} // }
} // }
if (arg_spec->keyword.values.data[i] == nullptr) { // if (arg_spec->keyword.values.data[i] == nullptr) {
// if this one does not have a default value // // if this one does not have a default value
if (!was_set) { // if (!was_set) {
create_generic_error( // create_generic_error(
"There was no value supplied for the required " // "There was no value supplied for the required "
"keyword argument ':%s'.", // "keyword argument ':%s'.",
&defined_keyword->value.symbol->data); // &defined_keyword->value.symbol->data);
return; // return;
} // }
} else { // } else {
// this one does have a default value, lets see if we have // // this one does have a default value, lets see if we have
// to use it or if the user supplied his own // // to use it or if the user supplied his own
if (!was_set) { // if (!was_set) {
try_void sym = Memory::get_symbol(defined_keyword->value.symbol); // try_void sym = Memory::get_symbol(defined_keyword->value.symbol);
if (is_c_function) { // if (is_c_function) {
try_void val = arg_spec->keyword.values.data[i]; // try_void val = arg_spec->keyword.values.data[i];
} else { // } else {
try_void val = Memory::copy_lisp_object_except_pairs(arg_spec->keyword.values.data[i]); // try_void val = Memory::copy_lisp_object_except_pairs(arg_spec->keyword.values.data[i]);
} // }
define_symbol(sym, val); // define_symbol(sym, val);
} // }
} // }
} // }
}; // };
proc read_rest_arg = [&]() -> void { // proc read_rest_arg = [&]() -> void {
if (arguments == Memory::nil) { // if (arguments == Memory::nil) {
if (arg_spec->rest) { // if (arg_spec->rest) {
define_symbol(arg_spec->rest, Memory::nil); // define_symbol(arg_spec->rest, Memory::nil);
} // }
} else { // } else {
if (arg_spec->rest) { // if (arg_spec->rest) {
define_symbol( // define_symbol(
arg_spec->rest, // arg_spec->rest,
// NOTE(Felix): arguments will be a list, and I THINK // // NOTE(Felix): arguments will be a list, and I THINK
// we do not need to copy it... // // we do not need to copy it...
arguments); // arguments);
} else { // } else {
// rest was not declared but additional arguments were found // // rest was not declared but additional arguments were found
create_generic_error( // create_generic_error(
"A rest argument was not declared " // "A rest argument was not declared "
"but the function was called with additional arguments."); // "but the function was called with additional arguments.");
return; // return;
} // }
} // }
}; // };
try read_positional_args(); // try read_positional_args();
try read_keyword_args(); // try read_keyword_args();
try check_keyword_args(); // try check_keyword_args();
try read_rest_arg(); // try read_rest_arg();
return new_env; // return new_env;
} // }
proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* { // proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function, bool should_evaluate_args) -> Lisp_Object* {
profile_this(); // profile_this();
Environment* new_env; // Environment* new_env;
Lisp_Object* result; // Lisp_Object* result;
try new_env = create_extended_environment_for_function_application(arguments, function, should_evaluate_args); // try new_env = create_extended_environment_for_function_application(arguments, function, should_evaluate_args);
push_environment(new_env); // push_environment(new_env);
defer { // defer {
pop_environment(); // pop_environment();
}; // };
if (Memory::get_type(function) == Lisp_Object_Type::CFunction) // if (Memory::get_type(function) == Lisp_Object_Type::CFunction)
// if c function: // // if c function:
try result = function->value.cFunction->body(); // try result = function->value.cFunction->body();
else // else
// if lisp function // // if lisp function
try result = eval_expr(function->value.function->body); // try result = eval_expr(function->value.function->body);
return result; // return result;
} // }
proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void { proc create_arguments_from_lambda_list_and_inject(Lisp_Object* arguments, Lisp_Object* function) -> void {
/* NOTE This parses the argument specification of funcitons /* NOTE This parses the argument specification of funcitons
@@ -500,12 +494,7 @@ namespace Slime {
* positional_arguments, keyword_arguments and rest_argument * positional_arguments, keyword_arguments and rest_argument
* and filling it in * and filling it in
*/ */
Arguments* result; Arguments* result = &function->value.function->args;;
if (Memory::get_type(function) == Lisp_Object_Type::CFunction) {
result = &function->value.cFunction->args;
} else {
result = &function->value.function->args;
}
// first init the fields // first init the fields
result->rest = nullptr; result->rest = nullptr;
@@ -604,41 +593,41 @@ namespace Slime {
return nullptr; return nullptr;
} }
proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* { // proc eval_arguments(Lisp_Object* arguments) -> Lisp_Object* {
profile_this(); // profile_this();
// int my_out_arguments_length = 0; // // int my_out_arguments_length = 0;
if (arguments == Memory::nil) { // if (arguments == Memory::nil) {
// *(out_arguments_length) = 0; // // *(out_arguments_length) = 0;
return arguments; // return arguments;
} // }
Lisp_Object* evaluated_arguments; // Lisp_Object* evaluated_arguments;
try evaluated_arguments = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); // try evaluated_arguments = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
Lisp_Object* evaluated_arguments_head = evaluated_arguments; // Lisp_Object* evaluated_arguments_head = evaluated_arguments;
Lisp_Object* current_head = arguments; // Lisp_Object* current_head = arguments;
while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { // while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first); // try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first);
evaluated_arguments_head->value.pair.first->sourceCodeLocation = // evaluated_arguments_head->value.pair.first->sourceCodeLocation =
copy_scl(current_head->value.pair.first->sourceCodeLocation); // copy_scl(current_head->value.pair.first->sourceCodeLocation);
current_head = current_head->value.pair.rest; // current_head = current_head->value.pair.rest;
if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) { // if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
try evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil); // try evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
evaluated_arguments_head = evaluated_arguments_head->value.pair.rest; // evaluated_arguments_head = evaluated_arguments_head->value.pair.rest;
} else if (current_head == Memory::nil) { // } else if (current_head == Memory::nil) {
evaluated_arguments_head->value.pair.rest = current_head; // evaluated_arguments_head->value.pair.rest = current_head;
} else { // } else {
create_parsing_error("Attempting to evaluate ill formed argument list."); // create_parsing_error("Attempting to evaluate ill formed argument list.");
return nullptr; // return nullptr;
} // }
// ++my_out_arguments_length; // // ++my_out_arguments_length;
} // }
// *(out_arguments_length) = my_out_arguments_length; // // *(out_arguments_length) = my_out_arguments_length;
return evaluated_arguments; // return evaluated_arguments;
} // }
proc pause() { proc pause() {
printf("\n-----------------------\n" printf("\n-----------------------\n"
@@ -654,6 +643,7 @@ namespace Slime {
} }
proc nrc_eval(Lisp_Object* expr) -> Lisp_Object* { proc nrc_eval(Lisp_Object* expr) -> Lisp_Object* {
using namespace Globals::Current_Execution;
enum struct Action { enum struct Action {
Eval, Eval,
Step, Step,
@@ -664,17 +654,12 @@ namespace Slime {
Pop_Environment Pop_Environment
}; };
Array_List<Lisp_Object*> cs;
Array_List<Lisp_Object*> pcs;
Array_List<Action> nas; Array_List<Action> nas;
Array_List<int> ams;
cs.alloc();
pcs.alloc();
nas.alloc(); nas.alloc();
ams.alloc();
proc debug_step = [&] { proc debug_step = [&] {
return;
// printf("%d\n", cs.next_index);
printf("cs:\n "); printf("cs:\n ");
for (auto lo : cs) { for (auto lo : cs) {
print(lo, true); print(lo, true);
@@ -705,7 +690,7 @@ namespace Slime {
for (auto am : ams) { for (auto am : ams) {
printf("%d\n ", am); printf("%d\n ", am);
} }
pause(); // pause();
}; };
proc push_pc_on_cs = [&] { proc push_pc_on_cs = [&] {
@@ -772,10 +757,10 @@ namespace Slime {
fflush(stdout); fflush(stdout);
try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol); try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol);
Lisp_Object* func; Lisp_Object* func;
try_void func = Memory::create_lisp_object_function(Function_Type::Lambda); try_void func = Memory::create_lisp_object_function(Lisp_Function_Type::Lambda);
func->value.function->parent_environment = get_current_environment(); func->value.function->parent_environment = get_current_environment();
create_arguments_from_lambda_list_and_inject(definee->value.pair.rest, func); create_arguments_from_lambda_list_and_inject(definee->value.pair.rest, func);
func->value.function->body = maybe_wrap_body_in_begin(thing_cons); func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons);
define_symbol(definee->value.pair.first, func); define_symbol(definee->value.pair.first, func);
cs.append(Memory::t); cs.append(Memory::t);
} break; } break;
@@ -808,7 +793,7 @@ namespace Slime {
Action current_action; Action current_action;
Lisp_Object* pc; Lisp_Object* pc;
while (nas.next_index > 0) { while (nas.next_index > 0) {
// debug_step(); debug_step();
current_action = nas.data[--nas.next_index]; current_action = nas.data[--nas.next_index];
switch (current_action) { switch (current_action) {
@@ -843,26 +828,29 @@ namespace Slime {
Lisp_Object_Type type = Memory::get_type(pc); Lisp_Object_Type type = Memory::get_type(pc);
switch (type) { switch (type) {
case Lisp_Object_Type::CFunction: { case Lisp_Object_Type::Function: {
if (pc->value.cFunction->is_special_form) { if(pc->value.function->is_c) {
if (pc == Memory::_if) try handle_if(); if (pc->value.function->type.c_function_type ==
else if (pc == Memory::_begin) try handle_begin(); C_Function_Type::cMacro)
else if (pc == Memory::_define) try handle_define(); {
else { if (pc == Memory::_if) try handle_if();
push_pc_on_cs(); else if (pc == Memory::_begin) try handle_begin();
else if (pc == Memory::_define) try handle_define();
else {
push_pc_on_cs();
nas.append(Action::Step);
}
} else {
nas.append(Action::Step); nas.append(Action::Step);
} }
} else { } else {
nas.append(Action::Step); if (pc->value.function->type == Function_Type::Macro) {
} push_pc_on_cs();
} break; nas.append(Action::Eval);
case Lisp_Object_Type::Function: { nas.append(Action::Step);
if (pc->value.function->type == Function_Type::Macro) { } else {
push_pc_on_cs(); nas.append(Action::Step);
nas.append(Action::Eval); }
nas.append(Action::Step);
} else {
nas.append(Action::Step);
} }
} break; } break;
default: { default: {
@@ -931,77 +919,77 @@ namespace Slime {
proc eval_expr(Lisp_Object* node) -> Lisp_Object* { proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
return nrc_eval(node); return nrc_eval(node);
profile_this(); // profile_this();
using namespace Globals::Current_Execution; // using namespace Globals::Current_Execution;
call_stack.append(node); // call_stack.append(node);
defer { // defer {
--call_stack.next_index; // --call_stack.next_index;
}; // };
switch (Memory::get_type(node)) { // switch (Memory::get_type(node)) {
case Lisp_Object_Type::Symbol: { // case Lisp_Object_Type::Symbol: {
Lisp_Object* value; // Lisp_Object* value;
try value = lookup_symbol(node, get_current_environment()); // try value = lookup_symbol(node, get_current_environment());
return value; // return value;
} // }
case Lisp_Object_Type::Pair: { // case Lisp_Object_Type::Pair: {
Lisp_Object* lispOperator; // Lisp_Object* lispOperator;
if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction && // if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction &&
Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function) // Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function)
{ // {
try lispOperator = eval_expr(node->value.pair.first); // try lispOperator = eval_expr(node->value.pair.first);
} else { // } else {
lispOperator = node->value.pair.first; // lispOperator = node->value.pair.first;
} // }
Lisp_Object* arguments = node->value.pair.rest; // Lisp_Object* arguments = node->value.pair.rest;
// check for c function // // check for c function
if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) { // if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) {
Lisp_Object* result; // Lisp_Object* result;
try result = apply_arguments_to_function( // try result = apply_arguments_to_function(
arguments, // arguments,
lispOperator, // lispOperator,
!lispOperator->value.cFunction->is_special_form); // !lispOperator->value.cFunction->is_special_form);
return result; // return result;
} // }
// check for lisp function // // check for lisp function
if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) { // if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) {
// only for lambdas we evaluate the arguments before // // only for lambdas we evaluate the arguments before
// apllying, for the other types, special-lambda and macro // // apllying, for the other types, special-lambda and macro
// we do not need. // // we do not need.
Lisp_Object* result; // Lisp_Object* result;
try result = apply_arguments_to_function( // try result = apply_arguments_to_function(
arguments, // arguments,
lispOperator, // lispOperator,
lispOperator->value.function->type == Function_Type::Lambda); // lispOperator->value.function->type == Function_Type::Lambda);
// NOTE(Felix): The parser does not understnad (import ..) // // NOTE(Felix): The parser does not understnad (import ..)
// so it cannot expand imported macros at read time // // so it cannot expand imported macros at read time
// (because at read time, they are not imported yet, this // // (because at read time, they are not imported yet, this
// is done at runtime...). That is why we sometimes have // // is done at runtime...). That is why we sometimes have
// stray macros fying around, in that case, we expand them // // stray macros fying around, in that case, we expand them
// and bake them in, so they do not have to be expanded // // and bake them in, so they do not have to be expanded
// later again. We will call this "lazy macro expansion" // // later again. We will call this "lazy macro expansion"
if (lispOperator->value.function->type == Function_Type::Macro) { // if (lispOperator->value.function->type == Function_Type::Macro) {
// bake in the macro expansion: // // bake in the macro expansion:
*node = *Memory::copy_lisp_object(result); // *node = *Memory::copy_lisp_object(result);
result->sourceCodeLocation = copy_scl(result->sourceCodeLocation); // result->sourceCodeLocation = copy_scl(result->sourceCodeLocation);
// eval again because macro // // eval again because macro
try result = eval_expr(result); // try result = eval_expr(result);
} // }
return result; // return result;
} // }
create_generic_error("The first element of the pair was not a function but: %s", // create_generic_error("The first element of the pair was not a function but: %s",
Lisp_Object_Type_to_string(Memory::get_type(lispOperator))); // Lisp_Object_Type_to_string(Memory::get_type(lispOperator)));
return nullptr; // return nullptr;
} // }
default: return node; // default: return node;
} // }
} }
proc is_truthy(Lisp_Object* expression) -> bool { proc is_truthy(Lisp_Object* expression) -> bool {
src/gc.cpp
+3 -1
View File
@@ -47,7 +47,9 @@ namespace Slime::GC {
// for parameter names, as symbols and keywords are never // for parameter names, as symbols and keywords are never
// garbage collected // garbage collected
maybe_mark(node->value.function->parent_environment); maybe_mark(node->value.function->parent_environment);
maybe_mark(node->value.function->body); if (!node->value.function->is_c) {
maybe_mark(node->value.function->body.lisp_body);
}
// mark the default arguemnt values: // mark the default arguemnt values:
for (auto it : node->value.function->args.keyword.values) { for (auto it : node->value.function->args.keyword.values) {
if (it) if (it)
src/globals.cpp
+4 -1
View File
@@ -4,7 +4,10 @@ namespace Slime::Globals {
Array_List<void*> load_path; Array_List<void*> load_path;
namespace Current_Execution { namespace Current_Execution {
Array_List<Lisp_Object*> call_stack; Array_List<Lisp_Object*> cs;
Array_List<Lisp_Object*> pcs;
Array_List<int> ams;
// Array_List<Lisp_Object*> call_stack;
Array_List<Environment*> envi_stack; Array_List<Environment*> envi_stack;
} }
src/io.cpp
+14 -9
View File
@@ -315,7 +315,6 @@ namespace Slime {
case (Lisp_Object_Type::Keyword): fputs(":", file); // NOTE(Felix): intentionall fallthough case (Lisp_Object_Type::Keyword): fputs(":", file); // NOTE(Felix): intentionall fallthough
case (Lisp_Object_Type::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.symbol)); break; case (Lisp_Object_Type::Symbol): fprintf(file, "%s", Memory::get_c_str(node->value.symbol)); break;
case (Lisp_Object_Type::Continuation): fputs("[continuation]", file); break; case (Lisp_Object_Type::Continuation): fputs("[continuation]", file); break;
case (Lisp_Object_Type::CFunction): fputs("[C-function]", file); break;
case (Lisp_Object_Type::Pointer): fputs("[pointer]", file); break; case (Lisp_Object_Type::Pointer): fputs("[pointer]", file); break;
case (Lisp_Object_Type::HashMap): { case (Lisp_Object_Type::HashMap): {
for_hash_map (*(node->value.hashMap)) { for_hash_map (*(node->value.hashMap)) {
@@ -352,14 +351,20 @@ namespace Slime {
fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol)); fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol));
break; break;
} }
if (node->value.function->type == Function_Type::Lambda) if (node->value.function->is_c) {
fputs("[lambda]", file); switch (node->value.function->type.c_function_type) {
// else if (node->value.function->type == Function_Type::Special_Lambda) case C_Function_Type::cFunction: {fputs("[c-function]", file);} break;
// fputs("[special-lambda]", file); case C_Function_Type::cSpecial: {fputs("[c-special]", file);} break;
else if (node->value.function->type == Function_Type::Macro) case C_Function_Type::cMacro: {fputs("[c-macro]", file);} break;
fputs("[macro]", file); default: {fputs("[c-??]", file);}
else }
assert(false); } else {
switch (node->value.function->type.lisp_function_type) {
case Lisp_Function_Type::Lambda: {fputs("[lambda]", file);} break;
case Lisp_Function_Type::Macro: {fputs("[macro]", file);} break;
default: {fputs("[??]", file);}
}
}
} break; } break;
case (Lisp_Object_Type::Pair): { case (Lisp_Object_Type::Pair): {
Lisp_Object* head = node; Lisp_Object* head = node;
src/libslime.cpp
-1
View File
@@ -76,7 +76,6 @@ unsigned int hm_hash(Slime::Lisp_Object* obj) {
switch (Memory::get_type(obj)) { switch (Memory::get_type(obj)) {
// hash from adress: if two objects of these types have // hash from adress: if two objects of these types have
// different addresses, they are different // different addresses, they are different
case Lisp_Object_Type::CFunction:
case Lisp_Object_Type::Function: case Lisp_Object_Type::Function:
case Lisp_Object_Type::Symbol: case Lisp_Object_Type::Symbol:
case Lisp_Object_Type::Keyword: case Lisp_Object_Type::Keyword:
src/lisp_object.cpp
-7
View File
@@ -19,7 +19,6 @@ namespace Slime {
case(Lisp_Object_Type::Symbol): return "symbol"; case(Lisp_Object_Type::Symbol): return "symbol";
case(Lisp_Object_Type::Keyword): return "keyword"; case(Lisp_Object_Type::Keyword): return "keyword";
case(Lisp_Object_Type::Function): return "function"; case(Lisp_Object_Type::Function): return "function";
case(Lisp_Object_Type::CFunction): return "C-function";
case(Lisp_Object_Type::Continuation): return "continuation"; case(Lisp_Object_Type::Continuation): return "continuation";
case(Lisp_Object_Type::Pair): return "pair"; case(Lisp_Object_Type::Pair): return "pair";
case(Lisp_Object_Type::Vector): return "vector"; case(Lisp_Object_Type::Vector): return "vector";
@@ -37,12 +36,6 @@ namespace Slime {
case Lisp_Object_Type::HashMap: { case Lisp_Object_Type::HashMap: {
delete this->value.hashMap; delete this->value.hashMap;
} break; } break;
case Lisp_Object_Type::CFunction: {
this->value.cFunction->args.positional.symbols.dealloc();
this->value.cFunction->args.keyword.keywords.dealloc();
this->value.cFunction->args.keyword.values.dealloc();
free(this->value.cFunction);
} break;
case Lisp_Object_Type::Function:{ case Lisp_Object_Type::Function:{
this->value.function->args.positional.symbols.dealloc(); this->value.function->args.positional.symbols.dealloc();
this->value.function->args.keyword.keywords.dealloc(); this->value.function->args.keyword.keywords.dealloc();
src/memory.cpp
+14 -12
View File
@@ -176,8 +176,11 @@ namespace Slime::Memory {
char* exe_path = get_exe_dir(); char* exe_path = get_exe_dir();
// don't free exe path because it will be used until end of time // don't free exe path because it will be used until end of time
Globals::load_path.alloc(); Globals::load_path.alloc();
Globals::Current_Execution::call_stack.alloc(); // Globals::Current_Execution::call_stack.alloc();
Globals::Current_Execution::envi_stack.alloc(); Globals::Current_Execution::envi_stack.alloc();
Globals::Current_Execution::cs.alloc();
Globals::Current_Execution::pcs.alloc();
Globals::Current_Execution::ams.alloc();
add_to_load_path(exe_path); add_to_load_path(exe_path);
add_to_load_path("../bin/"); add_to_load_path("../bin/");
@@ -424,19 +427,19 @@ namespace Slime::Memory {
} }
} }
proc create_lisp_object_cfunction(bool is_special) -> Lisp_Object* { proc create_lisp_object_cfunction(C_Function_Type type) -> Lisp_Object* {
Lisp_Object* node; Lisp_Object* node;
try node = create_lisp_object(); try node = create_lisp_object();
set_type(node, Lisp_Object_Type::CFunction); set_type(node, Lisp_Object_Type::Function);
node->value.cFunction = (cFunction*)malloc(sizeof(cFunction)); node->value.function = (Function*)malloc(sizeof(Function));
node->value.cFunction->args.keyword.keywords.alloc(); node->value.function->type.c_function_type = type;
node->value.cFunction->args.keyword.values.alloc(); node->value.function->args.keyword.keywords.alloc();
node->value.cFunction->args.positional.symbols.alloc(); node->value.function->args.keyword.values.alloc();
node->value.cFunction->is_special_form = is_special; node->value.function->args.positional.symbols.alloc();
return node; return node;
} }
proc create_lisp_object_function(Function_Type ft) -> Lisp_Object* { proc create_lisp_object_function(Lisp_Function_Type ft) -> Lisp_Object* {
Lisp_Object* func; Lisp_Object* func;
try func = Memory::create_lisp_object(); try func = Memory::create_lisp_object();
Memory::set_type(func, Lisp_Object_Type::Function); Memory::set_type(func, Lisp_Object_Type::Function);
@@ -444,7 +447,7 @@ namespace Slime::Memory {
func->value.function->args.keyword.keywords.alloc(); func->value.function->args.keyword.keywords.alloc();
func->value.function->args.keyword.values.alloc(); func->value.function->args.keyword.values.alloc();
func->value.function->args.positional.symbols.alloc(); func->value.function->args.positional.symbols.alloc();
func->value.function->type = ft; func->value.function->type.lisp_function_type = ft;
return func; return func;
} }
@@ -465,8 +468,7 @@ namespace Slime::Memory {
if (n == Memory::nil || n == Memory::t || if (n == Memory::nil || n == Memory::t ||
Memory::get_type(n) == Lisp_Object_Type::Symbol || Memory::get_type(n) == Lisp_Object_Type::Symbol ||
Memory::get_type(n) == Lisp_Object_Type::Keyword || Memory::get_type(n) == Lisp_Object_Type::Keyword ||
Memory::get_type(n) == Lisp_Object_Type::Function || Memory::get_type(n) == Lisp_Object_Type::Function)
Memory::get_type(n) == Lisp_Object_Type::CFunction)
{ {
return n; return n;
} }
src/structs.cpp
+21 -14
View File
@@ -22,7 +22,6 @@ namespace Slime {
HashMap, HashMap,
// OwningPointer, // OwningPointer,
Function, Function,
CFunction,
}; };
enum class Lisp_Object_Flags enum class Lisp_Object_Flags
@@ -32,9 +31,17 @@ namespace Slime {
Under_Construction = 1 << 6, Under_Construction = 1 << 6,
}; };
enum struct Function_Type { enum struct Lisp_Function_Type {
Lambda, Lambda, // normal evaluation order
Macro Macro // args are not evaluated, a new programm is returned
// that will be executed again
};
enum struct C_Function_Type {
cFunction, // normal evaluation order
cSpecial, // args are not evaluated, but result is returned
// as you would expect
cMacro // No return value, but the current_execution is
// modified
}; };
enum struct Log_Level { enum struct Log_Level {
@@ -101,16 +108,17 @@ namespace Slime {
}; };
struct Function { struct Function {
Function_Type type;
Arguments args; Arguments args;
Lisp_Object* body; // maybe implicit begin Environment* parent_environment;
Environment* parent_environment; // we are doing closures now!! bool is_c;
}; union {
Lisp_Function_Type lisp_function_type;
struct cFunction { C_Function_Type c_function_type;
Lisp_Object* (*body)(); } type;
Arguments args; union {
bool is_special_form; Lisp_Object* lisp_body;
Lisp_Object* (*c_body)();
} body;
}; };
struct Lisp_Object { struct Lisp_Object {
@@ -125,7 +133,6 @@ namespace Slime {
Pair pair; Pair pair;
Vector vector; Vector vector;
Function* function; Function* function;
cFunction* cFunction;
void* pointer; void* pointer;
Continuation* continuation; Continuation* continuation;
Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap; Hash_Map<Lisp_Object*, Lisp_Object*>* hashMap;
src/testing.cpp
+35 -35
View File
@@ -623,49 +623,49 @@ namespace Slime {
} }
}; };
push_environment(Memory::create_child_environment( // push_environment(Memory::create_child_environment(
get_current_environment())); // get_current_environment()));
printf("-- Util --\n"); // printf("-- Util --\n");
invoke_test(test_array_lists_adding_and_removing); // invoke_test(test_array_lists_adding_and_removing);
invoke_test(test_array_lists_sorting); // invoke_test(test_array_lists_sorting);
invoke_test(test_array_lists_searching); // invoke_test(test_array_lists_searching);
printf("\n -- Parsing --\n"); // printf("\n -- Parsing --\n");
invoke_test(test_parse_atom); // invoke_test(test_parse_atom);
invoke_test(test_parse_expression); // invoke_test(test_parse_expression);
printf("\n-- Basic evaluating --\n"); // printf("\n-- Basic evaluating --\n");
invoke_test(test_eval_operands); // invoke_test(test_eval_operands);
printf("\n-- Built ins --\n"); // printf("\n-- Built ins --\n");
invoke_test(test_built_in_add); // invoke_test(test_built_in_add);
invoke_test(test_built_in_substract); // invoke_test(test_built_in_substract);
invoke_test(test_built_in_multiply); // invoke_test(test_built_in_multiply);
invoke_test(test_built_in_divide); // invoke_test(test_built_in_divide);
invoke_test(test_built_in_if); // invoke_test(test_built_in_if);
invoke_test(test_built_in_and); // invoke_test(test_built_in_and);
invoke_test(test_built_in_or); // invoke_test(test_built_in_or);
invoke_test(test_built_in_not); // invoke_test(test_built_in_not);
invoke_test(test_built_in_type); // invoke_test(test_built_in_type);
printf("\n-- Memory management --\n"); // printf("\n-- Memory management --\n");
invoke_test(test_singular_t_and_nil); // invoke_test(test_singular_t_and_nil);
invoke_test(test_singular_symbols); // invoke_test(test_singular_symbols);
pop_environment(); // pop_environment();
printf("\n-- Test Files --\n"); printf("\n-- Test Files --\n");
invoke_test_script("evaluation_of_default_args"); // invoke_test_script("evaluation_of_default_args");
invoke_test_script("alists"); // invoke_test_script("alists");
invoke_test_script("case_and_cond"); // invoke_test_script("case_and_cond");
invoke_test_script("lexical_scope"); // invoke_test_script("lexical_scope");
invoke_test_script("class_macro"); // invoke_test_script("class_macro");
invoke_test_script("import_and_load"); // invoke_test_script("import_and_load");
invoke_test_script("macro_expand"); // invoke_test_script("macro_expand");
invoke_test_script("automata"); // invoke_test_script("automata");
invoke_test_script("sicp"); invoke_test_script("sicp");
invoke_test_script("hashmaps"); // invoke_test_script("hashmaps");
invoke_test_script("singular_imports"); // invoke_test_script("singular_imports");
return result; return result;
} }