| @@ -8,9 +8,17 @@ | |||||
| context-mode-map) | context-mode-map) | ||||
| (context-mode 1) | (context-mode 1) | ||||
| (defun start-debugger () | |||||
| (async-shell-command | |||||
| (concat | |||||
| "cdbg64.exe" " -t " | |||||
| (expand-windows-path (concat (projectile-project-root) | |||||
| "bin/slime.exe"))))) | |||||
| (defhydra hydra-context (context-mode-map "<f2>") | (defhydra hydra-context (context-mode-map "<f2>") | ||||
| "Context Actions:" | "Context Actions:" | ||||
| ("b" save-and-find-build-script-and-compile "build" :color blue) | ("b" save-and-find-build-script-and-compile "build" :color blue) | ||||
| ("d" start-debugger "debug" :color blue) | |||||
| ("o" browse-file-directory "open" :color blue) | ("o" browse-file-directory "open" :color blue) | ||||
| ("q" nil "quit" :color blue)) | ("q" nil "quit" :color blue)) | ||||
| @@ -0,0 +1,36 @@ | |||||
| (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")) | |||||
| @@ -0,0 +1,47 @@ | |||||
| (define-package interpolation | |||||
| (define-typed (lerp a :number b :number t :number) | |||||
| (+ (* t (- b a)) a)) | |||||
| (define-typed (lerper a :number b :number) | |||||
| (define-typed (ret t :number) | |||||
| (lerp a b t)) | |||||
| ret) | |||||
| (define-typed (stepped-lerper a :number b :number #steps :number) | |||||
| (let ((t 0) | |||||
| (dt (/ 1 #steps))) | |||||
| (lambda () | |||||
| (let ((res (lerp a b t))) | |||||
| (mutate t (+ t dt)) | |||||
| res)))) | |||||
| (define make-point pair) | |||||
| (define point->x first) | |||||
| (define point->y rest) | |||||
| (define (point-lerp p1 p2 t) | |||||
| (make-point (lerp (point->x p1) (point->x p2) t) | |||||
| (lerp (point->y p1) (point->y p2) t))) | |||||
| (define (point-lerper p1 p2) | |||||
| (lambda (t) (point-lerp p1 p2 t))) | |||||
| (define (bezier2 p1 p2 p3 t) | |||||
| (point-lerp (point-lerp p1 p2 t) | |||||
| (point-lerp p2 p3 t) | |||||
| t)) | |||||
| (define (bezierer2 p1 p2 p3) | |||||
| (let ((lerper1 (point-lerper p1 p2)) | |||||
| (lerper2 (point-lerper p2 p3))) | |||||
| (lambda (t) | |||||
| (point-lerp (lerper1 t) | |||||
| (lerper2 t) t)))) | |||||
| ) | |||||
| (define sl1 (interpolation-> stepped-lerper 0 1 5)) | |||||
| (define sl2 (interpolation-> stepped-lerper 10 -10 20)) | |||||
| @@ -24,4 +24,3 @@ | |||||
| (define-syntax (-> obj meth :rest args) | (define-syntax (-> obj meth :rest args) | ||||
| `(,obj ',meth @args)) | `(,obj ',meth @args)) | ||||
| @@ -98,7 +98,7 @@ condition is false." | |||||
| (construct-list | (construct-list | ||||
| i <- '(1 2 3 4 5 6 7 8) | i <- '(1 2 3 4 5 6 7 8) | ||||
| when (evenp i) | |||||
| if (= 0 (% i 2)) | |||||
| yield i) | yield i) | ||||
| " | " | ||||
| (define (append-map f ll) | (define (append-map f ll) | ||||
| @@ -116,8 +116,8 @@ condition is false." | |||||
| ((= () (rest body)) (first body)) | ((= () (rest body)) (first body)) | ||||
| ((= (first (rest body)) '<-) | ((= (first (rest body)) '<-) | ||||
| `(,append-map (lambda (,(first body)) (list ,(rec (rest (rest (rest body)))))) ,(first (rest (rest body))))) | `(,append-map (lambda (,(first body)) (list ,(rec (rest (rest (rest body)))))) ,(first (rest (rest body))))) | ||||
| ((= (first body) 'when) | |||||
| `(if ,(first (rest body)) ,(rec (rest (rest body))))) | |||||
| ((= (first body) 'if) | |||||
| `(when ,(first (rest body)) ,(rec (rest (rest body))))) | |||||
| ((= (first body) 'yield) | ((= (first body) 'yield) | ||||
| (first (rest body))) | (first (rest body))) | ||||
| (else (error "Not a do-able expression")))) | (else (error "Not a do-able expression")))) | ||||
| @@ -0,0 +1,28 @@ | |||||
| (import "cxr.slime") | |||||
| (define key-not-found-index -1) | |||||
| (define (make-set :rest vals) | |||||
| (set-type | |||||
| (if vals | |||||
| (list vals) | |||||
| '(())) | |||||
| :set)) | |||||
| (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 (set-contains? set val) | |||||
| (unless (= (set-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) | |||||
| @@ -23,6 +23,13 @@ | |||||
| (assert (= (counter1) 4)) | (assert (= (counter1) 4)) | ||||
| (assert (= (counter1) 5)) | (assert (= (counter1) 5)) | ||||
| (define (g) | |||||
| (define x 0) | |||||
| (lambda () | |||||
| (define temp x) | |||||
| (mutate x (+ x 1)) | |||||
| temp)) | |||||
| ;; key arguments | ;; key arguments | ||||
| (define (make-key-counter) | (define (make-key-counter) | ||||
| @@ -24,6 +24,8 @@ | |||||
| (assert (= (counter1) 5)) | (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 (make-key-counter) ((lambda (:keys var) (lambda () (mutate var (+ 1 var)) var)) :var 0)) | ||||
| (define key-counter1 (make-key-counter)) | (define key-counter1 (make-key-counter)) | ||||
| @@ -164,14 +164,12 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> | |||||
| proc read_rest_arg = [&]() -> void { | proc read_rest_arg = [&]() -> void { | ||||
| if (arguments == Memory::nil) { | if (arguments == Memory::nil) { | ||||
| if (function->rest_argument) { | if (function->rest_argument) { | ||||
| try_void sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument); | |||||
| define_symbol(sym, Memory::nil); | |||||
| define_symbol(function->rest_argument, Memory::nil); | |||||
| } | } | ||||
| } else { | } else { | ||||
| if (function->rest_argument) { | if (function->rest_argument) { | ||||
| try_void sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument); | |||||
| define_symbol( | define_symbol( | ||||
| sym, | |||||
| function->rest_argument, | |||||
| // NOTE(Felix): arguments will be a list, and I THINK | // NOTE(Felix): arguments will be a list, and I THINK | ||||
| // we do not need to copy it... | // we do not need to copy it... | ||||
| arguments); | arguments); | ||||
| @@ -334,7 +332,7 @@ proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void { | |||||
| create_parsing_error("After the 'rest' marker there must follow a symbol."); | create_parsing_error("After the 'rest' marker there must follow a symbol."); | ||||
| return; | return; | ||||
| } | } | ||||
| function->rest_argument = arguments->value.pair.first->value.symbol.identifier; | |||||
| function->rest_argument = arguments->value.pair.first; | |||||
| if (arguments->value.pair.rest != Memory::nil) { | if (arguments->value.pair.rest != Memory::nil) { | ||||
| create_parsing_error("The lambda list must end after the rest symbol"); | create_parsing_error("The lambda list must end after the rest symbol"); | ||||
| } | } | ||||
| @@ -483,6 +481,7 @@ proc eval_expr(Lisp_Object* node) -> Lisp_Object* { | |||||
| create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node))); | create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node))); | ||||
| return nullptr; | return nullptr; | ||||
| } | } | ||||
| } | } | ||||
| } | } | ||||
| @@ -557,6 +556,5 @@ proc interprete_stdin() -> void { | |||||
| print(evaluated); | print(evaluated); | ||||
| printf("\n"); | printf("\n"); | ||||
| } | } | ||||
| } | } | ||||
| } | } | ||||
| @@ -1,7 +1,7 @@ | |||||
| #include "slime.h" | #include "slime.h" | ||||
| int main(int argc, char* argv[]) { | int main(int argc, char* argv[]) { | ||||
| if (argc > 1) { | |||||
| if (argc > 1) { | |||||
| if (Slime::string_equal(argv[1], "--run-tests")) { | if (Slime::string_equal(argv[1], "--run-tests")) { | ||||
| return Slime::run_all_tests() ? 0 : 1; | return Slime::run_all_tests() ? 0 : 1; | ||||
| } | } | ||||
| @@ -17,8 +17,8 @@ enum struct Lisp_Object_Type { | |||||
| String, | String, | ||||
| Pair, | Pair, | ||||
| Continuation, | Continuation, | ||||
| // Pointer, | |||||
| // OwningPointer, | |||||
| Pointer, | |||||
| OwningPointer, | |||||
| Function, | Function, | ||||
| CFunction, | CFunction, | ||||
| }; | }; | ||||
| @@ -95,8 +95,9 @@ struct Function { | |||||
| Function_Type type; | Function_Type type; | ||||
| Positional_Arguments* positional_arguments; | Positional_Arguments* positional_arguments; | ||||
| Keyword_Arguments* keyword_arguments; | Keyword_Arguments* keyword_arguments; | ||||
| // rest_argument will be nullptr if no rest argument is declared | |||||
| String* rest_argument; | |||||
| // NOTE(Felix): rest_argument will be nullptr if no rest argument | |||||
| // is declared otherwise its a symbol | |||||
| Lisp_Object* rest_argument; | |||||
| Lisp_Object* body; // implicit begin | Lisp_Object* body; // implicit begin | ||||
| Environment* parent_environment; // we are doing closures now!! | Environment* parent_environment; // we are doing closures now!! | ||||
| }; | }; | ||||