| @@ -1,10 +1,11 @@ | |||||
| (define-module automata | (define-module automata | ||||
| :imports ("sets.slime") | |||||
| :exports (make-dfa) | :exports (make-dfa) | ||||
| (import "sets.slime") | |||||
| (define (make-dfa Q S delta q0 F) | (define (make-dfa Q S delta q0 F) | ||||
| (let ((q q0)) | (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))) | |||||
| ) | ) | ||||
| @@ -1,18 +1,17 @@ | |||||
| (define-module math | (define-module math | ||||
| :imports ("oo.slime") | |||||
| :exports (pi abs sqrt make-vector3) | :exports (pi abs sqrt make-vector3) | ||||
| (import "oo.slime") | |||||
| (define pi | (define pi | ||||
| "Tha famous circle constant." | |||||
| :doc "Tha famous circle constant." | |||||
| 3.14159265) | 3.14159265) | ||||
| (define (abs x) | (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))) | (if (> x 0) x (- x))) | ||||
| (define (sqrt 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)) | (** x 0.5)) | ||||
| (define-class (vector3 x y z) | (define-class (vector3 x y z) | ||||
| @@ -58,4 +57,4 @@ | |||||
| (- (* (-> other y) x) (* (-> other x) y)))) | (- (* (-> other y) x) (* (-> other x) y)))) | ||||
| (define (print) | (define (print) | ||||
| (printf :sep "" "[vector3] (" x " " y " " z ")")))) | |||||
| (print :sep "" "[vector3] (" x " " y " " z ")")))) | |||||
| @@ -141,9 +141,9 @@ ithe sequence as arguemens." | |||||
| @body))) | @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) "::"))) | (let ((module-prefix (concat-strings (symbol->string module-name) "::"))) | ||||
| (eval `(begin @body)) | |||||
| (eval `(begin @(map (lambda (x) `(,import ,x)) imports) @body)) | |||||
| (pair 'begin | (pair 'begin | ||||
| (map (lambda (orig-export-name) | (map (lambda (orig-export-name) | ||||
| (let ((export-name (string->symbol | (let ((export-name (string->symbol | ||||
| @@ -151,7 +151,7 @@ ithe sequence as arguemens." | |||||
| (symbol->string orig-export-name))))) | (symbol->string orig-export-name))))) | ||||
| `(define ,export-name | `(define ,export-name | ||||
| ,(mytry (eval orig-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)))) | exports)))) | ||||
| @@ -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-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 ())) | (define (null? x) :doc "Checks if the argument is =nil=." (= x ())) | ||||