sort takes optional fcmp

defaults to `cmp`
vygr · Apr 23, 2024 · a893bb0 · a893bb0
1 parent 88ce2b6
commit a893bb0
Show file tree

Hide file tree

Showing 30 changed files with 62 additions and 58 deletions.
diff --git a/STATUS.md b/STATUS.md
@@ -33,6 +33,9 @@ Added `-d`, `-i` and `-a` options to `files` command.
 
 New `(flatten list) -> list` function in `root.inc`.
 
+Change the argument ordering for the `(sort list [cmp])` function and made the
+comparison function optional and default to `cmp`.
+
 ------
 
 Fix `forward.lisp` defs regexp !

diff --git a/apps/bubbles/app.lisp b/apps/bubbles/app.lisp
@@ -109,8 +109,8 @@
 		(bind '(sw sh) (. canvas :pref_size))
 		(defq hsw (i2n (>> sw 1)) hsh (i2n (>> sh 1)))
 		(render-verts canvas
-			(sort (# (if (<= (last (first %0)) (last (first %1))) 1 -1))
-				(clip-verts hsw hsh (elem-get dlist +dlist_layer1_verts))))
+			(sort (clip-verts hsw hsh (elem-get dlist +dlist_layer1_verts))
+				(# (if (<= (last (first %0)) (last (first %1))) 1 -1))))
 		(. canvas :swap 0))
 	(elem-set dlist +dlist_mask 0))
 

diff --git a/apps/chess/app.lisp b/apps/chess/app.lisp
@@ -99,7 +99,7 @@
 					(dispatch-job key val)))
 			((= idx +select_reply)
 				;child reply, process in sequence order
-				(sort (# (- (getf %1 +reply_seq) (getf %0 +reply_seq))) (push replys msg))
+				(sort (push replys msg) (# (- (getf %1 +reply_seq) (getf %0 +reply_seq))))
 				(while (and (/= (length replys) 0)
 							(= (getf (last replys) +reply_seq) next_seq))
 					(setq msg (pop replys) next_seq (inc next_seq))

diff --git a/apps/chess/child.lisp b/apps/chess/child.lisp
@@ -375,7 +375,7 @@
 						((= (abs score) +timeout_value)
 							+timeout_value)
 						((>= alpha beta))))
-				(list (sort (lambda (a b) (- (first b) (first a))) ply0_brds))))
+				(list (sort ply0_brds (lambda (a b) (- (first b) (first a)))))))
 		(if (num? timeout) :t
 			(setq nbrd (if pbrd pbrd nbrd) pbrd :nil))) (list (range 1 max_ply)))
 	nbrd)

diff --git a/apps/docs/info.inc b/apps/docs/info.inc
@@ -2,15 +2,15 @@
 (env-push)
 
 (defun root-funcs ()
-	(sort cmp (reduce (lambda (_ (k v))
+	(sort (reduce (lambda (_ (k v))
 		(if (func? v) (push _ k) _)) (tolist *root_env*) (list))))
 
 (defun root-lambdas ()
-	(sort cmp (reduce (lambda (_ (k v))
+	(sort (reduce (lambda (_ (k v))
 		(if (lambda-func? v) (push _ k) _)) (tolist *root_env*) (list))))
 
 (defun root-macros ()
-	(sort cmp (reduce (lambda (_ (k v))
+	(sort (reduce (lambda (_ (k v))
 		(if (macro-func? v) (push _ k) _)) (tolist *root_env*) (list))))
 
 (defun paragraph (words)

diff --git a/apps/docs/search.inc b/apps/docs/search.inc
@@ -9,7 +9,7 @@
 	(defq cmd (cat "grep -c -f -m "
 			(if whole_words "-w " "") (if regexp "-r " "")
 			(id-encode pattern) " ")
-		results (sort (const cmp) (map (# (trim-end %0 (ascii-char 10)))
+		results (sort (map (# (trim-end %0 (ascii-char 10)))
 			(filter-array nempty? (map (const second)
 				(pipe-farm (map (# (cat cmd %0))
 					(files-all "docs" '(".md"))) 20000000)))))))

diff --git a/apps/edit/app_impl.lisp b/apps/edit/app_impl.lisp
@@ -119,7 +119,7 @@
 
 (defun populate-file-trees ()
 	;reload open tree
-	(sort cmp *open_files*)
+	(sort *open_files*)
 	(. *open_tree* :empty)
 	(each (# (. *open_tree* :add_route %0)) (defq dirs (files-dirs *open_files*)))
 	(each (# (. *open_tree* :add_route %0)) *open_files*)

diff --git a/apps/edit/file.inc b/apps/edit/file.inc
@@ -95,7 +95,7 @@
 	(when (selection?)
 		(bind '(y y1) (select-lines))
 		(open-files (filter-array (# (/= (age %0) 0))
-			(unique (sort (const cmp)
+			(unique (sort
 				(split (.-> (. *edit* :get_buffer)
 					(:set_cursor 0 y1)
 					(:copy 0 y)) (ascii-char +char_lf))))))))

diff --git a/apps/edit/search.inc b/apps/edit/search.inc
@@ -149,7 +149,7 @@
 		(defq cmd (cat "grep -c -f "
 				(if whole_words "-w " "") (if regexp "-r " "")
 				(id-encode pattern) " ")
-			results (apply (const cat) (sort (const cmp) (map (const second)
+			results (apply (const cat) (sort (map (const second)
 				(pipe-farm (map (# (cat cmd %0))
 					(filter-array (lambda (f) (notany (# (eql f %0)) +dictionaries))
 						(files-all "." +file_types 2))) 20000000)))))
@@ -209,7 +209,7 @@
 					(find (first s) '("defun" "defmacro" "redefun" "redefmacro" "defclass" "ffi"))
 					(eql (second s) name) (setq pos (list file 0 _))))
 				(file-stream file)) pos)
-			(sort (const cmp) (cat *open_files*)))
+			(sort (cat *open_files*)))
 		(when pos
 			(action-push)
 			(push *cursor_stack* pos)

diff --git a/apps/edit/ui.inc b/apps/edit/ui.inc
@@ -57,7 +57,7 @@
 	;load all files in this folder
 	(defq folder (. *file_tree* :get_route
 		(. *window* :find_id (getf *msg* +ev_msg_action_source_id))))
-	(open-files (defq files (sort cmp (files-all folder +file_types))))
+	(open-files (defq files (sort (files-all folder +file_types))))
 	(switch-file (first files)))
 
 (defun action-file-leaf-action ()

diff --git a/apps/fonts/app.lisp b/apps/fonts/app.lisp
@@ -48,7 +48,7 @@
 	(bind '(x y w h) (apply view-fit (cat (. *window* :get_pos) (. *window* :pref_size))))
 	(. *window* :change_dirty x y w h))
 
-(defq index 1 id :t fonts (sort cmp (files-all "fonts/" '(".ctf"))))
+(defq index 1 id :t fonts (sort (files-all "fonts/" '(".ctf"))))
 
 (ui-window *window* ()
 	(ui-title-bar *window_title* "" (0xea19) +event_close)

diff --git a/apps/images/app.lisp b/apps/images/app.lisp
@@ -9,7 +9,7 @@
 (enums +select 0
 	(enum main tip))
 
-(defq images (sort cmp (files-all "apps/images/data" '(".cpm" ".tga" ".svg")))
+(defq images (sort (files-all "apps/images/data" '(".cpm" ".tga" ".svg")))
 	index (some (# (if (eql "apps/images/data/tiger.svg" %0) _)) images)
 	id :t)
 

diff --git a/apps/molecule/app.lisp b/apps/molecule/app.lisp
@@ -24,7 +24,7 @@
 	+left (* +focal_dist +real_-1/3) +right (* +focal_dist +real_1/3)
 	+canvas_mode (if anti_alias +canvas_flag_antialias 0)
 	*mol_index* 0 *auto_mode* :nil *dirty* :t
-	balls (list) mol_files (sort cmp (files-all "apps/molecule/data/" '(".sdf")))
+	balls (list) mol_files (sort (files-all "apps/molecule/data/" '(".sdf")))
 	+palette (push `(,quote) (map (lambda (_) (Vec3-f
 			(n2f (/ (logand (>> _ 16) 0xff) 0xff))
 			(n2f (/ (logand (>> _ 8) 0xff) 0xff))
@@ -98,8 +98,8 @@
 		(task-slice)) balls))
 
 (defun sort-balls (balls)
-	(sort (lambda ((v1 _ _) (v2 _ _))
-		(if (<= (elem-get v1 +vec4_w) (elem-get v2 +vec4_w)) 1 -1)) balls))
+	(sort balls (lambda ((v1 _ _) (v2 _ _))
+		(if (<= (elem-get v1 +vec4_w) (elem-get v2 +vec4_w)) 1 -1))))
 
 (defun clip-balls (balls)
 	(filter-array (lambda (((_ _ _ w) _ _)) (<= +near w +far)) balls))

diff --git a/apps/pcb/app.lisp b/apps/pcb/app.lisp
@@ -17,7 +17,7 @@
 	(defq out (list))
 	(each! 0 -1 (lambda (f m) (and (eql m "8") (ends-with ".pcb" f) (push out (cat p f))))
 		(unzip (split (pii-dirlist p) ",") 2))
-	(sort cmp out))
+	(sort out))
 
 (defq *pcbs* (all-pcbs "apps/pcb/data/")
 	*index* (some (# (if (eql "apps/pcb/data/test1.pcb" %0) _)) *pcbs*)

diff --git a/apps/pcb/router.inc b/apps/pcb/router.inc
@@ -41,7 +41,7 @@
 		(list minx miny maxx maxy)))
 
 (defun sort-netlist (netlist)
-	(sort (# (- (. %0 :get_area) (. %1 :get_area))) netlist))
+	(sort netlist (# (- (. %0 :get_area) (. %1 :get_area)))))
 
 (defclass Pad (radius gap pos shape) :nil
 	; (Pad radius gap pos shape) -> pad
@@ -97,12 +97,12 @@
 			(elem-set wire _ (Vec3-f (* x grid_res) (* y grid_res) z))) wire)) wires)
 
 	;sort pads
-	(sort (lambda (p1 p2)
+	(sort pads (lambda (p1 p2)
 		(bind '(x1 y1 z1) (. p1 :get_pos))
 		(bind '(x2 y2 z2) (. p2 :get_pos))
 		(if (= (defq s (- x1 x2)) 0)
 			(if (= (defq s (- y1 y2)) 0)
-				(defq s (- z1 z2)))) s) pads)
+				(defq s (- z1 z2)))) s))
 
 	;build pad collision lines and endpoint nodes
 	(defq i 0)
@@ -310,10 +310,11 @@
 					(setq exit (push pth n)))
 				(:t ;sort nodes and take the first
 					(setq path_node (second (elem-get
-						(sort (# (- (first %0) (first %1)))
-						(map (# (list (vec-squared-euclidean-distance path_node %0) %0))
-						(filter-array (# (= (. pcb :get_node %0) (. pcb :get_node (first nearer_nodes))))
-						(sort (# (- (. pcb :get_node %0) (. pcb :get_node %1))) nearer_nodes)))) 0))))))
+						(sort
+							(map (# (list (vec-squared-euclidean-distance path_node %0) %0))
+							(filter-array (# (= (. pcb :get_node %0) (. pcb :get_node (first nearer_nodes))))
+							(sort nearer_nodes (# (- (. pcb :get_node %0) (. pcb :get_node %1))))))
+							(# (- (first %0) (first %1)))) 0))))))
 		exit)
 
 	(defmethod :route ()
@@ -331,7 +332,7 @@
 						(each (# (. visited :insert %0)) (elem-get pad_end_nodes (dec _)))
 						(unless (some (# (. visited :find %0)) ends)
 							(. pcb :mark_distances visited ends radius gap via)
-							(sort (# (- (. pcb :get_node %0) (. pcb :get_node %1))) ends)
+							(sort ends (# (- (. pcb :get_node %0) (. pcb :get_node %1))))
 							(defq nodes (. this :backtrack_path visited (first ends) radius via gap))
 							(. pcb :unmark_distances)
 							(cond

diff --git a/apps/services/app.lisp b/apps/services/app.lisp
@@ -27,7 +27,7 @@
 
 (defun populate ()
 	(defq new_services (mail-enquire ""))
-	(sort cmp new_services)
+	(sort new_services)
 	(unless (and (= (length new_services) (length services))
 				(if (empty? new_services) :t (every eql new_services services)))
 		;service directory has changed

diff --git a/class/lisp/root.inc b/class/lisp/root.inc
@@ -491,9 +491,9 @@
 ; sort and randomise
 ;;;;;;;;;;;;;;;;;;;;
 
-(defun sort (_f _a &optional _l _h)
-	; (sort fcmp list [start end]) -> list
-	(setd _l 0 _h (length _a))
+(defun sort (_a &optional _f _l _h)
+	; (sort list [fcmp start end]) -> list
+	(setd _f (const cmp) _l 0 _h (length _a))
 	(defq _q (list _l _h))
 	(while (setq _h (pop _q) _l (pop _q))
 		(when (< _l _h)
@@ -557,7 +557,7 @@
 				'(# quote quasi-quote static-q static-qq))))
 		;exit list func
 		progn)
-	(setq args (sort (const cmp) args))
+	(setq args (sort args))
 	`(lambda ,args ~_))
 
 ;;;;;;;;;;;;

diff --git a/cmd/files.lisp b/cmd/files.lisp
@@ -35,10 +35,10 @@
 		(defq postfix (if (< (length args) 2) "." (second args))
 			prefix (if (< (length args) 3) "" (third args)))
 		(if (ends-with "/" postfix) (setq postfix (most postfix)))
-		(each (const print) (unique (sort (const cmp)
+		(each (const print) (unique (sort
 			(reduce (lambda (files (option func)) (if option (func files) files))
 				(list
-					(list opt_i (# (unique (sort (const cmp) (flatten (map (const files-depends) %0))))))
+					(list opt_i (# (unique (sort (flatten (map (const files-depends) %0))))))
 					(list opt_a (const files-all-depends))
 					(list opt_d (const files-dirs)))
 				(map (# (if (starts-with "./" %0) (slice %0 2 -1) %0))

diff --git a/cmd/make.lisp b/cmd/make.lisp
@@ -85,13 +85,13 @@
 								(push (last docs) "lisp binding" line)))))) (file-stream file))) *imports*)))
 
 	;create VP classes docs
-	(sort (# (cmp (first %0) (first %1))) classes)
+	(sort classes (# (cmp (first %0) (first %1))))
 	(each (lambda ((cls super &rest methds))
 		(defq stream (file-stream (cat "docs/reference/vp_classes/" cls ".md") +file_open_write))
 		(write-line stream (cat "# " cls +LF))
 		(unless (eql ":nil" super)
 			(write-line stream (cat "## " super +LF)))
-		(sort (# (cmp (first %0) (first %1))) methds)
+		(sort methds (# (cmp (first %0) (first %1))))
 		(defq lisp_methds (filter-array (# (starts-with ":lisp_" (first %0))) methds)
 			methds (filter-array (# (not (starts-with ":lisp_" (first %0)))) methds))
 		(when (nempty? lisp_methds)
@@ -178,9 +178,9 @@
 			(each (lambda ((name info))
 					(write-line stream (cat "### " name +LF))
 					(information stream info))
-				(sort (# (cmp (first %0) (first %1))) methods))
+				(sort methods (# (cmp (first %0) (first %1)))))
 			(print "-> " document))
-		(sort (# (cmp (first %0) (first %1))) classes))
+		(sort classes (# (cmp (first %0) (first %1)))))
 
 	;create key bindings docs
 	(defq document "docs/reference/keys.md" current_file ""
@@ -195,8 +195,8 @@
 				(write-line stream "```code")
 				(each (# (write-line stream %0)) info)
 				(write-line stream (cat "```" +LF))))
-		(sort (# (if (/= 0 (defq _ (cmp (first %0) (first %1))))
-			_ (cmp (second %0) (second %1)))) keys))
+		(sort keys (# (if (/= 0 (defq _ (cmp (first %0) (first %1))))
+			_ (cmp (second %0) (second %1))))))
 	(print "-> " document)
 
 	;create functions docs
@@ -207,7 +207,7 @@
 			(when (nempty? info)
 				(write-line stream (cat "### " name +LF))
 				(information stream info)))
-		(sort (# (cmp (first %0) (first %1))) functions))
+		(sort functions (# (cmp (first %0) (first %1)))))
 	(print "-> " document)
 
 	;create macros docs
@@ -218,7 +218,7 @@
 			(when (nempty? info)
 				(write-line stream (cat "### " name +LF))
 				(information stream info)))
-		(sort (# (cmp (first %0) (first %1))) macros))
+		(sort macros (# (cmp (first %0) (first %1)))))
 	(print "-> " document)
 
 	;create commands docs
@@ -229,9 +229,9 @@
 			(write-line stream "```code")
 			(write stream result)
 			(write-line stream "```"))
-		(sort (# (cmp (first %0) (first %1)))
-			(pipe-farm (map (# (cat %0 " -h"))
-				(files-all "cmd" '(".lisp") 4 -6)))))
+		(sort (pipe-farm (map (# (cat %0 " -h"))
+					(files-all "cmd" '(".lisp") 4 -6)))
+			(# (cmp (first %0) (first %1)))))
 	(print "-> " document))
 
 (defun main ()

diff --git a/cmd/sort.lisp b/cmd/sort.lisp
@@ -22,4 +22,4 @@
 			(each-line (# (push lines %0)) (io-stream 'stdin))
 			;sort args
 			(setq lines (rest args)))
-		(each print (sort cmp lines))))
+		(each print (sort lines))))
diff --git a/docs/reference/functions.md b/docs/reference/functions.md
@@ -919,7 +919,7 @@ adjust text offset
 ### sort
 
 ```code
-(sort fcmp list [start end]) -> list
+(sort list [fcmp start end]) -> list
 ```
 
 ### split

diff --git a/gui/edit/lisp.inc b/gui/edit/lisp.inc
@@ -445,7 +445,7 @@
 				(bind '(y y1) (select-lines this))
 				(. this :set_anchor 0 y)
 				(. buffer :paste (apply (const cat) (join
-					(sort cmp (split (.-> buffer (:set_cursor 0 y1) (:cut 0 y)) (ascii-char +char_lf)))
+					(sort (split (.-> buffer (:set_cursor 0 y1) (:cut 0 y)) (ascii-char +char_lf)))
 					(list (ascii-char +char_lf)) 2)))))
 		this)
 

diff --git a/gui/tree/lisp.inc b/gui/tree/lisp.inc
@@ -107,7 +107,7 @@
 		; (. tree :populate [root exts n mode]) -> tree
 		;load up a file tree
 		(setd mode 3)
-		(defq files (sort cmp (files-all root exts n)))
+		(defq files (sort (files-all root exts n)))
 		(if (/= (logand 1 mode) 0)
 			(each (# (. this :add_route %0)) (files-dirs files)))
 		(if (/= (logand 2 mode) 0)

diff --git a/lib/boot/image.inc b/lib/boot/image.inc
@@ -55,7 +55,7 @@
 		(# (merge-obj boot_funcs (elem-get (func-load %0) +blob_refs)))
 		boot_funcs)
 	;sort into order, leaving the init/statics first !
-	(sort cmp boot_funcs 2)
+	(sort boot_funcs (const cmp) 2)
 	;list of function blobs and links in order
 	;list of offsets of header and link sections
 	(defq blobs (map (# (get %0 *blob_map*)) boot_funcs)

diff --git a/lib/debug/debug.inc b/lib/debug/debug.inc
@@ -52,7 +52,7 @@
 	(each (lambda ((var val))
 		(setq var (pad var max_var_size)
 			val (debug-sanitize (str val) (- (const (- +debug_width 3)) max_var_size) :t))
-		(push msg var " : " val +LF)) (sort (# (cmp (first %0) (first %1))) e))
+		(push msg var " : " val +LF)) (sort e (# (cmp (first %0) (first %1)))))
 	(apply (const cat) (push msg +LF)))
 
 (defun debug-msg (rval sform e n)

diff --git a/lib/debug/profile.inc b/lib/debug/profile.inc
@@ -27,8 +27,8 @@
 		(push msg
 			(pad k m) " cnt: " (pad (first v) 8)
 			" ns: " (pad (third v) 8) +LF))
-		(sort (lambda ((k1 v1) (k2 v2))
-			(- (third v2) (third v1))) e))
+		(sort e (lambda ((k1 v1) (k2 v2))
+			(- (third v2) (third v1)))))
 	(apply (const cat) (push msg +LF)))
 
 (redefun profile-report (n &optional reset)

diff --git a/lib/files/files.inc b/lib/files/files.inc
@@ -50,7 +50,7 @@
 (defun files-all-depends (files &optional imps)
 	; (files-all-depends paths &optional imps) -> paths
 	;create list of all dependencies, with implicit options
-	(setq files (unique (sort (const cmp) (cat files))))
+	(setq files (unique (sort (cat files))))
 	(when imps
 		(each (# (unless (find %0 files) (push files %0)))
 			(cat (list "class/lisp/root.inc" "class/lisp/task.inc") imps)))