More work in the object system

.gitignore

@@ -6,3 +6,4 @@ build
 test/test
 test/*.o
 bin
+cmake-build-debug

check.py

@@ -0,0 +1,16 @@
+from collections import defaultdict
+import re
+
+col = defaultdict(lambda: defaultdict(int))
+
+with open("out.res") as file:
+    for line in file:
+        parts = line.split()
+        op = int(parts[0], 16)
+        effect = int(parts[1])
+        col[op][effect] += 1
+
+for k, v in col.items():
+    print(hex(k))
+    for c, n in v.items():
+        print(" ", c, n)

example/example.cdr

@@ -12,65 +12,230 @@
                   (reduce f (f i (first xs)) (rest xs)))))
 
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defn fib (n)
+  (if (< n 2)
+    n
+    (+ (fib (- n 2)) (fib (- n 1)))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(class account
-       (balance)
-       ((withdraw (fn (c) (def balance (- balance c))))
-        (deposit (fn (c) (def balance (+ balance c))))
-        (get-balance (fn () balance))))
 
-(def checking (account 30))
-(checking.withdraw 10)
-(checking.deposit 300)
 
+(defn read-eval ()
+  (do
+    (print "CEDAR> ")
+    (eval (macroexpand (read)))))
 
+;; (let ((v nil))
+;;   (def v (catch (read-eval)
+;;            e (do (println "unhandled exception:" e) nil)))
+;;   (if (not (= v :EOF))
+;;     (do
+;;       (println v)
+;;       (recur nil))))
 
-((get checking 'deposit) 300)
 
-(class person (name)
-  ((speak (fn () (println name "says hi!")))))
 
+(defn inc (n) (+ n 1))
+(defn dec (n) (- n 1))
 
-(def guy (person "bob"))
-(guy.speak)
 
+(defmacro class (name & fields)
+  `(do
+      ,(if (not (symbol? name)) (throw (str "Invalid class name: " name)))
+      ;; define the name as a global class
+      (def ,name (cedar/make-class ',name))
+      ;; map over each of the fields, expand them
+      ;; and convert the defs as class fields
+      (do ,@(map (fn (mexpr)
+                   (if (not (list? mexpr)) (throw (str "invalid class field: " mexpr))
+                      (let ((expr (macroexpand mexpr)))
+                        (cond (= 'def (first expr))
+                              `(cedar/register-class-field ,name
+                                                           ',(first (rest expr))
+                                                           ,(first (rest (rest expr))))
+                              (= :extends (first expr)) :EXTENDS
+                              :else (throw (str "Invalid class field: " mexpr))))))
+                 fields))))
+
+
+
+;; since setting dict entries with keys as idents is
+;; so common, this macro automatically quotes the key
+;; identifier so you dont have to think about it.
+(defmacro setq (coll name val)
+  `(set ,coll (quote ,name) ,val))
+
+;; define a macro for use inside classes to clean up
+;; the (set self 'name val) form. Cause it's ugly.
+(defmacro set-self (name val)
+  `(set self (quote ,name) ,val))
+
+;; the stream class is a basic io class
+;; it offers .write and .read
+(class stream
+  (def write nil)
+  (def read nil))
+
+(class file-descriptor (:extends steam)
+  (def fd nil)
+  ;; constructor that
+  (def (new self fd_arg)
+    (set-self fd fd_arg))
+  (def (write self s)
+    (os-write self.fd s))
+  (def (read self n)
+    (os-read self.fd n)))
+
+
+
+(def (fopen-flags path flags)
+  (let ((fd (os-open path flags)))
+    (cond (= fd -1)  (throw (str "unable to open file '" path "'"))
+          :otherwise (new file-descriptor fd))))
+
+(def (fopen path)
+  (fopen-flags path (bit-or O_RDWR O_APPEND O_CREAT)))
 
 
-(defmacro defn-memo (name args body))
+(def file (fopen "file.txt"))
+
 
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def (join l s)
+  (reduce (fn (a b) (str a s b)) (str (first l)) (rest l)))
 
-(defn fib (n)
-  (if (< n 2)
-    n
-    (+ (fib (- n 2)) (fib (- n 1)))))
 
 
-(defn read-eval ()
-  (do
-    (print "* ")
-    (eval (macroexpand (read)))))
 
 
+(class lazy-seq
+  ;; the function that will be called eventually
+  (def func nil)
+  ;; if the lazy sequence has been evaluated yet
+  (def evaluated nil)
+  ;; the value stored in the list. will be filled
+  ;; when .seq is called
+  (def value :lazy-not-evaluated)
+  ;; constructor. Takes the function that will be
+  ;; evaluated on .seq
+  (def (new self f) (set self 'func f))
+  ;; implementations of first and rest
+  (def (first self) (first (.seq self)))
+  (def (rest self) (rest (.seq self)))
+  ;; the seq function "steps" this lazy sequence.
+  ;; this means it checks if it's been evaluated
+  ;; yet, and if it needs to, evaluates the function
+  ;; caching it's result and returning it. If it
+  ;; has already been evaluated, there is no reason
+  ;; in calling the function again and it returns
+  ;; the value it had cached
+  (def (seq self)
+    (if self.evaluated self.value
+      (do (set self 'evaluated t)
+          (set self 'value (self.func)))))
+  ;; convert the lazy list into a string.
+  ;; WARNING: this will consume the *entire*
+  ;; list
+  (def (str self)
+    (str "(" (join self " ") ")")))
+
+(defmacro lazily (& expr)
+  `(new lazy-seq (fn () (do ,@expr))))
 
+(class lazy-range
+  ;; constructor that loads in the values
+  (def (new self lo hi st)
+    (set-self lo lo)
+    (set-self hi hi)
+    (set-self st st))
+  ;; convert the lazy list into a string.
+  ;; WARNING: this will consume the *entire*
+  ;; list
+  (def (str self)
+    (str "(" (join self " ") ")"))
 
-;; (let ((v nil))
-;;   (def v (read-eval))
-;;   (if (not (= v :EOF))
-;;     (do
-;;       (println v)
-;;       (recur nil))))
+  ;; overload first
+  (def (first self) self.lo)
+  ;; overload rest
+  (def (rest self)
+    (let ((lo self.lo)
+          (hi self.hi)
+          (st self.st))
+      (println "REST")
+      (if (or (= hi :inf) (not (> hi lo)))
+        (new lazy-range (+ lo st) hi st)
+        :wqw))))
 
+(def (step lo hi st)
+  (new lazy-range lo hi st))
 
-(defmacro lazy-seq
-  (body)
-  (list 'cedar/new-lazy-sequence (list 'fn () body)))
 
+(def (pos n)
+  (lazily (cons n (pos (inc n)))))
 
-(defn inc (n) (+ n 1))
-(defn dec (n) (- n 1))
+(def positive-numbers (pos 1))
+(def (square x) (* x x))
+
+(def (consume-lazy l)
+  (map (fn (x) x) l))
+
+
+
+(class assertion-error
+  (def (new self msg) (set self 'msg msg)))
+
+(defmacro assert (claim)
+  (list 'when-not claim
+    (list 'throw (list 'assertion-error (str claim)))))
+
+
+(defmacro comment (& body)
+  nil)
+
+
+(defmacro case (check & cases)
+  (let ((sym (gensym)))
+    (list 'let (list (list sym check)))))
+
+
+(def each
+  (fn (f l)
+    (if (not (nil? l))
+      (do (f (first l))
+          (each f (rest l))))))
+
+
+(def (drop n l)
+  (if (= n 0) l
+    (drop (dec n) (rest l))))
+
+(def (take n l)
+  (if (= n 0) nil
+    (lazily (cons (first l) (take (dec n) (rest l))))))
+
+
+(def (infinite-list-from ind)
+  (lazily (cons ind (range (inc ind)))))
+
+(def (step-inf lo st)
+  (lazily (cons lo (step-inf (inc lo) (+ lo st)))))
+
+(def (range lo & xs)
+    (let ((nx (first xs))
+          (hi (second xs)))
+      (cond (nil? nx)   (if (= lo :inf) (step-inf 0 1) (step 0 (dec lo) 1))
+            (nil? hi)   (if (= nx :inf) (step-inf lo 1) (step lo nx 1))
+            (= hi :inf) (step-inf lo (- nx lo))
+            :else       (step lo hi (- nx lo)))))
+
+
+(def (filter pred coll)
+  (lazily
+    (let ((s (seq coll)))
+      (let ((f (first s)) (r (rest s)))
+        (if (pred f)
+          (cons f (filter pred r))
+          (filter pred r))))))

include/cedar.h

@@ -29,7 +29,6 @@
 
 #include "cedar/version.h"
 #include "cedar/parser.h"
-#include "cedar/context.h"
 #include "cedar/vm/bytecode.h"
 #include "cedar/vm/compiler.h"
 #include "cedar/vm/machine.h"
@@ -40,13 +39,14 @@
 #include "cedar/object/nil.h"
 #include "cedar/object/list.h"
 #include "cedar/object/sequence.h"
+#include "cedar/object/lazy_seq.h"
 #include "cedar/object/indexable.h"
 #include "cedar/object/number.h"
 #include "cedar/object/lambda.h"
 #include "cedar/object/string.h"
 #include "cedar/object/dict.h"
-#include "cedar/object/lazy_sequence.h"
 #include "cedar/object/vector.h"
+#include "cedar/object/user_type.h"
 #include "cedar/memory.h"
 #include "cedar/object.h"
 #include "cedar/runes.h"

include/cedar/object.h

@@ -34,16 +34,42 @@
 #include <atomic>
 #include <cstdint>
 #include <new>
+#include <map>
+
+#define GC_OPERATOR_NEW_ARRAY
+#include <gc/gc_cpp.h>
 
 namespace cedar {
 
   class object;
   class object_type;
 
 
-  class object {
+  class object : public gc {
+   public:
+
+    // object_type *type = nullptr;
+    // refcount is used by the `ref` class to determine how many things hold
+    // references to this particular object on the heap
+    u32 refcount = 0;
+
+
+    virtual u64 hash(void) = 0;
+
+    virtual ~object() {};
+
+    virtual const char *object_type_name(void) = 0;
+
+    bool is_pair(void);
+
+
    protected:
+
+    // refs should be able to access values of objects, as it is always safer to
+    // go through a reference to call these functions
     friend ref;
+
+
     virtual cedar::runes to_string(bool human = false) = 0;
 
     /*
@@ -95,31 +121,6 @@ namespace cedar {
      */
     inline size_t type_id() const { return typeid(*this).hash_code(); }
 
-   public:
-
-    object_type *type = nullptr;
-
-    virtual u64 hash(void) = 0;
-    // const char *name = "object";
-
-    // set no_autofree to true to have the refcount system ignore this object
-    // when it would be freed
-    bool no_autofree = false;
-
-    // refcount is used by the `ref` class to determine how many things hold
-    // references to this particular object on the heap
-    // uint32_t refcount = 0;
-    u64 refcount = 0;
-
-    virtual ~object(){};
-
-    virtual ref to_number() = 0;
-
-    virtual const char *object_type_name(void) = 0;
-
-    bool is_pair(void);
-
-
   };
 
 }  // namespace cedar

include/cedar/object/dict.h

@@ -41,9 +41,9 @@ namespace cedar {
     dict(void);
     ~dict(void);
 
-    ref to_number();
 
     inline const char *object_type_name(void) { return "dict"; };
+    bool has_key(ref);
     u64 hash(void);
     ref get(ref);
     ref set(ref, ref);