Felix Brendel 6 лет назад
Родитель
Сommit
97f45f166f
4 измененных файлов: 14 добавлений и 14 удалений
  1. +5
    -4
      bin/automata.slime
  2. +5
    -6
      bin/math.slime
  3. +3
    -3
      bin/pre.slime
  4. +1
    -1
      bin/pre.slime.expanded

+ 5
- 4
bin/automata.slime Просмотреть файл

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

+ 5
- 6
bin/math.slime Просмотреть файл

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

+ 3
- 3
bin/pre.slime Просмотреть файл

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




+ 1
- 1
bin/pre.slime.expanded Просмотреть файл

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



Загрузка…
Отмена
Сохранить