felix
/
slime
1
0
Bifurcation 0
Code Tickets 0 Demandes d'ajout 0 Versions 0 Wiki Activité
Parcourir la source

Macros are now properly getting baked in Modules bug still persists

master
Felix Brendel il y a 6 ans
Parent
3b85873039
révision
aac3985a61
20 fichiers modifiés avec 599 ajouts et 514 suppressions
Vue séparée
Option de Diff
Voir les Statistiques Télécharger le Fichier Patch Télécharger le Fichier des Différences
  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 Voir le fichier

@@ -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 Voir le fichier

@@ -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 Voir le fichier

@@ -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 Voir le fichier

@@ -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 Voir le fichier

@@ -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 Voir le fichier

@@ -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 Voir le fichier

@@ -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 Voir le fichier

@@ -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 Voir le fichier

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

+ 3
- 3
src/env.cpp Voir le fichier

@@ -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 Voir le fichier

@@ -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 Voir le fichier

@@ -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 Voir le fichier

@@ -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 Voir le fichier

@@ -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 Voir le fichier

@@ -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 Voir le fichier

@@ -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 Voir le fichier

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

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


+ 1
- 8
src/testing.cpp Voir le fichier

@@ -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 Voir le fichier

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


Écrire Aperçu
Chargement…
Annuler
Enregistrer