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

small fixes in stdlib

Browse Source
This commit is contained in:
Felix Brendel
2019-09-23 22:44:08 +02:00
parent 088127387e
commit 97f45f166f
4 changed files with 14 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files
bin/automata.slime
+5 -4
View File
@@ -1,10 +1,11 @@
(define-module automata
:imports ("sets.slime")
:exports (make-dfa)
(import "sets.slime")
(define (make-dfa Q S delta q0 F)
(let ((q q0))
(lambda (s)
(set! q (delta q s))
(list (if (set::contains? F q) :accept :fail) q))))
(set-type! (lambda (s)
(set! q (delta q s))
(list (if (set::contains? F q) :accept :fail) q))
:automaton)))
)
bin/math.slime
+5 -6
View File
@@ -1,18 +1,17 @@
(define-module math
:imports ("oo.slime")
:exports (pi abs sqrt make-vector3)
(import "oo.slime")
(define pi
"Tha famous circle constant."
:doc "Tha famous circle constant."
3.14159265)
(define (abs x)
"Accepts one argument and returns the absoulte value of it"
:doc "Accepts one argument and returns the absoulte value of it"
(if (> x 0) x (- x)))
(define (sqrt x)
"Accepts one argument and returns the square root of it"
:doc "Accepts one argument and returns the square root of it"
(** x 0.5))
(define-class (vector3 x y z)
@@ -58,4 +57,4 @@
(- (* (-> other y) x) (* (-> other x) y))))
(define (print)
(printf :sep "" "[vector3] (" x " " y " " z ")"))))
(print :sep "" "[vector3] (" x " " y " " z ")"))))
bin/pre.slime
+3 -3
View File
@@ -141,9 +141,9 @@ ithe sequence as arguemens."
@body)))
(define-syntax (define-module module-name :exports . body)
(define-syntax (define-module module-name (:imports ()) :exports . body)
(let ((module-prefix (concat-strings (symbol->string module-name) "::")))
(eval `(begin @body))
(eval `(begin @(map (lambda (x) `(,import ,x)) imports) @body))
(pair 'begin
(map (lambda (orig-export-name)
(let ((export-name (string->symbol
@@ -151,7 +151,7 @@ ithe sequence as arguemens."
(symbol->string orig-export-name)))))
`(define ,export-name
,(mytry (eval orig-export-name)
(error "The module does not contain" orig-export-name)))))
(error "The module does not contain" orig-export-name)))))
exports))))
bin/pre.slime.expanded
+1 -1
View File
@@ -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 ,(mytry (eval orig-export-name) (error "The module does not contain" orig-export-name))))) exports))))
(define-syntax (define-module module-name (:imports ()) :exports . body) (let ((module-prefix (concat-strings (symbol->string module-name) "::"))) (eval `(begin (unquote-splicing (map (lambda (x) `(,import ,x)) imports)) (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 ()))