소스 검색

fixes splicing of nil and macros dont expand at parse time fr now

master
Felix Brendel 7 년 전
부모
커밋
c0e79075bc
9개의 변경된 파일98개의 추가작업 그리고 51개의 파일을 삭제
  1. +1
    -1
      bin/a.slime
  2. +4
    -1
      bin/b.slime
  3. +3
    -0
      bin/c.slime
  4. +18
    -28
      bin/oo.slime
  5. +8
    -8
      bin/pre.slime.expanded
  6. +29
    -12
      src/built_ins.cpp
  7. +5
    -0
      src/env.cpp
  8. +13
    -0
      src/eval.cpp
  9. +17
    -1
      src/parse.cpp

+ 1
- 1
bin/a.slime 파일 보기

@@ -1 +1 @@
(define-syntax (e x) x)
(define-syntax (e x) `(+ 1 ,x))

+ 4
- 1
bin/b.slime 파일 보기

@@ -1,3 +1,6 @@
(import "a.slime")

(printf (e 2))
(define (f) (e 2))
(show f)
(f)
(show f)

+ 3
- 0
bin/c.slime 파일 보기

@@ -0,0 +1,3 @@
(import "b.slime")

(printf (e 3))

+ 18
- 28
bin/oo.slime 파일 보기

@@ -1,29 +1,19 @@
(define-syntax (define-class name members :rest body)
"Macro for creating classes."
(define (underscore sym)
(string->symbol (concat-strings "_" (symbol->string sym))))
(define-syntax (define-class name-and-members :rest body)
"Macro for creating simple classes."
(let ((name (first name-and-members))
(members (rest name-and-members)))
`(define
;; The function definition
(,(string->symbol (concat-strings "make-" (symbol->string name))) @members)
;; The docstring
,(concat-strings "This is the handle to an object of the class " (symbol->string name))
;; the body
(let ,(zip members members)
@body
(set-type
(special-lambda (:rest args)
"This is the docs for the handle"
(eval (first args)))
,(symbol->keyword name))))))

(define underscored-members (map underscore members))

;; the wrapping let environment
(define let-body `(let ,(zip members underscored-members)))

;; the body
(extend let-body body)
;; (map (lambda (fun) (append let-body fun)) body)

;; the dispatch function
(append let-body `(set-type
(special-lambda
(message :rest args)
"This is the docs for the handle"
(eval (extend (list message) args))) ,(symbol->keyword name)))

;; stuff it all in the constructor function
`(define
;; The function definition
,(pair (string->symbol (concat-strings "make-" (symbol->string name))) underscored-members)
;; The docstring
,(concat-strings "This is the handle to an object of the class " (symbol->string name))
;; the body
,let-body))
(define-class (vec x y z))

+ 8
- 8
bin/pre.slime.expanded 파일 보기

@@ -24,7 +24,7 @@
the (rest) of the last element of the sequence." (if (pair? seq) (begin (define e (end seq)) (mutate e (pair (first e) elem)) seq) elem))

(define (extend2 seq elem) "Extends a list with the given element, by putting it in
the (rest) of the last element of the sequence." (printf "addr of (end seq)" (addr-of (end seq))) (if (pair? seq) ((lambda (e) (printf "addr if e inner" (addr-of e)) (mutate e (pair (first e) elem)) seq) (end seq))) elem)
the (rest) of the last element of the sequence." (printf "addr of (end seq)" (addr-of (end seq))) (if (pair? seq) (let ((e (end seq))) (printf "addr if e inner" (addr-of e)) (mutate e (pair (first e) elem)) seq)) elem)

(define (append seq elem) "Appends an element to a sequence, by extendeing the list
with (pair elem nil)." (extend seq (pair elem ())))
@@ -36,7 +36,7 @@ with (pair elem nil)." (extend seq (pair elem ())))
(define (decrement val) "Subtracts one from the argument." (- val 1))

(define (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'." (if (< from to) (pair from (range :from (+ 1 from) :to to))))
by the key 'from' and ends with the number defined in 'to'." (when (< from to) (pair from (range :from (+ 1 from) :to to))))

(define (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) (begin (mutate head (pair (first head) (pair (copy from) nil))) (define head (rest head)) (mutate from (increment from)))) result)
@@ -49,7 +49,7 @@ elemens as argument to that function." (if (nil? seq) seq (pair (fun (first seq)
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." (eval (pair fun seq)))
instead." (apply fun seq))

(define (reduce-binary fun seq) "Takes a function and a sequence as arguments and applies the
function to the argument sequence. reduce-binary applies the
@@ -59,17 +59,17 @@ as compared to `reduce'." (if (nil? (rest seq)) (first seq) (fun (first seq) (re
(define (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." (if seq (if (fun (first seq)) (pair (first seq) (filter fun (rest seq))) (filter fun (rest seq)))))
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)))))

(define (zip l1 l2) (if (and (nil? l1) (nil? l2)) nil (pair (list (first l1) (first l2)) (zip (rest l1) (rest l2)))))
(define (zip l1 l2) (unless (and (nil? l1) (nil? l2)) (pair (list (first l1) (first l2)) (zip (rest l1) (rest l2)))))

(define (unzip lists) (if lists (define (iter lists l1 l2) (define elem (first lists)) (if elem (iter (rest lists) (pair (first elem) l1) (pair (first (rest elem)) l2)) (list l1 l2)))) (iter lists () ()))
(define (unzip lists) (when lists (define (iter lists l1 l2) (define elem (first lists)) (if elem (iter (rest lists) (pair (first elem) l1) (pair (first (rest elem)) l2)) (list l1 l2)))) (iter lists () ()))

(define (enumerate seq) (define (enumerate-inner seq next-num) (if seq (pair (list (first seq) next-num) (enumerate-inner (rest seq) (+ 1 next-num))))) (enumerate-inner seq 0))
(define (enumerate seq) (define (enumerate-inner seq next-num) (when seq (pair (list (first seq) next-num) (enumerate-inner (rest seq) (+ 1 next-num))))) (enumerate-inner seq 0))

(define (printf :keys sep :defaults-to " " end :defaults-to "
" :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." (define printf-quoted (special-lambda (:keys sep end :rest args) (if (nil? args) (begin (print (eval end)) nil) (begin (print (first args)) (if (nil? (rest args)) nil (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))))
las argument." (define printf-quoted (special-lambda (:keys sep end :rest args) (if (nil? args) (begin (print (eval end)) nil) (begin (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))))


+ 29
- 12
src/built_ins.cpp 파일 보기

@@ -496,8 +496,7 @@ proc load_built_ins_into_environment(Environment* env) -> void {
// funciton, we can't just modify it because otherwise
// we modify the body of the function and would bake
// in the result...
Lisp_Object* newPair;
try newPair = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
Lisp_Object* newPair = Memory::nil;
Lisp_Object* newPairHead = newPair;
Lisp_Object* head = expr;
while (Memory::get_type(head) == Lisp_Object_Type::Pair) {
@@ -509,25 +508,43 @@ proc load_built_ins_into_environment(Environment* env) -> void {
{
Lisp_Object* spliced = unquoteSomeExpressions(head->value.pair.first);

if (spliced == Memory::nil) {
head = head->value.pair.rest;
continue;
}

try assert_type(spliced, Lisp_Object_Type::Pair);
newPairHead->value.pair.first = spliced->value.pair.first;
newPairHead->value.pair.rest = spliced->value.pair.rest;
if (newPair == Memory::nil) {
try newPair = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
newPairHead = newPair;
} else {
try newPairHead->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
newPairHead->value.pair.first = spliced->value.pair.first;
newPairHead->value.pair.rest = spliced->value.pair.rest;

// now skip to the end
while (newPairHead->value.pair.rest != Memory::nil) {
newPairHead = newPairHead->value.pair.rest;
}
}

// now skip to the end
while (newPairHead->value.pair.rest != Memory::nil) {
} else {
if (newPair == Memory::nil) {
try newPair = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
newPairHead = newPair;
} else {
try newPairHead->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
newPairHead = newPairHead->value.pair.rest;
}
} else {
newPairHead->value.pair.first = unquoteSomeExpressions(head->value.pair.first);
}

if (Memory::get_type(head->value.pair.rest) != Lisp_Object_Type::Pair)
break;
// if (Memory::get_type(head->value.pair.rest) != Lisp_Object_Type::Pair) {
// break;
// }

try newPairHead->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);

newPairHead = newPairHead->value.pair.rest;
head = head->value.pair.rest;

}
newPairHead->value.pair.rest = Memory::nil;



+ 5
- 0
src/env.cpp 파일 보기

@@ -67,6 +67,11 @@ proc print_indent(int indent) -> void {
}

proc print_environment_indent(Environment* env, int indent) -> void {
// if(env == Globals::root_environment) {
// print_indent(indent);
// printf("[built-ins]-Environment (%lld)\n", (long long)env);
// return;
// }
for (int i = 0; i < env->next_index; ++i) {
print_indent(indent);
print(env->values[i]);


+ 13
- 0
src/eval.cpp 파일 보기

@@ -418,6 +418,19 @@ proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {

Lisp_Object* result;
try result = apply_arguments_to_function(arguments, &lispOperator->value.function);

// NOTE(Felix): The parser does not understnad (import ..)
// so it cannot expand imported macros at read time
// (because at read time, they are not imported yet, this
// is done at runtime...). That is why we sometimes have
// stray macros fying around, in that case, we expand them
// and bake them in, so they do not have to be expanded
// later again.
if (lispOperator->value.function.type == Function_Type::Macro) {
*node = *result;
try result = eval_expr(result, env);
}

return result;
}
}


+ 17
- 1
src/parse.cpp 파일 보기

@@ -449,16 +449,32 @@ namespace Parser {
} else {
// if threre is a macro named like this, then macroexpand
// if not it is regular code, dont touch.
break;

Lisp_Object* macro = try_lookup_symbol(parsed_symbol, environment_for_macros);
if (macro &&
Memory::get_type(macro) == Lisp_Object_Type::Function &&
macro->value.function.type == Function_Type::Macro)
{
// printf("Found macro: ") ;
// printf("pretending to expand macro at %s %d %d: ",
// Memory::get_c_str(parser_file),
// parser_line, parser_col);
// print(parsed_symbol);
// printf("\n");
// NOTE(Felix): Execute it as a special lambda,
// because if we keep it as a macro, the evaluator
// will think it is a stray macro that was not yet
// expanded, and attempt to evaluate it twice (1.
// for expanding, and 2. for evaluating)
macro->value.function.type = Function_Type::Special_Lambda;
// NOTE(Felix): deferred so even if eval expr
// fails, and returns, the type will be be
// resetted to macro.
defer {
macro->value.function.type = Function_Type::Macro;
};
try expression = eval_expr(expression, environment_for_macros);
break;
} else break;
}
}


불러오는 중...
취소
저장