felix
/
slime
1
0
Форкнуть 0
Код Задачи 0 Pull Request'ы 0 Релизы 0 Вики Активность
Просмотр исходного кода

better errors and new define syntax

master
FelixBrendel 7 лет назад
Родитель
181ace1eed
Сommit
edef0b017b
12 измененных файлов: 276 добавлений и 426 удалений
Единый вид
Опции Diff
Показать статистику Скачать Patch файл Скачать Diff файл
  1. +0
    -223
      bin/pre.slime
  2. +0
    -81
      bin/tests/class_macro.slime
  3. +0
    -11
      bin/tests/lexical_scope.slime
  4. +106
    -48
      src/built_ins.cpp
  5. +36
    -26
      src/defines.cpp
  6. +6
    -4
      src/error.cpp
  7. +4
    -8
      src/eval.cpp
  8. +1
    -0
      src/forward_decls.cpp
  9. +18
    -15
      src/io.cpp
  10. +37
    -0
      src/memory.cpp
  11. +65
    -10
      src/parse.cpp
  12. +3
    -0
      src/slime.h

+ 0
- 223
bin/pre.slime Просмотреть файл

@@ -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)))

+ 0
- 81
bin/tests/class_macro.slime Просмотреть файл

@@ -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))

+ 0
- 11
bin/tests/lexical_scope.slime Просмотреть файл

@@ -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
src/built_ins.cpp Просмотреть файл

@@ -65,9 +65,10 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Lisp_Object* evaluated_arguments; Lisp_Object* evaluated_arguments;


#define cLambda [=](Lisp_Object* arguments, Environment* env) mutable -> Lisp_Object* #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) { proc defun = [&](const char* name, auto fun) {
@@ -77,6 +78,46 @@ proc load_built_ins_into_environment(Environment* env) -> void {
env); 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 { defun("=", cLambda {
int arguments_length; int arguments_length;
try { try {
@@ -316,25 +357,57 @@ proc load_built_ins_into_environment(Environment* env) -> void {
arguments_length = list_length(arguments); arguments_length = list_length(arguments);
} }


if (arguments_length != 2) {
if (arguments_length < 2) {
report_error(Error_Type::Wrong_Number_Of_Arguments); report_error(Error_Type::Wrong_Number_Of_Arguments);
} }


Lisp_Object* symbol = arguments->value.pair->first; Lisp_Object* symbol = arguments->value.pair->first;
Lisp_Object* value;


if (symbol->type == Lisp_Object_Type::Pair) { 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 { 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); define_symbol(symbol, value, env);
@@ -635,7 +708,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
return evaluated_arguments->value.pair->first; return evaluated_arguments->value.pair->first;
}); });
defun("lambda", cLambda { defun("lambda", cLambda {
/*
/* TODO(Felix): first one crashes
* (lambda ()) * (lambda ())
* (lambda (x d) (+ 1 2) (- 1 2) (* 1 2)) * (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) if (arguments_length == 0)
report_error(Error_Type::Wrong_Number_Of_Arguments); 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 { defun("special-lambda", cLambda {
/* /*
@@ -953,6 +994,23 @@ proc load_built_ins_into_environment(Environment* env) -> void {
delete_error(); 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; return Memory::nil;
}); });
defun("print", cLambda { defun("print", cLambda {


+ 36
- 26
src/defines.cpp Просмотреть файл

@@ -10,10 +10,14 @@ constexpr bool is_debug_build = false;
#define if_debug if constexpr (is_debug_build) #define if_debug if constexpr (is_debug_build)


#ifdef _MSC_VER #ifdef _MSC_VER
# define if_windows if constexpr (1)
# define if_linux if constexpr (0)
# define debug_break() if_debug __debugbreak() # define debug_break() if_debug __debugbreak()
#else #else
# include <signal.h> # include <signal.h>
# define debug_break() if_debug raise(SIGTRAP) # define debug_break() if_debug raise(SIGTRAP)
# define if_windows if (0)
# define if_linux if (1)
#endif #endif


#define assert(cond) \ #define assert(cond) \
@@ -26,26 +30,32 @@ constexpr bool is_debug_build = false;


#define concat_( a, b) a##b #define concat_( a, b) a##b
#define label(prefix, lnum) concat_(prefix,lnum) #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__): 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__): else label(body,__LINE__):




@@ -75,11 +85,11 @@ constexpr bool is_debug_build = false;
return ret; \ 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
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 { 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
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* { proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length) -> Lisp_Object* {
int my_out_arguments_length = 0; int my_out_arguments_length = 0;
if (arguments->type == Lisp_Object_Type::Nil) { if (arguments->type == Lisp_Object_Type::Nil) {
*(out_arguments_length) = 0;
return arguments; 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* { proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
#define report_error(_type) { \
create_error(_type, node->sourceCodeLocation); \
return nullptr; \
}

switch (node->type) { switch (node->type) {
case Lisp_Object_Type::T: case Lisp_Object_Type::T:
case Lisp_Object_Type::Nil: case Lisp_Object_Type::Nil:
@@ -372,7 +368,7 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
} }
case Lisp_Object_Type::Pair: { case Lisp_Object_Type::Pair: {
current_source_code_location = node->sourceCodeLocation; current_source_code_location = node->sourceCodeLocation;
Lisp_Object* lispOperator; Lisp_Object* lispOperator;
if (node->value.pair->first->type != Lisp_Object_Type::CFunction && if (node->value.pair->first->type != Lisp_Object_Type::CFunction &&
node->value.pair->first->type != Lisp_Object_Type::Function) node->value.pair->first->type != Lisp_Object_Type::Function)
@@ -411,10 +407,10 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
} }
} }
default: { 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 { proc is_truthy (Lisp_Object* expression, Environment* env) -> bool {


+ 1
- 0
src/forward_decls.cpp Просмотреть файл

@@ -7,3 +7,4 @@ proc list_length(Lisp_Object*) -> int;
proc load_built_ins_into_environment(Environment*) -> void; proc load_built_ins_into_environment(Environment*) -> void;
proc parse_argument_list(Lisp_Object*, Function*) -> void; proc parse_argument_list(Lisp_Object*, Function*) -> void;
proc create_error(Error_Type type, Source_Code_Location* location) -> 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
src/io.cpp Просмотреть файл

@@ -22,9 +22,9 @@ proc string_equal(String* str1, String* str2) -> bool {


proc get_nibble(char c) -> char { proc get_nibble(char c) -> char {
if (c >= 'A' && c <= 'F') if (c >= 'A' && c <= 'F')
return (c - 'a') + 10;
else if (c >= 'a' && c <= 'f')
return (c - 'A') + 10; return (c - 'A') + 10;
else if (c >= 'a' && c <= 'f')
return (c - 'a') + 10;
return (c - '0'); return (c - '0');
} }


@@ -42,6 +42,7 @@ proc unescape_string(char* in) -> bool {
} else { } else {
/* escape sequence */ /* escape sequence */
switch (*++p) { switch (*++p) {
case '0': *out++ = '\a'; ++p; break;
case 'a': *out++ = '\a'; ++p; break; case 'a': *out++ = '\a'; ++p; break;
case 'b': *out++ = '\b'; ++p; break; case 'b': *out++ = '\b'; ++p; break;
case 'f': *out++ = '\f'; ++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 'r': *out++ = '\r'; ++p; break;
case 't': *out++ = '\t'; ++p; break; case 't': *out++ = '\t'; ++p; break;
case 'v': *out++ = '\v'; ++p; break; case 'v': *out++ = '\v'; ++p; break;

case '"': case '"':
case '\'': case '\'':
case '\\': case '\\':
*out++ = *p++; *out++ = *p++;
case '?': case '?':
break; 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: default:
int_err = "Unexpected '\\' with no escape sequence."; int_err = "Unexpected '\\' with no escape sequence.";
break; break;
@@ -227,10 +227,10 @@ proc panic(char* message) -> void {
exit(1); exit(1);
} }


proc print(Lisp_Object* node) -> void {
proc print(Lisp_Object* node, bool print_quotes = false) -> void {
switch (node->type) { switch (node->type) {
case (Lisp_Object_Type::Nil): { case (Lisp_Object_Type::Nil): {
printf("nil");
printf("()");
} break; } break;
case (Lisp_Object_Type::T): { case (Lisp_Object_Type::T): {
printf("t"); printf("t");
@@ -239,7 +239,10 @@ proc print(Lisp_Object* node) -> void {
printf("%f", node->value.number->value); printf("%f", node->value.number->value);
} break; } break;
case (Lisp_Object_Type::String): { 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; } break;
case (Lisp_Object_Type::Symbol): { case (Lisp_Object_Type::Symbol): {
printf("%s", Memory::get_c_str(node->value.symbol->identifier)); printf("%s", Memory::get_c_str(node->value.symbol->identifier));


+ 37
- 0
src/memory.cpp Просмотреть файл

@@ -46,6 +46,11 @@ namespace Memory {
return &str->data; 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* { proc create_string(const char* str, int len) -> String* {
// TODO(Felix): check the holes first, not just always append // TODO(Felix): check the holes first, not just always append
// at the end // at the end
@@ -146,6 +151,13 @@ namespace Memory {
return node; 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* { proc get_or_create_lisp_object_symbol(String* identifier) -> Lisp_Object* {
// TODO(Felix): if we already have it stored somewhere then // TODO(Felix): if we already have it stored somewhere then
// reuse it and dont create new one // reuse it and dont create new one
@@ -223,4 +235,29 @@ namespace Memory {
load_built_ins_into_environment(ret); load_built_ins_into_environment(ret);
return 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
src/parse.cpp Просмотреть файл

@@ -1,8 +1,9 @@
namespace Parser { namespace Parser {
String* standard_in;
String* parser_file; String* parser_file;
int parser_line; int parser_line;
int parser_col; int parser_col;

// NOTE(Felix): In this environment, the build in functions will // NOTE(Felix): In this environment, the build in functions will
// be loaded, and the macros will be stored in form of // be loaded, and the macros will be stored in form of
// special-lambdas, that get executed in this environment at // 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 // change that, we have to define some funcions in this
// environment. // environment.
environment_for_macros = env; environment_for_macros = env;
standard_in = Memory::create_string("stdin");
} }


proc inject_scl(Lisp_Object* lo) -> void { proc inject_scl(Lisp_Object* lo) -> void {
@@ -98,6 +100,7 @@ namespace Parser {
// update the index to point to the character after the atom // update the index to point to the character after the atom
// ended // ended
*index_in_text += atom_length; *index_in_text += atom_length;
parser_col += atom_length;


return ret; return ret;
} }
@@ -147,6 +150,7 @@ namespace Parser {


// plus one because we want to go after the quotes // plus one because we want to go after the quotes
*index_in_text += 1; *index_in_text += 1;
++parser_col;


return ret; return ret;
} }
@@ -170,18 +174,31 @@ namespace Parser {
create_source_code_location(parser_file, parser_line, parser_col)); create_source_code_location(parser_file, parser_line, parser_col));
return nullptr; 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)); 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] = '"'; 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); Lisp_Object* ret = Memory::create_lisp_object_string(string);
inject_scl(ret); inject_scl(ret);
@@ -445,7 +462,7 @@ namespace Parser {
} }


proc parse_single_expression(char* text) -> Lisp_Object* { proc parse_single_expression(char* text) -> Lisp_Object* {
parser_file = Memory::create_string("stdin");
parser_file = standard_in;
parser_line = 1; parser_line = 1;
parser_col = 1; parser_col = 1;


@@ -474,6 +491,44 @@ namespace Parser {
return nullptr; 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 { proc write_expanded_file(String* file_name, Lisp_Object_Array_List* program) -> void {
const char* ext = ".expanded"; const char* ext = ".expanded";
char* newName = (char*)calloc(10 + file_name->length, sizeof(char)); char* newName = (char*)calloc(10 + file_name->length, sizeof(char));


+ 3
- 0
src/slime.h Просмотреть файл

@@ -1,9 +1,11 @@
#pragma once #pragma once


#define _CRT_SECURE_NO_WARNINGS
#define _CRT_SECURE_NO_DEPRECATE #define _CRT_SECURE_NO_DEPRECATE
#include <stdio.h> #include <stdio.h>
#include <string.h> #include <string.h>
#include <cmath> #include <cmath>
#include <ctype.h>
// #include <type_traits> // #include <type_traits>
#include <functional> #include <functional>


@@ -25,3 +27,4 @@ namespace Slime {
} }


#undef _CRT_SECURE_NO_DEPRECATE #undef _CRT_SECURE_NO_DEPRECATE
#undef _CRT_SECURE_NO_WARNINGS

Редактирование Предпросмотр
Загрузка…
Отмена
Сохранить