implement vectors

bin/automata.slime

@@ -1,36 +1,10 @@
-(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"))
+(define-module automata
+  :exports (make-dfa)
+  (import "sets.slime")
+
+  (define (make-dfa Q S delta q0 F)
+    (let ((q q0))
+      (lambda (s)
+        (set! q (delta q s))
+        (list (if (set::contains? F q) :accept :fail) q))))
+  )

bin/interpolation.slime

@@ -1,5 +1,8 @@
 
-(define-package interpolation
+(define-module interpolation
+  :exports (lerp lerper stepped-lerper
+            point-lerp point-lerper
+            bezier2 bezierer2)
 
   (define-typed (lerp a :number b :number t :number)
     (+ (* t (- b a)) a))
@@ -43,5 +46,5 @@
   )
 
 
-(define sl1 (interpolation-> stepped-lerper 0 1 5))
-(define sl2 (interpolation-> stepped-lerper 10 -10 20))
+(define sl1 (interpolation::stepped-lerper 0 1 5))
+(define sl2 (interpolation::stepped-lerper 10 -10 20))

bin/math.slime

@@ -1,6 +1,7 @@
-(import "oo.slime")
+(define-module math
+  :exports (pi abs sqrt make-vector3)
 
-(define-package math
+  (import "oo.slime")
 
   (define pi
     "Tha famous circle constant."

bin/pre.slime

@@ -1,3 +1,5 @@
+
+
 (define-syntax (pe expr)
   `(printf ',expr "evaluates to" ,expr))
 
@@ -141,18 +143,33 @@ ithe sequence as arguemens."
        (assert-types= @lambda-list)
        @body)))
 
-(define-syntax (define-package name :rest body)
-  `(define ,(string->symbol (concat-strings (symbol->string name) "->"))
-     ((lambda ()
-        @body
-        (set-type
-          (special-lambda (:rest args)
-                      (let ((op   (first args))
-                            (args (rest  args)))
-                        (if (callable? (eval op))
-                            (apply op args)
-                          (eval op))))
-          :package)))))
+
+(define-syntax (define-module module-name :keys exports :rest body)
+  (let ((module-prefix (concat-strings (symbol->string module-name) "::")))
+    (eval `(begin @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
+                      ,(try (eval orig-export-name)
+                            (error "The module does not contain" orig-export-name)))))
+               exports))))
+
+
+;; (define-syntax (define-package name :rest body)
+;;   `(define ,(string->symbol (concat-strings (symbol->string name) "->"))
+;;      ((lambda ()
+;;         @body
+;;         (set-type
+;;           (special-lambda (:rest args)
+;;                       (let ((op   (first args))
+;;                             (args (rest  args)))
+;;                         (if (callable? (eval op))
+;;                             (apply op args)
+;;                           (eval op))))
+;;           :package)))))
 
 (define (null? x)
   "Checks if the argument is =nil=."

bin/sets.slime

@@ -1,28 +1,33 @@
-(import "cxr.slime")
+(define-module set
+  :exports (make find contains? insert!)
 
-(define key-not-found-index -1)
+  (import "cxr.slime")
 
-(define (make-set :rest vals)
-  (set-type
-   (if vals
-       (list vals)
-     '(()))
-   :set))
+  (define key-not-found-index -1)
 
-(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 (make :rest vals)
+    (set-type
+     (if vals
+         (list vals)
+       '(()))
+     :set))
 
-(define (set-contains? set val)
-  (unless (= (set-find set val) key-not-found-index)
+  (define (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 (contains? set val)
+    (unless (= (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)
+  (define (insert! set value)
+    (unless (contains? set value)
+      (set! set (pair (pair value (first set)) ()))
+      (set-type set :set))
+    set)
+
+  )

bin/tests/automata.slime

@@ -0,0 +1,46 @@
+(import "sets.slime")
+(import "automata.slime")
+
+;; (make-delta
+;;  ("q0" :: "M" -> "q1")
+;;  ("q1" :: "A" -> "q0"
+;;           "G" -> "q1")
+;;  ("q2" :: "E" -> "q0"))
+
+(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)))
+
+(define aut (automata::make-dfa (set::make "q0" "q1" "q2")
+                                (set::make "M" "A" "G" "E")
+                                delta
+                                "q0"
+                                (set::make "q0")))
+
+(let ((state (aut ())))
+  (assert (= (first state)        :accept))
+  (assert (= (first (rest state)) "q0")))
+
+(let ((state (aut "M")))
+  (assert (= (first state)        :fail))
+  (assert (= (first (rest state)) "q1")))
+
+(let ((state (aut "A")))
+  (assert (= (first state)        :accept))
+  (assert (= (first (rest state)) "q0")))
+
+(let ((state (aut "M")))
+  (assert (= (first state)        :fail))
+  (assert (= (first (rest state)) "q1")))
+
+(let ((state (aut "G")))
+  (assert (= (first state)        :fail))
+  (assert (= (first (rest state)) "q2")))
+
+(let ((state (aut "E")))
+  (assert (= (first state)        :accept))
+  (assert (= (first (rest state)) "q0")))

src/built_ins.cpp

@@ -22,6 +22,7 @@ proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
     case Lisp_Object_Type::Number: return n1->value.number == n2->value.number;
     case Lisp_Object_Type::String: return string_equal(n1->value.string, n2->value.string);
     case Lisp_Object_Type::Pair:
+    case Lisp_Object_Type::Vector:
         create_not_yet_implemented_error();
         return false;
     }
@@ -456,7 +457,7 @@ proc load_built_ins_into_environment() -> void {
             try assert_type(target_symbol, Lisp_Object_Type::Symbol);
 
             Environment* target_env = find_binding_environment(target_symbol->value.symbol.identifier, get_current_environment());
-            assert(target_env);
+            try assert(target_env);
 
             push_environment(target_env);
             defer {
@@ -465,6 +466,28 @@ proc load_built_ins_into_environment() -> void {
 
             define_symbol(target_symbol, source);
 
+            return source;
+        });
+    defun("set-car!", "TODO", __LINE__, cLambda {
+            try evaluated_arguments = eval_arguments(arguments, &arguments_length);
+            try assert_arguments_length(2, arguments_length);
+            Lisp_Object* target = evaluated_arguments->value.pair.first;
+            Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first;
+
+            assert_type(target, Lisp_Object_Type::Pair);
+
+            *target->value.pair.first = *source;
+            return source;
+        });
+    defun("set-cdr!", "TODO", __LINE__, cLambda {
+            try evaluated_arguments = eval_arguments(arguments, &arguments_length);
+            try assert_arguments_length(2, arguments_length);
+            Lisp_Object* target = evaluated_arguments->value.pair.first;
+            Lisp_Object* source = evaluated_arguments->value.pair.rest->value.pair.first;
+
+            assert_type(target, Lisp_Object_Type::Pair);
+
+            *target->value.pair.rest = *source;
             return source;
         });
     defun("if", "TODO", __LINE__, cLambda {
@@ -750,6 +773,12 @@ proc load_built_ins_into_environment() -> void {
             try evaluated_arguments = eval_arguments(arguments, &arguments_length);
             return evaluated_arguments;
         });
+    defun("vector", "TODO", __LINE__, cLambda {
+            try evaluated_arguments = eval_arguments(arguments, &arguments_length);
+            Lisp_Object* ret;
+            try ret = Memory::create_lisp_object_vector(arguments_length, evaluated_arguments);
+            return ret;
+        });
     defun("pair", "TODO", __LINE__, cLambda {
             try evaluated_arguments = eval_arguments(arguments, &arguments_length);
             try assert_arguments_length(2, arguments_length);
@@ -829,6 +858,7 @@ proc load_built_ins_into_environment() -> void {
             case Lisp_Object_Type::T:       return Memory::get_or_create_lisp_object_keyword("t");
             case Lisp_Object_Type::Number:  return Memory::get_or_create_lisp_object_keyword("number");
             case Lisp_Object_Type::Pair:    return Memory::get_or_create_lisp_object_keyword("pair");
+            case Lisp_Object_Type::Vector:  return Memory::get_or_create_lisp_object_keyword("vector");
             case Lisp_Object_Type::String:  return Memory::get_or_create_lisp_object_keyword("string");
             case Lisp_Object_Type::Symbol:  return Memory::get_or_create_lisp_object_keyword("symbol");
             }

src/io.cpp

@@ -294,6 +294,14 @@ proc print(Lisp_Object* node, bool print_repr = false, FILE* file = stdout) -> v
         else
             fputs(Memory::get_c_str(node->value.string), file);
     } break;
+    case (Lisp_Object_Type::Vector): {
+        fputs("[vector", file);
+        for (int i = 0; i < node->value.vector.length; ++i) {
+            fputs(" ", file);
+            print(node->value.vector.data+i);
+        }
+        fputs("]", file);
+    } break;
     case (Lisp_Object_Type::Function): {
         if (node->userType) {
             fprintf(file, "[%s]", Memory::get_c_str(node->userType->value.symbol.identifier));

src/lisp_object.cpp

@@ -21,6 +21,7 @@ proc Lisp_Object_Type_to_string(Lisp_Object_Type type) -> const char* {
     case(Lisp_Object_Type::CFunction):    return "C-function";
     case(Lisp_Object_Type::Continuation): return "continuation";
     case(Lisp_Object_Type::Pair):         return "pair";
+    case(Lisp_Object_Type::Vector):         return "vector";
     }
     return "unknown";
 }

src/memory.cpp

@@ -226,6 +226,50 @@ namespace Memory {
         return node;
     }
 
+    proc allocate_vector(int size) -> Lisp_Object* {
+        /*
+          int object_memory_size;
+          Int_Array_List* free_spots_in_object_memory;
+          Lisp_Object* object_memory;
+          int next_index_in_object_memory = 0;
+
+         */
+
+        if (object_memory_size - next_index_in_object_memory < size) {
+            create_out_of_memory_error(
+                "There is not enough space in the lisp object "
+                "memory to allocate additional lisp objects. "
+                "Maybe try increasing the Memory size when "
+                "calling Memory::init()");
+            return nullptr;
+        }
+        int start = next_index_in_object_memory;
+        next_index_in_object_memory += size;
+        return object_memory+start;
+    }
+
+    proc create_lisp_object_vector(int length, Lisp_Object* element_list) -> Lisp_Object* {
+        try assert_type(element_list, Lisp_Object_Type::Pair);
+
+        Lisp_Object* node;
+        try node = create_lisp_object();
+        set_type(node, Lisp_Object_Type::Vector);
+
+        node->value.vector.length = length;
+        try node->value.vector.data = allocate_vector(length);
+
+        Lisp_Object* head = element_list;
+
+        int i = 0;
+        while (head != Memory::nil) {
+            node->value.vector.data[i] = *head->value.pair.first;
+            head = head->value.pair.rest;
+            ++i;
+        }
+
+        return node;
+    }
+
     proc get_or_create_lisp_object_symbol(String* identifier) -> Lisp_Object* {
         // TODO(Felix): if we already have it stored somewhere then
         // reuse it and dont create new one

src/structs.cpp

@@ -16,6 +16,7 @@ enum struct Lisp_Object_Type {
     Number,
     String,
     Pair,
+    Vector,
     Continuation,
     // Pointer,
     // OwningPointer,
@@ -76,6 +77,11 @@ struct Pair {
     Lisp_Object* rest;
 };
 
+struct Vector {
+    int length;
+    Lisp_Object* data;
+};
+
 struct Positional_Arguments {
     Lisp_Object** symbols; // Array of Pointers to Lisp_Object<Symbol>
     int next_index;
@@ -87,6 +93,7 @@ struct Keyword_Arguments {
     // NOTE(Felix): values[i] will be nullptr if no defalut value was
     // declared for key identifiers[i]
     Lisp_Object_Array_List* values;
+    // TODO(Felix): Why do we use a Array list here??
     int next_index;
     int length;
 };
@@ -116,6 +123,7 @@ struct Lisp_Object {
         double        number;
         String*       string;
         Pair          pair;
+        Vector        vector;
         Function      function;
         cFunction*    cFunction;
         Continuation  continuation;

src/testing.cpp

@@ -639,6 +639,8 @@ proc run_all_tests() -> bool {
     invoke_test_script("import_and_load");
     invoke_test_script("sicp");
     invoke_test_script("macro_expand");
+    invoke_test_script("automata");
+
 
     return result;
 }