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

Macros are now properly getting baked in Modules bug still persists

master
Felix Brendel 6 лет назад
Родитель
3b85873039
Сommit
aac3985a61
20 измененных файлов: 599 добавлений и 514 удалений
Разделённый вид
Опции Diff
Показать статистику Скачать Patch файл Скачать Diff файл
  1. +2
    -0
      .gitignore
  2. +1
    -1
      3rd/ftb
  3. +33
    -33
      bin/pre.slime
  4. +16
    -17
      bin/tests/modules.slime
  5. +234
    -241
      bin/tests/sicp.slime
  6. +19
    -5
      build.sh
  7. +68
    -63
      profiler_vis/report2tracing.py
  8. +12
    -6
      src/assert.hpp
  9. +83
    -15
      src/built_ins.cpp
  10. +0
    -1
      src/defines.cpp
  11. +3
    -3
      src/env.cpp
  12. +18
    -37
      src/eval.cpp
  13. +22
    -5
      src/globals.cpp
  14. +60
    -17
      src/io.cpp
  15. +1
    -0
      src/libslime.cpp
  16. +0
    -1
      src/main.cpp
  17. +21
    -59
      src/memory.cpp
  18. +2
    -0
      src/structs.cpp
  19. +1
    -8
      src/testing.cpp
  20. +3
    -2
      todo.org

+ 2
- 0
.gitignore Просмотреть файл

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

+ 1
- 1
3rd/ftb

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

+ 33
- 33
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."


+ 16
- 17
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)))

+ 234
- 241
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))

+ 19
- 5
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


+ 68
- 63
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))

+ 12
- 6
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

+ 83
- 15
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") {


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

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

+ 3
- 3
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);
}


+ 18
- 37
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;


+ 22
- 5
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;
}


+ 60
- 17
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);
}
}

+ 1
- 0
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"


+ 0
- 1
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]);
}


+ 21
- 59
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;


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

@@ -32,6 +32,8 @@ namespace Slime {
};

enum struct NasAction {
And_Then_Action,
Macro_Write_Back,
Eval,
Step,
TM,


+ 1
- 8
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");


+ 3
- 2
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


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