Quellcode durchsuchen

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

master
FelixBrendel vor 6 Jahren
Ursprung
Commit
241ac60ced
11 geänderte Dateien mit 141 neuen und 15 gelöschten Zeilen
  1. +8
    -0
      .dir-locals.el
  2. +36
    -0
      bin/automata.slime
  3. +47
    -0
      bin/interpolation.slime
  4. +0
    -1
      bin/oo.slime
  5. +3
    -3
      bin/pre.slime
  6. +28
    -0
      bin/sets.slime
  7. +7
    -0
      bin/tests/lexical_scope.slime
  8. +2
    -0
      bin/tests/lexical_scope.slime.expanded
  9. +4
    -6
      src/eval.cpp
  10. +1
    -1
      src/main.cpp
  11. +5
    -4
      src/structs.cpp

+ 8
- 0
.dir-locals.el Datei anzeigen

@@ -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
- 0
bin/automata.slime Datei anzeigen

@@ -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
- 0
bin/interpolation.slime Datei anzeigen

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

+ 0
- 1
bin/oo.slime Datei anzeigen

@@ -24,4 +24,3 @@
(define-syntax (-> obj meth :rest args)
`(,obj ',meth @args))



+ 3
- 3
bin/pre.slime Datei anzeigen

@@ -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
- 0
bin/sets.slime Datei anzeigen

@@ -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
- 0
bin/tests/lexical_scope.slime Datei anzeigen

@@ -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
- 0
bin/tests/lexical_scope.slime.expanded Datei anzeigen

@@ -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
src/eval.cpp Datei anzeigen

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

}
}

+ 1
- 1
src/main.cpp Datei anzeigen

@@ -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;
}


+ 5
- 4
src/structs.cpp Datei anzeigen

@@ -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!!
};


Laden…
Abbrechen
Speichern