better errors and new define syntax
This commit is contained in:
FelixBrendel
-223
@@ -1,223 +0,0 @@
|
||||
(define-syntax when (condition :rest body)
|
||||
;; (break)
|
||||
`(if ,condition ,(pair prog body) nil))
|
||||
;; (list 'if condition (pair 'prog body) nil))
|
||||
|
||||
(define-syntax unless (condition :rest body)
|
||||
`(if ,condition nil ,(pair prog body)))
|
||||
|
||||
(define-syntax defun (name arguments :rest body)
|
||||
;; (type-assert arguments :pair)
|
||||
;; `(define ,name (lambda ,arguments ,body))
|
||||
|
||||
;; TODO(Felix: I think we do not need to wrap the body of the lamba
|
||||
;; in a prog
|
||||
|
||||
;; see if we have a docstring
|
||||
(if (and (= (type (first body)) :string) (not (= (type (rest body)) :nil)))
|
||||
(list 'define name (list 'lambda arguments (first body) (pair 'prog (rest body))))
|
||||
(list 'define name (list 'lambda arguments (pair 'prog body)))))
|
||||
|
||||
|
||||
(define-syntax defspecial (name arguments :rest body)
|
||||
;; (type-assert arguments :pair)
|
||||
;; `(define ,name (lambda ,arguments ,body))
|
||||
|
||||
;; see if we have a docstring
|
||||
(if (and (= (type (first body)) :string) (not (= (type (rest body)) :nil)))
|
||||
(list 'define name (list 'special-lambda arguments (first body) (pair 'prog (rest body))))
|
||||
(list 'define name (list 'special-lambda arguments (pair 'prog body)))))
|
||||
|
||||
;; (cond
|
||||
;; (p1 v1)
|
||||
;; (p2 v2))
|
||||
(define-syntax cond (:rest clauses)
|
||||
(defun rec (clauses)
|
||||
(if (= nil clauses)
|
||||
nil
|
||||
(list 'if (first (first clauses))
|
||||
(pair 'prog (rest (first clauses)))
|
||||
(rec (rest clauses)))))
|
||||
(rec clauses))
|
||||
|
||||
(defun nil? (x)
|
||||
"Checks if the argument is nil."
|
||||
(= x nil))
|
||||
|
||||
(defun number? (x)
|
||||
"Checks if the argument is a number."
|
||||
(= (type x) :number))
|
||||
|
||||
(defun symbol? (x)
|
||||
"Checks if the argument is a symbol."
|
||||
(= (type x) :symbol))
|
||||
|
||||
(defun keyword? (x)
|
||||
"Checks if the argument is a keyword."
|
||||
(= (type x) :keyword))
|
||||
|
||||
(defun pair? (x)
|
||||
"Checks if the argument is a pair."
|
||||
(= (type x) :pair))
|
||||
|
||||
(defun string? (x)
|
||||
"Checks if the argument is a string."
|
||||
(= (type x) :string))
|
||||
|
||||
(defun lambda? (x)
|
||||
"Checks if the argument is a function."
|
||||
(= (type x) :dynamic-function))
|
||||
|
||||
(defun special-lambda? (x)
|
||||
"Checks if the argument is a macro."
|
||||
(= (type x) :dynamic-macro))
|
||||
|
||||
(defun built-in-function? (x)
|
||||
"Checks if the argument is a built-in function."
|
||||
(= (type x) :built-in-function))
|
||||
|
||||
(defun apply (fun seq)
|
||||
"Applies the funciton to the sequence, as in calls the function
|
||||
with ithe sequence as arguemens."
|
||||
(eval (pair fun seq)))
|
||||
|
||||
(defun end (seq)
|
||||
"Returns the last pair in the sqeuence."
|
||||
(if (or (nil? seq) (not (pair? (rest seq))))
|
||||
seq
|
||||
(end (rest seq))))
|
||||
|
||||
(defun last (seq)
|
||||
"Returns the (first) of the last (pair) of the given sequence."
|
||||
(first (end seq)))
|
||||
|
||||
(defun extend (seq elem)
|
||||
"Extends a list with the given element, by putting it in
|
||||
the (rest) of the last element of the sequence."
|
||||
(when (pair? seq)
|
||||
(define e (end seq))
|
||||
(mutate e (pair (first e) elem)))
|
||||
seq)
|
||||
|
||||
(defun append (seq elem)
|
||||
"Appends an element to a sequence, by extendeing the list
|
||||
with (pair elem nil)."
|
||||
(extend seq (pair elem nil)))
|
||||
|
||||
(defun length (seq)
|
||||
"Returns the length of the given sequence."
|
||||
(if (nil? seq)
|
||||
0
|
||||
(incr (length (rest seq)))))
|
||||
|
||||
(defun increment (val)
|
||||
"Adds one to the argument."
|
||||
(+ val 1))
|
||||
|
||||
(defun decrement (val)
|
||||
"Subtracts one from the argument."
|
||||
(- val 1))
|
||||
|
||||
|
||||
;; (defmacro n-times (@times @action)
|
||||
;; "Executes @action @times times."
|
||||
;; (unless (<= (eval @times) 0)
|
||||
;; (eval @action)
|
||||
;; (apply n-times (list (list - @times 1) @action))))
|
||||
|
||||
;; (defmacro for (@symbol @from @to :rest @for-body)
|
||||
;; "Designed to resemble a C style for loop. It takes a symbol as
|
||||
;; well as its starting number and end number and executes the
|
||||
;; @for-body with the defined symbol for all numbers between @from
|
||||
;; to @to, where @to is exclusive."
|
||||
;; (if (< (eval @from) (eval @to))
|
||||
;; (macro-define @op incr)
|
||||
;; (if (> (eval @from) (eval @to))
|
||||
;; (macro-define @op decr)
|
||||
;; (macro-define @op nil)))
|
||||
;; (when @op
|
||||
;; (macro-define (eval @symbol) (eval @from))
|
||||
;; (eval (pair prog @for-body))
|
||||
;; (eval (extend (list for @symbol (@op @from) @to) @for-body))))
|
||||
|
||||
(defun range (:keys from :defaults-to 0 to)
|
||||
"Returns a sequence of numbers starting with the number defined
|
||||
by the key 'from' and ends with the number defined in 'to'."
|
||||
(when (< from to)
|
||||
(pair from (range :from (+ 1 from) :to to))))
|
||||
|
||||
(defun range-while (:keys from :defaults-to 0 to)
|
||||
"Returns a sequence of numbers starting with the number defined
|
||||
by the key 'from' and ends with the number defined in 'to'."
|
||||
(define result (list (copy from)))
|
||||
(define head result)
|
||||
(mutate from (increment from))
|
||||
(while (< from to)
|
||||
(prog
|
||||
(mutate head (pair (first head) (pair (copy from) nil)))
|
||||
(define head (rest head))
|
||||
(mutate from (increment from))))
|
||||
result)
|
||||
|
||||
(defun map (fun seq)
|
||||
"Takes a function and a sequence as arguments and returns a new
|
||||
sequence which contains the results of using the first sequences
|
||||
elemens as argument to that function."
|
||||
(if (nil? seq)
|
||||
seq
|
||||
(pair (fun (first seq))
|
||||
(map fun (rest seq)))))
|
||||
|
||||
(defun reduce (fun seq)
|
||||
"Takes a function and a sequence as arguments and applies the
|
||||
function to the argument sequence. This only works correctly if
|
||||
the given function accepts a variable amount of parameters. If
|
||||
your funciton is limited to two arguments, use `reduce-binary'
|
||||
instead."
|
||||
(apply fun seq))
|
||||
|
||||
(defun reduce-binary (fun seq)
|
||||
"Takes a function and a sequence as arguments and applies the
|
||||
function to the argument sequence. reduce-binary applies the
|
||||
arguments `pair-wise' which means it works with binary functions
|
||||
as compared to `reduce'."
|
||||
(if (nil? (rest seq))
|
||||
(first seq)
|
||||
(fun (first seq)
|
||||
(reduce-binary fun (rest seq)))))
|
||||
|
||||
(defun filter (fun seq)
|
||||
"Takes a function and a sequence as arguments and applies the
|
||||
function to every value in the sequence. If the result of that
|
||||
funciton application returns a truthy value, the original value is
|
||||
added to a list, which in the end is returned."
|
||||
(when seq
|
||||
(if (fun (first seq))
|
||||
(pair (first seq)
|
||||
(filter fun (rest seq)))
|
||||
(filter fun (rest seq)))))
|
||||
|
||||
(defun zip (l1 l2)
|
||||
(if (and (nil? l1) (nil? l2))
|
||||
nil
|
||||
(pair (list (first l1) (first l2)) (zip (rest l1) (rest l2)))))
|
||||
|
||||
(defun printf (:keys sep :defaults-to " " end :defaults-to "\n" :rest args)
|
||||
"A wrapper for the built-in (print) that accepts a variable number
|
||||
of arguments and also provides keywords for specifying the printed
|
||||
separators between the arguments and what should be printed after the
|
||||
las argument."
|
||||
(defspecial printf-quoted (:keys @sep @end :rest @args)
|
||||
(if (nil? @args)
|
||||
(prog (print (eval @end)) nil)
|
||||
(prog
|
||||
(print (first @args))
|
||||
(unless (nil? (rest @args))
|
||||
(print (eval @sep)))
|
||||
(eval (pair printf-quoted
|
||||
(extend (list :@sep (eval @sep) :@end (eval @end)) (rest @args)))))))
|
||||
|
||||
(eval (pair printf-quoted (extend (list :@sep (eval sep) :@end (eval end)) args))))
|
||||
|
||||
(defspecial pe (@expr)
|
||||
(printf @expr "evaluates to" (eval @expr)))
|
||||
@@ -1,81 +0,0 @@
|
||||
(defun type-wrap (obj type)
|
||||
(set-type obj type)
|
||||
obj)
|
||||
|
||||
(define-syntax defclass (name members :rest body)
|
||||
"Macro for creatating classes."
|
||||
(defun underscore (sym)
|
||||
(string->symbol (concat-strings "_" (symbol->string sym))))
|
||||
|
||||
(define underscored-members (map underscore members))
|
||||
|
||||
;; the wrapping let environment
|
||||
(define let-body (list 'let (zip members underscored-members)))
|
||||
|
||||
;; the body
|
||||
(map (lambda (fun) (append let-body fun)) body)
|
||||
|
||||
;; the dispatch function
|
||||
(append let-body '(special-lambda (message :rest args)
|
||||
"This is the docs for the handle"
|
||||
(eval (extend (list message) args))))
|
||||
|
||||
;; stuff it all in the constructor function
|
||||
(eval (list defun (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members
|
||||
"This is the handle to an object of the class "
|
||||
let-body)))
|
||||
|
||||
;; (v1 print)
|
||||
;; (v1 length)
|
||||
;; (v1 get-x)
|
||||
;; (v1 set-x 10)
|
||||
|
||||
(defclass vector3 (x y z)
|
||||
(defun get-x () x)
|
||||
(defun get-y () y)
|
||||
(defun get-z () z)
|
||||
|
||||
(defun set-x (new-x) (mutate x new-x))
|
||||
(defun set-y (new-y) (mutate y new-y))
|
||||
(defun set-z (new-z) (mutate z new-z))
|
||||
|
||||
(defun length ()
|
||||
(** (+ (* x x) (* y y) (* z z)) 0.5))
|
||||
|
||||
(defun scale (fac)
|
||||
(mutate x (* fac x))
|
||||
(mutate y (* fac y))
|
||||
(mutate z (* fac z))
|
||||
fac)
|
||||
|
||||
(defun add (other)
|
||||
(make-vector3
|
||||
(+ x (other get-x))
|
||||
(+ y (other get-y))
|
||||
(+ z (other get-z))))
|
||||
|
||||
(defun subtract (other)
|
||||
(make-vector3
|
||||
(- x (other get-x))
|
||||
(- y (other get-y))
|
||||
(- z (other get-z))))
|
||||
|
||||
(defun scalar-product (other)
|
||||
(+ (* x (other get-x))
|
||||
(* y (other get-y))
|
||||
(* z (other get-z))))
|
||||
|
||||
(defun cross-product (other)
|
||||
(make-vector3
|
||||
(- (* y (other get-z)) (* z (other get-y)))
|
||||
(- (* z (other get-x)) (* x (other get-z)))
|
||||
(- (* x (other get-y)) (* y (other get-x)))))
|
||||
|
||||
(defun printout ()
|
||||
(printf "[vector3] (" x y z ")"))
|
||||
)
|
||||
|
||||
(define v1 (make-vector3 1 2 3))
|
||||
(define v2 (make-vector3 3 2 1))
|
||||
|
||||
(assert (= (v1 scalar-product v2) 10))
|
||||
@@ -1,11 +0,0 @@
|
||||
(defun make-counter ()
|
||||
(let ((var 0))
|
||||
(lambda ()
|
||||
(mutate var (+ 1 var))
|
||||
var)))
|
||||
|
||||
(define counter (make-counter))
|
||||
|
||||
(assert (= (counter) 1))
|
||||
(assert (= (counter) 3))
|
||||
(assert (= (counter) 3))
|
||||
+106
-48
@@ -65,9 +65,10 @@ proc load_built_ins_into_environment(Environment* env) -> void {
|
||||
Lisp_Object* evaluated_arguments;
|
||||
|
||||
#define cLambda [=](Lisp_Object* arguments, Environment* env) mutable -> Lisp_Object*
|
||||
#define report_error(_type) { \
|
||||
create_error(_type, current_source_code_location); \
|
||||
return nullptr; \
|
||||
#define report_error(_type) { \
|
||||
printf("Error occurred\nin %s:%d\n", __FILE__, __LINE__); \
|
||||
create_error(_type, current_source_code_location); \
|
||||
return nullptr; \
|
||||
}
|
||||
|
||||
proc defun = [&](const char* name, auto fun) {
|
||||
@@ -77,6 +78,46 @@ proc load_built_ins_into_environment(Environment* env) -> void {
|
||||
env);
|
||||
};
|
||||
|
||||
proc parse_lambda_starting_from_args = [&](Lisp_Object* arguments, Environment* env) -> Lisp_Object* {
|
||||
Function* function = new(Function);
|
||||
function->parent_environment = env;
|
||||
function->type = Function_Type::Lambda;
|
||||
|
||||
// if parameters were specified
|
||||
if (arguments->value.pair->first->type != Lisp_Object_Type::Nil) {
|
||||
try {
|
||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Pair);
|
||||
}
|
||||
try {
|
||||
parse_argument_list(arguments->value.pair->first, function);
|
||||
}
|
||||
} else {
|
||||
function->positional_arguments = create_positional_argument_list(1);
|
||||
function->keyword_arguments = create_keyword_argument_list(1);
|
||||
function->rest_argument = nullptr;
|
||||
}
|
||||
|
||||
arguments = arguments->value.pair->rest;
|
||||
// if there is a docstring, use it
|
||||
if (arguments->value.pair->first->type == Lisp_Object_Type::String) {
|
||||
function->docstring = arguments->value.pair->first->value.string;
|
||||
arguments = arguments->value.pair->rest;
|
||||
} else {
|
||||
function->docstring = nullptr;
|
||||
}
|
||||
|
||||
// we are now in the function body, just wrap it in an
|
||||
// implicit prog
|
||||
function->body = Memory::create_lisp_object_pair(
|
||||
Memory::get_or_create_lisp_object_symbol("prog"),
|
||||
arguments);
|
||||
|
||||
Lisp_Object* ret = Memory::create_lisp_object();
|
||||
ret->type = Lisp_Object_Type::Function;
|
||||
ret->value.function = function;
|
||||
return ret;
|
||||
};
|
||||
|
||||
defun("=", cLambda {
|
||||
int arguments_length;
|
||||
try {
|
||||
@@ -316,25 +357,57 @@ proc load_built_ins_into_environment(Environment* env) -> void {
|
||||
arguments_length = list_length(arguments);
|
||||
}
|
||||
|
||||
if (arguments_length != 2) {
|
||||
if (arguments_length < 2) {
|
||||
report_error(Error_Type::Wrong_Number_Of_Arguments);
|
||||
}
|
||||
|
||||
Lisp_Object* symbol = arguments->value.pair->first;
|
||||
Lisp_Object* value;
|
||||
|
||||
if (symbol->type == Lisp_Object_Type::Pair) {
|
||||
/*
|
||||
1: arguments
|
||||
2: symbol
|
||||
3: real_symbol
|
||||
|
||||
(define (f x) "docs" (+ 1 x))
|
||||
|
||||
[ | ] -> [1| ] -> [ | ] -> [ |/]
|
||||
| | | |
|
||||
V | V V
|
||||
define | "docs" [ | ] -> [ | ] -> [ |/]
|
||||
| | | |
|
||||
V V V V
|
||||
[2| ] -> [ |/] + 1 x
|
||||
| |
|
||||
V V
|
||||
f(3) x
|
||||
*/
|
||||
|
||||
Lisp_Object* real_symbol = symbol->value.pair->first;
|
||||
|
||||
try {
|
||||
symbol = eval_expr(symbol, env);
|
||||
assert_type(real_symbol, Lisp_Object_Type::Symbol);
|
||||
}
|
||||
}
|
||||
|
||||
if (symbol->type != Lisp_Object_Type::Symbol) {
|
||||
report_error(Error_Type::Type_Missmatch);
|
||||
}
|
||||
Lisp_Object* fake_lambda = Memory::create_lisp_object_pair(
|
||||
symbol ->value.pair->rest,
|
||||
arguments->value.pair->rest);
|
||||
|
||||
Lisp_Object* value = arguments->value.pair->rest->value.pair->first;
|
||||
try {
|
||||
value = eval_expr(value, env);
|
||||
value = parse_lambda_starting_from_args(fake_lambda, env);
|
||||
symbol = real_symbol;
|
||||
} else {
|
||||
if (arguments_length > 2) {
|
||||
report_error(Error_Type::Wrong_Number_Of_Arguments);
|
||||
}
|
||||
if (symbol->type != Lisp_Object_Type::Symbol) {
|
||||
report_error(Error_Type::Type_Missmatch);
|
||||
}
|
||||
|
||||
value = arguments->value.pair->rest->value.pair->first;
|
||||
try {
|
||||
value = eval_expr(value, env);
|
||||
}
|
||||
}
|
||||
|
||||
define_symbol(symbol, value, env);
|
||||
@@ -635,7 +708,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
|
||||
return evaluated_arguments->value.pair->first;
|
||||
});
|
||||
defun("lambda", cLambda {
|
||||
/*
|
||||
/* TODO(Felix): first one crashes
|
||||
* (lambda ())
|
||||
* (lambda (x d) (+ 1 2) (- 1 2) (* 1 2))
|
||||
*/
|
||||
@@ -646,43 +719,11 @@ proc load_built_ins_into_environment(Environment* env) -> void {
|
||||
if (arguments_length == 0)
|
||||
report_error(Error_Type::Wrong_Number_Of_Arguments);
|
||||
|
||||
Function* function = new(Function);
|
||||
function->parent_environment = env;
|
||||
function->type = Function_Type::Lambda;
|
||||
Lisp_Object* function = parse_lambda_starting_from_args(arguments, env);
|
||||
// parse lambda starting from arguments
|
||||
|
||||
// if parameters were specified
|
||||
if (arguments->value.pair->first->type != Lisp_Object_Type::Nil) {
|
||||
try {
|
||||
assert_type(arguments->value.pair->first, Lisp_Object_Type::Pair);
|
||||
}
|
||||
try {
|
||||
parse_argument_list(arguments->value.pair->first, function);
|
||||
}
|
||||
} else {
|
||||
function->positional_arguments = create_positional_argument_list(1);
|
||||
function->keyword_arguments = create_keyword_argument_list(1);
|
||||
function->rest_argument = nullptr;
|
||||
}
|
||||
|
||||
arguments = arguments->value.pair->rest;
|
||||
// if there is a docstring, use it
|
||||
if (arguments->value.pair->first->type == Lisp_Object_Type::String) {
|
||||
function->docstring = arguments->value.pair->first->value.string;
|
||||
arguments = arguments->value.pair->rest;
|
||||
} else {
|
||||
function->docstring = nullptr;
|
||||
}
|
||||
|
||||
// we are now in the function body, just wrap it in an
|
||||
// implicit prog
|
||||
function->body = Memory::create_lisp_object_pair(
|
||||
Memory::get_or_create_lisp_object_symbol("prog"),
|
||||
arguments);
|
||||
|
||||
Lisp_Object* ret = Memory::create_lisp_object();
|
||||
ret->type = Lisp_Object_Type::Function;
|
||||
ret->value.function = function;
|
||||
return ret;
|
||||
return function;
|
||||
});
|
||||
defun("special-lambda", cLambda {
|
||||
/*
|
||||
@@ -953,6 +994,23 @@ proc load_built_ins_into_environment(Environment* env) -> void {
|
||||
delete_error();
|
||||
}
|
||||
|
||||
return Memory::nil;
|
||||
});
|
||||
defun("show", cLambda {
|
||||
try {
|
||||
evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
|
||||
}
|
||||
if (arguments_length != 1) {
|
||||
report_error(Error_Type::Wrong_Number_Of_Arguments);
|
||||
}
|
||||
if (evaluated_arguments->value.pair->first->type != Lisp_Object_Type::Function) {
|
||||
report_error(Error_Type::Type_Missmatch);
|
||||
}
|
||||
|
||||
puts("body:\n");
|
||||
print(evaluated_arguments->value.pair->first->value.function->body);
|
||||
puts("\n");
|
||||
|
||||
return Memory::nil;
|
||||
});
|
||||
defun("print", cLambda {
|
||||
|
||||
+36
-26
@@ -10,10 +10,14 @@ constexpr bool is_debug_build = false;
|
||||
#define if_debug if constexpr (is_debug_build)
|
||||
|
||||
#ifdef _MSC_VER
|
||||
# define if_windows if constexpr (1)
|
||||
# define if_linux if constexpr (0)
|
||||
# define debug_break() if_debug __debugbreak()
|
||||
#else
|
||||
# include <signal.h>
|
||||
# define debug_break() if_debug raise(SIGTRAP)
|
||||
# define if_windows if (0)
|
||||
# define if_linux if (1)
|
||||
#endif
|
||||
|
||||
#define assert(cond) \
|
||||
@@ -26,26 +30,32 @@ constexpr bool is_debug_build = false;
|
||||
|
||||
#define concat_( a, b) a##b
|
||||
#define label(prefix, lnum) concat_(prefix,lnum)
|
||||
#define try \
|
||||
if (1) \
|
||||
goto label(body,__LINE__); \
|
||||
else \
|
||||
while (1) \
|
||||
if (1) { \
|
||||
if(error) return 0; \
|
||||
break; \
|
||||
} \
|
||||
#define try \
|
||||
if (1) \
|
||||
goto label(body,__LINE__); \
|
||||
else \
|
||||
while (1) \
|
||||
if (1) { \
|
||||
if(error) { \
|
||||
printf("in %s:%d\n", __FILE__, __LINE__); \
|
||||
return 0; \
|
||||
} \
|
||||
break; \
|
||||
} \
|
||||
else label(body,__LINE__):
|
||||
|
||||
#define try_void \
|
||||
if (1) \
|
||||
goto label(body,__LINE__); \
|
||||
else \
|
||||
while (1) \
|
||||
if (1) { \
|
||||
if(error) return; \
|
||||
break; \
|
||||
} \
|
||||
#define try_void \
|
||||
if (1) \
|
||||
goto label(body,__LINE__); \
|
||||
else \
|
||||
while (1) \
|
||||
if (1) { \
|
||||
if(error) { \
|
||||
printf("in %s:%d\n", __FILE__, __LINE__); \
|
||||
return; \
|
||||
} \
|
||||
break; \
|
||||
} \
|
||||
else label(body,__LINE__):
|
||||
|
||||
|
||||
@@ -75,11 +85,11 @@ constexpr bool is_debug_build = false;
|
||||
return ret; \
|
||||
}
|
||||
|
||||
// #define console_normal "\x1B[0m"
|
||||
// #define console_red "\x1B[31m"
|
||||
// #define console_green "\x1B[32m"
|
||||
// #define console_cyan "\x1B[36m"
|
||||
#define console_normal ""
|
||||
#define console_red ""
|
||||
#define console_green ""
|
||||
#define console_cyan ""
|
||||
#define console_normal "\x1B[0m"
|
||||
#define console_red "\x1B[31m"
|
||||
#define console_green "\x1B[32m"
|
||||
#define console_cyan "\x1B[36m"
|
||||
// #define console_normal ""
|
||||
// #define console_red ""
|
||||
// #define console_green ""
|
||||
// #define console_cyan ""
|
||||
|
||||
+6
-4
@@ -39,8 +39,10 @@ proc Error_Type_to_string(Error_Type type) -> const char* {
|
||||
}
|
||||
|
||||
proc assert_type(Lisp_Object* node, Lisp_Object_Type type) -> void {
|
||||
if (!node)
|
||||
create_error(Error_Type::Unknown_Error, nullptr);
|
||||
if (node->type == type) return;
|
||||
create_error(Error_Type::Type_Missmatch, node->sourceCodeLocation);
|
||||
if_debug {
|
||||
if (!node)
|
||||
create_error(Error_Type::Unknown_Error, nullptr);
|
||||
if (node->type == type) return;
|
||||
create_error(Error_Type::Type_Missmatch, node->sourceCodeLocation);
|
||||
}
|
||||
}
|
||||
|
||||
+4
-8
@@ -321,6 +321,7 @@ proc extract_keyword_value(char* keyword, Parsed_Arguments* args) -> Lisp_Object
|
||||
proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length) -> Lisp_Object* {
|
||||
int my_out_arguments_length = 0;
|
||||
if (arguments->type == Lisp_Object_Type::Nil) {
|
||||
*(out_arguments_length) = 0;
|
||||
return arguments;
|
||||
}
|
||||
|
||||
@@ -351,11 +352,6 @@ proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments
|
||||
}
|
||||
|
||||
proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
|
||||
#define report_error(_type) { \
|
||||
create_error(_type, node->sourceCodeLocation); \
|
||||
return nullptr; \
|
||||
}
|
||||
|
||||
switch (node->type) {
|
||||
case Lisp_Object_Type::T:
|
||||
case Lisp_Object_Type::Nil:
|
||||
@@ -372,7 +368,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
|
||||
}
|
||||
case Lisp_Object_Type::Pair: {
|
||||
current_source_code_location = node->sourceCodeLocation;
|
||||
|
||||
|
||||
Lisp_Object* lispOperator;
|
||||
if (node->value.pair->first->type != Lisp_Object_Type::CFunction &&
|
||||
node->value.pair->first->type != Lisp_Object_Type::Function)
|
||||
@@ -411,10 +407,10 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
|
||||
}
|
||||
}
|
||||
default: {
|
||||
report_error(Error_Type::Not_A_Function);
|
||||
create_error(Error_Type::Not_A_Function, node->sourceCodeLocation);
|
||||
return nullptr;
|
||||
}
|
||||
}
|
||||
#undef report_error
|
||||
}
|
||||
|
||||
proc is_truthy (Lisp_Object* expression, Environment* env) -> bool {
|
||||
|
||||
@@ -7,3 +7,4 @@ proc list_length(Lisp_Object*) -> int;
|
||||
proc load_built_ins_into_environment(Environment*) -> void;
|
||||
proc parse_argument_list(Lisp_Object*, Function*) -> void;
|
||||
proc create_error(Error_Type type, Source_Code_Location* location) -> void;
|
||||
proc assert_type(Lisp_Object* node, Lisp_Object_Type type) -> void;
|
||||
|
||||
+18
-15
@@ -22,9 +22,9 @@ proc string_equal(String* str1, String* str2) -> bool {
|
||||
|
||||
proc get_nibble(char c) -> char {
|
||||
if (c >= 'A' && c <= 'F')
|
||||
return (c - 'a') + 10;
|
||||
else if (c >= 'a' && c <= 'f')
|
||||
return (c - 'A') + 10;
|
||||
else if (c >= 'a' && c <= 'f')
|
||||
return (c - 'a') + 10;
|
||||
return (c - '0');
|
||||
}
|
||||
|
||||
@@ -42,6 +42,7 @@ proc unescape_string(char* in) -> bool {
|
||||
} else {
|
||||
/* escape sequence */
|
||||
switch (*++p) {
|
||||
case '0': *out++ = '\a'; ++p; break;
|
||||
case 'a': *out++ = '\a'; ++p; break;
|
||||
case 'b': *out++ = '\b'; ++p; break;
|
||||
case 'f': *out++ = '\f'; ++p; break;
|
||||
@@ -49,22 +50,21 @@ proc unescape_string(char* in) -> bool {
|
||||
case 'r': *out++ = '\r'; ++p; break;
|
||||
case 't': *out++ = '\t'; ++p; break;
|
||||
case 'v': *out++ = '\v'; ++p; break;
|
||||
|
||||
case '"':
|
||||
case '\'':
|
||||
case '\\':
|
||||
*out++ = *p++;
|
||||
case '?':
|
||||
break;
|
||||
// case 'x':
|
||||
// case 'X':
|
||||
// if (!isxdigit(p[1]) || !isxdigit(p[2])) {
|
||||
// int_err = "Invalid character on hexadecimal escape.";
|
||||
// } else {
|
||||
// *out++ = (char)(get_nibble(p[1]) * 0x10 + get_nibble(p[2]));
|
||||
// p += 3;
|
||||
// }
|
||||
// break;
|
||||
case 'x':
|
||||
case 'X':
|
||||
if (!isxdigit(p[1]) || !isxdigit(p[2])) {
|
||||
int_err = "Invalid character on hexadecimal escape.";
|
||||
} else {
|
||||
*out++ = (char)(get_nibble(p[1]) * 0x10 + get_nibble(p[2]));
|
||||
p += 3;
|
||||
}
|
||||
break;
|
||||
default:
|
||||
int_err = "Unexpected '\\' with no escape sequence.";
|
||||
break;
|
||||
@@ -227,10 +227,10 @@ proc panic(char* message) -> void {
|
||||
exit(1);
|
||||
}
|
||||
|
||||
proc print(Lisp_Object* node) -> void {
|
||||
proc print(Lisp_Object* node, bool print_quotes = false) -> void {
|
||||
switch (node->type) {
|
||||
case (Lisp_Object_Type::Nil): {
|
||||
printf("nil");
|
||||
printf("()");
|
||||
} break;
|
||||
case (Lisp_Object_Type::T): {
|
||||
printf("t");
|
||||
@@ -239,7 +239,10 @@ proc print(Lisp_Object* node) -> void {
|
||||
printf("%f", node->value.number->value);
|
||||
} break;
|
||||
case (Lisp_Object_Type::String): {
|
||||
printf("\"%s\"", Memory::get_c_str(node->value.string));
|
||||
if (print_quotes)
|
||||
printf("\"%s\"", Memory::get_c_str(node->value.string));
|
||||
else
|
||||
printf("%s", Memory::get_c_str(node->value.string));
|
||||
} break;
|
||||
case (Lisp_Object_Type::Symbol): {
|
||||
printf("%s", Memory::get_c_str(node->value.symbol->identifier));
|
||||
|
||||
@@ -46,6 +46,11 @@ namespace Memory {
|
||||
return &str->data;
|
||||
}
|
||||
|
||||
inline proc get_c_str(Lisp_Object* str) -> char* {
|
||||
assert_type(str, Lisp_Object_Type::String);
|
||||
return get_c_str(str->value.string);
|
||||
}
|
||||
|
||||
proc create_string(const char* str, int len) -> String* {
|
||||
// TODO(Felix): check the holes first, not just always append
|
||||
// at the end
|
||||
@@ -146,6 +151,13 @@ namespace Memory {
|
||||
return node;
|
||||
}
|
||||
|
||||
proc create_lisp_object_string(char* str) -> Lisp_Object* {
|
||||
Lisp_Object* node = create_lisp_object();
|
||||
node->type = Lisp_Object_Type::String;
|
||||
node->value.string = create_string(str);
|
||||
return node;
|
||||
}
|
||||
|
||||
proc get_or_create_lisp_object_symbol(String* identifier) -> Lisp_Object* {
|
||||
// TODO(Felix): if we already have it stored somewhere then
|
||||
// reuse it and dont create new one
|
||||
@@ -223,4 +235,29 @@ namespace Memory {
|
||||
load_built_ins_into_environment(ret);
|
||||
return ret;
|
||||
}
|
||||
|
||||
inline proc create_list(Lisp_Object* o1) -> Lisp_Object* {
|
||||
return create_lisp_object_pair(o1, nil);
|
||||
}
|
||||
|
||||
inline proc create_list(Lisp_Object* o1, Lisp_Object* o2) -> Lisp_Object* {
|
||||
return create_lisp_object_pair(o1, create_list(o2));
|
||||
}
|
||||
|
||||
inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3) -> Lisp_Object* {
|
||||
return create_lisp_object_pair(o1, create_list(o2, o3));
|
||||
}
|
||||
|
||||
inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3, Lisp_Object* o4) -> Lisp_Object* {
|
||||
return create_lisp_object_pair(o1, create_list(o2, o3, o4));
|
||||
}
|
||||
|
||||
inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3, Lisp_Object* o4, Lisp_Object* o5) -> Lisp_Object* {
|
||||
return create_lisp_object_pair(o1, create_list(o2, o3, o4, o5));
|
||||
}
|
||||
|
||||
inline proc create_list(Lisp_Object* o1, Lisp_Object* o2, Lisp_Object* o3, Lisp_Object* o4, Lisp_Object* o5, Lisp_Object* o6) -> Lisp_Object* {
|
||||
return create_lisp_object_pair(o1, create_list(o2, o3, o4, o5, o6));
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
+65
-10
@@ -1,8 +1,9 @@
|
||||
namespace Parser {
|
||||
|
||||
String* standard_in;
|
||||
String* parser_file;
|
||||
int parser_line;
|
||||
int parser_col;
|
||||
|
||||
// NOTE(Felix): In this environment, the build in functions will
|
||||
// be loaded, and the macros will be stored in form of
|
||||
// special-lambdas, that get executed in this environment at
|
||||
@@ -19,6 +20,7 @@ namespace Parser {
|
||||
// change that, we have to define some funcions in this
|
||||
// environment.
|
||||
environment_for_macros = env;
|
||||
standard_in = Memory::create_string("stdin");
|
||||
}
|
||||
|
||||
proc inject_scl(Lisp_Object* lo) -> void {
|
||||
@@ -98,6 +100,7 @@ namespace Parser {
|
||||
// update the index to point to the character after the atom
|
||||
// ended
|
||||
*index_in_text += atom_length;
|
||||
parser_col += atom_length;
|
||||
|
||||
return ret;
|
||||
}
|
||||
@@ -147,6 +150,7 @@ namespace Parser {
|
||||
|
||||
// plus one because we want to go after the quotes
|
||||
*index_in_text += 1;
|
||||
++parser_col;
|
||||
|
||||
return ret;
|
||||
}
|
||||
@@ -170,18 +174,31 @@ namespace Parser {
|
||||
create_source_code_location(parser_file, parser_line, parser_col));
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
// TODO(Felix): manually copy to parse control sequences
|
||||
// correctly without the need to unescape the string, also
|
||||
// better for keeping track of the encountered new lines and
|
||||
// characters since last new line so we can update the parser
|
||||
// location more easily
|
||||
strcpy(&string->data, text+(*index_in_text));
|
||||
/* manually copy to parse control sequences correctly */
|
||||
/* int temp_index = 0; */
|
||||
/* while (text+(temp_index+(*index_in_text)) != '\0') { */
|
||||
/* string[temp_index++] = text[temp_index+(*index_in_text)]; */
|
||||
/* } */
|
||||
/* string[temp_index++] = '\0'; */
|
||||
|
||||
text[*index_in_text+string_length] = '"';
|
||||
|
||||
*index_in_text += string_length +1; // plus one because we want to
|
||||
// go after the quotes
|
||||
// plus one because we want to go after the quotes
|
||||
*index_in_text += string_length +1;
|
||||
|
||||
// NOTE(Felix): this only has to be done until we manually
|
||||
// copy the string and we can do some bookeeping:
|
||||
/* recalculate the parser cursors position: */
|
||||
/* new col = (count chars since last \n) + 1 */
|
||||
for (int i = 0; i < string->length; ++i) {
|
||||
if (*((&string->data)+i) == '\n') {
|
||||
++parser_line;
|
||||
parser_col = 0;
|
||||
} else {
|
||||
++parser_col;
|
||||
}
|
||||
}
|
||||
|
||||
Lisp_Object* ret = Memory::create_lisp_object_string(string);
|
||||
inject_scl(ret);
|
||||
@@ -445,7 +462,7 @@ namespace Parser {
|
||||
}
|
||||
|
||||
proc parse_single_expression(char* text) -> Lisp_Object* {
|
||||
parser_file = Memory::create_string("stdin");
|
||||
parser_file = standard_in;
|
||||
parser_line = 1;
|
||||
parser_col = 1;
|
||||
|
||||
@@ -474,6 +491,44 @@ namespace Parser {
|
||||
return nullptr;
|
||||
}
|
||||
|
||||
proc parse_single_expression_or_bare_words(char* text, char* bare) -> Lisp_Object* {
|
||||
parser_file = standard_in;
|
||||
parser_line = 1;
|
||||
parser_col = 1;
|
||||
|
||||
int index_in_text = 0;
|
||||
Lisp_Object* result;
|
||||
eat_until_code(text, &index_in_text);
|
||||
if (text[(index_in_text)] == '\0')
|
||||
return Memory::nil;
|
||||
if (text[index_in_text] == '(' ||
|
||||
text[index_in_text] == '\'' ||
|
||||
text[index_in_text] == '`' ||
|
||||
text[index_in_text] == ',')
|
||||
{
|
||||
try {
|
||||
result = parse_expression(text, &index_in_text);
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
else {
|
||||
int pos = index_in_text;
|
||||
int end_pos = index_in_text;
|
||||
while (text[end_pos] != '\n')
|
||||
++end_pos;
|
||||
|
||||
text[end_pos] = '\0';
|
||||
Lisp_Object* str = Memory::create_lisp_object_string(
|
||||
Memory::create_string(text+index_in_text));
|
||||
text[end_pos] = '\n';
|
||||
|
||||
return Memory::create_list(
|
||||
Memory::get_or_create_lisp_object_symbol(bare), str);
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
proc write_expanded_file(String* file_name, Lisp_Object_Array_List* program) -> void {
|
||||
const char* ext = ".expanded";
|
||||
char* newName = (char*)calloc(10 + file_name->length, sizeof(char));
|
||||
|
||||
@@ -1,9 +1,11 @@
|
||||
#pragma once
|
||||
|
||||
#define _CRT_SECURE_NO_WARNINGS
|
||||
#define _CRT_SECURE_NO_DEPRECATE
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
#include <cmath>
|
||||
#include <ctype.h>
|
||||
// #include <type_traits>
|
||||
#include <functional>
|
||||
|
||||
@@ -25,3 +27,4 @@ namespace Slime {
|
||||
}
|
||||
|
||||
#undef _CRT_SECURE_NO_DEPRECATE
|
||||
#undef _CRT_SECURE_NO_WARNINGS
|
||||
|
||||
Reference in New Issue
Block a user