removed limo_cons. conses are now inside the limo_data. speedup

Author: netlution-mmolle

builtins.c

@@ -256,7 +256,7 @@ BUILTIN(builtin_setcar)
   limo_data *cons = eval(FIRST_ARG, env);
   limo_data *value = eval(SECOND_ARG, env);
 
-  if (cons->type != limo_TYPE_CONS || cons->d_cons == NULL)
+  if (cons->type != limo_TYPE_CONS)
     limo_error("ERROR: (setcar CONS value)");
 
   CAR(cons) = value;
@@ -270,7 +270,7 @@ BUILTIN(builtin_setcdr)
   limo_data *cons = eval(FIRST_ARG, env);
   limo_data *value = eval(SECOND_ARG, env);
 
-  if (cons->type != limo_TYPE_CONS || cons->d_cons == NULL)
+  if (cons->type != limo_TYPE_CONS)
     limo_error("ERROR: (setcdr CONS value)");
 
   CDR(cons) = value;

dict.c

@@ -28,10 +28,13 @@ inline int limo_equals(limo_data *a, limo_data *b)
       return !strncmp(a->d_string, b->d_string, a->hash);
 
   case limo_TYPE_CONS:
-    return a->d_cons == b->d_cons;
+    return CAR(a) == CAR(b) && CDR(a) == CDR(b);
 
   case limo_TYPE_GMPQ:
     return !mpq_cmp(LIMO_MPQ(a), LIMO_MPQ(b));
+
+  case limo_TYPE_NIL:
+    return b->type == limo_TYPE_NIL;
   }
 
   return 0;
@@ -101,7 +104,7 @@ limo_dict *make_dict_size(int minused)
   return d;
 }
 
-void dict_resize(limo_data *dict)
+inline void dict_resize(limo_data *dict)
 {
   limo_data new = *dict;
   limo_dict *olddict = dict->d_dict;
@@ -117,7 +120,7 @@ void dict_resize(limo_data *dict)
   dict->d_dict = newdict;
 }
 
-void dict_check_resize(limo_data *dict)
+inline void dict_check_resize(limo_data *dict)
 {
   if (3 * (dict->d_dict->used) > 2*dict->d_dict->size)
     dict_resize(dict);
@@ -127,8 +130,8 @@ void dict_put_cons_ex(limo_data *dict, limo_data *cons, int flags)
 {
   limo_dict_item *ld_place;
 
-  if (dict->type != limo_TYPE_DICT)
-    limo_error("dict_put(): didn't get a dict.");
+  /* if (dict->type != limo_TYPE_DICT) */
+  /*   limo_error("dict_put(): didn't get a dict."); */
 
   ld_place = dict_get_place(dict, CAR(cons));
   if (ld_place->cons == NULL) {

eval.c

@@ -159,9 +159,7 @@ limo_data *eval(limo_data *form, limo_data *env)   // tail recursion :D
   limo_data *stacktrace_cons;
 
   limo_data thunk;
-  limo_cons thunk_cons;
   thunk.type = limo_TYPE_THUNK;
-  thunk.d_cons = &thunk_cons;
 
   if (limo_register) {        // TODO: here is a check of "things". could be used to signal Ctrl-c
     if (limo_register & LR_SIGINT) {
@@ -177,25 +175,20 @@ limo_data *eval(limo_data *form, limo_data *env)   // tail recursion :D
 
   stacktrace_cons = make_cons(form, tmp_stacktrace);
   pk_stacktrace_set(stacktrace_cons);
-  for (;;) {
-    form=real_eval(form, env, &thunk);
-    assert(form);
-    assert(form->type != limo_TYPE_CONST);
-
-    if (form->type == limo_TYPE_THUNK) {
-      limo_data *next_form;
-      //      printf("THUNK:"); writer(form); printf("\n");
-      next_form= CDR(form);
-      env      = CAR(form);
-      form     = next_form;
-      CAR(stacktrace_cons) = form;
-    }
-    else {
-        pk_stacktrace_set(tmp_stacktrace);
-	return form;
-    }
-  }
 
+  form=real_eval(form, env, &thunk);
+  while (form->type == limo_TYPE_THUNK) {
+    limo_data *next_form;
+    //      printf("THUNK:"); writer(form); printf("\n");
+    next_form= CDR(form);
+    env      = CAR(form);
+    form     = next_form;
+    CAR(stacktrace_cons) = form;
+
+    form = real_eval(form, env, &thunk);
+  }
+  pk_stacktrace_set(tmp_stacktrace);
+  return form;
 }
 
 limo_data *real_eval(limo_data *ld, limo_data *env, limo_data *thunk_place)

examples/autosnake.limo

@@ -29,7 +29,7 @@
 (defun shuffle (l)
   (when l
     (setq r (random (list-length l)))
-    (cons (nth r l) (shuffle (remove-nth l r)))))
+    (dcons (nth r l) (shuffle (remove-nth l r)))))
 
 (defun random-choice (l)
   (nth (random (list-length l)) l))

examples/autosnake2.limo

@@ -219,7 +219,7 @@
 	  (:else
 	   (cons (car bs) (remove-as as (cdr bs))))))
   (freezeq remove-as)
-  (let* ((ssnake (qsort tuple-lt snake))
+  (let* ((ssnake (sort tuple-lt snake))
 	 (pot-apple-fields (remove-as ssnake *all-fields*)))
     (if pot-apple-fields
 	(random-choice pot-apple-fields)
@@ -280,7 +280,7 @@
 		     (cons (wn-get (car headpos) (+ (cdr headpos) 1))
 			   (cons (car headpos)
 				 (+ (cdr headpos) 1)))))))
-	 (moves-most-ahead (qsort (lambda (m n) (> (norm-to-tail (car m) tailwn)
+	 (moves-most-ahead (sort (lambda (m n) (> (norm-to-tail (car m) tailwn)
 					      (norm-to-tail (car n) tailwn)))
 				  moves)))
     (if (or *circlestrat*

examples/mandelbrot.limo

@@ -10,11 +10,6 @@
 
 (setq *surface* ([_sdl . sdl-setvideomode] 640 480 24 [_sdl . sdl_hwsurface]))
 
-(freezeq +)
-(freezeq -)
-(freezeq /)
-(freezeq *)
-
 (defun bit (n v)
   (mod (floor (/ v n)) 2))
 
@@ -26,20 +21,6 @@
 					      (* 255 (bit 4 n))))
 				      (range 0 17 1))))
 
-(defun sqrt (x) 
-  (block fun
-    (let ((lo 0)
-	  (hi x)
-	  (mid (/ x 2)))
-      (for-each i (drange 0 10 1)
-	(setq sqr (* mid mid))
-	(cond ((= sqr x) (return-from fun mid))
-	      ((< sqr x) (setf lo mid))
-	      (:t (setf hi mid)))
-	(setf mid (/ (+ hi lo) 2)))
-      mid)))
-(freezeq sqrt)
-
 (defun csqr (c)
   (cons (- (* (car c) (car c))
 	   (* (cdr c) (cdr c)))
@@ -51,10 +32,6 @@
 	(+ (cdr a) (cdr b))))
 (freezeq cadd)
 
-(defun cabs (c)
-  (sqrt (+ (* (car c) (car c)) (* (cdr c) (cdr c)))))
-(freezeq cabs)
-
 (defun mandelbrot (x y)
   (block fun
     (progn

examples/tetris.limo

@@ -1,4 +1,4 @@
-(mod-load "ncurses")
+(import "ncurses.limo")
 
 (defun min (a b)
   (if (< a b) a b))
@@ -75,35 +75,35 @@
 			(() :t :t)
 			(() :t ())))))
 
-(defclass screen ()
-  (defmethod init (self scr)
-    (setmember [self . _scr] scr))
-  (defmethod keypad (self onoff)
-    ([_ncurses . keypad] [self . _scr] onoff))
-  (defmethod move (self y x)
-    ([_ncurses . wmove] [self . _scr] y x))
-  (defmethod addch (self c)
-    ([_ncurses . waddch] [self . _scr] c))
-  (defmethod refresh (self)
-    ([_ncurses . wrefresh] [self . _scr]))
-  (defmethod getch (self)
-    ([_ncurses . wgetch] [self . _scr]))
-  (defmethod erase (self)
-    ([_ncurses . werase] [self . _scr]))
-  (defmethod print-with-attr (self str attr)
-    (for-each c (string-to-list str)
-      [self addch (+ (ord c) attr)]))
-  (defmethod nodelay (self bf)
-    ([_ncurses . nodelay] [self . _scr] bf))
-  (defmethod halfdelay (self tenths)
-    ([_ncurses . halfdelay] tenths)))
+;; (defclass screen ()
+;;   (defmethod init (self scr)
+;;     (setmember [self . _scr] scr))
+;;   (defmethod keypad (self onoff)
+;;     ([_ncurses . keypad] [self . _scr] onoff))
+;;   (defmethod move (self y x)
+;;     ([_ncurses . wmove] [self . _scr] y x))
+;;   (defmethod addch (self c)
+;;     ([_ncurses . waddch] [self . _scr] c))
+;;   (defmethod refresh (self)
+;;     ([_ncurses . wrefresh] [self . _scr]))
+;;   (defmethod getch (self)
+;;     ([_ncurses . wgetch] [self . _scr]))
+;;   (defmethod erase (self)
+;;     ([_ncurses . werase] [self . _scr]))
+;;   (defmethod print-with-attr (self str attr)
+;;     (for-each c (string-to-list str)
+;;       [self addch (+ (ord c) attr)]))
+;;   (defmethod nodelay (self bf)
+;;     ([_ncurses . nodelay] [self . _scr] bf))
+;;   (defmethod halfdelay (self tenths)
+;;     ([_ncurses . halfdelay] tenths)))
 
-(defun ncurses-init ()
-  ([_ncurses . initscr])
-  ([_ncurses . cbreak])
-  ([_ncurses . noecho])
-  ([_ncurses . keypad] ([_ncurses . stdscr]) :t)
-  ([_ncurses . stdscr]))
+;; (defun ncurses-init ()
+;;   ([_ncurses . initscr])
+;;   ([_ncurses . cbreak])
+;;   ([_ncurses . noecho])
+;;   ([_ncurses . keypad] ([_ncurses . stdscr]) :t)
+;;   ([_ncurses . stdscr]))
 
 (defun enumerate (l)
   (defun enumerate-helper (s l)

helpers.c

@@ -3,9 +3,7 @@
 
 inline int (is_nil)(limo_data *ld)
 {
-  if (!ld)
-    limo_error("null pointer (is_nil)");
-  return ld->type == limo_TYPE_CONS && !ld->d_cons;
+  return ld->type == limo_TYPE_NIL;
 }
 
 int list_length(limo_data *l)
@@ -28,7 +26,7 @@ char *limo_strdup(char *in)
 limo_data *thunk_safe_cdr(limo_data *x)
 {
   limo_data *cdr;
-  cdr = (x)->d_cons->cdr;
+  cdr = CDR(x);
   while (cdr->type == limo_TYPE_THUNK)
     cdr = eval(CDR(cdr), CAR(cdr));
 

libs/fd/fd.c

@@ -118,7 +118,7 @@ BUILTIN(builtin_fd_poll)
   for (i=0; i<pollfdlist_length; ++i,CDR(ld_cursor)=make_cons(nil, nil), ld_cursor=CDR(ld_cursor))
     CAR(ld_res) = make_number_from_long_long(pfds[i].revents);
 
-  ld_cursor->d_cons=NULL;
+  ld_cursor->type=limo_TYPE_NIL;
   return ld_res;
 }
 

limo-code/random.limo

@@ -6,3 +6,25 @@
   (mod (+ (* 255 (random-byte 256))
 	  (random-byte 256))
        n))
+
+(defun shuffle (l)   ; merge
+  (defun seconds (l) ; every second item
+    (when l
+      (dcons (car l)
+             (when (cdr l) (seconds (cddr l))))))
+  
+  (defun merge (l m)
+    (cond ((and l m)
+           (if (= 0 (random-byte 2))
+               (dcons (car l) (merge (cdr l) m))
+               (dcons (car m) (merge l (cdr m)))))
+          (l l)
+          (m m)
+          (:else nil)))
+  (undyn
+   (when l
+     (let ((left (undyn (seconds l)))
+           (right (undyn (seconds (cdr l)))))
+       (if (not (and left right))
+           (or left right)
+           (merge (shuffle left) (shuffle right)))))))