removed special-lambdas to make evaluatino of arfgs more regular
This commit is contained in:
@@ -85,9 +85,6 @@ condition is false."
|
|||||||
,(rec (rest clauses))))))
|
,(rec (rest clauses))))))
|
||||||
(rec clauses))
|
(rec clauses))
|
||||||
|
|
||||||
(define-syntax (define-special name-and-args . body)
|
|
||||||
`(define ,(first name-and-args) (special-lambda ,(rest name-and-args) @body)))
|
|
||||||
|
|
||||||
(define-syntax (construct-list . body)
|
(define-syntax (construct-list . body)
|
||||||
:doc "
|
:doc "
|
||||||
{{{example_start}}}
|
{{{example_start}}}
|
||||||
@@ -471,7 +468,6 @@ added to a list, which in the end is returned."
|
|||||||
;; (vector-ref v2 0))))
|
;; (vector-ref v2 0))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; (unless (bound? generic-+-map)
|
;; (unless (bound? generic-+-map)
|
||||||
;; (set! generic-+-map (create-hash-map)))
|
;; (set! generic-+-map (create-hash-map)))
|
||||||
;; (hm/set! generic-+-map '(:vector :vector) (lambda (v1 v2)
|
;; (hm/set! generic-+-map '(:vector :vector) (lambda (v1 v2)
|
||||||
|
|||||||
@@ -18,8 +18,6 @@
|
|||||||
|
|
||||||
(define-syntax (case var . clauses) (define (rec clauses) (if (= nil clauses) nil (if (= (first (first clauses)) 'else) (begin (if (not (= (rest clauses) ())) (error :syntax-error "There are additional clauses after the else clause!") (pair 'begin (rest (first clauses))))) `(if (member? ,var ',(first (first clauses))) (begin (unquote-splicing (rest (first clauses)))) ,(rec (rest clauses)))))) (rec clauses))
|
(define-syntax (case var . clauses) (define (rec clauses) (if (= nil clauses) nil (if (= (first (first clauses)) 'else) (begin (if (not (= (rest clauses) ())) (error :syntax-error "There are additional clauses after the else clause!") (pair 'begin (rest (first clauses))))) `(if (member? ,var ',(first (first clauses))) (begin (unquote-splicing (rest (first clauses)))) ,(rec (rest clauses)))))) (rec clauses))
|
||||||
|
|
||||||
(define-syntax (define-special name-and-args . body) `(define ,(first name-and-args) (special-lambda ,(rest name-and-args) (unquote-splicing body))))
|
|
||||||
|
|
||||||
(define-syntax (construct-list . body) :doc "\n{{{example_start}}}\n(construct-list\n i <- '(1 2 3 4 5)\n yield (* i i))\n{{{example_end}}}\n\n(construct-list\n i <- '(1 2 3 4)\n j <- '(A B)\n yield (pair i j))\n\n(construct-list\n i <- '(1 2 3 4 5 6 7 8)\n if (= 0 (% i 2))\n yield i)\n" (define (append-map f ll) (unless (= ll ()) (define val (f (first ll))) (if (= (first val) ()) (append-map f (rest ll)) (extend val (append-map f (rest ll)))))) (define (rec body) (cond ((= () body) ()) ((= () (rest body)) (first body)) ((= (first (rest body)) '<-) `(,append-map (lambda (,(first body)) (list ,(rec (rest (rest (rest body)))))) ,(first (rest (rest body))))) ((= (first body) 'if) `(when ,(first (rest body)) ,(rec (rest (rest body))))) ((= (first (rest body)) 'yield) (first (rest body))) (else (error :syntax-error "Not a do-able expression")))) (rec body))
|
(define-syntax (construct-list . body) :doc "\n{{{example_start}}}\n(construct-list\n i <- '(1 2 3 4 5)\n yield (* i i))\n{{{example_end}}}\n\n(construct-list\n i <- '(1 2 3 4)\n j <- '(A B)\n yield (pair i j))\n\n(construct-list\n i <- '(1 2 3 4 5 6 7 8)\n if (= 0 (% i 2))\n yield i)\n" (define (append-map f ll) (unless (= ll ()) (define val (f (first ll))) (if (= (first val) ()) (append-map f (rest ll)) (extend val (append-map f (rest ll)))))) (define (rec body) (cond ((= () body) ()) ((= () (rest body)) (first body)) ((= (first (rest body)) '<-) `(,append-map (lambda (,(first body)) (list ,(rec (rest (rest (rest body)))))) ,(first (rest (rest body))))) ((= (first body) 'if) `(when ,(first (rest body)) ,(rec (rest (rest body))))) ((= (first (rest body)) 'yield) (first (rest body))) (else (error :syntax-error "Not a do-able expression")))) (rec body))
|
||||||
|
|
||||||
(define-syntax (define-typed args . body) (define (get-arg-names args) (when args (pair (first args) (get-arg-names (rest (rest args)))))) (let ((name (first args)) (lambda-list (rest args)) (arg-names (get-arg-names (rest args)))) `(define (,name (unquote-splicing arg-names)) (assert-types= (unquote-splicing lambda-list)) (unquote-splicing body))))
|
(define-syntax (define-typed args . body) (define (get-arg-names args) (when args (pair (first args) (get-arg-names (rest (rest args)))))) (let ((name (first args)) (lambda-list (rest args)) (arg-names (get-arg-names (rest args)))) `(define (,name (unquote-splicing arg-names)) (assert-types= (unquote-splicing lambda-list)) (unquote-splicing body))))
|
||||||
|
|||||||
@@ -5,6 +5,7 @@ pushd $SCRIPTPATH > /dev/null
|
|||||||
# _DEBUG
|
# _DEBUG
|
||||||
# time g++ -fpermissive src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1
|
# time g++ -fpermissive src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1
|
||||||
time clang++ -D_DEBUG -D_PROFILING -D_DONT_BREAK_ON_ERRORS src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1
|
time clang++ -D_DEBUG -D_PROFILING -D_DONT_BREAK_ON_ERRORS src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1
|
||||||
|
# time clang++ -O3 -D_DONT_BREAK_ON_ERRORS src/main.cpp -g -o ./bin/slime --std=c++17 || exit 1
|
||||||
|
|
||||||
echo ""
|
echo ""
|
||||||
pushd ./bin > /dev/null
|
pushd ./bin > /dev/null
|
||||||
|
|||||||
+16
-20
@@ -779,31 +779,27 @@ proc load_built_ins_into_environment() -> void {
|
|||||||
fun->value.function.body = maybe_wrap_body_in_begin(body);
|
fun->value.function.body = maybe_wrap_body_in_begin(body);
|
||||||
return fun;
|
return fun;
|
||||||
};
|
};
|
||||||
define_special((special-lambda args . body), "TODO") {
|
// define_special((special-lambda args . body), "TODO") {
|
||||||
fetch(args, body);
|
// fetch(args, body);
|
||||||
|
|
||||||
Lisp_Object* fun;
|
// Lisp_Object* fun;
|
||||||
try fun = Memory::create_lisp_object();
|
// try fun = Memory::create_lisp_object();
|
||||||
Memory::set_type(fun, Lisp_Object_Type::Function);
|
// Memory::set_type(fun, Lisp_Object_Type::Function);
|
||||||
fun->value.function.type = Function_Type::Special_Lambda;
|
// fun->value.function.type = Function_Type::Special_Lambda;
|
||||||
|
|
||||||
in_caller_env {
|
// in_caller_env {
|
||||||
fun->value.function.parent_environment = get_current_environment();
|
// fun->value.function.parent_environment = get_current_environment();
|
||||||
}
|
// }
|
||||||
|
|
||||||
try create_arguments_from_lambda_list_and_inject(args, fun);
|
// try create_arguments_from_lambda_list_and_inject(args, fun);
|
||||||
fun->value.function.body = maybe_wrap_body_in_begin(body);
|
// fun->value.function.body = maybe_wrap_body_in_begin(body);
|
||||||
return fun;
|
// return fun;
|
||||||
};
|
// };
|
||||||
define((apply fun args), "TODO") {
|
define((apply fun args), "TODO") {
|
||||||
fetch(fun, args);
|
fetch(fun, args);
|
||||||
Lisp_Object* result;
|
Lisp_Object* result;
|
||||||
|
|
||||||
// try assert_type(args, Lisp_Object_Type::Pair);
|
try result = apply_arguments_to_function(args, fun, /*eval_args=*/false);
|
||||||
// HACK(Felix): this is probably a really nasty hack:
|
|
||||||
fluid_let (fun->value.function.type, Function_Type::Special_Lambda) {
|
|
||||||
try result = apply_arguments_to_function(args, fun);
|
|
||||||
}
|
|
||||||
|
|
||||||
return result;
|
return result;
|
||||||
};
|
};
|
||||||
@@ -907,8 +903,8 @@ proc load_built_ins_into_environment() -> void {
|
|||||||
Function* fun = &n->value.function;
|
Function* fun = &n->value.function;
|
||||||
if (fun->type == Function_Type::Lambda)
|
if (fun->type == Function_Type::Lambda)
|
||||||
return Memory::get_or_create_lisp_object_keyword("lambda");
|
return Memory::get_or_create_lisp_object_keyword("lambda");
|
||||||
else if (fun->type == Function_Type::Special_Lambda)
|
// else if (fun->type == Function_Type::Special_Lambda)
|
||||||
return Memory::get_or_create_lisp_object_keyword("special-lambda");
|
// return Memory::get_or_create_lisp_object_keyword("special-lambda");
|
||||||
else if (fun->type == Function_Type::Macro)
|
else if (fun->type == Function_Type::Macro)
|
||||||
return Memory::get_or_create_lisp_object_keyword("macro");
|
return Memory::get_or_create_lisp_object_keyword("macro");
|
||||||
else return Memory::get_or_create_lisp_object_keyword("unknown");
|
else return Memory::get_or_create_lisp_object_keyword("unknown");
|
||||||
|
|||||||
+15
-13
@@ -1,6 +1,7 @@
|
|||||||
proc create_extended_environment_for_function_application(
|
proc create_extended_environment_for_function_application(
|
||||||
Lisp_Object* unevaluated_arguments,
|
Lisp_Object* unevaluated_arguments,
|
||||||
Lisp_Object* function) -> Environment*
|
Lisp_Object* function,
|
||||||
|
bool should_evaluate) -> Environment*
|
||||||
{
|
{
|
||||||
profile_this;
|
profile_this;
|
||||||
bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
|
bool is_c_function = Memory::get_type(function) == Lisp_Object_Type::CFunction;
|
||||||
@@ -15,17 +16,12 @@ proc create_extended_environment_for_function_application(
|
|||||||
if (is_c_function) {
|
if (is_c_function) {
|
||||||
new_env = Memory::create_child_environment(get_root_environment());
|
new_env = Memory::create_child_environment(get_root_environment());
|
||||||
arg_spec = &function->value.cFunction->args;
|
arg_spec = &function->value.cFunction->args;
|
||||||
// if it is not a special form, evaluate the arguments
|
|
||||||
if (!function->value.cFunction->is_special_form) {
|
|
||||||
try arguments = eval_arguments(arguments);
|
|
||||||
}
|
|
||||||
} else {
|
} else {
|
||||||
new_env = Memory::create_child_environment(function->value.function.parent_environment);
|
new_env = Memory::create_child_environment(function->value.function.parent_environment);
|
||||||
arg_spec = &function->value.function.args;
|
arg_spec = &function->value.function.args;
|
||||||
// if it is a lambda
|
}
|
||||||
if (function->value.function.type == Function_Type::Lambda) {
|
if (should_evaluate) {
|
||||||
try arguments = eval_arguments(arguments);
|
try arguments = eval_arguments(arguments);
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
// NOTE(Felix): Even though we will return the environment at the
|
// NOTE(Felix): Even though we will return the environment at the
|
||||||
@@ -230,12 +226,12 @@ proc create_extended_environment_for_function_application(
|
|||||||
return new_env;
|
return new_env;
|
||||||
}
|
}
|
||||||
|
|
||||||
proc apply_arguments_to_function(Lisp_Object* arguments, Lisp_Object* function) -> 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);
|
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();
|
||||||
@@ -435,7 +431,10 @@ proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
|
|||||||
// 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(arguments, lispOperator);
|
try result = apply_arguments_to_function(
|
||||||
|
arguments,
|
||||||
|
lispOperator,
|
||||||
|
!lispOperator->value.cFunction->is_special_form);
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -446,7 +445,10 @@ proc eval_expr(Lisp_Object* node) -> Lisp_Object* {
|
|||||||
// we do not need.
|
// we do not need.
|
||||||
|
|
||||||
Lisp_Object* result;
|
Lisp_Object* result;
|
||||||
try result = apply_arguments_to_function(arguments, lispOperator);
|
try result = apply_arguments_to_function(
|
||||||
|
arguments,
|
||||||
|
lispOperator,
|
||||||
|
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
|
||||||
|
|||||||
+2
-2
@@ -313,8 +313,8 @@ proc print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout) -> v
|
|||||||
}
|
}
|
||||||
if (node->value.function.type == Function_Type::Lambda)
|
if (node->value.function.type == Function_Type::Lambda)
|
||||||
fputs("[lambda]", file);
|
fputs("[lambda]", file);
|
||||||
else if (node->value.function.type == Function_Type::Special_Lambda)
|
// else if (node->value.function.type == Function_Type::Special_Lambda)
|
||||||
fputs("[special-lambda]", file);
|
// fputs("[special-lambda]", file);
|
||||||
else if (node->value.function.type == Function_Type::Macro)
|
else if (node->value.function.type == Function_Type::Macro)
|
||||||
fputs("[macro]", file);
|
fputs("[macro]", file);
|
||||||
else
|
else
|
||||||
|
|||||||
+1
-1
@@ -52,7 +52,7 @@ enum class Lisp_Object_Flags : u64
|
|||||||
|
|
||||||
enum struct Function_Type {
|
enum struct Function_Type {
|
||||||
Lambda,
|
Lambda,
|
||||||
Special_Lambda,
|
// Special_Lambda,
|
||||||
Macro
|
Macro
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user