From 241ac60ced23e1b31401b0c6699e9116084d1d34 Mon Sep 17 00:00:00 2001 From: FelixBrendel Date: Thu, 1 Aug 2019 19:48:09 +0200 Subject: [PATCH] args are now stored with their symbols instead of ther string identifiers --- .dir-locals.el | 8 +++++ bin/automata.slime | 36 ++++++++++++++++++++ bin/interpolation.slime | 47 ++++++++++++++++++++++++++ bin/oo.slime | 1 - bin/pre.slime | 6 ++-- bin/sets.slime | 28 +++++++++++++++ bin/tests/lexical_scope.slime | 7 ++++ bin/tests/lexical_scope.slime.expanded | 2 ++ src/eval.cpp | 10 +++--- src/main.cpp | 2 +- src/structs.cpp | 9 ++--- 11 files changed, 141 insertions(+), 15 deletions(-) create mode 100644 bin/automata.slime create mode 100644 bin/interpolation.slime create mode 100644 bin/sets.slime diff --git a/.dir-locals.el b/.dir-locals.el index 78bfb35..5ccc464 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -8,9 +8,17 @@ context-mode-map) (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 "") "Context Actions:" ("b" save-and-find-build-script-and-compile "build" :color blue) + ("d" start-debugger "debug" :color blue) ("o" browse-file-directory "open" :color blue) ("q" nil "quit" :color blue)) diff --git a/bin/automata.slime b/bin/automata.slime new file mode 100644 index 0000000..07bb357 --- /dev/null +++ b/bin/automata.slime @@ -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")) diff --git a/bin/interpolation.slime b/bin/interpolation.slime new file mode 100644 index 0000000..a4f7f62 --- /dev/null +++ b/bin/interpolation.slime @@ -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)) diff --git a/bin/oo.slime b/bin/oo.slime index b620b9c..f574310 100644 --- a/bin/oo.slime +++ b/bin/oo.slime @@ -24,4 +24,3 @@ (define-syntax (-> obj meth :rest args) `(,obj ',meth @args)) - diff --git a/bin/pre.slime b/bin/pre.slime index 6955e08..70e4414 100644 --- a/bin/pre.slime +++ b/bin/pre.slime @@ -98,7 +98,7 @@ condition is false." (construct-list i <- '(1 2 3 4 5 6 7 8) - when (evenp i) + if (= 0 (% i 2)) yield i) " (define (append-map f ll) @@ -116,8 +116,8 @@ condition is false." ((= () (rest body)) (first body)) ((= (first (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 (rest body))) (else (error "Not a do-able expression")))) diff --git a/bin/sets.slime b/bin/sets.slime new file mode 100644 index 0000000..575b352 --- /dev/null +++ b/bin/sets.slime @@ -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) diff --git a/bin/tests/lexical_scope.slime b/bin/tests/lexical_scope.slime index cccedcc..65c796e 100644 --- a/bin/tests/lexical_scope.slime +++ b/bin/tests/lexical_scope.slime @@ -23,6 +23,13 @@ (assert (= (counter1) 4)) (assert (= (counter1) 5)) +(define (g) + (define x 0) + (lambda () + (define temp x) + (mutate x (+ x 1)) + temp)) + ;; key arguments (define (make-key-counter) diff --git a/bin/tests/lexical_scope.slime.expanded b/bin/tests/lexical_scope.slime.expanded index c2e2d4f..2a3c968 100644 --- a/bin/tests/lexical_scope.slime.expanded +++ b/bin/tests/lexical_scope.slime.expanded @@ -24,6 +24,8 @@ (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 key-counter1 (make-key-counter)) diff --git a/src/eval.cpp b/src/eval.cpp index 436621e..aae2d6a 100644 --- a/src/eval.cpp +++ b/src/eval.cpp @@ -164,14 +164,12 @@ proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> proc read_rest_arg = [&]() -> void { if (arguments == Memory::nil) { 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 { if (function->rest_argument) { - try_void sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument); define_symbol( - sym, + function->rest_argument, // NOTE(Felix): arguments will be a list, and I THINK // we do not need to copy it... 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."); 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) { 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))); return nullptr; } + } } @@ -557,6 +556,5 @@ proc interprete_stdin() -> void { print(evaluated); printf("\n"); } - } } diff --git a/src/main.cpp b/src/main.cpp index bead382..21b00b5 100644 --- a/src/main.cpp +++ b/src/main.cpp @@ -1,7 +1,7 @@ #include "slime.h" int main(int argc, char* argv[]) { - if (argc > 1) { + if (argc > 1) { if (Slime::string_equal(argv[1], "--run-tests")) { return Slime::run_all_tests() ? 0 : 1; } diff --git a/src/structs.cpp b/src/structs.cpp index 6837c47..f63adf3 100644 --- a/src/structs.cpp +++ b/src/structs.cpp @@ -17,8 +17,8 @@ enum struct Lisp_Object_Type { String, Pair, Continuation, - // Pointer, - // OwningPointer, + Pointer, + OwningPointer, Function, CFunction, }; @@ -95,8 +95,9 @@ struct Function { Function_Type type; Positional_Arguments* positional_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 Environment* parent_environment; // we are doing closures now!! };