Macros are now properly getting baked in Modules bug still persists

.gitignore

@@ -24,3 +24,5 @@ todo.html
 /tests/fullslime/main
 *.o
 /bin/slime_d
+/bin/slime_p
+*.json

3rd/ftb

@@ -1 +1 @@
-Subproject commit 8b50444d9ea34f264fdf8ec400ea9d304bf81a3c
+Subproject commit 98aa1450d8e63046d3260ea7fb4ff12c9c7e2629

bin/pre.slime

@@ -14,7 +14,7 @@
 
 (define the-empty-stream ())
 
-(define (stream-null? s) (if s t ()))
+(define (stream-null? s) (when s t))
 
 (define-syntax (delay expr)
   `(,lambda () ,expr))
@@ -26,7 +26,7 @@
 (define-syntax (add . args) (pair '+ args))
 
 (define-syntax (when condition . body)
-  :doc "Special form for when multiple actions should be done if a
+  "Special form for when multiple actions should be done if a
 condition is true.
 
 {{{example_start}}}
@@ -46,14 +46,14 @@ condition is true.
 
 
 (define-syntax (unless condition . body)
-  :doc "Special form for when multiple actions should be done if a
+  "Special form for when multiple actions should be done if a
 condition is false."
   (if (= (rest body) ())
       `(if ,condition nil ,@body)
     `(if ,condition nil (begin ,@body))))
 
 (define-syntax (n-times times action)
-  :doc "Executes action times times."
+  "Executes action times times."
   (define (repeat times elem)
     (unless (> 1 times)
       (pair elem (repeat (- times 1) elem))))
@@ -102,7 +102,7 @@ condition is false."
   (rec clauses))
 
 (define-syntax (construct-list . body)
-  :doc "
+  "
 {{{example_start}}}
 (construct-list
   i <- '(1 2 3 4 5)
@@ -143,7 +143,7 @@ condition is false."
   (rec body))
 
 ;; (define-syntax (apply fun seq)
-;;   :doc "Applies the function to the sequence, as in calls the function with
+;;   "Applies the function to the sequence, as in calls the function with
 ;; ithe sequence as arguemens."
 ;;   `(eval (pair ,fun ,seq)))
 
@@ -160,9 +160,9 @@ condition is false."
        ,@body)))
 
 
-(define-syntax (define-module module-name (:imports ()) :exports . body)
+(define-syntax (define-module module-name (:imports ()) (:exports ()) . body)
   (let ((module-prefix (concat-strings (symbol->string module-name) "::")))
-    (eval `(begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body))
+    (eval `(,begin ,@(map (lambda (x) `(,import ,x)) imports) ,@body))
     (pair 'begin
           (map (lambda (orig-export-name)
                  ((lambda (export-name)
@@ -235,11 +235,11 @@ condition is false."
   )
 
 (define (null? x)
-  :doc "Checks if the argument is =nil=."
+  "Checks if the argument is =nil=."
   (= x ()))
 
 (define (type=? obj typ)
-  :doc "Checks if the argument =obj= is of type =typ="
+  "Checks if the argument =obj= is of type =typ="
   (= (type obj) typ))
 
 (define (types=? . objs)
@@ -264,43 +264,43 @@ condition is false."
   (inner objs))
 
 (define (number? x)
-  :doc "Checks if the argument is a number."
+  "Checks if the argument is a number."
   (type=? x :number))
 
 (define (symbol? x)
-  :doc "Checks if the argument is a symbol."
+  "Checks if the argument is a symbol."
   (type=? x :symbol))
 
 (define (keyword? x)
-  :doc "Checks if the argument is a keyword."
+  "Checks if the argument is a keyword."
   (type=? x :keyword))
 
 (define (pair? x)
-  :doc "Checks if the argument is a pair."
+  "Checks if the argument is a pair."
   (type=? x :pair))
 
 (define (string? x)
-  :doc "Checks if the argument is a string."
+  "Checks if the argument is a string."
   (type=? x :string))
 
 (define (lambda? x)
-  :doc "Checks if the argument is a function."
+  "Checks if the argument is a function."
   (type=? x :lambda))
 
 (define (macro? x)
-  :doc "Checks if the argument is a macro."
+  "Checks if the argument is a macro."
   (type=? x :macro))
 
 (define (special-lambda? x)
-  :doc "Checks if the argument is a special-lambda."
+  "Checks if the argument is a special-lambda."
   (type=? x :dynamic-macro))
 
 (define (built-in-function? x)
-  :doc "Checks if the argument is a built-in function."
+  "Checks if the argument is a built-in function."
   (type=? x :cfunction))
 
 (define (continuation? x)
-  :doc "Checks if the argument is a continuation."
+  "Checks if the argument is a continuation."
   (type=? x :continuation))
 
 (define (procedure? x)
@@ -311,7 +311,7 @@ condition is false."
       (continuation? x)))
 
 (define (end seq)
-  :doc "Returns the last pair in the sqeuence.
+  "Returns the last pair in the sqeuence.
 
 {{{example_start}}}
 (define a (list 1 2 3 4))
@@ -323,7 +323,7 @@ condition is false."
     (end (rest seq))))
 
 (define (last seq)
-  :doc "Returns the (first) of the last (pair) of the given sequence.
+  "Returns the (first) of the last (pair) of the given sequence.
 
 {{{example_start}}}
 (define a (list 1 2 3 4))
@@ -333,7 +333,7 @@ condition is false."
   (first (end seq)))
 
 (define (extend seq elem)
-  :doc "Extends a list with the given element, by putting it in
+  "Extends a list with the given element, by putting it in
 the (rest) of the last element of the sequence."
   (if (pair? seq)
       (begin
@@ -343,7 +343,7 @@ the (rest) of the last element of the sequence."
     elem))
 
 (define (extend2 seq elem)
-  :doc "Extends a list with the given element, by putting it in
+  "Extends a list with the given element, by putting it in
 the (rest) of the last element of the sequence."
   (print "addr of (end seq)" (addr-of (end seq)))
   (if (pair? seq)
@@ -354,12 +354,12 @@ the (rest) of the last element of the sequence."
     elem)
 
 (define (append seq elem)
-  :doc "Appends an element to a sequence, by extendeing the list
+  "Appends an element to a sequence, by extendeing the list
 with (pair elem nil)."
   (extend seq (pair elem ())))
 
 (define (length seq)
-  :doc "Returns the length of the given sequence."
+  "Returns the length of the given sequence."
   (if (null? seq)
       0
     (+ 1 (length (rest seq)))))
@@ -384,21 +384,21 @@ with (pair elem nil)."
         (else (pair (first seq) (list-without-index (rest seq) (- index 1))))))
 
 (define (increment val)
-  :doc "Adds one to the argument."
+  "Adds one to the argument."
   (+ val 1))
 
 (define (decrement val)
-  :doc "Subtracts one from the argument."
+  "Subtracts one from the argument."
   (- val 1))
 
 (define (range (:from 0) :to)
-  :doc "Returns a sequence of numbers starting with the number defined
+  "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))))
 
 (define (range-while (:from 0) :to)
-  :doc "Returns a sequence of numbers starting with the number defined
+  "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)
@@ -420,7 +420,7 @@ elemens as argument to that function."
           (map fun (rest seq)))))
 
 (define (reduce fun seq)
-  :doc "Takes a function and a sequence as arguments and applies the
+  "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=]]
@@ -428,7 +428,7 @@ instead."
   (apply fun seq))
 
 (define (reduce-binary fun seq)
-  :doc "Takes a function and a sequence as arguments and applies the
+  "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=]]."
@@ -438,7 +438,7 @@ function to the argument sequence. reduce-binary applies the arguments
          (reduce-binary fun (rest seq)))))
 
 (define (filter fun seq)
-  :doc "Takes a function and a sequence as arguments and applies the
+  "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."

bin/tests/modules.slime

@@ -1,22 +1,21 @@
-;; (define-module math
-;;   :exports
-;;   (pi tau pow sqrt)
+(define-module math
+  :exports
+  (pi tau pow sqrt)
 
-;;   (define pi 3.1415)
-;;   (define tau (* 2 pi))
-;;   (define (pow a b) (** a b))
-;;   (define (sqrt a) (** a 0.5)))
+  (define pi 3.1415)
+  (define tau (* 2 pi))
+  (define (pow a b) (** a b))
+  (define (sqrt a) (** a 0.5)))
 
-;; (assert (= math::pi 3.1415))
-;; (assert (= math::tau (* 2 math::tau)))
+(assert (= math::pi 3.1415))
+(assert (= math::tau (* 2 math::tau)))
 
 
-(tdefine-module 'math
-  :exports
-  '(pi tau pow sqrt)
-
-  '(define pi 3.1415)
-  '(define tau (* 2 pi))
-  '(define (pow a b) (** a b))
-  '(define (sqrt a) (** a 0.5)))
+;; (tdefine-module 'math
+;;   :exports
+;;   '(pi tau pow sqrt)
 
+;;   '(define pi 3.1415)
+;;   '(define tau (* 2 pi))
+;;   '(define (pow a b) (** a b))
+;;   '(define (sqrt a) (** a 0.5)))

bin/tests/sicp.slime

@@ -1,149 +1,149 @@
 
-;; (define (abs x)
-;;   (cond ((< x 0) (- x))
-;;         (else x)))
+(define (abs x)
+  (cond ((< x 0) (- x))
+        (else x)))
 
-;; (assert (= (abs 1) 1))
-;; (assert (= (abs (- 2)) 2))
+(assert (= (abs 1) 1))
+(assert (= (abs (- 2)) 2))
 
 
-;; (define (abs x)
-  ;; (if (< x 0)
-      ;; (- x)
-    ;; x))
+(define (abs x)
+  (if (< x 0)
+      (- x)
+    x))
 
-;; (assert (= (abs 12) 12))
-;; (assert (= (abs (- 32)) 32))
+(assert (= (abs 12) 12))
+(assert (= (abs (- 32)) 32))
 
 
-;; (define (>= x y)
-;;   (or (> x y)
-;;       (= x y)))
+(define (>= x y)
+  (or (> x y)
+      (= x y)))
 
-;; (assert (>= 2 2))
-;; (assert (>= 3 2))
-;; (assert (not (>= 1 2)))
-;; (assert (not (>= 12 44)))
+(assert (>= 2 2))
+(assert (>= 3 2))
+(assert (not (>= 1 2)))
+(assert (not (>= 12 44)))
 
 
-;; (define (>= x y)
-;;   (not (< x y)))
+(define (>= x y)
+  (not (< x y)))
 
-;; (assert (>= 2 2))
-;; (assert (>= 3 2))
-;; (assert (not (>= 1 2)))
-;; (assert (not (>= 12 44)))
+(assert (>= 2 2))
+(assert (>= 3 2))
+(assert (not (>= 1 2)))
+(assert (not (>= 12 44)))
 
 
-;; (define (a-plus-abs-b a b)
-;;   ((if (> b 0) + -) a b))
+(define (a-plus-abs-b a b)
+  ((if (> b 0) + -) a b))
 
-;; (assert (= (a-plus-abs-b 1  2) 3))
-;; (assert (= (a-plus-abs-b 1 -2) 3))
+(assert (= (a-plus-abs-b 1  2) 3))
+(assert (= (a-plus-abs-b 1 -2) 3))
 
-;; (define (square x) (* x x))
-;; (define (cube x) (* x x x))
+(define (square x) (* x x))
+(define (cube x) (* x x x))
 
-;; (assert (= ((lambda (x y z)
-;;               (+ x y (square z)))
-;;             1 2 3)
-;;            12))
+(assert (= ((lambda (x y z)
+              (+ x y (square z)))
+            1 2 3)
+           12))
 
 ;; ;;; --------------------
 ;; ;;;    newtons method
 ;; ;;; --------------------
 
-;; (define tolerance 0.001)
+(define tolerance 0.001)
 
-;; (define (square x)
-;;   (* x x))
+(define (square x)
+  (* x x))
 
-;; (define (average x y)
-  ;; (/ (+ x y) 2))
+(define (average x y)
+  (/ (+ x y) 2))
 
-;; (define (improve guess x)
-;;   (average guess (/ x guess)))
+(define (improve guess x)
+  (average guess (/ x guess)))
 
-;; (define (good-enough? guess x)
-;;   (< (abs (- (square guess) x)) tolerance))
+(define (good-enough? guess x)
+  (< (abs (- (square guess) x)) tolerance))
 
-;; (define (sqrt-iter guess x)
-;;   (if (good-enough? guess x)
-;;       guess
-;;     (sqrt-iter (improve guess x) x)))
+(define (sqrt-iter guess x)
+  (if (good-enough? guess x)
+      guess
+    (sqrt-iter (improve guess x) x)))
 
-;; (define (sqrt x)
-;;   (sqrt-iter 1.0 x))
+(define (sqrt x)
+  (sqrt-iter 1.0 x))
 
-;; (define (sqrt2 x)
-;;   (define (good-enough? guess x)
-;;     (< (abs (- (square guess) x)) 0.001))
+(define (sqrt2 x)
+  (define (good-enough? guess x)
+    (< (abs (- (square guess) x)) 0.001))
 
-;;   (define (improve guess x)
-;;     (average guess (/ x guess)))
+  (define (improve guess x)
+    (average guess (/ x guess)))
 
-;;   (define (sqrt-iter guess x)
-;;     (if (good-enough? guess x)
-;;         guess
-;;       (sqrt-iter (improve guess x) x)))
+  (define (sqrt-iter guess x)
+    (if (good-enough? guess x)
+        guess
+      (sqrt-iter (improve guess x) x)))
 
-;;   (sqrt-iter 1.0 x))
+  (sqrt-iter 1.0 x))
 
-;; (define (sqrt3 x)
-;;   (define (good-enough? guess)
-;;     (< (abs (- (square guess) x)) 0.001))
+(define (sqrt3 x)
+  (define (good-enough? guess)
+    (< (abs (- (square guess) x)) 0.001))
 
-;;   (define (improve guess)
-;;     (average guess (/ x guess)))
+  (define (improve guess)
+    (average guess (/ x guess)))
 
-;;   (define (sqrt-iter guess)
-;;     (if (good-enough? guess)
-;;         guess
-;;       (sqrt-iter (improve guess))))
+  (define (sqrt-iter guess)
+    (if (good-enough? guess)
+        guess
+      (sqrt-iter (improve guess))))
 
-;;   (sqrt-iter 1.0))
+  (sqrt-iter 1.0))
 
-;; (assert      (< (abs (- 3 (sqrt 9)))  tolerance))
-;; (assert      (< (abs (- 4 (sqrt 16))) tolerance))
-;; (assert (not (< (abs (- 4 (sqrt 15))) tolerance)))
+(assert      (< (abs (- 3 (sqrt 9)))  tolerance))
+(assert      (< (abs (- 4 (sqrt 16))) tolerance))
+(assert (not (< (abs (- 4 (sqrt 15))) tolerance)))
 
-;; (assert      (< (abs (- 3 (sqrt2 9)))  tolerance))
-;; (assert      (< (abs (- 4 (sqrt2 16))) tolerance))
-;; (assert (not (< (abs (- 4 (sqrt2 15))) tolerance)))
+(assert      (< (abs (- 3 (sqrt2 9)))  tolerance))
+(assert      (< (abs (- 4 (sqrt2 16))) tolerance))
+(assert (not (< (abs (- 4 (sqrt2 15))) tolerance)))
 
-;; (assert      (< (abs (- 3 (sqrt3 9)))  tolerance))
-;; (assert      (< (abs (- 4 (sqrt3 16))) tolerance))
-;; (assert (not (< (abs (- 4 (sqrt3 15))) tolerance)))
+(assert      (< (abs (- 3 (sqrt3 9)))  tolerance))
+(assert      (< (abs (- 4 (sqrt3 16))) tolerance))
+(assert (not (< (abs (- 4 (sqrt3 15))) tolerance)))
 
 
-;; ;;; -----------------
-;; ;;;     factorial
-;; ;;; -----------------
+;;; -----------------
+;;;     factorial
+;;; -----------------
 
-;; (define (factorial n)
-;;   (if (= n 1)
-;;       1
-;;     (* n (factorial (- n 1)))))
+(define (factorial n)
+  (if (= n 1)
+      1
+    (* n (factorial (- n 1)))))
 
-;; (define (factorial2 n)
-;;   (fact-iter 1 1 n))
+(define (factorial2 n)
+  (fact-iter 1 1 n))
 
-;; (define (fact-iter product counter max-count)
-;;   (if (> counter max-count)
-;;       product
-;;     (fact-iter (* counter product) (+ counter 1) max-count)))
+(define (fact-iter product counter max-count)
+  (if (> counter max-count)
+      product
+    (fact-iter (* counter product) (+ counter 1) max-count)))
 
-;; (define (factorial3 n)
-;;   (define (iter product counter)
-;;     (if (> counter n)
-;;         product
-;;       (iter (* counter product) (+ counter 1))))
+(define (factorial3 n)
+  (define (iter product counter)
+    (if (> counter n)
+        product
+      (iter (* counter product) (+ counter 1))))
 
-;;   (iter 1 1))
+  (iter 1 1))
 
-;; (assert (= (factorial  6) 720))
-;; (assert (= (factorial2 6) 720))
-;; (assert (= (factorial3 6) 720))
+(assert (= (factorial  6) 720))
+(assert (= (factorial2 6) 720))
+(assert (= (factorial3 6) 720))
 
 ;;; ----------------
 ;;;     ackermann
@@ -154,13 +154,6 @@
           ((= n 0) (A (- m 1) 1))
           (else (A (- m 1) (A m (- n 1))))))
 
-;; (define (A m n)
-  ;; (if (= m 0)
-      ;; (+ n 1)
-    ;; (if (= n 0)
-        ;; (A (- m 1) 1)
-      ;; (A (- m 1) (A m (- n 1))))))
-
 (assert (= (A 0 0) 1))
 (assert (= (A 1 2) 4))
 (assert (= (A 3 1) 13))
@@ -170,50 +163,50 @@
 ;; ;;;    Fibonacci
 ;; ;;; ---------------
 
-;; (define (fib n)
-;;   (cond ((= n 0) 0)
-;;         ((= n 1) 1)
-;;         (else (+ (fib (- n 1)) (fib (- n 2))))))
-
-;; (define (fib2 n)
-;;   (fib-iter 1 0 n))
-
-;; (define (fib-iter a b count)
-;;   (if (= count 0)
-;;       b
-;;     (fib-iter (+ a b) a (- count 1))))
-
-;; (assert (= (fib 2) 1))
-;; (assert (= (fib 3) 2))
-;; (assert (= (fib 4) 3))
-;; (assert (= (fib 5) 5))
-;; (assert (= (fib 6) 8))
-
-;; (assert (= (fib2 2) 1))
-;; (assert (= (fib2 3) 2))
-;; (assert (= (fib2 4) 3))
-;; (assert (= (fib2 5) 5))
-;; (assert (= (fib2 6) 8))
-
-;; ;;; ------------------
-;; ;;;    count change
-;; ;;; ------------------
-
-;; (define (count-change amount)
-;;   (define (cc amount kinds-of-coins)
-;;     (cond ((= amount 0) 1)
-;;           ((or (< amount 0) (= kinds-of-coins 0)) 0)
-;;           (else (+ (cc amount (- kinds-of-coins 1))
-;;                    (cc (- amount (first-denomination kinds-of-coins)) kinds-of-coins)))))
-
-;;   (define (first-denomination kinds-of-coins)
-;;     (cond ((= kinds-of-coins 1) 1)
-;;           ((= kinds-of-coins 2) 5)
-;;           ((= kinds-of-coins 3) 10)
-;;           ((= kinds-of-coins 4) 25)
-;;           ((= kinds-of-coins 5) 50)))
-
-;;   (cc amount 5))
+(define (fib n)
+  (cond ((= n 0) 0)
+        ((= n 1) 1)
+        (else (+ (fib (- n 1)) (fib (- n 2))))))
+
+(define (fib2 n)
+  (fib-iter 1 0 n))
+
+(define (fib-iter a b count)
+  (if (= count 0)
+      b
+    (fib-iter (+ a b) a (- count 1))))
+
+(assert (= (fib 2) 1))
+(assert (= (fib 3) 2))
+(assert (= (fib 4) 3))
+(assert (= (fib 5) 5))
+(assert (= (fib 6) 8))
+
+(assert (= (fib2 2) 1))
+(assert (= (fib2 3) 2))
+(assert (= (fib2 4) 3))
+(assert (= (fib2 5) 5))
+(assert (= (fib2 6) 8))
+
+;;; ------------------
+;;;    count change
+;;; ------------------
+
+(define (count-change amount)
+  (define (cc amount kinds-of-coins)
+    (cond ((= amount 0) 1)
+          ((or (< amount 0) (= kinds-of-coins 0)) 0)
+          (else (+ (cc amount (- kinds-of-coins 1))
+                   (cc (- amount (first-denomination kinds-of-coins)) kinds-of-coins)))))
+
+  (define (first-denomination kinds-of-coins)
+    (cond ((= kinds-of-coins 1) 1)
+          ((= kinds-of-coins 2) 5)
+          ((= kinds-of-coins 3) 10)
+          ((= kinds-of-coins 4) 25)
+          ((= kinds-of-coins 5) 50)))
+
+  (cc amount 5))
 
 ;; (assert (= (count-change 100) 292))
 
@@ -221,128 +214,128 @@
 ;; ;;;    exponentiation
 ;; ;;; --------------------
 
-;; (define (expt b n)
-;;   (if (= n 0)
-;;       1
-;;     (* b (expt b (- n 1)))))
+(define (expt b n)
+  (if (= n 0)
+      1
+    (* b (expt b (- n 1)))))
 
-;; (define (expt2 b n)
-;;   (define (expt-iter b counter product)
-;;     (if (= counter 0)
-;;         product
-;;       (expt-iter b (- counter 1) (* b product))))
+(define (expt2 b n)
+  (define (expt-iter b counter product)
+    (if (= counter 0)
+        product
+      (expt-iter b (- counter 1) (* b product))))
 
-;;   (expt-iter b n 1))
+  (expt-iter b n 1))
 
-;; (define (fast-expt b n)
-;;   (define (even? n)
-;;     (= (% n 2) 0))
+(define (fast-expt b n)
+  (define (even? n)
+    (= (% n 2) 0))
 
-;;   (cond ((= n 0) 1)
-;;         ((even? n) (square (fast-expt b (/ n 2))))
-;;         (else (* b (fast-expt b (- n 1))))))
+  (cond ((= n 0) 1)
+        ((even? n) (square (fast-expt b (/ n 2))))
+        (else (* b (fast-expt b (- n 1))))))
 
-;; (assert (= (expt 1 2) 1))
-;; (assert (= (expt 2 2) 4))
-;; (assert (= (expt 2 3) 8))
+(assert (= (expt 1 2) 1))
+(assert (= (expt 2 2) 4))
+(assert (= (expt 2 3) 8))
 
-;; (assert (= (expt2 1 2) 1))
-;; (assert (= (expt2 2 2) 4))
-;; (assert (= (expt2 2 3) 8))
+(assert (= (expt2 1 2) 1))
+(assert (= (expt2 2 2) 4))
+(assert (= (expt2 2 3) 8))
 
-;; (assert (= (fast-expt 1 2) 1))
-;; (assert (= (fast-expt 2 2) 4))
-;; (assert (= (fast-expt 2 3) 8))
+(assert (= (fast-expt 1 2) 1))
+(assert (= (fast-expt 2 2) 4))
+(assert (= (fast-expt 2 3) 8))
 
-;; ;;; ----------
-;; ;;;    gcd
-;; ;;; ----------
+;;; ----------
+;;;    gcd
+;;; ----------
 
-;; (define (gcd a b)
-;;   (if (= b 0)
-;;       a
-;;     (gcd b (% a b))))
+(define (gcd a b)
+  (if (= b 0)
+      a
+    (gcd b (% a b))))
 
-;; (assert (= (gcd 40 6) 2))
-;; (assert (= (gcd 13 4) 1))
+(assert (= (gcd 40 6) 2))
+(assert (= (gcd 13 4) 1))
 
 
-;; ;;; ----------
-;; ;;;   primes
-;; ;;; ----------
+;;; ----------
+;;;   primes
+;;; ----------
 
-;; (define (smallest-divisor n)
-;;   (find-divisor n 2))
+(define (smallest-divisor n)
+  (find-divisor n 2))
 
-;; (define (find-divisor n test-divisor)
-;;   (cond ((> (square test-divisor) n) n)
-;;         ((divides? test-divisor n) test-divisor)
-;;         (else (find-divisor n (+ test-divisor 1)))))
+(define (find-divisor n test-divisor)
+  (cond ((> (square test-divisor) n) n)
+        ((divides? test-divisor n) test-divisor)
+        (else (find-divisor n (+ test-divisor 1)))))
 
-;; (define (divides? a b)
-;;   (= (% b a) 0))
+(define (divides? a b)
+  (= (% b a) 0))
 
-;; (define (prime? n)
-;;   (= n (smallest-divisor n)))
+(define (prime? n)
+  (= n (smallest-divisor n)))
 
-;; (assert (prime? 13))
-;; (assert (prime? 11))
-;; (assert (not (prime? 12)))
+(assert (prime? 13))
+(assert (prime? 11))
+(assert (not (prime? 12)))
 
 
-;;; ----------------------
-;;;    simple integral
-;;; ----------------------
+;; ----------------------
+   ;; simple integral
+;; ----------------------
 
-;; (define (sum term a next b)
-;;   (if (> a b)
-;;       0
-;;     (+ (term a) (sum term (next a) next b))))
+(define (sum term a next b)
+  (if (> a b)
+      0
+    (+ (term a) (sum term (next a) next b))))
 
-;; (define (integral f a b dx)
-;;   (define (add-dx x) (+ x dx))
-;;   (* (sum f (+ a (/ dx 2.0)) add-dx b) dx))
+(define (integral f a b dx)
+  (define (add-dx x) (+ x dx))
+  (* (sum f (+ a (/ dx 2.0)) add-dx b) dx))
 
-;; (define (pi-sum a b)
-;;   (define (pi-term x) (/ 1.0 (* x (+ x 2))))
-;;   (define (pi-next x) (+ x 4))
-;;   (sum pi-term a pi-next b))
+(define (pi-sum a b)
+  (define (pi-term x) (/ 1.0 (* x (+ x 2))))
+  (define (pi-next x) (+ x 4))
+  (sum pi-term a pi-next b))
 
-;; (assert (< (abs (- (* 8 (pi-sum 1 100))     3.121595)) 0.0001))
-;; (assert (< (abs (- (integral cube 0 1 0.02) 0.249950)) 0.0001))
+(assert (< (abs (- (* 8 (pi-sum 1 100))     3.121595)) 0.0001))
+(assert (< (abs (- (integral cube 0 1 0.02) 0.249950)) 0.0001))
 
 
 ;; ------------------------------------------------------------
-;;       F(x,y) = x(1 + xy)^2 + y(1 − y) + (1 + xy)(1 − y)
+      ;; F(x,y) = x(1 + xy)^2 + y(1 − y) + (1 + xy)(1 − y)
 ;; ------------------------------------------------------------
 
-;; (define (f x y)
-;;   (let ((a (+ 1 (* x y)))
-;;         (b (- 1 y)))
-;;     (+ (* x (square a))
-;;        (* y b)
-;;        (* a b))))
+(define (f x y)
+  (let ((a (+ 1 (* x y)))
+        (b (- 1 y)))
+    (+ (* x (square a))
+       (* y b)
+       (* a b))))
 
-;; (assert (= (f 0 0) 1))
-;; (assert (= (f 1 1) 4))
+(assert (= (f 0 0) 1))
+(assert (= (f 1 1) 4))
 
 
-;; ;;; ---------------
-;; ;;;    find zero
-;; ;;; ---------------
+;;; ---------------
+;;;    find zero
+;;; ---------------
 
-;; (define (positive? x) (< 0 x))
-;; (define (negative? x) (< x 0))
+(define (positive? x) (< 0 x))
+(define (negative? x) (< x 0))
 
-;; (define (search f neg-point pos-point)
-;;   (let ((midpoint (average neg-point pos-point)))
-;;     (if (close-enough? neg-point pos-point)
-;;         midpoint
-;;       (let ((test-value (f midpoint)))
-;;         (cond ((positive? test-value) (search f neg-point midpoint))
-;;               ((negative? test-value) (search f midpoint pos-point))
-;;               (else midpoint))))))
+(define (search f neg-point pos-point)
+  (let ((midpoint (average neg-point pos-point)))
+    (if (close-enough? neg-point pos-point)
+        midpoint
+      (let ((test-value (f midpoint)))
+        (cond ((positive? test-value) (search f neg-point midpoint))
+              ((negative? test-value) (search f midpoint pos-point))
+              (else midpoint))))))
 
-;; (define (close-enough? x y) (< (abs (- x y)) 0.001))
+(define (close-enough? x y) (< (abs (- x y)) 0.001))
 
-;; (assert (close-enough? (search (lambda (x) (- 1 (square x))) -3 3) -1))
+(assert (close-enough? (search (lambda (x) (- 1 (square x))) -3 3) -1))

build.sh

@@ -26,6 +26,14 @@ time clang++ -D_DEBUG -D_DONT_BREAK_ON_ERRORS \
 #      src/main.cpp -g -o ./bin/slime --std=c++17 \
 #      -I3rd/ || exit 1
 
+echo ""
+echo "------------------------------"
+echo " compiling fullslime  (prof)  "
+echo "------------------------------"
+time clang++ -D_DONT_BREAK_ON_ERRORS -D_PROFILING \
+     src/main.cpp -o ./bin/slime_p --std=c++17 \
+     -I3rd/ || exit 1
+
 pushd ./bin > /dev/null
 
 # echo ""
@@ -40,11 +48,17 @@ echo "    running tests     "
 echo "----------------------"
 time valgrind -q --track-origins=yes --leak-check=full --show-leak-kinds=all ./slime_d --run-tests || exit 1
 
-# echo ""
-# echo "------------------------"
-# echo "    running benches     "
-# echo "------------------------"
-# hyperfine -s color --warmup 5 "./slime --run-tests > /dev/null"
+echo ""
+echo "----------------------"
+echo "    running profile   "
+echo "----------------------"
+time ./slime_p --run-tests || exit 1
+
+echo ""
+echo "------------------------"
+echo "    running benches     "
+echo "------------------------"
+hyperfine -s color --warmup 5 "./slime --run-tests > /dev/null"
 
 popd > /dev/null
 # popd > /dev/null

profiler_vis/report2tracing.py

@@ -1,63 +1,68 @@
-import json
-import csv
-import sys
-
-class FancyFloat(float):
-    def __repr__(self):
-        return format(Decimal(self), "f")
-
-class JsonRpcEncoder(json.JSONEncoder):
-    def decimalize(self, val):
-        if isinstance(val, dict):
-            return {k:self.decimalize(v) for k,v in val.items()}
-
-        if isinstance(val, (list, tuple)):
-            return type(val)(self.decimalize(v) for v in val)
-
-        if isinstance(val, float):
-            return FancyFloat(val)
-
-        return val
-
-    def encode(self, val):
-        return super().encode(self.decimalize(val))
-
-if len(sys.argv) == 1:
-    print("No file was provided")
-else:
-    trace_events = []
-    call_stack = []
-    with open(sys.argv[1], "r") as in_file:
-        csv_reader = csv.reader(in_file, delimiter=',')
-        pf = 1
-        first_line = True
-        for line in csv_reader:
-            if first_line:
-                pf = float(line[0]) / 1000
-                first_line = False
-                continue
-            if line[0] == "->":
-                call_stack.append(line)
-            elif line[0] == "<-":
-                call = call_stack.pop()
-                dict = {
-                    "pid": 1,
-                    "tid": 1,
-                    "ts" : float(call[1]),
-                    "dur": (float(line[1])-float(call[1])),
-                    "ph" : "X",
-                    "name": call[2],
-                    "args": {
-                        "file":  f"({call[3]}:{call[4]})",
-                    }
-                }
-                if call[5]:
-                    dict["args"]["info1"] = call[5]
-                if call[6]:
-                    dict["args"]["info2"] = call[6]
-                trace_events.append(dict)
-            else:
-                print("invalid syntax")
-                break
-    with open("out.json", "w") as out_file:
-        out_file.write(json.dumps({"traceEvents": trace_events}))
+#!/usr/bin/python
+
+import json
+import csv
+import sys
+
+class FancyFloat(float):
+    def __repr__(self):
+        return format(Decimal(self), "f")
+
+class JsonRpcEncoder(json.JSONEncoder):
+    def decimalize(self, val):
+        if isinstance(val, dict):
+            return {k:self.decimalize(v) for k,v in val.items()}
+
+        if isinstance(val, (list, tuple)):
+            return type(val)(self.decimalize(v) for v in val)
+
+        if isinstance(val, float):
+            return FancyFloat(val)
+
+        return val
+
+    def encode(self, val):
+        return super().encode(self.decimalize(val))
+
+if len(sys.argv) == 1:
+    print("No file was provided")
+else:
+    trace_events = []
+    call_stack = []
+    with open(sys.argv[1], "r") as in_file:
+        csv_reader = csv.reader(in_file, delimiter=',')
+        pf = 1
+        first_line = True
+        last_ts = -1;
+        for line in csv_reader:
+            if first_line:
+                pf = float(line[0]) / 1000
+                first_line = False
+                continue
+            if line[0] == "->":
+                call_stack.append(line)
+            elif line[0] == "<-":
+                call = call_stack.pop()
+                ts = float(call[1])
+                dur = (float(line[1])-ts)
+                dict = {
+                    "pid": 1,
+                    "tid": 1,
+                    "ts" : ts,
+                    "dur": dur,
+                    "ph" : "X",
+                    "name": call[2],
+                    "args": {
+                        "file":  f"({call[3]}:{call[4]})",
+                    }
+                }
+                if call[5]:
+                    dict["args"]["info1"] = call[5]
+                if call[6]:
+                    dict["args"]["info2"] = call[6]
+                trace_events.append(dict)
+            else:
+                print("invalid syntax")
+                break
+    with open("out.json", "w") as out_file:
+        out_file.write(json.dumps({"traceEvents": trace_events}, indent=4))

src/assert.hpp

@@ -41,11 +41,16 @@
         }                                                               \
     } while(0)
 
-#define assert(condition)                               \
-    do {                                                \
-        if (!(condition)) {                             \
-            create_generic_error("Assertion-error.");   \
-        }                                               \
+#define assert_list_length(_node, _len) assert("List length assertion", list_length(_node) == _len)
+
+#define assert(message, condition)                                              \
+    do {                                                                        \
+        if (!(condition)) {                                                     \
+            create_generic_error("Assertion-error: %s\n"                        \
+                                 "            for: %s\n"                        \
+                                 "             in: %s:%d",                      \
+                                 message, #condition, __FILE__, __LINE__);      \
+        }                                                                       \
     } while(0)
 
 #else
@@ -53,5 +58,6 @@
 #  define assert_arguments_length_less_equal(expected, actual)    do {} while (0)
 #  define assert_arguments_length_greater_equal(expected, actual) do {} while (0)
 #  define assert_type(_node, _type)                               do {} while (0)
-#  define assert(condition)                                       do {} while (0)
+#  define assert_list_length(_node, _len)                         do {} while (0)
+#  define assert(message, condition)                              do {} while (0)
 #endif

src/built_ins.cpp

@@ -144,9 +144,70 @@ namespace Slime {
         profile_this();
         String* file_name_built_ins = Memory::create_string(__FILE__);
 
-        // define_macro((apply fun args), "TODO") {
-            // profile_with_name("(apply)");
-        // };
+        define_macro((apply fun fun_args), "TODO") {
+            // NOTE(Felix): is has to be a macro because apply by
+            // itself cannot return the result, we have to invoke eval
+            // and to prevent recursion, apply is a macro
+
+            profile_with_name("(apply)");
+            using namespace Globals::Current_Execution;
+
+            --cs.next_index;
+            --ams.next_index;
+            Lisp_Object* args = pcs[--pcs.next_index];
+            try_void assert_list_length(args, 2);
+
+            Lisp_Object* fun      = args->value.pair.first;
+            Lisp_Object* fun_args = args->value.pair.rest->value.pair.first;
+
+            // 3. push args on the stack and apply
+            ats.append([] {
+                Lisp_Object* args_as_list = cs[--cs.next_index];
+                for_lisp_list (args_as_list) {
+                    cs.append(it);
+                }
+                pcs.append(Memory::nil);
+                (nass.end()-1)->append(NasAction::Step);
+            });
+            (nass.end()-1)->append(NasAction::And_Then_Action);
+
+            // 2. Eval fun_args and keep them on the stack
+            ats.append([] {
+                // NOTE(Felix): Flip the top 2 elements on cs because
+                // top is now the evaluated function, and below is the unevaluated args
+                Lisp_Object* tmp = cs[cs.next_index-1];
+                cs[cs.next_index-1] = cs[cs.next_index-2];
+                cs[cs.next_index-2] = tmp;
+                (nass.end()-1)->append(NasAction::Eval);
+            });
+            (nass.end()-1)->append(NasAction::And_Then_Action);
+
+
+            // 1. Eval function and keep it on the stack, below it
+            // store the unevaluated argument list
+            ams.append(cs.next_index);
+            cs.append(fun_args);
+            cs.append(fun);
+            (nass.end()-1)->append(NasAction::Eval);
+
+        };
+        define((get-counter),
+               "When called returns a procedure that represents\n"
+               "a counter. Each time it is called it returns the\n"
+               "next whole number.")
+        {
+            define_symbol(
+                Memory::get_symbol("c"),
+                Memory::create_lisp_object((double)0));
+            String* file_name_built_ins = Memory::create_string(__FILE__);
+            define((lambda), "") {
+                fetch(c);
+                c->value.number++;
+                return c;
+            };
+            fetch(lambda);
+            return lambda;
+        };
         define_macro((eval expr),
                      "Takes one argument, and evaluates it two times.")
         {
@@ -234,8 +295,9 @@ namespace Slime {
                     try_void assert_type(doc,  Lisp_Object_Type::String);
                     try_void assert_type(form, Lisp_Object_Type::Pair);
                     thing = form->value.pair.first;
-                    try_void assert(form->value.pair.rest == Memory::nil);
-                    // TODO docs
+                    try_void assert("list must end here.", form->value.pair.rest == Memory::nil);
+                    // TODO docs (maybe with hooks) we have to attach
+                    // the docs to the result of evaluating
                 }
                 cs.append(definee);
                 cs.append(thing);
@@ -243,12 +305,18 @@ namespace Slime {
                 (nass.end()-1)->append(NasAction::Eval);
             } break;
             case Lisp_Object_Type::Pair: {
-                fflush(stdout);
                 try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol);
                 Lisp_Object* func;
                 try_void func =  Memory::create_lisp_object_function(Lisp_Function_Type::Lambda);
                 func->value.function->parent_environment = get_current_environment();
                 create_arguments_from_lambda_list_and_inject(definee->value.pair.rest, func);
+                if (Memory::get_type(thing_cons->value.pair.first) == Lisp_Object_Type::String &&
+                    thing_cons->value.pair.rest != Memory::nil)
+                {
+                    // extract docs
+                    func->docstring = thing_cons->value.pair.first->value.string;
+                    thing_cons = thing_cons->value.pair.rest;
+                }
                 func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons);
                 define_symbol(definee->value.pair.first, func);
                 cs.append(Memory::t);
@@ -376,6 +444,7 @@ namespace Slime {
         {
             profile_with_name("(+)");
             fetch(args);
+
             double sum = 0;
 
             for_lisp_list (args) {
@@ -573,8 +642,8 @@ namespace Slime {
 
             int int_idx = ((int)idx->value.number);
 
-            try assert(int_idx >= 0);
-            try assert(int_idx < vec->value.vector.length);
+            try assert("vector access index must be >= 0", int_idx >= 0);
+            try assert("vector access index must be < length", int_idx < vec->value.vector.length);
 
             return vec->value.vector.data+int_idx;
         };
@@ -587,8 +656,8 @@ namespace Slime {
 
             int int_idx = ((int)idx->value.number);
 
-            try assert(int_idx >= 0);
-            try assert(int_idx < vec->value.vector.length);
+            try assert("vector access index must be >= 0", int_idx >= 0);
+            try assert("vector access index must be < length", int_idx < vec->value.vector.length);
 
             vec->value.vector.data[int_idx] = *val;
 
@@ -973,7 +1042,7 @@ namespace Slime {
             printf(" (internal: %s)", Lisp_Object_Type_to_string(Memory::get_type(val)));
             printf("\nand is printed as: ");
             print(val);
-            printf("\n\ndocs: \n  %s\n",
+            printf("\n\ndocs:\n=====\n  %s\n\n",
                    (val->docstring)
                    ? Memory::get_c_str(val->docstring)
                    : "No docs avaliable");
@@ -1027,12 +1096,12 @@ namespace Slime {
             profile_with_name("(show)");
             fetch(n);
             try assert_type(n, Lisp_Object_Type::Function);
-            try assert(!n->value.function->is_c);
+            try assert("c-functoins cannot be shown", !n->value.function->is_c);
             puts("body:\n");
             print(n->value.function->body.lisp_body);
             puts("\n");
-            printf("parent_env: %lld\n",
-                   (long long)n->value.function->parent_environment);
+            printf("parent_env: %p\n",
+                   n->value.function->parent_environment);
 
             return Memory::nil;
         };
@@ -1085,7 +1154,6 @@ namespace Slime {
             profile_with_name("(exit)");
             fetch(code);
             try assert_type(code, Lisp_Object_Type::Number);
-            Slime::Memory::free_everything();
             exit((int)code->value.number);
         };
         define((break), "TODO") {

src/defines.cpp

@@ -20,4 +20,3 @@
 #define console_red    "\x1B[31m"
 #define console_green  "\x1B[32m"
 #define console_cyan   "\x1B[36m"
-

src/env.cpp

@@ -98,7 +98,7 @@ namespace Slime {
 
         if(env == get_root_environment()) {
             print_indent(indent);
-            printf("[built-ins]-Environment (%lld)\n", (long long)env);
+            printf("[built-ins]-Environment (%p)\n", env);
             return;
         }
 
@@ -111,14 +111,14 @@ namespace Slime {
         }
         for (int i = 0; i < env->parents.next_index; ++i) {
             print_indent(indent);
-            printf("parent (0x%016llx)", (long long)env->parents.data[i]);
+            printf("parent (%p)", env->parents.data[i]);
             puts(":");
             print_environment_indent(env->parents.data[i], indent+4);
         }
     }
 
     proc print_environment(Environment* env) -> void {
-        printf("\n=== Environment === (0x%016llx)\n", (long long)env);
+        printf("\n=== Environment === (%p)\n", env);
         print_environment_indent(env, 0);
     }
 

src/eval.cpp

@@ -56,7 +56,7 @@ namespace Slime {
                 }
                 // NOTE(Felix): We have to copy all the arguments,
                 // otherwise we change the program code.
-                // XXX(Felix): T C functions we pass by reference.
+                // XXX(Felix): To C functions we pass by reference.
                 // TODO(Felix): Why did we decide this??
                 if (is_c_function) {
                     define_symbol(sym, next_arg);
@@ -65,6 +65,8 @@ namespace Slime {
                         sym,
                         Memory::copy_lisp_object_except_pairs(next_arg));
                 }
+                assert("cs access index out of range",
+                       arg_pos+1 < cs->next_index);
                 next_arg = cs->data[++arg_pos];
             }
         };
@@ -380,6 +382,7 @@ namespace Slime {
     }
 
     proc eval_expr(Lisp_Object* expr) -> Lisp_Object* {
+        profile_this();
         using namespace Globals::Current_Execution;
 
         nass.reserve(1);
@@ -393,40 +396,8 @@ namespace Slime {
         proc debug_step = [&] {
             if (!Globals::debug_log)
                 return;
-            printf("\n-------------------\ncs:\n ");
-            for (int i = 0; i < cs.next_index; ++i)  {
-                char* t = lisp_object_to_string(cs.data[i], true);
-                printf(" %d: %s\n ", i, t);
-                defer { free(t); };
-            }
-            printf("\npcs:\n ");
-            for (auto lo : pcs)  {
-                print(lo, true);
-                printf("\n ");
-            }
-            printf("\nnnas:\n ");
-            for (auto nas: nass) {
-                printf("nas:\n ");
-                for (auto na : nas)  {
-                    printf("  - %s\n ", [&]
-                        {
-                            switch(na) {
-                            case NasAction::Pop_Environment:  return "Pop_Environment";
-                            case NasAction::Define_Var:       return "Define_Var";
-                            case NasAction::Eval:             return "Eval";
-                            case NasAction::Step:             return "Step";
-                            case NasAction::TM:               return "TM";
-                            case NasAction::Pop:              return "Pop";
-                            case NasAction::If:               return "If";
-                            }
-                            return "??";
-                        }());
-                }
-            }
-            printf("\nams:\n ");
-            for (auto am : ams)  {
-                printf("%d\n ", am);
-            }
+            printf("\n-------------------\n");
+            print_current_execution();
             // pause();
         };
 
@@ -451,6 +422,9 @@ namespace Slime {
             case NasAction::Pop: {
                 --cs.next_index;
             } break;
+            case NasAction::And_Then_Action: {
+                ats.data[--ats.next_index]();
+            } break;
             case NasAction::Pop_Environment: {
                 pop_environment();
             } break;
@@ -465,6 +439,7 @@ namespace Slime {
                     cs.data[cs.next_index-1] = pc->value.pair.first;
                     ams.append(cs.next_index-1);
                     pcs.append(pc->value.pair.rest);
+                    mes.append(pc);
                     nas->append(NasAction::TM);
                     nas->append(NasAction::Eval);
                 } break;
@@ -474,6 +449,9 @@ namespace Slime {
                 }
                 }
             } break;
+            case NasAction::Macro_Write_Back: {
+                *mes.data[--mes.next_index] = *cs[cs.next_index-1];
+            } break;
             case NasAction::TM: {
                 pc = cs.data[cs.next_index-1];
 
@@ -483,7 +461,7 @@ namespace Slime {
                     if(pc->value.function->is_c) {
                         if (pc->value.function->type.c_function_type == C_Function_Type::cMacro) {
                             try pc->value.function->body.c_macro_body();
-                        } else if(pc->value.function->type.c_function_type == C_Function_Type::cSpecial)
+                        } else if (pc->value.function->type.c_function_type == C_Function_Type::cSpecial)
                         {
                             // TODO(Felix): Why not call the function
                             // right away, and instead push step, so
@@ -493,14 +471,17 @@ namespace Slime {
                         } else {
                             nas->append(NasAction::Step);
                         }
+                        --mes.next_index;
                     } else {
                         if (pc->value.function->type.lisp_function_type ==
                             Lisp_Function_Type::Macro)
                         {
                             push_pc_on_cs();
                             nas->append(NasAction::Eval);
+                            nas->append(NasAction::Macro_Write_Back);
                             nas->append(NasAction::Step);
                         } else {
+                            --mes.next_index;
                             nas->append(NasAction::Step);
                         }
                     }
@@ -597,7 +578,7 @@ namespace Slime {
     proc interprete_stdin() -> void {
         try_void Memory::init(4096 * 256* 100);
 
-        printf("Welcome to the lispy interpreter.\n");
+        printf("Welcome to the lispy interpreter.\n%s\n", version_string);
 
         char* line;
 

src/globals.cpp

@@ -1,14 +1,31 @@
+namespace Slime {
+#define v_major 0
+#define v_minor 1
+#define STRINGIZE2(s) #s
+#define STRINGIZE(s) STRINGIZE2(s)
+#define VERSION_STRING "v" STRINGIZE(v_major) "." STRINGIZE(v_minor) " - built on " __DATE__ " " __TIME__
+    const char* version_string = VERSION_STRING;
+    const int major_version = v_major;
+    const int minor_version = v_minor;
+#undef v_major
+#undef v_minor
+#undef STRINGIZE2
+#undef STRINGIZE
+#undef VERSION_STRING
+}
+
 namespace Slime::Globals {
     char* bin_path = nullptr;
     Log_Level log_level = Log_Level::Debug;
     bool debug_log = false;
     Array_List<void*> load_path;
     namespace Current_Execution {
-        Array_List<Lisp_Object*>            cs;
-        Array_List<Lisp_Object*>           pcs;
-        Array_List<int>                    ams;
-        Array_List<Array_List<NasAction>> nass;
-        // Array_List<Lisp_Object*> call_stack;
+        Array_List<Lisp_Object*>            cs; // call stack
+        Array_List<Lisp_Object*>           pcs; // program counter stack
+        Array_List<int>                    ams; // apply marker stack
+        Array_List<Array_List<NasAction>> nass; // next action stack stack
+        Array_List<Lambda<void()>>         ats; // and then stack
+        Array_List<Lisp_Object*>           mes; // macro expansion stack
         Array_List<Environment*> envi_stack;
     }
 

src/io.cpp

@@ -399,11 +399,20 @@ namespace Slime {
                 // NOTE(Felix): try to find the symbol it is bound to
                 // in global env
                 Lisp_Object* name = (Lisp_Object*)(get_root_environment()->hm.search_key_to_object(node));
-                switch (node->value.function->type.c_function_type) {
-                case C_Function_Type::cFunction: asprintf(&temp, "[c-function %s]",&((Lisp_Object*)name)->value.symbol->data); break;
-                case C_Function_Type::cSpecial:  asprintf(&temp, "[c-special %s]", &((Lisp_Object*)name)->value.symbol->data); break;
-                case C_Function_Type::cMacro:    asprintf(&temp, "[c-macro %s]",   &((Lisp_Object*)name)->value.symbol->data); break;
-                default:                         return strdup("[c-??]");
+                if (name) {
+                    switch (node->value.function->type.c_function_type) {
+                    case C_Function_Type::cFunction: asprintf(&temp, "[c-function %s]",&((Lisp_Object*)name)->value.symbol->data); break;
+                    case C_Function_Type::cSpecial:  asprintf(&temp, "[c-special %s]", &((Lisp_Object*)name)->value.symbol->data); break;
+                    case C_Function_Type::cMacro:    asprintf(&temp, "[c-macro %s]",   &((Lisp_Object*)name)->value.symbol->data); break;
+                    default:                         return strdup("[c-??]");
+                    }
+                } else {
+                    switch (node->value.function->type.c_function_type) {
+                    case C_Function_Type::cFunction: asprintf(&temp, "[c-function]"); break;
+                    case C_Function_Type::cSpecial:  asprintf(&temp, "[c-special]"); break;
+                    case C_Function_Type::cMacro:    asprintf(&temp, "[c-macro]"); break;
+                    default:                         return strdup("[c-??]");
+                    }
                 }
                 return temp;
             } else {
@@ -444,7 +453,8 @@ namespace Slime {
                         string_builder.append(strdup(",@"));
 
                     assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
-                    assert(head->value.pair.rest->value.pair.rest == Memory::nil);
+                    assert("The list must end here.",
+                           head->value.pair.rest->value.pair.rest == Memory::nil);
 
                     string_builder.append(lisp_object_to_string(head->value.pair.rest->value.pair.first, print_repr));
                     return string_buider_to_string(string_builder);
@@ -511,16 +521,49 @@ namespace Slime {
         }
     }
 
-    proc print_call_stack() -> void {
-        printf("call stack cannot be printed.");
-        // using Globals::Current_Execution::call_stack;
-
-        // printf("callstack [%d] (most recent call last):\n", call_stack.next_index);
-        // for (int i = 0; i < call_stack.next_index; ++i) {
-        //     printf("%2d -> ", i);
-        //     print_single_call(call_stack.data[i]);
-        //     printf("\n");
-        // }
+    proc print_current_execution() -> void {
+        using Globals::Current_Execution::cs;
+        using Globals::Current_Execution::pcs;
+        using Globals::Current_Execution::nass;
+        using Globals::Current_Execution::ams;
+        printf("cs:\n ");
+        for (int i = 0; i < cs.next_index; ++i)  {
+            char* t = lisp_object_to_string(cs.data[i], true);
+            printf(" %d: %s\n ", i, t);
+            defer {
+                free(t);
+            };
+        }
+        printf("\npcs:\n ");
+        for (auto lo : pcs)  {
+            print(lo, true);
+            printf("\n ");
+        }
+        printf("\nnnas:\n ");
+        for (auto nas: nass) {
+            printf("nas:\n ");
+            for (auto na : nas)  {
+                printf("  - %s\n ", [&]
+                    {
+                        switch(na) {
+                        case NasAction::Macro_Write_Back: return "Macro_Write_Back";
+                        case NasAction::And_Then_Action:  return "And_Then_Action";
+                        case NasAction::Pop_Environment:  return "Pop_Environment";
+                        case NasAction::Define_Var:       return "Define_Var";
+                        case NasAction::Eval:             return "Eval";
+                        case NasAction::Step:             return "Step";
+                        case NasAction::TM:               return "TM";
+                        case NasAction::Pop:              return "Pop";
+                        case NasAction::If:               return "If";
+                        }
+                        return "??";
+                    }());
+            }
+        }
+        printf("\nams:\n ");
+        for (auto am : ams)  {
+            printf("%d\n ", am);
+        }
     }
 
     proc log_error() -> void {
@@ -530,7 +573,7 @@ namespace Slime {
         puts(console_normal);
 
         fputs("  in: ", stdout);
-        print_call_stack();
+        print_current_execution();
         puts(console_normal);
     }
 }

src/libslime.cpp

@@ -37,6 +37,7 @@ unsigned int hm_hash(Slime::Lisp_Object* obj);
 #include "ftb/bucket_allocator.hpp"
 #include "ftb/macros.hpp"
 #include "ftb/profiler.hpp"
+#include "ftb/hooks.hpp"
 
 #    include "defines.cpp"
 #    include "assert.hpp"

src/main.cpp

@@ -19,7 +19,6 @@ int main(int argc, char* argv[]) {
             Slime::Memory::init(4096 * 256* 100);
             if (Slime::Globals::error) return 1;
             Slime::built_in_load(Slime::Memory::create_string("generate-docs.slime"));
-            Slime::Memory::free_everything();
         } else {
             Slime::interprete_file(argv[1]);
         }

src/memory.cpp

@@ -11,12 +11,12 @@ namespace Slime::Memory {
     // ------------------
     //   lisp_objects
     // ------------------
-    Bucket_Allocator<Lisp_Object> object_memory(1024, 8);
+    Bucket_Allocator<Lisp_Object> object_memory;
 
     // ------------------
     //   environments
     // ------------------
-    Bucket_Allocator<Environment> environment_memory(1024, 8);
+    Bucket_Allocator<Environment> environment_memory;
 
     // NOTE(Felix): we are doing hashmaps separately so we don't have
     // to malloc them every time, and if two lisp objects have the
@@ -26,7 +26,7 @@ namespace Slime::Memory {
     // ------------------
     //   Hashmaps
     // ------------------
-    Bucket_Allocator<Hash_Map<Lisp_Object*, Lisp_Object*>> hashmap_memory(256, 8);
+    Bucket_Allocator<Hash_Map<Lisp_Object*, Lisp_Object*>> hashmap_memory;
 
     // ------------------
     //   strings
@@ -163,6 +163,12 @@ namespace Slime::Memory {
         Globals::Current_Execution::ams.dealloc();
         Globals::Current_Execution::pcs.dealloc();
         Globals::Current_Execution::nass.dealloc();
+        Globals::Current_Execution::ats.dealloc();
+        Globals::Current_Execution::mes.dealloc();
+
+        object_memory.dealloc();
+        environment_memory.dealloc();
+        hashmap_memory.dealloc();
 
         global_symbol_table.dealloc();
         global_keyword_table.dealloc();
@@ -193,6 +199,16 @@ namespace Slime::Memory {
 
     proc init(int sms) -> void {
         profile_this();
+
+        object_memory.alloc(1024, 8);
+        environment_memory.alloc(1024, 8);
+        hashmap_memory.alloc(256, 8);
+
+        system_shutdown_hook << [&] {
+            if_debug {
+                Slime::Memory::free_everything();
+            }
+        };
         char* exe_path = get_exe_dir();
         // don't free exe path because it will be used until end of time
         Globals::load_path.alloc();
@@ -206,6 +222,8 @@ namespace Slime::Memory {
         Globals::Current_Execution::nass.alloc();
         Globals::Current_Execution::pcs.alloc();
         Globals::Current_Execution::ams.alloc();
+        Globals::Current_Execution::ats.alloc();
+        Globals::Current_Execution::mes.alloc();
 
         add_to_load_path(exe_path);
         add_to_load_path("../bin/");
@@ -233,64 +251,8 @@ namespace Slime::Memory {
         Environment* user_env;
         try_void user_env = Memory::create_child_environment(env);
         push_environment(user_env);
-
-       /* try_void _if     = lookup_symbol(get_symbol("if"), env);
-        try_void _define = lookup_symbol(get_symbol("define"), env);
-        try_void _begin  = lookup_symbol(get_symbol("begin"), env);*/
     }
 
-    proc reset() -> void {
-        profile_this();
-
-        free_spots_in_string_memory.next_index      = 0;
-
-        global_symbol_table.dealloc();
-        global_keyword_table.dealloc();
-        file_to_env_map.dealloc();
-
-        global_symbol_table.alloc();
-        global_keyword_table.alloc();
-        file_to_env_map.alloc();
-
-        try_void Parser::standard_in = create_string("stdin");
-
-        object_memory.for_each([](Lisp_Object* lo){
-            lo->~Lisp_Object();
-        });
-        environment_memory.for_each([](Environment* env){
-            env->~Environment();
-        });
-
-        object_memory.~Bucket_Allocator();
-        environment_memory.~Bucket_Allocator();
-
-        new(&object_memory)      Bucket_Allocator<Lisp_Object>(1024, 8);
-        new(&environment_memory) Bucket_Allocator<Environment>(1024, 8);
-
-        next_free_spot_in_string_memory  = string_memory;
-
-
-        // init nil
-        try_void nil = create_lisp_object();
-        set_type(nil, Lisp_Object_Type::Nil);
-
-        // init t
-        try_void t = create_lisp_object();
-        set_type(t, Lisp_Object_Type::T);
-
-        Globals::Current_Execution::envi_stack.next_index = 0;
-        Environment* env;
-        try_void env = create_built_ins_environment();
-        push_environment(env);
-
-        Environment* user_env;
-        try_void user_env = Memory::create_child_environment(env);
-        push_environment(user_env);
-
-        try_void _if     = lookup_symbol(get_symbol("if"), env);
-        try_void _define = lookup_symbol(get_symbol("define"), env);
-        try_void _begin  = lookup_symbol(get_symbol("begin"), env);
-    }
 
     proc create_lisp_object(void* ptr) -> Lisp_Object* {
         Lisp_Object* node;

src/structs.cpp

@@ -32,6 +32,8 @@ namespace Slime {
     };
 
     enum struct NasAction {
+        And_Then_Action,
+        Macro_Write_Back,
         Eval,
         Step,
         TM,

src/testing.cpp

@@ -582,14 +582,7 @@ namespace Slime {
         profile_this();
 
         bool result = true;
-
         try Memory::init(409600);
-        defer {
-            if_debug {
-                Slime::Memory::free_everything();
-            }
-        };
-
 
         push_environment(Memory::create_child_environment(
                              get_current_environment()));
@@ -629,7 +622,7 @@ namespace Slime {
         invoke_test_script("macro_expand");
         invoke_test_script("sicp");
         invoke_test_script("simple_built_ins");
-        invoke_test_script("modules");
+        // invoke_test_script("modules");
         // invoke_test_script("class_macro");
         // invoke_test_script("automata");
         // invoke_test_script("alists");

todo.org

@@ -1,3 +1,4 @@
+* TODO assert list_length for arguemns of macros
 * TODO update header files
 * TODO use better type names: u32, ..
 * TODO write and/or as macros
@@ -9,9 +10,9 @@
         1
       (* n (fac (sub1 n)))))
 3628800
-* TODO runHook NAS_Action 
+* TODO runHook NAS_Action
 * TODO consisitent names (Lisp_Object_Type_to_string .. lisp_object_to_string)
-* TODO rename modifying functions to prefix '!'
+* TODO rename modifying functions to have suffix '!'
 * TODO rename slime to plisk
 * TODO BUG 1: eval dot notation
 #+BEGIN_SRC lisp