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

work transfer to laptop

Browse Source
This commit is contained in:
Felix Brendel
2019-09-19 09:20:26 +02:00
parent 5a117d94ee
commit 0c73728217
22 changed files with 3018 additions and 3090 deletions
Download Patch File Download Diff File Expand all files Collapse all files
bin/alist.slime
+10 -10
View File
@@ -28,12 +28,12 @@
(define key-not-found-index -1)
(define (make-alist)
(set-type
(set-type!
'(())
:alist))
(define (make-plist)
(set-type
(set-type!
'(())
:plist))
@@ -41,9 +41,9 @@
(let ((associations (first alist)))
(define (pprint-intern associations)
(when associations
(printf " "
(caar associations) "->"
(cdar associations))
(print " "
(caar associations) "->"
(cdar associations))
(pprint-intern (rest associations))))
(print "(")
(when associations
@@ -55,9 +55,9 @@
(let ((props (first plist)))
(define (pprint-intern props)
(when props
(printf " "
(car props) "->"
(cadr props))
(print " "
(car props) "->"
(cadr props))
(pprint-intern (cddr props))))
(print "(")
(when props
@@ -113,7 +113,7 @@
(define (alist-set! alist key value)
(mutate alist (set-type (pair (pair (pair key value)
(mutate alist (set-type! (pair (pair (pair key value)
(car alist))
())
:alist)))
@@ -142,7 +142,7 @@
(plist-get-intern props prop)))
(define (plist-set! plist prop value)
(mutate plist (set-type (pair (pair prop (pair value (first plist))) ())
(mutate plist (set-type! (pair (pair prop (pair value (first plist))) ())
:plist)))
(define (plist-set-overwrite! plist prop value)
bin/pre.slime
+71 -72
View File
@@ -1,10 +1,8 @@
(define-syntax (pe expr)
`(printf ',expr "evaluates to" ,expr))
`(print ',expr "evaluates to" ,expr))
(define-syntax (when condition :rest body)
"Special form for when multiple actions should be done if a
(define-syntax (when condition . body)
:doc "Special form for when multiple actions should be done if a
condition is true.
{{{example_start}}}
@@ -22,22 +20,23 @@ condition is true.
`(if ,condition @body nil)
`(if ,condition (begin @body) nil)))
(define-syntax (unless condition :rest body)
"Special form for when multiple actions should be done if a
(define-syntax (unless condition . body)
:doc "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)
"Executes action times times."
:doc "Executes action times times."
(define (repeat times elem)
(unless (> 1 times)
(pair elem (repeat (- times 1) elem))))
`(begin @(repeat times action)))
(define-syntax (let bindings :rest body)
(define-syntax (let bindings . body)
(define (unzip lists)
(break)
(when lists
(define (iter lists l1 l2)
(define elem (first lists))
@@ -51,9 +50,9 @@ condition is false."
(define unzipped (unzip bindings))
`((lambda ,(first unzipped) @body) @(first (rest unzipped))))
`((,lambda ,(first unzipped) @body) @(first (rest unzipped))))
(define-syntax (cond :rest clauses)
(define-syntax (cond . clauses)
(define (rec clauses)
(if (= nil clauses)
nil
@@ -68,7 +67,7 @@ condition is false."
(rec clauses))
(define-syntax (case var :rest clauses)
(define-syntax (case var . clauses)
(define (rec clauses)
(if (= nil clauses)
nil
@@ -82,11 +81,11 @@ condition is false."
,(rec (rest clauses))))))
(rec clauses))
(define-syntax (define-special name-and-args :rest body)
(define-syntax (define-special name-and-args . body)
`(define ,(first name-and-args) (special-lambda ,(rest name-and-args) @body)))
(define-syntax (construct-list :rest body)
"
(define-syntax (construct-list . body)
:doc "
{{{example_start}}}
(construct-list
i <- '(1 2 3 4 5)
@@ -127,11 +126,11 @@ condition is false."
(rec body))
(define-syntax (apply fun seq)
"Applies the function to the sequence, as in calls the function with
:doc "Applies the function to the sequence, as in calls the function with
ithe sequence as arguemens."
`(eval (pair ,fun ,seq)))
(define-syntax (define-typed args :rest body)
(define-syntax (define-typed args . body)
(define (get-arg-names args)
(when args
(pair (first args)
@@ -144,7 +143,7 @@ ithe sequence as arguemens."
@body)))
(define-syntax (define-module module-name :keys exports :rest body)
(define-syntax (define-module module-name :exports . body)
(let ((module-prefix (concat-strings (symbol->string module-name) "::")))
(eval `(begin @body))
(pair 'begin
@@ -159,14 +158,14 @@ ithe sequence as arguemens."
(define (null? x)
"Checks if the argument is =nil=."
:doc "Checks if the argument is =nil=."
(= x ()))
(define (type=? obj typ)
"Checks if the argument =obj= is of type =typ="
:doc "Checks if the argument =obj= is of type =typ="
(= (type obj) typ))
(define (types=? :rest objs)
(define (types=? . objs)
(define (inner objs)
(if objs
(let ((actual-type (type (first objs)))
@@ -177,7 +176,7 @@ ithe sequence as arguemens."
t))
(inner objs))
(define (assert-types= :rest objs)
(define (assert-types= . objs)
(define (inner objs)
(when objs
(let ((actual-type (type (first objs)))
@@ -188,39 +187,39 @@ ithe sequence as arguemens."
(inner objs))
(define (number? x)
"Checks if the argument is a number."
:doc "Checks if the argument is a number."
(type=? x :number))
(define (symbol? x)
"Checks if the argument is a symbol."
:doc "Checks if the argument is a symbol."
(type=? x :symbol))
(define (keyword? x)
"Checks if the argument is a keyword."
:doc "Checks if the argument is a keyword."
(type=? x :keyword))
(define (pair? x)
"Checks if the argument is a pair."
:doc "Checks if the argument is a pair."
(type=? x :pair))
(define (string? x)
"Checks if the argument is a string."
:doc "Checks if the argument is a string."
(type=? x :string))
(define (lambda? x)
"Checks if the argument is a function."
:doc "Checks if the argument is a function."
(type=? x :lambda))
(define (macro? x)
"Checks if the argument is a macro."
:doc "Checks if the argument is a macro."
(type=? x :macro))
(define (special-lambda? x)
"Checks if the argument is a special-lambda."
:doc "Checks if the argument is a special-lambda."
(type=? x :dynamic-macro))
(define (built-in-function? x)
"Checks if the argument is a built-in function."
:doc "Checks if the argument is a built-in function."
(type=? x :built-in-function))
(define (callable? x)
@@ -230,11 +229,11 @@ ithe sequence as arguemens."
(built-in-function? x)))
(define (end seq)
"Returns the last pair in the sqeuence.
:doc "Returns the last pair in the sqeuence.
{{{example_start}}}
(define a (list 1 2 3 4))
(printf (end a))
(print (end a))
{{{example_end}}}
"
(if (or (null? seq) (not (pair? (rest seq))))
@@ -242,17 +241,17 @@ ithe sequence as arguemens."
(end (rest seq))))
(define (last seq)
"Returns the (first) of the last (pair) of the given sequence.
:doc "Returns the (first) of the last (pair) of the given sequence.
{{{example_start}}}
(define a (list 1 2 3 4))
(printf (last a))
(print (last a))
{{{example_end}}}
"
(first (end seq)))
(define (extend seq elem)
"Extends a list with the given element, by putting it in
:doc "Extends a list with the given element, by putting it in
the (rest) of the last element of the sequence."
(if (pair? seq)
(begin
@@ -262,23 +261,23 @@ the (rest) of the last element of the sequence."
elem))
(define (extend2 seq elem)
"Extends a list with the given element, by putting it in
:doc "Extends a list with the given element, by putting it in
the (rest) of the last element of the sequence."
(printf "addr of (end seq)" (addr-of (end seq)))
(print "addr of (end seq)" (addr-of (end seq)))
(if (pair? seq)
(let ((e (end seq)))
(printf "addr if e inner" (addr-of e))
(print "addr if e inner" (addr-of e))
(mutate e (pair (first e) elem))
seq))
elem)
(define (append seq elem)
"Appends an element to a sequence, by extendeing the list
:doc "Appends an element to a sequence, by extendeing the list
with (pair elem nil)."
(extend seq (pair elem ())))
(define (length seq)
"Returns the length of the given sequence."
:doc "Returns the length of the given sequence."
(if (null? seq)
0
(+ 1 (length (rest seq)))))
@@ -303,21 +302,21 @@ with (pair elem nil)."
(else (pair (first seq) (list-without-index (rest seq) (- index 1))))))
(define (increment val)
"Adds one to the argument."
:doc "Adds one to the argument."
(+ val 1))
(define (decrement val)
"Subtracts one from the argument."
:doc "Subtracts one from the argument."
(- val 1))
(define (range :keys from :defaults-to 0 to)
"Returns a sequence of numbers starting with the number defined by the
key =from= and ends with the number defined in =to=."
(define (range (:from 0) :to)
:doc "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 :keys from :defaults-to 0 to)
"Returns a sequence of numbers starting with the number defined
(define (range-while (:from 0) to)
:doc "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)
@@ -330,7 +329,7 @@ by the key 'from' and ends with the number defined in 'to'."
result)
(define (map fun seq)
"Takes a function and a sequence as arguments and returns a new
:doc "Takes a function and a sequence as arguments and returns a new
sequence which contains the results of using the first sequences
elemens as argument to that function."
(if (null? seq)
@@ -339,17 +338,17 @@ elemens as argument to that function."
(map fun (rest seq)))))
(define (reduce fun seq)
"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=]]
:doc "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=]]
instead."
(apply fun seq))
(define (reduce-binary fun seq)
"Takes a function and a sequence as arguments and applies the
:doc "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
*pair-wise* which means it works with binary functions as compared to
[[=reduce=]]."
(if (null? (rest seq))
(first seq)
@@ -357,7 +356,7 @@ function to the argument sequence. reduce-binary applies the arguments
(reduce-binary fun (rest seq)))))
(define (filter fun seq)
"Takes a function and a sequence as arguments and applies the
:doc "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."
@@ -392,20 +391,20 @@ added to a list, which in the end is returned."
(enumerate-inner (rest seq) (+ 1 next-num)))))
(enumerate-inner seq 0))
(define (printf :keys sep :defaults-to " " end :defaults-to "\n" :rest args)
"A wrapper for the built-in function [[=print=]] that accepts a
variable number of arguments and also provides keywords for specifying
the printed separators (=sep=) between the arguments and what should
be printed after the last argument (=end=)."
(define (printf-inner args)
(if args
(begin
(print (first args))
(when (rest args)
(print sep))
(printf-inner (rest args)))
; else
(print end)))
;; (define (print (:sep " ") (:end "\n") . args)
;; "A wrapper for the built-in function [[=print=]] that accepts a
;; variable number of arguments and also provides keywords for specifying
;; the printed separators (=sep=) between the arguments and what should
;; be printed after the last argument (=end=)."
;; (define (print-inner args)
;; (if args
;; (begin
;; (print (first args))
;; (when (rest args)
;; (print sep))
;; (print-inner (rest args)))
;; ; else
;; (print end)))
(printf-inner args)
())
;; (print-inner args)
;; ())
bin/pre.slime.expanded
+51 -29
View File
@@ -1,42 +1,66 @@
(define (null? x) "Checks if the argument is =nil=." (= x ()))
(define-syntax (pe expr) `(print ',expr "evaluates to" ,expr))
(define (type=? obj typ) "Checks if the argument =obj= is of type =typ=" (= (type obj) typ))
(define-syntax (when condition . body) :doc "Special form for when multiple actions should be done if a\ncondition is true.\n\n{{{example_start}}}\n(when (not ())\n (print "Hello ")\n (print "from ")\n (print "when!"))\n\n(when ()\n (print "Goodbye ")\n (print "World!"))\n{{{example_end}}}\n" (if (= (rest body) ()) `(if ,condition (unquote-splicing body) nil) `(if ,condition (begin (unquote-splicing body)) nil)))
(define (types=? :rest objs) (define (inner objs) (if objs (let ((actual-type (type (first objs))) (desired-type (first (rest objs)))) (if (= actual-type desired-type) (inner (rest (rest objs))) ())) t)) (inner objs))
(define-syntax (unless condition . body) :doc "Special form for when multiple actions should be done if a\ncondition is false." (if (= (rest body) ()) `(if ,condition nil (unquote-splicing body)) `(if ,condition nil (begin (unquote-splicing body)))))
(define (assert-types= :rest objs) (define (inner objs) (when objs (let ((actual-type (type (first objs))) (desired-type (first (rest objs)))) (if (= actual-type desired-type) (inner (rest (rest objs))) (error "type missmatch" actual-type desired-type))))) (inner objs))
(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 (number? x) "Checks if the argument is a number." (type=? x :number))
(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 (symbol? x) "Checks if the argument is a symbol." (type=? x :symbol))
(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))
(define (keyword? x) "Checks if the argument is a keyword." (type=? x :keyword))
(define-syntax (case var . 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 (member? ,var ',(first (first clauses))) (begin (unquote-splicing (rest (first clauses)))) ,(rec (rest clauses)))))) (rec clauses))
(define (pair? x) "Checks if the argument is a pair." (type=? x :pair))
(define-syntax (define-special name-and-args . body) `(define ,(first name-and-args) (special-lambda ,(rest name-and-args) (unquote-splicing body))))
(define (string? x) "Checks if the argument is a string." (type=? x :string))
(define-syntax (construct-list . body) :doc "\n{{{example_start}}}\n(construct-list\n i <- '(1 2 3 4 5)\n yield (* i i))\n{{{example_end}}}\n\n(construct-list\n i <- '(1 2 3 4)\n j <- '(A B)\n yield (pair i j))\n\n(construct-list\n i <- '(1 2 3 4 5 6 7 8)\n if (= 0 (% i 2))\n yield i)\n" (define (append-map f ll) (unless (= ll ()) (define val (f (first ll))) (if (= (first val) ()) (append-map f (rest ll)) (extend val (append-map f (rest ll)))))) (define (rec body) (cond ((= () body) ()) ((= () (rest body)) (first body)) ((= (first (rest body)) '<-) `(,append-map (lambda (,(first body)) (list ,(rec (rest (rest (rest body)))))) ,(first (rest (rest body))))) ((= (first body) 'if) `(when ,(first (rest body)) ,(rec (rest (rest body))))) ((= (first (rest body)) 'yield) (first (rest body))) (else (error "Not a do-able expression")))) (rec body))
(define (lambda? x) "Checks if the argument is a function." (type=? x :lambda))
(define-syntax (apply fun seq) :doc "Applies the function to the sequence, as in calls the function with\nithe sequence as arguemens." `(eval (pair ,fun ,seq)))
(define (macro? x) "Checks if the argument is a macro." (type=? x :macro))
(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 (special-lambda? x) "Checks if the argument is a special-lambda." (type=? x :dynamic-macro))
(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 (built-in-function? x) "Checks if the argument is a built-in function." (type=? x :built-in-function))
(define (null? x) :doc "Checks if the argument is =nil=." (= x ()))
(define (type=? obj typ) :doc "Checks if the argument =obj= is of type =typ=" (= (type obj) typ))
(define (types=? . objs) (define (inner objs) (if objs (let ((actual-type (type (first objs))) (desired-type (first (rest objs)))) (if (= actual-type desired-type) (inner (rest (rest objs))) ())) t)) (inner objs))
(define (assert-types= . objs) (define (inner objs) (when objs (let ((actual-type (type (first objs))) (desired-type (first (rest objs)))) (if (= actual-type desired-type) (inner (rest (rest objs))) (error "type missmatch" actual-type desired-type))))) (inner objs))
(define (number? x) :doc "Checks if the argument is a number." (type=? x :number))
(define (symbol? x) :doc "Checks if the argument is a symbol." (type=? x :symbol))
(define (keyword? x) :doc "Checks if the argument is a keyword." (type=? x :keyword))
(define (pair? x) :doc "Checks if the argument is a pair." (type=? x :pair))
(define (string? x) :doc "Checks if the argument is a string." (type=? x :string))
(define (lambda? x) :doc "Checks if the argument is a function." (type=? x :lambda))
(define (macro? x) :doc "Checks if the argument is a macro." (type=? x :macro))
(define (special-lambda? x) :doc "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." (type=? x :built-in-function))
(define (callable? x) (or (lambda? x) (special-lambda? x) (macro? x) (built-in-function? x)))
(define (end seq) "Returns the last pair in the sqeuence.\n\n{{{example_start}}}\n(define a (list 1 2 3 4))\n(printf (end a))\n{{{example_end}}}\n" (if (or (null? seq) (not (pair? (rest seq)))) seq (end (rest seq))))
(define (end seq) :doc "Returns the last pair in the sqeuence.\n\n{{{example_start}}}\n(define a (list 1 2 3 4))\n(print (end a))\n{{{example_end}}}\n" (if (or (null? seq) (not (pair? (rest seq)))) seq (end (rest seq))))
(define (last seq) "Returns the (first) of the last (pair) of the given sequence.\n\n{{{example_start}}}\n(define a (list 1 2 3 4))\n(printf (last a))\n{{{example_end}}}\n" (first (end seq)))
(define (last seq) :doc "Returns the (first) of the last (pair) of the given sequence.\n\n{{{example_start}}}\n(define a (list 1 2 3 4))\n(print (last a))\n{{{example_end}}}\n" (first (end seq)))
(define (extend seq elem) "Extends a list with the given element, by putting it in\nthe (rest) of the last element of the sequence." (if (pair? seq) (begin (define e (end seq)) (mutate e (pair (first e) elem)) seq) elem))
(define (extend seq elem) :doc "Extends a list with the given element, by putting it in\nthe (rest) of the last element of the sequence." (if (pair? seq) (begin (define e (end seq)) (mutate e (pair (first e) elem)) seq) elem))
(define (extend2 seq elem) "Extends a list with the given element, by putting it in\nthe (rest) of the last element of the sequence." (printf "addr of (end seq)" (addr-of (end seq))) (if (pair? seq) (let ((e (end seq))) (printf "addr if e inner" (addr-of e)) (mutate e (pair (first e) elem)) seq)) elem)
(define (extend2 seq elem) :doc "Extends a list with the given element, by putting it in\nthe (rest) of the last element of the sequence." (print "addr of (end seq)" (addr-of (end seq))) (if (pair? seq) (let ((e (end seq))) (print "addr if e inner" (addr-of e)) (mutate e (pair (first e) elem)) seq)) elem)
(define (append seq elem) "Appends an element to a sequence, by extendeing the list\nwith (pair elem nil)." (extend seq (pair elem ())))
(define (append seq elem) :doc "Appends an element to a sequence, by extendeing the list\nwith (pair elem nil)." (extend seq (pair elem ())))
(define (length seq) "Returns the length of the given sequence." (if (null? seq) 0 (+ 1 (length (rest seq)))))
(define (length seq) :doc "Returns the length of the given sequence." (if (null? seq) 0 (+ 1 (length (rest seq)))))
(define (member? elem seq) (when (pair? seq) (if (= elem (first seq)) t (member? elem (rest seq)))))
@@ -44,21 +68,21 @@
(define (list-without-index seq index) (cond ((or (< index 0) (null? seq)) (error "list-remove-index!: index out of range")) ((= 0 index) (rest seq)) (else (pair (first seq) (list-without-index (rest seq) (- index 1))))))
(define (increment val) "Adds one to the argument." (+ val 1))
(define (increment val) :doc "Adds one to the argument." (+ val 1))
(define (decrement val) "Subtracts one from the argument." (- val 1))
(define (decrement val) :doc "Subtracts one from the argument." (- val 1))
(define (range :keys from :defaults-to 0 to) "Returns a sequence of numbers starting with the number defined by the\nkey =from= and ends with the number defined in =to=." (when (< from to) (pair from (range :from (+ 1 from) :to to))))
(define (range (:from 0) :to) :doc "Returns a sequence of numbers starting with the number defined\nby 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 :keys from :defaults-to 0 to) "Returns a sequence of numbers starting with the number defined\nby the key 'from' and ends with the number defined in 'to'." (define result (list (copy from))) (define head result) (mutate from (increment from)) (while (< from to) (begin (mutate head (pair (first head) (pair (copy from) nil))) (define head (rest head)) (mutate from (increment from)))) result)
(define (range-while (:from 0) to) :doc "Returns a sequence of numbers starting with the number defined\nby the key 'from' and ends with the number defined in 'to'." (define result (list (copy from))) (define head result) (mutate from (increment from)) (while (< from to) (begin (mutate head (pair (first head) (pair (copy from) nil))) (define head (rest head)) (mutate from (increment from)))) result)
(define (map fun seq) "Takes a function and a sequence as arguments and returns a new\nsequence which contains the results of using the first sequences\nelemens as argument to that function." (if (null? seq) seq (pair (fun (first seq)) (map fun (rest seq)))))
(define (map fun seq) :doc "Takes a function and a sequence as arguments and returns a new\nsequence which contains the results of using the first sequences\nelemens as argument to that function." (if (null? seq) seq (pair (fun (first seq)) (map fun (rest seq)))))
(define (reduce fun seq) "Takes a function and a sequence as arguments and applies the\nfunction to the argument sequence. This only works correctly if the\ngiven function accepts a variable amount of parameters. If your\nfunciton is limited to two arguments, use [[=reduce-binary=]]\ninstead." (apply fun seq))
(define (reduce fun seq) :doc "Takes a function and a sequence as arguments and applies the\nfunction to the argument sequence. This only works correctly if the\ngiven function accepts a variable amount of parameters. If your\nfunciton is limited to two arguments, use [[=reduce-binary=]]\ninstead." (apply fun seq))
(define (reduce-binary fun seq) "Takes a function and a sequence as arguments and applies the\nfunction to the argument sequence. reduce-binary applies the arguments\n*pair-wise* which means it works with binary functions as compared to\n[[=reduce=]]." (if (null? (rest seq)) (first seq) (fun (first seq) (reduce-binary fun (rest seq)))))
(define (reduce-binary fun seq) :doc "Takes a function and a sequence as arguments and applies the\nfunction to the argument sequence. reduce-binary applies the arguments\n*pair-wise* which means it works with binary functions as compared to\n[[=reduce=]]." (if (null? (rest seq)) (first seq) (fun (first seq) (reduce-binary fun (rest seq)))))
(define (filter fun seq) "Takes a function and a sequence as arguments and applies the\nfunction to every value in the sequence. If the result of that\nfunciton application returns a truthy value, the original value is\nadded to a list, which in the end is returned." (when seq (if (fun (first seq)) (pair (first seq) (filter fun (rest seq))) (filter fun (rest seq)))))
(define (filter fun seq) :doc "Takes a function and a sequence as arguments and applies the\nfunction to every value in the sequence. If the result of that\nfunciton application returns a truthy value, the original value is\nadded to a list, which in the end is returned." (when seq (if (fun (first seq)) (pair (first seq) (filter fun (rest seq))) (filter fun (rest seq)))))
(define (zip l1 l2) (unless (and (null? l1) (null? l2)) (pair (list (first l1) (first l2)) (zip (rest l1) (rest l2)))))
@@ -66,5 +90,3 @@
(define (enumerate seq) (define (enumerate-inner seq next-num) (when seq (pair (list (first seq) next-num) (enumerate-inner (rest seq) (+ 1 next-num))))) (enumerate-inner seq 0))
(define (printf :keys sep :defaults-to " " end :defaults-to "\n" :rest args) "A wrapper for the built-in function [[=print=]] that accepts a\nvariable number of arguments and also provides keywords for specifying\nthe printed separators (=sep=) between the arguments and what should\nbe printed after the last argument (=end=)." (define (printf-inner args) (if args (begin (print (first args)) (when (rest args) (print sep)) (printf-inner (rest args))) (print end))) (printf-inner args) ())
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/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 (: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))