args are now stored with their symbols instead of ther string identifiers

This commit is contained in:
FelixBrendel
2019-08-01 19:48:09 +02:00
parent 7cebcd1823
commit 241ac60ced
11 changed files with 141 additions and 15 deletions
+8
View File
@@ -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 "<f2>")
"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))
+36
View File
@@ -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"))
+47
View File
@@ -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))
-1
View File
@@ -24,4 +24,3 @@
(define-syntax (-> obj meth :rest args)
`(,obj ',meth @args))
+3 -3
View File
@@ -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"))))
+28
View File
@@ -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)
+7
View File
@@ -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)
+2
View File
@@ -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))
+4 -6
View File
@@ -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");
}
}
}
+5 -4
View File
@@ -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!!
};