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

implement vectors

Browse Source
This commit is contained in:
Felix Brendel
2019-08-08 14:21:30 +02:00
parent 5fa2c1bbf9
commit 4f2793b7ef
13 changed files with 279 additions and 1125 deletions
Download Patch File Download Diff File Expand all files Collapse all files
bin/automata.slime
+9 -35
View File
@@ -1,36 +1,10 @@
(import "sets.slime")
(define-module automata
:exports (make-dfa)
(import "sets.slime")
(define (make-dfa Q S delta q0 F)
(let ((q q0))
(lambda (s)
(mutate q (delta q s))
`(,(if (set-contains? F q) :accept :fail) ,q))))
(define (delta q s)
(cond (s (case q
(("q0") (case s (("M") "q1")))
(("q1") (case s (("A") "q0")
(("G") "q2")))
(("q2") (case s (("E") "q0")))))
(else q)))
;; (make-delta
;; ("q0" :: "M" -> "q1")
;; ("q1" :: "A" -> "q0"
;; "G" -> "q1")
;; ("q2" :: "E" -> "q0"))
(define aut (make-dfa (make-set "q0" "q1" "q2")
(make-set "M" "A" "G" "E")
delta
"q0"
(make-set "q0")))
(printf (aut "M"))
(printf (aut "A"))
(printf (aut "M"))
(printf (aut "G"))
(printf (aut "E"))
(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))))
)
bin/interpolation.slime
+6 -3
View File
@@ -1,5 +1,8 @@
(define-package interpolation
(define-module interpolation
:exports (lerp lerper stepped-lerper
point-lerp point-lerper
bezier2 bezierer2)
(define-typed (lerp a :number b :number t :number)
(+ (* t (- b a)) a))
@@ -43,5 +46,5 @@
)
(define sl1 (interpolation-> stepped-lerper 0 1 5))
(define sl2 (interpolation-> stepped-lerper 10 -10 20))
(define sl1 (interpolation::stepped-lerper 0 1 5))
(define sl2 (interpolation::stepped-lerper 10 -10 20))
bin/math.slime
+3 -2
View File
@@ -1,6 +1,7 @@
(import "oo.slime")
(define-module math
:exports (pi abs sqrt make-vector3)
(define-package math
(import "oo.slime")
(define pi
"Tha famous circle constant."
bin/pre.slime
+29 -12
View File
@@ -1,3 +1,5 @@
(define-syntax (pe expr)
`(printf ',expr "evaluates to" ,expr))
@@ -141,18 +143,33 @@ ithe sequence as arguemens."
(assert-types= @lambda-list)
@body)))
(define-syntax (define-package name :rest body)
`(define ,(string->symbol (concat-strings (symbol->string name) "->"))
((lambda ()
@body
(set-type
(special-lambda (:rest args)
(let ((op (first args))
(args (rest args)))
(if (callable? (eval op))
(apply op args)
(eval op))))
:package)))))
(define-syntax (define-module module-name :keys exports :rest body)
(let ((module-prefix (concat-strings (symbol->string module-name) "::")))
(eval `(begin @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-package name :rest body)
;; `(define ,(string->symbol (concat-strings (symbol->string name) "->"))
;; ((lambda ()
;; @body
;; (set-type
;; (special-lambda (:rest args)
;; (let ((op (first args))
;; (args (rest args)))
;; (if (callable? (eval op))
;; (apply op args)
;; (eval op))))
;; :package)))))
(define (null? x)
"Checks if the argument is =nil=."
bin/sets.slime
+27 -22
View File
@@ -1,28 +1,33 @@
(import "cxr.slime")
(define-module set
:exports (make find contains? insert!)
(define key-not-found-index -1)
(import "cxr.slime")
(define (make-set :rest vals)
(set-type
(if vals
(list vals)
'(()))
:set))
(define key-not-found-index -1)
(define (set-find set val)
(let ((values (car set)))
(define (inner values current-index)
(cond ((null? values) key-not-found-index)
((= (car values) val) current-index)
(else (inner (cdr values) (+ 1 current-index)))))
(inner values 0)))
(define (make :rest vals)
(set-type
(if vals
(list vals)
'(()))
:set))
(define (set-contains? set val)
(unless (= (set-find set val) key-not-found-index)
(define (find set val)
(let ((values (car set)))
(define (inner values current-index)
(cond ((null? values) key-not-found-index)
((= (car values) val) current-index)
(else (inner (cdr values) (+ 1 current-index)))))
(inner values 0)))
(define (contains? set val)
(unless (= (find set val) key-not-found-index)
t))
(define (set-insert! set value)
(unless (set-contains? set value)
(mutate set (pair (pair value (first set)) ()))
(set-type set :set))
set)
(define (insert! set value)
(unless (contains? set value)
(set! set (pair (pair value (first set)) ()))
(set-type set :set))
set)
)
bin/tests/automata.slime
+46
View File
@@ -0,0 +1,46 @@
(import "sets.slime")
(import "automata.slime")
;; (make-delta
;; ("q0" :: "M" -> "q1")
;; ("q1" :: "A" -> "q0"
;; "G" -> "q1")
;; ("q2" :: "E" -> "q0"))
(define (delta q s)
(cond (s (case q
(("q0") (case s (("M") "q1")))
(("q1") (case s (("A") "q0")
(("G") "q2")))
(("q2") (case s (("E") "q0")))))
(else q)))
(define aut (automata::make-dfa (set::make "q0" "q1" "q2")
(set::make "M" "A" "G" "E")
delta
"q0"
(set::make "q0")))
(let ((state (aut ())))
(assert (= (first state) :accept))
(assert (= (first (rest state)) "q0")))
(let ((state (aut "M")))
(assert (= (first state) :fail))
(assert (= (first (rest state)) "q1")))
(let ((state (aut "A")))
(assert (= (first state) :accept))
(assert (= (first (rest state)) "q0")))
(let ((state (aut "M")))
(assert (= (first state) :fail))
(assert (= (first (rest state)) "q1")))
(let ((state (aut "G")))
(assert (= (first state) :fail))
(assert (= (first (rest state)) "q2")))
(let ((state (aut "E")))
(assert (= (first state) :accept))
(assert (= (first (rest state)) "q0")))