Переглянути джерело

Checkpoint before unquote-splicing

master
Felix Brendel 7 роки тому
джерело
коміт
eb3bc262b9
6 змінених файлів з 592 додано та 93 видалено
  1. +103
    -18
      bin/pre.slime
  2. +9
    -2
      bin/pre.slime.expanded
  3. +410
    -24
      manual/manual.org
  4. +67
    -47
      src/built_ins.cpp
  5. +2
    -2
      src/memory.cpp
  6. +1
    -0
      todo.org

+ 103
- 18
bin/pre.slime Переглянути файл

@@ -12,20 +12,24 @@
(pair elem (repeat (- times 1) elem))))
(pair 'begin (repeat times action)))

;; (define (fib n))
;; (define-syntax define (name :rest value)
;; (print name)
;; (print (type name))
;; (if (= (type name) :pair)
;; (begin
;; ;; (print `(define ,(first name) ,`(pair lambda (pair (rest name) value))))
;; ;; (print rest)
;; (print "\naa\n")
;; (list 'define (first name) (pair 'lambda (pair (rest name) value))))
;; (begin
;; ;; (print (pair 'define (pair name value)))
;; (print "\nbb\n")
;; (pair 'define (pair name value)))))
(define-syntax (let bindings :rest body)
(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 unzipped (unzip bindings))

(pair `(lambda ,(first unzipped)
,(pair 'begin body))
(first (rest unzipped))))

(define-syntax (cond :rest clauses)
(define (rec clauses)
@@ -41,6 +45,63 @@
(rec (rest clauses))))))
(rec clauses))

(define-syntax (do-list :rest body)
(define (car seq) (first seq))
(define (cdr seq) (rest seq))
(define (cadr seq) (car (cdr seq)))
(define (cddr seq) (cdr (cdr seq)))
(define (caddr seq) (car (cddr seq)))
(define (cdddr seq) (cdr (cddr seq)))

(define (extend-map f ll)
(when ll
(extend
(f (first ll))
(extend-map f (rest ll)))))

(define (list-bind l f)
(extend-map f l))

(define (list-return x)
(list x))

(define (rec :rest body)
(cond
((= () body) (begin))
((= () (rest body)) (first body))
((= (first (rest body)) "<-")
`(,list-bind ,(caddr body) (lambda (,(first body)) (,rec . (unquote (cdddr body))))))
((= (first (rest body)) "when")
`(if ,(cadr body) (,rec . (unquote (cddr body))) (list-fail)))
((= (first (rest body)) "yield")
`(,list-return ,(cadr body)))
(else (error "Not a do-able expression: ~S" `',body))))

(rec body))

;; (define-syntax (define-special name-and-args)
;; (define (unzip lists)
;; (define elem (first lists))
;; (define l1 (pair (first elem) ()))
;; (define l2 (pair (first (rest elem)) ()))

;; (define (iter lists)
;; (define elem (first lists))
;; (when elem
;; (begin
;; (mutate l1 (pair (first elem) (copy l1)))
;; (mutate l2 (pair (first (rest elem)) (copy l2)))
;; (iter (rest lists)))))

;; (iter (rest lists))
;; (list l1 l2))

;; (define unzipped (unzip bindings))

;; (pair `(lambda ,(first unzipped)
;; ,(pair 'begin body))
;; (first (rest unzipped))))

(define (nil? x)
"Checks if the argument is nil."
(= x nil))
@@ -102,10 +163,21 @@ the (rest) of the last element of the sequence."
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)
(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 nil)))
(extend seq (pair elem ())))

(define (length seq)
"Returns the length of the given sequence."
@@ -194,10 +266,23 @@ added to a list, which in the end is returned."
(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)))))
(unless (and (nil? l1) (nil? l2))
(pair (list (first l1) (first l2))
(zip (rest l1) (rest l2)))))

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


+ 9
- 2
bin/pre.slime.expanded Переглянути файл

@@ -1,3 +1,5 @@
(show do-list)

(define (nil? x) "Checks if the argument is nil." (= x nil))

(define (number? x) "Checks if the argument is a number." (= (type x) :number))
@@ -26,8 +28,11 @@ ithe sequence as arguemens." (eval (pair fun seq)))
(define (extend seq elem) "Extends a list with the given element, by putting it in
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) (begin (printf "addr if e inner" (addr-of e)) (mutate e (pair (first e) elem)) seq)) (end seq))) elem)

(define (append seq elem) "Appends an element to a sequence, by extendeing the list
with (pair elem nil)." (extend seq (pair elem nil)))
with (pair elem nil)." (extend seq (pair elem ())))

(define (length seq) "Returns the length of the given sequence." (if (nil? seq) 0 (+ 1 (length (rest seq)))))

@@ -61,7 +66,9 @@ 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 ([C-function] (if (fun (first seq)) (pair (first seq) (filter fun (rest seq))) (filter fun (rest seq)))) nil))

(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) (if (and (nil? l1) (nil? l2)) nil ([C-function] (pair (list (first l1) (first l2)) (zip (rest l1) (rest l2))))))

(define (unzip lists) (if lists ([C-function] (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)))) nil) (iter lists () ()))

(define (enumerate seq) (define (enumerate-inner seq next-num) (if seq ([C-function] (pair (list (first seq) next-num) (enumerate-inner (rest seq) (+ 1 next-num)))) nil)) (enumerate-inner seq 0))



+ 410
- 24
manual/manual.org Переглянути файл

@@ -12,6 +12,10 @@ characteristics. There are Lisp-1 and Lisp-2 dialects and there is a difference
lexical scoping as opposed to dynamic scoping. These differences will be explained in later
sections.

Like most Lisps, Slime is dynamically typed. That means that like in statically typed Languages
Slime has different data types, but they are associated not with variables but with the Lisp objects
themselves. Variables can be assigend Lisp objects of any internal type.

The Lisp language family is known to be highly flexible and applicable in all areas by creating
domain specific languages in Lisp itself through a powerful macro system. The central data structure
in Lisp is the list. The reason why lisp is so powerful is because the program source code itself is
@@ -96,7 +100,7 @@ symbol). If the parser encounters a =.= inside of a list, it will treat the
=rest=. If there is no or more than one element after the =.= an parsing error will be thrown. Using
this syntax we can represent the ill formed list from [[illFormedList]] as =(1 2 . 3)=. We can also
write well formed lists using the dot notation if we point the rest to another list. So the well
formed list from [[simpleBoxDiagram]] can also be written as =(1 . (2 . (3)))=
formed list from [[simpleBoxDiagram]] can also be written as \[\texttt{(1 . (2 . (3)))}\]

** representing function calls in Lisp

@@ -195,7 +199,7 @@ value and only =I knew it!!= will be printed.
: I knew it!!

The programmer can also define their own special forms using =special-lambda= and macros, which will
be explained later.
be explained in [[Special lambdas]] and [[Macros]].

* Symbols and keywords
* Truthyness
@@ -346,7 +350,10 @@ defined and supplied after all the regular arguments.
#+name: code:keyword-args
#+caption: A more complex functoin definition using keyword arguments
#+begin_src slime
(define (complex required1 required2 :keys key1 key2 :defaults-to 3 key3)
(define (complex required1 required2 :keys
key1
key2 :defaults-to 3
key3)
(* (+ required1 required2)
key1
key2
@@ -382,7 +389,9 @@ other argument types, regular arguments and keyword arguments.
(when do-logging
(printf "Executing operation"
operation
"agains values yielded:"
"agains the values"
values
"yielded:"
result))
result)

@@ -395,11 +404,11 @@ other argument types, regular arguments and keyword arguments.
#+RESULTS: code:rest-args
: evaluates to =>
: 6
: Executing operation [C-function] agains values yielded: 110
: Executing operation * agains values (10 11) yielded: 110
: 110


* Environments
* Macros
* Built-in functions
This section provides a comprehensive list of the built in functions for Slime. Some of them are
defined in =C++= source code, some are themselves written in Slime. The cool thing about Slime is
@@ -410,25 +419,195 @@ embedded scripting language.
** Arithmetic functions
- =+= :: (=regular function [C++]=) Takes 0 or more numbers as arguments and returns the sum of all
the numbers.

{{{slime_header}}}
#+name: code:built-in-=
#+begin_src slime
(printf (+))
(printf (+ 3))
(printf (+ 1 3 2))
(printf (+ 1 (+ 3 4)))
#+end_src

#+results: code:built-in-=
: evaluates to =>
: 0
: 3
: 6
: 8


- =-= :: (=regular function [C++]=) Takes 0 or more numbers as arguments. If only one number is
supplied, its negation is returned, otherwise the difference of the first argument and the
sum of the remaining arguments is returned:
\[\texttt{(- 10 2 1)} \Rightarrow 10 - 2 - 1 = 10 - (2 + 1) = 7\]

{{{slime_header}}}
#+name: code:built-in--
#+begin_src slime
(printf (-))
(printf (- 3))
(printf (- 5 3 1))
(printf (- 5 (+ 3 1)))
#+end_src

#+RESULTS: code:built-in--
: evaluates to =>
: 0
: -3
: 1
: 1

- =*= :: (=regular function [C++]=) Takes 0 or more numbers as arguments and returns the product of
all the numbers.

{{{slime_header}}}
#+name: code:built-in-*
#+begin_src slime
(printf (*))
(printf (* 2))
(printf (* 5 3 2))
(printf (* 2 (+ 3 1)))
#+end_src

#+RESULTS: code:built-in-*
: evaluates to =>
: 1
: 2
: 30
: 8

- =/= :: (=regular function [C++]=) Takes 0 or more numbers as arguments. If only one number is
supplied, it is returned, otherwise the quotient of the first argument and the product of
the remaining arguments is returned:
\[\texttt{(/ 100 2 5)} \Rightarrow \frac{100}{\frac{2}{5}} = \frac{100}{2 \cdot 5} = 10\]

{{{slime_header}}}
#+name: code:built-in-/
#+begin_src slime
(printf (/))
(printf (/ 3))
(printf (/ 1 2))
(printf (/ 2 (+ 3 2 1)))
#+end_src

#+RESULTS: code:built-in-/
: evaluates to =>
: 1
: 3
: 0.500000
: 0.333333

- =**= :: (=regular function [C++]=) Takes 2 number arguments and returns the the first argument
taken to the power of the second argument.

{{{slime_header}}}
#+name: code:built-in-**
#+begin_src slime
(printf (** 1 200))
(printf (** 2 6))
(printf (** 25 0.5))
(printf (** 27 (/ 1 3)))
#+end_src

#+RESULTS: code:built-in-**
: evaluates to =>
: 1
: 64
: 5
: 3

- =%= :: (=regular function [C++]=) Takes 2 number arguments and rounds them down to integer values
and then returns the remainder of the division of the first argument by the second.

{{{slime_header}}}
#+name: code:built-in-mod
#+begin_src slime
(printf (% 10 3))
(printf (% (+ 3 (* 12 15)) 15))
#+end_src

#+RESULTS: code:built-in-%
: evaluates to =>
: 1
: 3

- =not= :: (=regular function [C++]=)

{{{slime_header}}}
#+name: code:built-in-not
#+begin_src slime
(printf (not 10))
(printf (not ()))
(printf (not (> 10 1)))
(printf (not (< 10 1)))
#+end_src

#+RESULTS: code:built-in-not
: evaluates to =>
: ()
: t
: ()
: t

- =and= :: (=regular function [C++]=)

{{{slime_header}}}
#+name: code:built-in-and
#+begin_src slime
(printf (and))
(printf (and 1 2 3 4))
(printf (and 1 2 () 4))
(printf (and (> 3 1) (< 3 10)))
#+end_src

#+RESULTS: code:built-in-and
: evaluates to =>
: t
: t
: ()
: t

- =or= :: (=regular function [C++]=)

{{{slime_header}}}
#+name: code:built-in-org
#+begin_src slime
(printf (or))
(printf (or 1 2 3 4))
(printf (or 1 2 () 4))
(printf (or (> 1 3) (< 3 10)))
#+end_src

#+RESULTS: code:built-in-org
: evaluates to =>
: ()
: t
: t
: t

- =increment= :: (=regular function [Slime]=)
{{{slime_header}}}
#+name: code:built-in-increment
#+begin_src slime
(printf (increment 11))
#+end_src

#+RESULTS: code:built-in-increment
: evaluates to =>
: 12


- =decrement= :: (=regular function [Slime]=)
{{{slime_header}}}
#+name: code:built-in-decrement
#+begin_src slime
(printf (decrement 12))
#+end_src

#+RESULTS: code:built-in-decrement
: evaluates to =>
: 11

** Comparison functions
- === :: (=regular function [C++]=) Takes 0 or more arguments and returns =t= iff
@@ -472,25 +651,232 @@ embedded scripting language.
\indent and =()= otherwise.

** Controlflow
+ =if= :: (=special form [C++]=)
+ =cond= :: (=special form [Slime]=)
+ =while= :: (=special form [C++]=)
+ =n-times= :: (=special form [Slime]=)
- =if= :: (=special form [C++]=) Takes 2 or more arguments. If the first argument (the
condition) evaluates to a truthy value, the second argument is evaluated and returned.
Else if more arguemnts are supplied, they will be evaluated and the last result will
be returned, if the condition was falsy and no further arguments were supplied, then
nil will be returned.

+ =when= :: (=special form [Slime]=)
+ =unless= :: (=special form [Slime]=)

{{{slime_header}}}
#+name: built-in-if
#+begin_src slime
(printf (if 1 1 2))
(printf (if () 1 2))
(printf (if () 1 ))
#+end_src

#+RESULTS: built-in-if
: evaluates to =>
: 1
: 2
: ()

- =cond= :: (=special form [Slime]=)

{{{slime_header}}}
#+name: built-in-cond
#+begin_src slime
(define (fib n)
(cond ((<= n 0) 0)
((= n 1) 1)
(else (+ (fib (- n 1))
(fib (- n 2))))))

(printf (fib 6))
#+end_src

#+RESULTS: built-in-cond
: evaluates to =>
: 8

- =while= :: (=special form [C++]=)

{{{slime_header}}}
#+name: built-in-while
#+begin_src slime
(define animals '("Bird" "Dolphin" "Giraffe"))

(while animals
(printf (first animals) "is an animal")
(define animals (rest animals))
)
#+end_src

#+RESULTS: built-in-while
: evaluates to =>
: Bird is an animal
: Dolphin is an animal
: Giraffe is an animal


- =n-times= :: (=special form [Slime]=)

{{{slime_header}}}
#+name: built-in-n-times
#+begin_src slime
(n-times 3 (printf "Three time's a charm"))
#+end_src

#+RESULTS: built-in-n-times
: evaluates to =>
: Three time's a charm
: Three time's a charm
: Three time's a charm


- =when= :: (=special form [Slime]=)

{{{slime_header}}}
#+name: built-in-when
#+begin_src slime
(printf (when 1 2 3))
(printf (when () 2 3))
#+end_src

#+RESULTS: built-in-when
: evaluates to =>
: 3
: ()

- =unless= :: (=special form [Slime]=)

{{{slime_header}}}
#+name: built-in-unless
#+begin_src slime
(printf (unless 1 2 3))
(printf (unless () 2 3))
#+end_src

#+RESULTS: built-in-unless
: evaluates to =>
: ()
: 3

** Functions for lists
- =pair= :: (=regular function [C++]=)
- =first= :: (=regular function [C++]=)
- =rest= :: (=regular function [C++]=)
- =list= :: (=regular function [C++]=)

- =end= :: (=regular function [Slime]=)
- =last= :: (=regular function [Slime]=)
- =extend= :: (=regular function [Slime]=)
- =pair= :: (=regular function [C++]=) Takes 2 arguments of any type and return a pair which
=first= field points to the first argument and the =rest= field points to the second
argument.

{{{slime_header}}}
#+name: built-in-pair
#+begin_src slime
(printf (pair 1 "yes"))
(printf (pair '+ ()))
(printf (pair '+ (pair 1 (pair 3 ()))))
(printf (eval (pair '+ '(1 3))))
#+end_src

#+RESULTS: built-in-pair
: evaluates to =>
: (1 . yes)
: (+)
: (+ 1 3)
: 4

- =first= :: (=regular function [C++]=) Takes a list as argument and returns the contents of its
=first= field.

{{{slime_header}}}
#+name: built-in-first
#+begin_src slime
(printf (first (pair 1 3)))
(printf (first (list 2 3)))
(printf (first '("hello" "world")))
#+end_src

#+RESULTS: built-in-first
: evaluates to =>
: 1
: 2
: hello


- =rest= :: (=regular function [C++]=) Takes a list as argument and returns the contents of its
=rest= field.
{{{slime_header}}}
#+name: built-in-rest
#+begin_src slime
(printf (rest (pair 1 3)))
(printf (rest (list 2 3)))
(printf (rest '("hello" "world")))
#+end_src


- =list= :: (=regular function [C++]=) Takes any number of arguments, evaluates each and returns a
list containing the results.

{{{slime_header}}}
#+name: built-in-list
#+begin_src slime
(printf (list))
(printf (list 1 2 3))
(printf (list (pair 1 2)
'(3 4)
(list 5 6)))
#+end_src

#+RESULTS: built-in-list
: evaluates to =>
: ()
: (1 2 3)
: ((1 . 2) (3 4) (5 6))


- =length= :: (=regular function [Slime]=) Takes a list as argument and returns the number of
elements in that list.

{{{slime_header}}}
#+name: built-in-length
#+begin_src slime
(printf (length ()))
(printf (length '(1 2 3)))
(printf (length '(+ 1 4 (+ 2 3))))
#+end_src

#+RESULTS: built-in-length
: evaluates to =>
: 0
: 3
: 4

- =end= :: (=regular function [Slime]=) Takes a list as argument. Returns the last pair in the
list.
{{{slime_header}}}
#+name: built-in-end
#+begin_src slime
(printf (end ()))
(printf (end '(1 2 3)))
(printf (end '(+ 1 4 (+ 2 3))))
#+end_src

#+RESULTS: built-in-end
: evaluates to =>
: ()
: (3)
: ((+ 2 3))

- =last= :: (=regular function [Slime]=) Takes a list as argument. Returns the last element in the
list.

{{{slime_header}}}
#+name: built-in-last
#+begin_src slime
(printf (last ()))
(printf (last '(1 2 3)))
(printf (last '(+ 1 4 (+ 2 3))))
#+end_src

#+RESULTS: built-in-last
: evaluates to =>
: ()
: 3
: (+ 2 3)

- =extend= :: (=regular function [Slime]=) Takes a list and any


- =append= :: (=regular function [Slime]=)
- =length= :: (=regular function [Slime]=)

- =range= :: (=regular function [Slime]=)
- =range-while= :: (=regular function [Slime]=)
@@ -530,8 +916,8 @@ embedded scripting language.
** no category
- =eval= :: (=regular function [C++]=)
- =apply= :: (=regular function [C++]=)
- =lambda= :: (=regular function [C++]=)
- =special-lambda= :: (=regular function [C++]=)
- =lambda= :: (=special form [C++]=) See the section about =Lambdas= in [[Lambdas]].
- =special-lambda= :: (=special form [C++]=) See the section about =Lambdas= in [[Lambdas]].

- =copy= :: (=regular function [C++]=)
- =import= :: (=regular function [C++]=)
@@ -542,7 +928,7 @@ embedded scripting language.
- =quasiquote= :: (=regular function [C++]=)
- =unquote= :: (=regular function [C++]=)
- =mutate= :: (=regular function [C++]=)
- =define= :: (=regular function [C++]=)
- =define= :: (=special form [C++]=) See the section about =define= in [[Define]].
- =assert= :: (=regular function [C++]=)
* testbox :noexport:
#+BEGIN_SRC ditaa :file diagrams/test.eps :cmdline --no-separation --no-shadows


+ 67
- 47
src/built_ins.cpp Переглянути файл

@@ -392,16 +392,24 @@ proc load_built_ins_into_environment(Environment* env) -> void {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
try assert_arguments_length(2, arguments_length);

if (evaluated_arguments->value.pair.first == Memory::nil ||
evaluated_arguments->value.pair.first == Memory::t ||
Memory::get_type(evaluated_arguments->value.pair.first) == Lisp_Object_Type::Keyword ||
Memory::get_type(evaluated_arguments->value.pair.first) == Lisp_Object_Type::Symbol)
Lisp_Object* target = evaluated_arguments->value.pair.first;
Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first;

if (target == Memory::nil ||
target == Memory::t ||
Memory::get_type(target) == Lisp_Object_Type::Keyword ||
Memory::get_type(target) == Lisp_Object_Type::Symbol)
{
create_generic_error("You cannot mutate nil, t, keywords or symbols");
create_generic_error("You cannot mutate to nil, t, keywords or symbols because they have to be unique");
}

Lisp_Object* target = evaluated_arguments->value.pair.first;
Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first;
if (source == Memory::nil ||
source == Memory::t ||
Memory::get_type(source) == Lisp_Object_Type::Keyword ||
Memory::get_type(source) == Lisp_Object_Type::Symbol)
{
create_generic_error("You cannot mutate nil, t, keywords or symbols");
}

*target = *source;
return target;
@@ -533,6 +541,12 @@ proc load_built_ins_into_environment(Environment* env) -> void {
Lisp_Object* condition_part = arguments->value.pair.first;
Lisp_Object* condition;
Lisp_Object* then_part = arguments->value.pair.rest;
Lisp_Object* wrapped_then_part;

try wrapped_then_part = Memory::create_lisp_object_pair(
Memory::get_or_create_lisp_object_symbol("begin"),
then_part);

Lisp_Object* result = Memory::nil;

while (true) {
@@ -541,63 +555,63 @@ proc load_built_ins_into_environment(Environment* env) -> void {
if (condition == Memory::nil)
break;

try result = eval_expr(then_part->value.pair.first, env);
try result = eval_expr(wrapped_then_part, env);
}
return result;

});
defun("let", cLambda {
// (let ((a 10)(b 20)) (body1) (body2))
try arguments_length = list_length(arguments);
try assert_arguments_length_greater_equal(1, arguments_length);
// defun("let", cLambda {
// // (let ((a 10)(b 20)) (body1) (body2))
// try arguments_length = list_length(arguments);
// try assert_arguments_length_greater_equal(1, arguments_length);

Environment* let_env;
try let_env = Memory::create_child_environment(env);
Lisp_Object* bindings = arguments->value.pair.first;
while (true) {
if (bindings == Memory::nil) {
break;
}
// Environment* let_env;
// try let_env = Memory::create_child_environment(env);
// Lisp_Object* bindings = arguments->value.pair.first;
// while (true) {
// if (bindings == Memory::nil) {
// break;
// }

try assert_type(bindings, Lisp_Object_Type::Pair);
// try assert_type(bindings, Lisp_Object_Type::Pair);

Lisp_Object* sym = bindings->value.pair.first->value.pair.first;
// Lisp_Object* sym = bindings->value.pair.first->value.pair.first;

try assert_type(sym, Lisp_Object_Type::Symbol);
// try assert_type(sym, Lisp_Object_Type::Symbol);

Lisp_Object* rest_sym = bindings->value.pair.first->value.pair.rest;
// Lisp_Object* rest_sym = bindings->value.pair.first->value.pair.rest;

try assert_type(rest_sym, Lisp_Object_Type::Pair);
try assert_type(rest_sym->value.pair.rest, Lisp_Object_Type::Nil);
// try assert_type(rest_sym, Lisp_Object_Type::Pair);
// try assert_type(rest_sym->value.pair.rest, Lisp_Object_Type::Nil);

Lisp_Object* value = eval_expr(rest_sym->value.pair.first, env);
// Lisp_Object* value = eval_expr(rest_sym->value.pair.first, env);

// NOTE(Felix): We have to copy the value here because
// if the let body modifies the value, it would bake
// in... bad bad...
define_symbol(sym, Memory::copy_lisp_object(value), let_env);
// // NOTE(Felix): We have to copy the value here because
// // if the let body modifies the value, it would bake
// // in... bad bad...
// define_symbol(sym, Memory::copy_lisp_object(value), let_env);

bindings = bindings->value.pair.rest;
}
// bindings = bindings->value.pair.rest;
// }

arguments = arguments->value.pair.rest;
// arguments = arguments->value.pair.rest;

Lisp_Object* evaluated_arguments;
try evaluated_arguments = eval_arguments(arguments, let_env, &arguments_length);
// Lisp_Object* evaluated_arguments;
// try evaluated_arguments = eval_arguments(arguments, let_env, &arguments_length);

if (evaluated_arguments == Memory::nil)
return evaluated_arguments;
// if (evaluated_arguments == Memory::nil)
// return evaluated_arguments;

// skip to the last evaluated operand and return it,
// we use eval_arguments here instead of doing it
// manually, because we want to increase code reuse,
// but at the cost that we have to find the end of the
// list again
while (Memory::get_type(evaluated_arguments->value.pair.rest) == Lisp_Object_Type::Pair) {
evaluated_arguments = evaluated_arguments->value.pair.rest;
}
return evaluated_arguments->value.pair.first;
});
// // skip to the last evaluated operand and return it,
// // we use eval_arguments here instead of doing it
// // manually, because we want to increase code reuse,
// // but at the cost that we have to find the end of the
// // list again
// while (Memory::get_type(evaluated_arguments->value.pair.rest) == Lisp_Object_Type::Pair) {
// evaluated_arguments = evaluated_arguments->value.pair.rest;
// }
// return evaluated_arguments->value.pair.first;
// });
defun("lambda", cLambda {
/* TODO(Felix): first one crashes
* (lambda ())
@@ -820,6 +834,12 @@ proc load_built_ins_into_environment(Environment* env) -> void {

return Memory::nil;
});
defun("addr-of", cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
try assert_arguments_length(1, arguments_length);

return Memory::create_lisp_object_number((u64)&(evaluated_arguments->value.pair.first->value));
});
defun("print", cLambda {
try evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
try assert_arguments_length(1, arguments_length);


+ 2
- 2
src/memory.cpp Переглянути файл

@@ -140,7 +140,7 @@ namespace Memory {
// if we still have space
if (object_memory_size == next_index_in_object_memory) {
create_out_of_memory_error(
"There is not enough space in the lisp object"
"There is not enough space in the lisp object "
"memory to allocate additional lisp objects. "
"Maybe try increasing the Memory size when "
"calling Memory::init()");
@@ -300,7 +300,7 @@ namespace Memory {
// if we still have space
if (environment_memory_size == next_index_in_environment_memory) {
create_out_of_memory_error(
"There is not enough space in the environment"
"There is not enough space in the environment "
"memory to allocate additional environments. "
"Maybe try increasing the Memory size when "
"calling Memory::init()");


+ 1
- 0
todo.org Переглянути файл

@@ -1,4 +1,5 @@
* TODO rename slime to plisk
* TODO rename modifying functions to prefix '!'
* TODO go through sicp and use the examples as test files
* TODO test macro expanding to macro
* TODO create global environment- and callstack


Завантаження…
Відмінити
Зберегти