* interp/vmlisp.lisp (SORTBY): Remove.

	(QSORT): Likewise.
	* interp/c-util.boot (formal?): Rename from isFormal.  Avoid POSITION.
	* interp/sys-utility.boot (sortBy): New.
	* interp/br-op1.boot: Use it.
	* interp/clam.boot: Likewise.
	* interp/define.boot: Likewise.
	* interp/i-output.boot: Likewise.
	* interp/i-coerfn.boot: Likewise.
	* interp/i-syscmd.boot: Likewise.
	* interp/showimp.boot: Likewise.
	* boot/tokens.boot: "<-" is now a token.
	* boot/ast.boot (bfKeyArg): New.
	(bfExpandKeys): Likewise.
	(bfApplication): Use it.
	* boot/parser.boot (bpKeyArg): New.
	(bpAssign): Use it.  Parse named arguments.

18 files changed, 143 insertions, 73 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index ebc8a2a5..b94f4db7 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,25 @@
 2011-12-28  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* interp/vmlisp.lisp (SORTBY): Remove.
+	(QSORT): Likewise.
+	* interp/c-util.boot (formal?): Rename from isFormal.  Avoid POSITION.
+	* interp/sys-utility.boot (sortBy): New.
+	* interp/br-op1.boot: Use it.
+	* interp/clam.boot: Likewise.
+	* interp/define.boot: Likewise.
+	* interp/i-output.boot: Likewise.
+	* interp/i-coerfn.boot: Likewise.
+	* interp/i-syscmd.boot: Likewise.
+	* interp/showimp.boot: Likewise.
+	* boot/tokens.boot: "<-" is now a token.
+	* boot/ast.boot (bfKeyArg): New.
+	(bfExpandKeys): Likewise.
+	(bfApplication): Use it.
+	* boot/parser.boot (bpKeyArg): New.
+	(bpAssign): Use it.  Parse named arguments.
+
+2011-12-28  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* boot/tokens.boot: Remove redundant renaming of REM.
 	loopBody and loopExit are not selectors.
 	* interp/i-output.boot: Include sys-utility.
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 4a476189..656fdceb 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -72,6 +72,7 @@ structure %Ast ==
   %Colon(%Symbol)                       -- :x
   %QualifiedName(%Symbol,%Symbol)       -- m::x
   %DefaultValue(%Symbol,%Ast)           -- opt. value for function param.
+  %Key(%Symbol,%Ast)                    -- k <- x
   %Bracket(%Ast)                        -- [x, y]
   %UnboundedSegment(%Ast)               -- 3..
   %BoundedSgement(%Ast,%Ast)            -- 2..4
@@ -770,8 +771,19 @@ bfHas(expr,prop) ==
   symbol? prop => ["GET",expr, quote prop]
   bpSpecificErrorHere('"expected identifier as property name")
   
+bfKeyArg(k,x) ==
+  ['%Key,k,x]
+
+bfExpandKeys l ==
+  args := nil
+  while l is [a,:l] repeat
+    a is ['%Key,k,x] =>
+      args := [x,makeSymbol(stringUpcase symbolName k,'"KEYWORD"),:args]
+    args := [a,:args]
+  reverse! args      
+
 bfApplication(bfop, bfarg) ==
-  bfTupleP bfarg => [bfop,:rest bfarg]
+  bfTupleP bfarg => [bfop,:bfExpandKeys rest bfarg]
   [bfop,bfarg]
  
 -- returns the meaning of x in the appropriate Boot dialect.
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index dde2bd3e..5c198129 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -858,6 +858,9 @@ bpAssign()==
     bpEqPeek "GIVES" =>
       bpRestore a
       bpLambda() or bpTrap()
+    bpEqPeek "LARROW" =>
+      bpRestore a
+      bpKeyArg() or bpTrap()
     true
   bpRestore a
   false
@@ -876,6 +879,10 @@ bpLambda() ==
       (bpAssign() or bpTrap()) and
         bpPush bfLambda(bpPop2(),bpPop1())
 
+bpKeyArg() ==
+  bpName() and bpEqKey "LARROW" and bpLogical() and
+    bpPush bfKeyArg(bpPop2(),bpPop1())
+
 -- should only be allowed in sequences
 bpExit()==
   bpAssign() and (bpEqKey "EXIT" and
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 3bf3ce53..b0c40086 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -51,86 +51,88 @@
 (DEFUN |%DefaultValue| #1=(|bfVar#24| |bfVar#25|)
   (CONS '|%DefaultValue| (LIST . #1#)))
 
-(DEFUN |%Bracket| #1=(|bfVar#26|) (CONS '|%Bracket| (LIST . #1#)))
+(DEFUN |%Key| #1=(|bfVar#26| |bfVar#27|) (CONS '|%Key| (LIST . #1#)))
 
-(DEFUN |%UnboundedSegment| #1=(|bfVar#27|)
+(DEFUN |%Bracket| #1=(|bfVar#28|) (CONS '|%Bracket| (LIST . #1#)))
+
+(DEFUN |%UnboundedSegment| #1=(|bfVar#29|)
   (CONS '|%UnboundedSegment| (LIST . #1#)))
 
-(DEFUN |%BoundedSgement| #1=(|bfVar#28| |bfVar#29|)
+(DEFUN |%BoundedSgement| #1=(|bfVar#30| |bfVar#31|)
   (CONS '|%BoundedSgement| (LIST . #1#)))
 
-(DEFUN |%Tuple| #1=(|bfVar#30|) (CONS '|%Tuple| (LIST . #1#)))
+(DEFUN |%Tuple| #1=(|bfVar#32|) (CONS '|%Tuple| (LIST . #1#)))
 
-(DEFUN |%ColonAppend| #1=(|bfVar#31| |bfVar#32|)
+(DEFUN |%ColonAppend| #1=(|bfVar#33| |bfVar#34|)
   (CONS '|%ColonAppend| (LIST . #1#)))
 
-(DEFUN |%Pretend| #1=(|bfVar#33| |bfVar#34|) (CONS '|%Pretend| (LIST . #1#)))
+(DEFUN |%Pretend| #1=(|bfVar#35| |bfVar#36|) (CONS '|%Pretend| (LIST . #1#)))
 
-(DEFUN |%Is| #1=(|bfVar#35| |bfVar#36|) (CONS '|%Is| (LIST . #1#)))
+(DEFUN |%Is| #1=(|bfVar#37| |bfVar#38|) (CONS '|%Is| (LIST . #1#)))
 
-(DEFUN |%Isnt| #1=(|bfVar#37| |bfVar#38|) (CONS '|%Isnt| (LIST . #1#)))
+(DEFUN |%Isnt| #1=(|bfVar#39| |bfVar#40|) (CONS '|%Isnt| (LIST . #1#)))
 
-(DEFUN |%Reduce| #1=(|bfVar#39| |bfVar#40|) (CONS '|%Reduce| (LIST . #1#)))
+(DEFUN |%Reduce| #1=(|bfVar#41| |bfVar#42|) (CONS '|%Reduce| (LIST . #1#)))
 
-(DEFUN |%PrefixExpr| #1=(|bfVar#41| |bfVar#42|)
+(DEFUN |%PrefixExpr| #1=(|bfVar#43| |bfVar#44|)
   (CONS '|%PrefixExpr| (LIST . #1#)))
 
-(DEFUN |%Call| #1=(|bfVar#43| |bfVar#44|) (CONS '|%Call| (LIST . #1#)))
+(DEFUN |%Call| #1=(|bfVar#45| |bfVar#46|) (CONS '|%Call| (LIST . #1#)))
 
-(DEFUN |%InfixExpr| #1=(|bfVar#45| |bfVar#46| |bfVar#47|)
+(DEFUN |%InfixExpr| #1=(|bfVar#47| |bfVar#48| |bfVar#49|)
   (CONS '|%InfixExpr| (LIST . #1#)))
 
-(DEFUN |%ConstantDefinition| #1=(|bfVar#48| |bfVar#49|)
+(DEFUN |%ConstantDefinition| #1=(|bfVar#50| |bfVar#51|)
   (CONS '|%ConstantDefinition| (LIST . #1#)))
 
-(DEFUN |%Definition| #1=(|bfVar#50| |bfVar#51| |bfVar#52|)
+(DEFUN |%Definition| #1=(|bfVar#52| |bfVar#53| |bfVar#54|)
   (CONS '|%Definition| (LIST . #1#)))
 
-(DEFUN |%Macro| #1=(|bfVar#53| |bfVar#54| |bfVar#55|)
+(DEFUN |%Macro| #1=(|bfVar#55| |bfVar#56| |bfVar#57|)
   (CONS '|%Macro| (LIST . #1#)))
 
-(DEFUN |%Lambda| #1=(|bfVar#56| |bfVar#57|) (CONS '|%Lambda| (LIST . #1#)))
+(DEFUN |%Lambda| #1=(|bfVar#58| |bfVar#59|) (CONS '|%Lambda| (LIST . #1#)))
 
-(DEFUN |%SuchThat| #1=(|bfVar#58|) (CONS '|%SuchThat| (LIST . #1#)))
+(DEFUN |%SuchThat| #1=(|bfVar#60|) (CONS '|%SuchThat| (LIST . #1#)))
 
-(DEFUN |%Assignment| #1=(|bfVar#59| |bfVar#60|)
+(DEFUN |%Assignment| #1=(|bfVar#61| |bfVar#62|)
   (CONS '|%Assignment| (LIST . #1#)))
 
-(DEFUN |%While| #1=(|bfVar#61|) (CONS '|%While| (LIST . #1#)))
+(DEFUN |%While| #1=(|bfVar#63|) (CONS '|%While| (LIST . #1#)))
 
-(DEFUN |%Until| #1=(|bfVar#62|) (CONS '|%Until| (LIST . #1#)))
+(DEFUN |%Until| #1=(|bfVar#64|) (CONS '|%Until| (LIST . #1#)))
 
-(DEFUN |%For| #1=(|bfVar#63| |bfVar#64| |bfVar#65|) (CONS '|%For| (LIST . #1#)))
+(DEFUN |%For| #1=(|bfVar#65| |bfVar#66| |bfVar#67|) (CONS '|%For| (LIST . #1#)))
 
-(DEFUN |%Implies| #1=(|bfVar#66| |bfVar#67|) (CONS '|%Implies| (LIST . #1#)))
+(DEFUN |%Implies| #1=(|bfVar#68| |bfVar#69|) (CONS '|%Implies| (LIST . #1#)))
 
-(DEFUN |%Iterators| #1=(|bfVar#68|) (CONS '|%Iterators| (LIST . #1#)))
+(DEFUN |%Iterators| #1=(|bfVar#70|) (CONS '|%Iterators| (LIST . #1#)))
 
-(DEFUN |%Cross| #1=(|bfVar#69|) (CONS '|%Cross| (LIST . #1#)))
+(DEFUN |%Cross| #1=(|bfVar#71|) (CONS '|%Cross| (LIST . #1#)))
 
-(DEFUN |%Repeat| #1=(|bfVar#70| |bfVar#71|) (CONS '|%Repeat| (LIST . #1#)))
+(DEFUN |%Repeat| #1=(|bfVar#72| |bfVar#73|) (CONS '|%Repeat| (LIST . #1#)))
 
-(DEFUN |%Pile| #1=(|bfVar#72|) (CONS '|%Pile| (LIST . #1#)))
+(DEFUN |%Pile| #1=(|bfVar#74|) (CONS '|%Pile| (LIST . #1#)))
 
-(DEFUN |%Append| #1=(|bfVar#73|) (CONS '|%Append| (LIST . #1#)))
+(DEFUN |%Append| #1=(|bfVar#75|) (CONS '|%Append| (LIST . #1#)))
 
-(DEFUN |%Case| #1=(|bfVar#74| |bfVar#75|) (CONS '|%Case| (LIST . #1#)))
+(DEFUN |%Case| #1=(|bfVar#76| |bfVar#77|) (CONS '|%Case| (LIST . #1#)))
 
-(DEFUN |%Return| #1=(|bfVar#76|) (CONS '|%Return| (LIST . #1#)))
+(DEFUN |%Return| #1=(|bfVar#78|) (CONS '|%Return| (LIST . #1#)))
 
-(DEFUN |%Leave| #1=(|bfVar#77|) (CONS '|%Leave| (LIST . #1#)))
+(DEFUN |%Leave| #1=(|bfVar#79|) (CONS '|%Leave| (LIST . #1#)))
 
-(DEFUN |%Throw| #1=(|bfVar#78|) (CONS '|%Throw| (LIST . #1#)))
+(DEFUN |%Throw| #1=(|bfVar#80|) (CONS '|%Throw| (LIST . #1#)))
 
-(DEFUN |%Catch| #1=(|bfVar#79| |bfVar#80|) (CONS '|%Catch| (LIST . #1#)))
+(DEFUN |%Catch| #1=(|bfVar#81| |bfVar#82|) (CONS '|%Catch| (LIST . #1#)))
 
-(DEFUN |%Finally| #1=(|bfVar#81|) (CONS '|%Finally| (LIST . #1#)))
+(DEFUN |%Finally| #1=(|bfVar#83|) (CONS '|%Finally| (LIST . #1#)))
 
-(DEFUN |%Try| #1=(|bfVar#82| |bfVar#83|) (CONS '|%Try| (LIST . #1#)))
+(DEFUN |%Try| #1=(|bfVar#84| |bfVar#85|) (CONS '|%Try| (LIST . #1#)))
 
-(DEFUN |%Where| #1=(|bfVar#84| |bfVar#85|) (CONS '|%Where| (LIST . #1#)))
+(DEFUN |%Where| #1=(|bfVar#86| |bfVar#87|) (CONS '|%Where| (LIST . #1#)))
 
-(DEFUN |%Structure| #1=(|bfVar#86| |bfVar#87|)
+(DEFUN |%Structure| #1=(|bfVar#88| |bfVar#89|)
   (CONS '|%Structure| (LIST . #1#)))
 
 (DEFPARAMETER |$inDefIS| NIL)
@@ -1151,8 +1153,38 @@
   (COND ((SYMBOLP |prop|) (LIST 'GET |expr| (|quote| |prop|)))
         (T (|bpSpecificErrorHere| "expected identifier as property name"))))
 
+(DEFUN |bfKeyArg| (|k| |x|) (LIST '|%Key| |k| |x|))
+
+(DEFUN |bfExpandKeys| (|l|)
+  (PROG (|x| |ISTMP#2| |k| |ISTMP#1| |a| |args|)
+    (RETURN
+     (PROGN
+      (SETQ |args| NIL)
+      (LOOP
+       (COND
+        ((NOT
+          (AND (CONSP |l|)
+               (PROGN (SETQ |a| (CAR |l|)) (SETQ |l| (CDR |l|)) T)))
+         (RETURN NIL))
+        ((AND (CONSP |a|) (EQ (CAR |a|) '|%Key|)
+              (PROGN
+               (SETQ |ISTMP#1| (CDR |a|))
+               (AND (CONSP |ISTMP#1|)
+                    (PROGN
+                     (SETQ |k| (CAR |ISTMP#1|))
+                     (SETQ |ISTMP#2| (CDR |ISTMP#1|))
+                     (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
+                          (PROGN (SETQ |x| (CAR |ISTMP#2|)) T))))))
+         (SETQ |args|
+                 (CONS |x|
+                       (CONS
+                        (INTERN (STRING-UPCASE (SYMBOL-NAME |k|)) "KEYWORD")
+                        |args|))))
+        (T (SETQ |args| (CONS |a| |args|)))))
+      (|reverse!| |args|)))))
+
 (DEFUN |bfApplication| (|bfop| |bfarg|)
-  (COND ((|bfTupleP| |bfarg|) (CONS |bfop| (CDR |bfarg|)))
+  (COND ((|bfTupleP| |bfarg|) (CONS |bfop| (|bfExpandKeys| (CDR |bfarg|))))
         (T (LIST |bfop| |bfarg|))))
 
 (DEFUN |bfReName| (|x|)
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index f6799dbf..f8417b34 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -863,6 +863,7 @@
         (COND
          ((|bpEqPeek| 'BEC) (|bpRestore| |a|) (OR (|bpAssignment|) (|bpTrap|)))
          ((|bpEqPeek| 'GIVES) (|bpRestore| |a|) (OR (|bpLambda|) (|bpTrap|)))
+         ((|bpEqPeek| 'LARROW) (|bpRestore| |a|) (OR (|bpKeyArg|) (|bpTrap|)))
          (T T)))
        (T (|bpRestore| |a|) NIL))))))
 
@@ -874,6 +875,10 @@
   (AND (|bpVariable|) (|bpEqKey| 'GIVES) (OR (|bpAssign|) (|bpTrap|))
        (|bpPush| (|bfLambda| (|bpPop2|) (|bpPop1|)))))
 
+(DEFUN |bpKeyArg| ()
+  (AND (|bpName|) (|bpEqKey| 'LARROW) (|bpLogical|)
+       (|bpPush| (|bfKeyArg| (|bpPop2|) (|bpPop1|)))))
+
 (DEFUN |bpExit| ()
   (AND (|bpAssign|)
        (OR
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index e59680a6..c259bda3 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -43,10 +43,10 @@
         (LIST "<" 'LT) (LIST ">" 'GT) (LIST "<=" 'LE) (LIST ">=" 'GE)
         (LIST "=" 'SHOEEQ) (LIST "~=" 'SHOENE) (LIST ".." 'SEG)
         (LIST "#" 'LENGTH) (LIST "=>" 'EXIT) (LIST "->" 'ARROW)
-        (LIST ":=" 'BEC) (LIST "+->" 'GIVES) (LIST "==" 'DEF)
-        (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN) (LIST ")" 'CPAREN)
-        (LIST "[" 'OBRACK) (LIST "]" 'CBRACK) (LIST "'" 'QUOTE)
-        (LIST "|" 'BAR)))
+        (LIST "<-" 'LARROW) (LIST ":=" 'BEC) (LIST "+->" 'GIVES)
+        (LIST "==" 'DEF) (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN)
+        (LIST ")" 'CPAREN) (LIST "[" 'OBRACK) (LIST "]" 'CBRACK)
+        (LIST "'" 'QUOTE) (LIST "|" 'BAR)))
 
 (DEFUN |shoeKeyTableCons| ()
   (PROG (|KeyTable|)
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index 2adea400..e8909318 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -110,6 +110,7 @@ shoeKeyWords == [  _
             ['"#", "LENGTH"], _
             ['"=>","EXIT" ], _
             ['"->", "ARROW"],_
+            ['"<-", "LARROW"], _
             ['":=", "BEC"], _
             ['"+->", "GIVES"], _
             ['"==", "DEF"], _
diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot
index c31af10f..db446fb5 100644
--- a/src/interp/br-op1.boot
+++ b/src/interp/br-op1.boot
@@ -405,8 +405,8 @@ dbGatherDataImplementation(htPage,opAlist) ==
     key is 'nowhere => nowheres := [x,:nowheres]
     key is 'constant =>constants := [x,:constants]
     others := [x,:others]   --add chain domains go here
-  fn [nowheres,constants,domexports,SORTBY('CDDR,reverse! others),SORTBY('CDDR,
-               reverse! defexports),SORTBY('CDDR,reverse! unexports)] where
+  fn [nowheres,constants,domexports,sortBy('CDDR,others),
+       sortBy('CDDR,defexports),sortBy('CDDR,unexports)] where
     fn l ==
       alist := nil
       for u in l repeat
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index e09772c6..a032f0a8 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1825,9 +1825,9 @@ compileQuietly fn ==
 
 ++ If `x' is a formal map variable, returns its position.
 ++ Otherwise return nil.
-isFormal: %Symbol -> %Maybe %Short
-isFormal x ==
-  POSITION(x,$FormalMapVariableList,KEYWORD::TEST, function EQ)
+formal?: %Symbol -> %Maybe %Short
+formal? x ==
+  or/[i for i in 0.. for y in $FormalMapVariableList | symbolEq?(x,y)]
 
 ++ Expand the form at position `slot' in the domain template `shell'
 ++ with argument list `args'.
@@ -1837,7 +1837,7 @@ expandFormTemplate(shell,args,slot) ==
     slot = 2 => "$$"
     expandFormTemplate(shell,args,vectorRef(shell,slot))
   slot isnt [.,:.] => slot
-  slot is ["local",parm] and (n := isFormal parm) => 
+  slot is ["local",parm] and (n := formal? parm) => 
     args.n   -- FIXME: we should probably expand with dual signature
   slot is ['%eval,val] => val
   slot is ['QUOTE,val] => 
@@ -1852,9 +1852,9 @@ equalFormTemplate(shell,args,slot,form) ==
     slot = 0 => form = "$"
     slot = 2 => form = "$$"
     equalFormTemplate(shell,args,vectorRef(shell,slot),form)
-  slot is ["local",parm] and (n := isFormal parm) => 
+  slot is ["local",parm] and (n := formal? parm) => 
     equalFormTemplate(shell,args,args.n,form)
-  slot is ["NTREVAL",val] => form = val
+  slot is ['%eval,val] => form = val
   slot is ['QUOTE,val] => 
      string? val or symbol? val or integer? val => val = form
      slot = form
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index 3ed51a32..34bd928e 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -272,7 +272,7 @@ formalSubstitute(form:=[.,:argl],u) ==
   applySubst(pairList($FormalMapVariableList,argl),u)
 
 isFormalArgumentList argl ==
-  and/[x=fa for x in argl for fa in $FormalMapVariableList]
+  and/[symbolEq?(x,fa) for x in argl for fa in $FormalMapVariableList]
 
 mkCategoryExtensionAlist cform ==
   not cons? cform => nil
diff --git a/src/interp/clam.boot b/src/interp/clam.boot
index a0c57a41..f1f88374 100644
--- a/src/interp/clam.boot
+++ b/src/interp/clam.boot
@@ -364,7 +364,7 @@ clearCategoryCache catName ==
   symbolValue(mkCacheName catName) := nil
  
 displayHashtable x ==
-  l:= reverse! SORTBY('CAR,[[opOf val,key] for [key,:val] in entries x])
+  l := sortBy(function first,[[opOf val,key] for [key,:val] in entries x])
   for [a,b] in l repeat
     sayBrightlyNT ['"%b",a,'"%d"]
     pp b
@@ -387,7 +387,7 @@ reportCircularCacheStats(fn,n) ==
   TERPRI()
  
 displayCacheFrequency al ==
-  al := reverse! SORTBY('CAR,al)
+  al := sortBy(function first,al)
   sayBrightlyNT "    #hits/#occurrences: "
   for [a,:b] in al repeat sayBrightlyNT [a,"/",b,"  "]
   TERPRI()
@@ -572,7 +572,7 @@ reportInstantiations() ==
     sayBrightly ['"# instantiated/# dropped/domain name",
       "%l",'"------------------------------------"]
     nTotal:= mTotal:= rTotal := nForms:= 0
-    for [n,m,form] in reverse! SORTBY('CADDR,conList) repeat
+    for [n,m,form] in sortBy(function third,conList) repeat
       nTotal:= nTotal+n; mTotal:= mTotal+m
       if n > 1 then rTotal:= rTotal + n-1
       nForms:= nForms + 1
@@ -669,7 +669,7 @@ globalHashtableStats(x,sortFn) ==
       argList1:= [constructor2ConstructorForm x for x in argList]
       reportList:= [[n,key,argList1],:reportList]
   sayBrightly ["%b","  USE  NAME ARGS","%d"]
-  for [n,fn,args] in reverse! SORTBY(sortFn,reportList) repeat
+  for [n,fn,args] in sortBy(sortFn,reportList) repeat
     sayBrightlyNT [:rightJustifyString(n,6),"  ",fn,": "]
     pp args
  
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 8edc4da2..d2fa9601 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -465,7 +465,7 @@ NRTmakeCategoryAlist(db,e) ==
   $catAncestorAlist: local := nil
   pcAlist := [:[[x,:"T"] for x in $uncondAlist],:$condAlist]
   $levelAlist: local := depthAssocList [CAAR x for x in pcAlist]
-  opcAlist := reverse! SORTBY(function NRTcatCompare,pcAlist)
+  opcAlist := sortBy(function NRTcatCompare,pcAlist)
   newPairlis := [[5 + i,:b] for [.,:b] in dbFormalSubst db for i in 1..]
   slot1 := [[a,:k] for [a,:b] in dbSubstituteAllQuantified(db,opcAlist)
                    | (k := predicateBitIndex(b,e)) ~= -1]
diff --git a/src/interp/i-coerfn.boot b/src/interp/i-coerfn.boot
index d1825ac3..bf42e2cf 100644
--- a/src/interp/i-coerfn.boot
+++ b/src/interp/i-coerfn.boot
@@ -287,7 +287,7 @@ Dmp2Up(u, source is [dmp,vl,S],target is [up,var,T]) ==
 
   -- only one variable in DMP case
   null vl' =>
-    u' := reverse! SORTBY('CAR,[[e.0,:c] for [e,:c] in u])
+    u' := sortBy(function first,[[e.0,:c] for [e,:c] in u])
     (u' := coerceInt(objNewWrap(u',[up,var,S]),target)) or
       coercionFailure()
     objValUnwrap u'
@@ -308,7 +308,7 @@ Dmp2Up(u, source is [dmp,vl,S],target is [up,var,T]) ==
         p.rest := c'
       zero = objValUnwrap(y) => 'iterate
       x := [[exp,:objValUnwrap(y)],:x]
-  y => reverse! SORTBY('CAR,x)
+  y => sortBy(function first,x)
   coercionFailure()
 
 removeVectorElt(v,pos) ==
diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot
index 421e9386..ccd535b7 100644
--- a/src/interp/i-output.boot
+++ b/src/interp/i-output.boot
@@ -1773,7 +1773,7 @@ charyTop(u,start,linelength) ==
 -->
   $testOutputLineFlag =>
     $testOutputLineList :=
-      [:ASSOCRIGHT SORTBY('CAR,d),:$testOutputLineList]
+      [:ASSOCRIGHT reverse! sortBy(function first,d),:$testOutputLineList]
   until n < m repeat
     scylla(n,d)
     n := n - 1
diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot
index d9cd3197..e15c18fb 100644
--- a/src/interp/i-syscmd.boot
+++ b/src/interp/i-syscmd.boot
@@ -2703,7 +2703,7 @@ workfilesSpad2Cmd args ==
   centerAndHighlight(" User-specified work files ",$LINELENGTH,specialChar 'hbar)
   SAY " "
   null $sourceFiles => SAY '"   no files specified"
-  SETQ($sourceFiles,SORTBY('pathnameType,$sourceFiles))
+  SETQ($sourceFiles,sortBy(function pathnameType,$sourceFiles))
   for fl in $sourceFiles repeat sayBrightly ["   " ,namestring fl]
 
 --% )zsystemdevelopment
diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot
index 000154f4..deb1f816 100644
--- a/src/interp/showimp.boot
+++ b/src/interp/showimp.boot
@@ -70,7 +70,7 @@ showImp(dom,:options) ==
   missingOnlyFlag => 'done
 
   --first display those exported by the domain, then add chain guys
-  u := [:domexports,:constants,:SORTBY('CDDR,others)]
+  u := [:domexports,:constants,:reverse! sortBy(function CDDR,others)]
   while u repeat
     [.,.,:key] := first u
     sayBrightly
@@ -78,14 +78,14 @@ showImp(dom,:options) ==
         ["Constants implemented by",:bright form2String key,'":"]
       ["Functions implemented by",:bright form2String key,'":"]
     u := showDomainsOp1(u,key)
-  u := SORTBY('CDDR,defexports)
+  u := reverse! sortBy(function CDDR,defexports)
   while u repeat
     [.,.,:key] := first u
     defop := makeSymbol(subString((s := PNAME first key),0,maxIndex s))
     domainForm := [defop,:CDDR key]
     sayBrightly ["Default functions from",:bright form2String domainForm,'":"]
     u := showDomainsOp1(u,key)
-  u := SORTBY('CDDR,unexports)
+  u := reverse! sortBy(function CDDR,unexports)
   while u repeat
     [.,.,:key] := first u
     sayBrightly ["Not exported: "]
diff --git a/src/interp/sys-utility.boot b/src/interp/sys-utility.boot
index 96bd829b..31168d54 100644
--- a/src/interp/sys-utility.boot
+++ b/src/interp/sys-utility.boot
@@ -388,6 +388,9 @@ remove!(l,x) ==
       return l
     p := rest p
       
+sortBy(k,l) ==
+  SORT(copyList l,function GGREATERP,key <- k)
+
 ++ Return the list of objects that follow x in l, including x itself.
 ++ Otherwise return nil.
 upwardCut(x,l) ==
diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp
index e571a161..47ccdec1 100644
--- a/src/interp/vmlisp.lisp
+++ b/src/interp/vmlisp.lisp
@@ -676,16 +676,6 @@
                (SETQ Y (CDR Y))
                (GO A)))))
 
-; 14.6 Miscellaneous
-
-(defun QSORT (l)
- (declare (special sortgreaterp))
-  (|reverse!| (sort (copy-seq l) SORTGREATERP)))
-
-(defun SORTBY (keyfn l)
- (declare (special sortgreaterp))
-  (|reverse!| (sort (copy-seq l) SORTGREATERP :key keyfn)))
-
 ; 16.0 Operations on Vectors
 
 ; 16.1 Creation