felix/slime
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fixed the tests with new args

Browse Source
This commit is contained in:
Felix Brendel
2019-09-21 01:24:15 +02:00
parent 5f90f2877f
commit 47b33f2f3a
14 changed files with 1108 additions and 1439 deletions
Download Patch File Download Diff File Expand all files Collapse all files
bin/oo.slime
+5 -6
View File
@@ -1,8 +1,8 @@
(define-syntax (define-class name-and-members :rest body)
(define-syntax (define-class name-and-members . body)
"Macro for creating simple classes."
(let ((name (first name-and-members))
(members (rest name-and-members)))
`(set-type
`(set-type!
(define
;; The function definition
(,(string->symbol (concat-strings "make-" (symbol->string name))) @members)
@@ -11,8 +11,8 @@
;; the body
@body
(let ,(zip members members)
(set-type
(lambda (:rest args)
(set-type!
(lambda args
"This is the docs for the handle"
(let ((op (eval (first args))))
(if (callable? op)
@@ -21,6 +21,5 @@
,(symbol->keyword name))))
:constructor)))
(define-syntax (-> obj meth :rest args)
(define-syntax (-> obj meth . args)
`(,obj ',meth @args))
bin/pre.slime
+1 -3
View File
@@ -36,7 +36,6 @@ condition is false."
(define-syntax (let bindings . body)
(define (unzip lists)
(break)
(when lists
(define (iter lists l1 l2)
(define elem (first lists))
@@ -45,7 +44,6 @@ condition is false."
(pair (first elem) l1)
(pair (first (rest elem)) l2))
(list l1 l2))))
(iter lists () ()))
(define unzipped (unzip bindings))
@@ -152,7 +150,7 @@ ithe sequence as arguemens."
(concat-strings module-prefix
(symbol->string orig-export-name)))))
`(define ,export-name
,(try (eval orig-export-name)
,(mytry (eval orig-export-name)
(error "The module does not contain" orig-export-name)))))
exports))))
bin/pre.slime.expanded
+2 -2
View File
@@ -6,7 +6,7 @@
(define-syntax (n-times times action) :doc "Executes action times times." (define (repeat times elem) (unless (> 1 times) (pair elem (repeat (- times 1) elem)))) `(begin (unquote-splicing (repeat times action))))
(define-syntax (let bindings . body) (define (unzip lists) (break) (when lists (define (iter lists l1 l2) (define elem (first lists)) (if elem (iter (rest lists) (pair (first elem) l1) (pair (first (rest elem)) l2)) (list l1 l2)))) (iter lists () ())) (define unzipped (unzip bindings)) `((,lambda ,(first unzipped) (unquote-splicing body)) (unquote-splicing (first (rest unzipped)))))
(define-syntax (let bindings . body) (define (unzip lists) (when lists (define (iter lists l1 l2) (define elem (first lists)) (if elem (iter (rest lists) (pair (first elem) l1) (pair (first (rest elem)) l2)) (list l1 l2)))) (iter lists () ())) (define unzipped (unzip bindings)) `((,lambda ,(first unzipped) (unquote-splicing body)) (unquote-splicing (first (rest unzipped)))))
(define-syntax (cond . clauses) (define (rec clauses) (if (= nil clauses) nil (if (= (first (first clauses)) 'else) (begin (if (not (= (rest clauses) ())) (error "There are additional clauses after the else clause!") (pair 'begin (rest (first clauses))))) `(if ,(first (first clauses)) (begin (unquote-splicing (rest (first clauses)))) ,(rec (rest clauses)))))) (rec clauses))
@@ -20,7 +20,7 @@
(define-syntax (define-typed args . body) (define (get-arg-names args) (when args (pair (first args) (get-arg-names (rest (rest args)))))) (let ((name (first args)) (lambda-list (rest args)) (arg-names (get-arg-names (rest args)))) `(define (,name (unquote-splicing arg-names)) (assert-types= (unquote-splicing lambda-list)) (unquote-splicing body))))
(define-syntax (define-module module-name :exports . body) (let ((module-prefix (concat-strings (symbol->string module-name) "::"))) (eval `(begin (unquote-splicing body))) (pair 'begin (map (lambda (orig-export-name) (let ((export-name (string->symbol (concat-strings module-prefix (symbol->string orig-export-name))))) `(define ,export-name ,(try (eval orig-export-name) (error "The module does not contain" orig-export-name))))) exports))))
(define-syntax (define-module module-name :exports . body) (let ((module-prefix (concat-strings (symbol->string module-name) "::"))) (eval `(begin (unquote-splicing body))) (pair 'begin (map (lambda (orig-export-name) (let ((export-name (string->symbol (concat-strings module-prefix (symbol->string orig-export-name))))) `(define ,export-name ,(mytry (eval orig-export-name) (error "The module does not contain" orig-export-name))))) exports))))
(define (null? x) :doc "Checks if the argument is =nil=." (= x ()))
bin/sets.slime
+3 -4
View File
@@ -5,8 +5,8 @@
(define key-not-found-index -1)
(define (make :rest vals)
(set-type
(define (make . vals)
(set-type!
(if vals
(list vals)
'(()))
@@ -27,7 +27,6 @@
(define (insert! set value)
(unless (contains? set value)
(set! set (pair (pair value (first set)) ()))
(set-type set :set))
(set-type! set :set))
set)
)
bin/tests/class_macro.slime.expanded
+14 -14
View File
@@ -1,14 +1,14 @@
(import "oo.slime")
(define-class (vector3 x y z) (define (set-x new-x) (mutate x new-x)) (define (set-y new-y) (mutate y new-y)) (define (set-z new-z) (mutate z new-z)) (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000)) (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac) (define (add other) (make-vector3 (+ (-> other x) x) (+ (-> other y) y) (+ (-> other z) z))) (define (subtract other) (make-vector3 (- (-> other x) x) (- (-> other y) y) (- (-> other z) z))) (define (equal? other) (and (= (-> other x) x) (= (-> other y) y) (= (-> other z) z))) (define (scalar-product other) (+ (* (-> other x) x) (* (-> other y) y) (* (-> other z) z))) (define (cross-product other) (make-vector3 (- (* (-> other z) y) (* (-> other y) z)) (- (* (-> other x) z) (* (-> other z) x)) (- (* (-> other y) x) (* (-> other x) y)))) (define (print) (printf :sep " " "[vector3] (" x y z ")")))
(define v1 (make-vector3 1 2 3))
(define v2 (make-vector3 3 2 1))
(assert (= (type v1) (type v2) :vector3))
(assert (= (v1 'scalar-product v2) 10))
(assert (-> (-> v1 cross-product v2) equal? (make-vector3 -4 8 -4)))
(import "oo.slime")
(define-class (vector3 x y z) (define (set-x new-x) (mutate x new-x)) (define (set-y new-y) (mutate y new-y)) (define (set-z new-z) (mutate z new-z)) (define (length) (** (+ (* x x) (* y y) (* z z)) 0.500000)) (define (scale fac) (mutate x (* fac x)) (mutate y (* fac y)) (mutate z (* fac z)) fac) (define (add other) (make-vector3 (+ (-> other x) x) (+ (-> other y) y) (+ (-> other z) z))) (define (subtract other) (make-vector3 (- (-> other x) x) (- (-> other y) y) (- (-> other z) z))) (define (equal? other) (and (= (-> other x) x) (= (-> other y) y) (= (-> other z) z))) (define (scalar-product other) (+ (* (-> other x) x) (* (-> other y) y) (* (-> other z) z))) (define (cross-product other) (make-vector3 (- (* (-> other z) y) (* (-> other y) z)) (- (* (-> other x) z) (* (-> other z) x)) (- (* (-> other y) x) (* (-> other x) y)))) (define (print) (printf :sep " " "[vector3] (" x y z ")")))
(define v1 (make-vector3 1 2 3))
(define v2 (make-vector3 3 2 1))
(assert (= (type v1) (type v2) :vector3))
(assert (= (v1 'scalar-product v2) 10))
(assert (-> (-> v1 cross-product v2) equal? (make-vector3 -4 8 -4)))
bin/tests/evaluation_of_default_args.slime
+2 -2
View File
@@ -1,7 +1,7 @@
((lambda (:keys k1 :defaults-to (+ 1 2 3))
((lambda ((:k1 (+ 1 2 3)))
(assert (= k1 6))))
((lambda (:keys k1 :defaults-to ())
((lambda ((:k1 ()))
(when k1
(assert ()))
(assert (= k1 ()))))
bin/tests/lexical_scope.slime
+1 -1
View File
@@ -32,7 +32,7 @@
;; key arguments
(define (make-key-counter)
((lambda (:keys var)
((lambda (:var)
(lambda ()
(mutate var (+ 1 var))
var))
bin/tests/lexical_scope.slime.expanded
+54 -54
View File
@@ -1,54 +1,54 @@
(define (make-counter) (let ((var 0)) (lambda () (set! var (+ 1 var)))))
(define counter1 (make-counter))
(assert (= (counter1) 1))
(define counter2 (make-counter))
(assert (= (counter2) 1))
(assert (= (counter2) 2))
(assert (= (counter1) 2))
(assert (= (counter1) 3))
(assert (= (counter2) 3))
(assert (= (counter2) 4))
(assert (= (counter2) 5))
(assert (= (counter1) 4))
(assert (= (counter1) 5))
(define (g) (define x 0) (lambda () (define temp x) (mutate x (+ x 1)) temp))
(define (make-key-counter) ((lambda (:keys var) (lambda () (mutate var (+ 1 var)) var)) :var 0))
(define key-counter1 (make-key-counter))
(assert (= (key-counter1) 1))
(define key-counter2 (make-key-counter))
(assert (= (key-counter2) 1))
(assert (= (key-counter2) 2))
(assert (= (key-counter1) 2))
(assert (= (key-counter1) 3))
(assert (= (key-counter2) 3))
(assert (= (key-counter2) 4))
(assert (= (key-counter2) 5))
(assert (= (key-counter1) 4))
(assert (= (key-counter1) 5))
(define (make-counter) (let ((var 0)) (lambda () (set! var (+ 1 var)))))
(define counter1 (make-counter))
(assert (= (counter1) 1))
(define counter2 (make-counter))
(assert (= (counter2) 1))
(assert (= (counter2) 2))
(assert (= (counter1) 2))
(assert (= (counter1) 3))
(assert (= (counter2) 3))
(assert (= (counter2) 4))
(assert (= (counter2) 5))
(assert (= (counter1) 4))
(assert (= (counter1) 5))
(define (g) (define x 0) (lambda () (define temp x) (mutate x (+ x 1)) temp))
(define (make-key-counter) ((lambda (:var) (lambda () (mutate var (+ 1 var)) var)) :var 0))
(define key-counter1 (make-key-counter))
(assert (= (key-counter1) 1))
(define key-counter2 (make-key-counter))
(assert (= (key-counter2) 1))
(assert (= (key-counter2) 2))
(assert (= (key-counter1) 2))
(assert (= (key-counter1) 3))
(assert (= (key-counter2) 3))
(assert (= (key-counter2) 4))
(assert (= (key-counter2) 5))
(assert (= (key-counter1) 4))
(assert (= (key-counter1) 5))