diff --git a/bin/pre.slime b/bin/pre.slime deleted file mode 100644 index fc8a287..0000000 --- a/bin/pre.slime +++ /dev/null @@ -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))) diff --git a/bin/tests/class_macro.slime b/bin/tests/class_macro.slime deleted file mode 100644 index 0a2fb5d..0000000 --- a/bin/tests/class_macro.slime +++ /dev/null @@ -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)) diff --git a/bin/tests/lexical_scope.slime b/bin/tests/lexical_scope.slime deleted file mode 100644 index d953f83..0000000 --- a/bin/tests/lexical_scope.slime +++ /dev/null @@ -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)) diff --git a/src/built_ins.cpp b/src/built_ins.cpp index 800d131..676ef33 100644 --- a/src/built_ins.cpp +++ b/src/built_ins.cpp @@ -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; - - // 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; - } + Lisp_Object* function = parse_lambda_starting_from_args(arguments, env); + // parse lambda starting from arguments - // 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 { diff --git a/src/defines.cpp b/src/defines.cpp index 725095e..43ee094 100644 --- a/src/defines.cpp +++ b/src/defines.cpp @@ -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 # 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 "" diff --git a/src/error.cpp b/src/error.cpp index 0ccdf55..854d9f3 100644 --- a/src/error.cpp +++ b/src/error.cpp @@ -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); + } } diff --git a/src/eval.cpp b/src/eval.cpp index a7c83d0..52ba6b2 100644 --- a/src/eval.cpp +++ b/src/eval.cpp @@ -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 { diff --git a/src/forward_decls.cpp b/src/forward_decls.cpp index a1187b8..8d73078 100644 --- a/src/forward_decls.cpp +++ b/src/forward_decls.cpp @@ -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; diff --git a/src/io.cpp b/src/io.cpp index 205bd04..eb6ca38 100644 --- a/src/io.cpp +++ b/src/io.cpp @@ -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)); diff --git a/src/memory.cpp b/src/memory.cpp index 1ee54d3..1eda2ed 100644 --- a/src/memory.cpp +++ b/src/memory.cpp @@ -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)); + } + } diff --git a/src/parse.cpp b/src/parse.cpp index 77d3aae..d799d9d 100644 --- a/src/parse.cpp +++ b/src/parse.cpp @@ -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)); diff --git a/src/slime.h b/src/slime.h index 4008d02..ffbe249 100644 --- a/src/slime.h +++ b/src/slime.h @@ -1,9 +1,11 @@ #pragma once +#define _CRT_SECURE_NO_WARNINGS #define _CRT_SECURE_NO_DEPRECATE #include #include #include +#include // #include #include @@ -25,3 +27,4 @@ namespace Slime { } #undef _CRT_SECURE_NO_DEPRECATE +#undef _CRT_SECURE_NO_WARNINGS