M lib/utils.hex → lib/utils.hex

@@ -60,19 +60,46 @@ (
   "_uncons_list" :
   () "_uncons_result" :
   0x1 "_uncons_c" :
-  _uncons_list 0x0 get ; Push the first item
   (_uncons_c _uncons_list len <)
     (
       _uncons_result _uncons_list _uncons_c get push "_uncons_result" :
       _uncons_c 0x1 + "_uncons_c" :
     )
   while
+  _uncons_list 0x0 get ; Push the first item
   _uncons_result ; Push the rest of the items
   "_uncons_list"   #
   "_uncons_result" #
   "_uncons_c"      #
 ) "uncons" ::
 
+;;; swons
+;; q1 a -> q2
+;; Prepends %:a%% to the beginning of %:q1%%.
+(
+  ' swap cat
+) "swons" ::
+
+;;; unswons
+;; q1 -> q2 a
+;; Removes the first item from %:q1%% and pushes it on the stack along with %:q2%% containing the rest of the items of %:q1%%.
+(
+  "_unswons_list" :
+  () "_unswons_result" :
+  0x1 "_unswons_c" :
+  (_unswons_c _unswons_list len <)
+    (
+      _unswons_result _unswons_list _unswons_c get push "_unswons_result" :
+      _unswons_c 0x1 + "_unswons_c" :
+    )
+  while
+  _unswons_result ; Push the rest of the items
+  _unswons_list 0x0 get ; Push the first item
+  "_unswons_list"   #
+  "_unswons_result" #
+  "_unswons_c"      #
+) "unswons" ::
+
 ;;; over
 ;; a1 a2 -> a1 a2 a1
 ;; Copies the second item on the stack and pushes it on top
@@ -111,11 +138,11 @@ ) "ends" ::
 
 ;; insert
 ;; q1 a i -> q2
-;; Inserts item %:a%% at position %:i%% within a quotation.
+;; Inserts item %:a%% before position %:i%% within a quotation.
 (
-  i "_insert_index" :
+  "_insert_index" :
   "_insert_item" :
-  i "_insert_list" :
+  "_insert_list" :
   0x0 "_insert_c" :
   () "_insert_result" :
   _insert_list len "_insert_len" :
@@ -147,7 +174,7 @@ (
   "_reverse_list" :
   _reverse_list len 0x1 - "_reverse_c" : 
   () "_reverse_result" :
-  (_reverse_c 0x0 <=)
+  (_reverse_c 0x0 >=)
     (
        _reverse_result _reverse_list _reverse_c get ' cat "_reverse_result" :
        _reverse_c 0x1 - "_reverse_c" :
@@ -161,16 +188,16 @@ ) "reverse" ::
 
 ;;; sort
 ;; q1 q2 -> q3
-;; Sorts the items of a quotation.
+;; Sorts the items of q1 based on q2.
 (
   "_sort_check" :
   "_sort_list" :
   () "_sort_result" :
-  _sort_list _len 0x1 - "_sort_pivot" :
+  _sort_list len 0x1 - "_sort_pivot" :
   0x0 "_sort_c" :
   () "_sort_left" :
   () "_sort_right" :
-  (0x1 _sort_list len <=)
+  (_sort_list len 0x1 <=)
     (_sort_list)
     (
       (_sort_c len <)

M scripts/test.hex → scripts/test.hex

@@ -131,7 +131,7 @@ 
     ((args len 0x2 ==) ("two") ("no") if "two" ==)
     ((dup *) "square" :: 0x2 square 0x4 == "square" #)
     (0x1 "tmp-a" : (tmp-a 0x3 <) (tmp-a 0x1 + "tmp-a" :) while tmp-a 0x3 ==)
-    (symbols len 0x60 ==)
+    (symbols len 0x62 ==)
     ;60
 
     ((0x2 0x0 /) (error "[symbol /] Division by zero" ==) try)
@@ -294,23 +294,42 @@ 
     ;------------------------------------------------------------------------;
     ; utils.hex tests                                                        ;
     ;------------------------------------------------------------------------;
-    ("This is a test" "This" begins)
-    ("This is a test" "this" begins not)
-    ("This is a test" "test" ends)
-    ("This is a test" "Test" ends not)
-    ;154
 
     (0x2 (0x1) (0x1) when 0x1 == swap drop)
     (0x2 (0x0) (0x1) when 0x2 ==)
     ("ccc" ("aaa") ("bbb") when "ccc" ==)
     ((0x1) ("yes") ("no") unless "no" == swap drop) 
-    ;158
+    ;154
 
     (() 0x1 push (0x1) ==)
     ((0x1 0x2 0x3) pop (0x1 0x2) ==)
     (0x0 (0x1 0x2 0x3) cons (0x0 0x1 0x2 0x3) ==)
     ((0x1 0x2 0x3) uncons stack (0x1 (0x2 0x3)) == swap drop swap drop)
+    ;158
+    
+    ((0x1 0x2 0x3) 0x0 swons (0x0 0x1 0x2 0x3) ==)
+    ((0x1 0x2 0x3) unswons stack ((0x2 0x3) 0x1) == swap drop swap drop)
+    ("a" "b" over stack "_r" : drop drop drop ("a" "b" "a") _r == "_r" #)
+    (0x1 (0x2) dip stack "_r" : (0x2 0x1) _r == "_r" #)
     ;162
+
+    ("This is a test" "This" begins)
+    ("This is a test" "this" begins not)
+    ("This is a test" "test" ends)
+    ("This is a test" "Test" ends not)
+    ;166
+
+    ((0x1 0x2 0x3 0x5 0x6) "a" 0x3 insert (0x1 0x2 0x3 "a" 0x5 0x6) ==)
+    ((0x1 0x2 0x3 0x5 0x6) "a" 0x0 insert ("a" 0x1 0x2 0x3 0x5 0x6) ==)
+    ((0x1 0x2 0x3 0x5 0x6) "a" 0x4 insert (0x1 0x2 0x3 0x5 "a" 0x6) ==)
+    ((0x1 0x2 0x3 0x5 0x6) "a" 0x1 insert (0x1 "a" 0x2 0x3 0x5 0x6) ==)
+    ;170
+
+    ((0x4 0x3 "c" 0x2 "b" 0x1 "a") reverse ("a" 0x1 "b" 0x2 "c" 0x3 0x4) ==)
+    ((0x1) reverse (0x1) ==)
+    ((0x1 0x2) reverse (0x2 0x1) ==)
+    (() reverse () ==)
+    ;174
 
 ) "TESTS" :