mim/mim/mimlib/sort-macros.ms

   1 <PACKAGE "SORT-MACROS">
   2 <USE-WHEN <DEBUGGING? "SORT-MACROS"> "BACKQUOTE">
   3 <ENTRY QUICKSORT-MACRO MERGESORT-MACRO>
   4
   5 <SETG \1aquicksort-macro-IMSUBR #IMSUBR [|AAADG]COH\AEHKDAAAAAAGDAAAAAAKBMH]AAAAABABCCE_CCE_CCE_CCE_CCE_CCE_CCE_CCE_CCE_CCE_CCE_CKFZA`H`H`HIDHAECOFYABBYBQD]AAAABSD]AAAABEDNAABUBLCKAAB]BLD[H`GIAABYBLCJAACEBLD[H`F_AACABLCIAACMBLD[H`FUAACICKFZA`H`H`HIDHAECOFYABBYCKFNAAB]DHAAABGQBADNAAB]BCAQBCDIAAAEBADMAAAUBIABBKAJBLCFAACUBLCEAACQCOFYAAGABIBMAAAYBKBMAAA]COFYAAGAB\D]AEABAAC[BIB]AAAAAEABBKAIBQD]AAAACOFYAAGABIBMAABABKBMAABECOFYAAGABIBMAABIBKBMAABMCOFYAAGAB\D]AEABAAC[BIB[H`GSBKAIBQD]AAAACOFYAAGACKFNAACMDGAMBLCIAACMBLD[H`BEAACIDAAIBCDNAACEBDCIH`H]BLCIAACEBLD[H`AQAACABADMAABUBIBNAACQBKBNAACUCOFYAAGABIBMAAAYBKBMAAA]COFYAAGAB\D]AEABAAC[BIB[H`D_BKAIBQD]AAAACOFYAAGABIBMAABYBKBMAAB]COFYAAGABIBMAABIBKBMAABMCOFYAAGAB\D]AEABAAC[BIB[H`CSBKAIBQD]AAAACOFYAAGACKFNAACMDGAMBLCIAACMBLD[H_FEAACIDAAIBCDNAACEBDCIH`H]BLCIAACEBLD[H_EQAACABADMAACEBIBNAACQBKBNAACUCOFYAAGABIBMAACIBKBMAACMCOFYAAGAB\D]AEABAAC[BIB[H_H_BKAIBQD]AAAACOFYAAGACKFNAACMDGAMBLCIAACMBLD[H_CQAACIDAAIBCDNAACEBDCIH`H]BLCIAACEBLD[H_B]AACABADMAACUBIBNAACQBKBNAACUCOFYAAGABIBMAACIBKBMAACMCOFYAAGAB\D]AEABAAC[BIB[H_FKBKAIBQD]AAAACOFYAAGACKFNAACMDGAMBLCIAACMBLD[H^H]AACIDAAIBCDNAACEBDCIH`H]BCDNAAB]BCDJH`H]BLCJAAB]BLD[H^HAAABYBLCIAACEBLD[H^GWAACADAAAH_BABQD]AAAABLCIAAB]BLD[H^GEAABYCKFNAACMDHAAAAESBCDNAACMBEARBEDJAAAEBQD]AAAABIACBKAKCOFYAAGABCDNAACMBCDJH`H]BLCJAACMBLD[H^EUAACIBLCIAAB]BLD[H^EKAABYBLCIAAC]BLD[H^EAAACYBOAJDHCQBEARBEDJAAAEBLCIAAC]BLD[H^DMAACYBQD]AAAABIACBKAKBLCJAACMBLD[H^C[AACICOFYAAGABCDNAAC]BDCIH`H]BCDNAACMBCDJH`H]BLCJAACMBLD[H^B]AACIBLCIAAC]BLD[H^BSAACYBOAJDHACDAFQBADMAACUBIBNAAAIBKBNAAAMCOFYAAGABIBMAACIBKBMAACMCOFYAAGABIB[H^FABKAIBADNAAB]COFYAAGABLCIAAB]BLD[H]HYAABYBADMAACEBIBNAAAIBKBNAAAMCOFYAAGABIBMAACIBKBMAACMCOFYAAGABIB[H^DMBKAIBADNAAB]COFYAAGABLCIAAB]BLD[H]GEAABYBQD]AAAABIBNAAAIBKBNAAAMCOFYAAGABIBMAACYBKBMAAC]COFYAAGABIB[H^BYBKAIBQD]AAAACOFYAAGABCDNAABUBUD]AAAABLCKAACEBLD[H]EIAACABLCIAAC]BLD[H]D_AACYBOAJDHAAAAEEBGARBGDJAAAEBQD]AAAABIADBKALBLCJAACMBLD[H]DAAACICOFYAAGABCDNAACMBCDJH`H]BLCIAACEBLD[H]CKAACABLCIAACUBLD[H]CAAACQBOAJDHCGBEARBEDJAAAEBLCIAACUBLD[H]BMAACQBQD]AAAABIACBKAKBLCJAACMBLD[H]A[AACICOFYAAGABCDNAACUBDCIH`H]BCDNAACMBCDJH`H]BLCIAACUBLD[H\H]AACQBOAJDHACDAF[BADNAACEBIBNAAAYBKBNAAA]BLCJAACMBLD[H\HAAACICOFYAAGABIBMAADABKBMAADECOFYAAGABIBNAAAIBKBNAAAMCOFYAAGABIAVBKBNAAAECOFYAAGAB\D]AEABAACCBIB[H]CEBKAIBADNAAC]COFYAAGABCDNAABUBUD]AAAABLCKAACUBLD[H\EUAACQBLCIAAC]BLD[H\EKAACYBOAJDHAAAAEEBGARBGDJAAAEBQD]AAAABIADBKALBLCJAACEBLD[H\DMAACACOFYAAGABCDNAACEBCDJH`H]BLCIAACUBLD[H\CWAACQBLCIAACMBLD[H\CMAACIBOAJDHCGBEARBEDJAAAEBLCIAACMBLD[H\BYAACIBQD]AAAABIACBKAKBLCJAACEBLD[H\BGAACACOFYAAGABCDNAACMBDCIH`H]BCDNAACEBCDJH`H]BLCIAACMBLD[H\AIAACIBOAJDHACDAF[BADNAACUBIBMAADIBKBMAADMBLCJAACEBLD[H[HMAACACOFYAAGABIBNAAAQBKBNAAAUCOFYAAGABIBNAAAIBKBNAAAMCOFYAAGABIAVBKBNAAAECOFYAAGAB\D]AEABAACSBIB[H\CQBKAIBADNAAC]COFYAAGABIBMAADQBKBMAADUCOFYAAGAB\D]ABABAAC[BIB[H[E[BKAIBQD]AAAACOFYAAGABIBMAADYBKBMAAD]COFYAAGAB\D]AEABAAC[BIB[H\AQBKAIBADNAAB]COFYAAGABLCIAAB]BLD[H[DIAABYBADMAAAUBIBNAAAIBKBNAAAMCOFYAAGABIBMAAAYBKBMAAA]COFYAAGAB\D]AEABAAC[BIB[H[GWBKAIBQD]AAAACOFYAAGABIBMAABABKBMAABECOFYAAGABIBMAABIBKBMAABMCOFYAAGAB\D]AEABAAC[BIB[H[FKBKAIBADMAAEECOFYAAGABIBNAABIBKBNAABMCOFYAAGAB\D]AEABAAC[BIB[H[EKBKAIBADMAAEMCOFYAAGAB\D]ABABAAC[BIB[HZHABKAIBQD]AAAACOFYAAGABIBMAADYBKBMAAD]COFYAAGAB\D]AEABAAC[BIB[H[CWBKAIBQD]AAAACOFYAAGABIBMAAEQBKBMAAEUCOFYAAGABIB[HZFGD[AACOFYAAGABIBMAAEYBKBMAAE]COFYAAGAB\D]AEABAAC[BIB[H[BABKAIBADNAAB]COFYAAGABLCIAAB]BLD[HZDYAABYBADMAABUBIBNAAAIBKBNAAAMCOFYAAGABIBMAAAYBKBMAAA]COFYAAGAB\D]AEABAAC[BIB[HZHGBKAIBQD]AAAACOFYAAGABIBMAABYBKBMAAB]COFYAAGABIBMAABIBKBMAABMCOFYAAGAB\D]AEABAAC[BIB[HZF[BKAIBADMAAEECOFYAAGABIBNAABABKBNAABECOFYAAGAB\D]AEABAAC[BIB[HZE[BKAIBADMAAEMCOFYAAGAB\D]ABABAAC[BIB[HYHQBKAIBQD]AAAACOFYAAGABIBMAADYBKBMAAD]COFYAAGAB\D]AEABAAC[BIB[HZDGBKAIBQD]AAAACOFYAAGABIBMAAFABKBMAAFECOFYAAGABIB[HYFWD[AACOFYAAGABIBMAAEYBKBMAAE]COFYAAGAB\D]AEABAAC[BIB[HZBQBKAIBADNAAB]COFYAAGABLCIAAB]BLD[HYEIAABYBADMAAFMBIBNAAAYBKBNAAA]COFYAAGABIBMAAFQBKBMAAFUCOFYAAGAB\D]AEABAAC[BIB[HYHWBKAIBQD]AAAACOFYAAGABIBMAAFYBKBMAAF]COFYAAGAB\D]ABABAAC[BIB[HYCABKAIBQD]AAAACOFYAAGABLCIAAC]BLD[HYBOAACYBADMAAFMBIBNAAAQBKBNAAAUCOFYAAGABIBMAAGABKBMAAGECOFYAAGAB\D]AEABAACSBIB[HYE]BKAIBQD]AAAACOFYAAGABIBMAAGIBKBMAAGMCOFYAAGAB\D]ABABAACSBIB[HXHGBKAIBADNAAC]COFYAAGABIBMAABYBKBMAAB]COFYAAGABIBMAABABKBMAABECOFYAAGABLCIAAC]BLD[HXF]AACYBQD]AAAABIBNAAAQBKBNAAAUCOFYAAGABIBNAAAIBKBNAAAMCOFYAAGABIBMAAAYBKBMAAA]COFYAAGAB\D]AEABAACSBIB[HYA_BKAIBQD]AAAACOFYAAGABIBMAAGQBKBMAAGUCOFYAAGAB\D]ABABAACSBIB[HXDIBKAIBADNAAC]COFYAAGAB\D]ABABAAC[BIB[HXCUBKAIBADNAAB]COFYAAGABIBMAAEYBKBMAAE]COFYAAGAB\D]AEABAAB[BIB[HXGKBKAIBQD]AAAACOFYAAGABLCIAAB]BLD[HXBCAABYBQD]AAAABIBNAAAYBKBNAAA]COFYAAGABIBNAAAQBKBNAAAUCOFYAAGABIBMAAGYBKBMAAG]COFYAAGAB\D]AEABAAC[BIB[HXEEBKAIBADNAAB]COFYAAGAB\D]ABABAAB[BIB[HWG[BKAIBQD]AAAACOFYAAGABIBMAADYBKBMAAD]COFYAAGABAB[HXCWCOHYAAFOBMHMABFQBMHMABFUBMH]AAAKADCCCCE_CCE_CCE_CCE_CCE_CCE_CCE_CCE_CCE_CCE_CCE_CKFZA`H`H`HIDHAECOFYABBYAMDNAGCHAAAKDGBABADNAAAMBCAQBCDIAAAEBEBIAAAIBEDIAAAMBLCKAABEBLCCAABABLCJAABMDAAIBADNAAAMBLCIAABMBQD]AAAABIBNAAAIBKBNAAAMCOFYAAGABLCIAABUBLD[HWCEAABQBADMAAHEBIBNAAAYBKBNAAA]COFYAAGAB\D]AEABAAB[BIB[HWF_BKAIBADMAAHMCOFYAAGAB\D]ABABAAB[BIB[HWAUBKAIBADMAAHUCOFYAAGABIBMAADYBKBMAAD]COFYAAGAB\D]AEABAAB[BIB[HWEKBKAIBQD]AAAACOFYAAGABIB[HVHGD[AACOFYAAGABIBMAAEYBKBMAAE]COFYAAGAB\D]AEABAAB[BIB[HWDABKAIBQD]AAAACOFYAAGABLCIAAB]BLD[HVFYAABYBADMAAH]BIBNAABIBKBNAABMCOFYAAGABIBMAABIBKBMAABMCOFYAAGAB\D]AEABAACCBIB[HWBGBKAIBQD]AAAACOFYAAGABIBMABAABKBMABAECOFYAAGABIBMAABIBKBMAABMCOFYAAGAB\D]AEABAACCBIB[HVH[BKAIBADMABAMCOFYAAGABIBMABAQBKBMABAUCOFYAAGAB\D]ABABAACCBIB[HVCEBKAIBQD]AAAACOFYAAGABLCIAACEBLD[HVBSAACABADMABA]BIBNAABIBKBNAABMCOFYAAGABIBMAABIBKBMAABMCOFYAAGAB\D]AEABAACKBIB[HVFABKAIBQD]AAAACOFYAAGABIBMABAABKBMABAECOFYAAGABIBMAABIBKBMAABMCOFYAAGAB\D]AEABAACKBIB[HVDUBKAIBADMABBECOFYAAGABLCIAACMBLD[HUGMAACIBADMAAHEBIBNAAAYBKBNAAA]COFYAAGAB\D]AEABAACSBIB[HVCGBKAIBADNAACMCOFYAAGAB\D]ABABAACKBIB[HUE]BKAIBADNAACECOFYAAGABIBMAADYBKBMAAD]COFYAAGAB\D]AEABAACCBIB[HVASBKAIBADNAAB]COFYAAGABIBMABBIBKBMABBMCOFYAAGABIBMABBQBKBMABBUCOFYAAGABIBMABBYBKBMABB]COFYAAGAB\D]AEABAAB[BIB[HUG[BKAIBQD]AAAACOFYAAGABLCIAAB]BLD[HUBSAABYBADMABCEBIBNAAAQBKBNAAAUCOFYAAGABIBMAAGABKBMAAGECOFYAAGAB\D]AEABAACCBIB[HUFABKAIBQD]AAAACOFYAAGABIBMABCIBKBMABCMCOFYAAGABIAVBKBNAAAECOFYAAGAB\D]AEABAACCBIB[HUDWBKAIBQD]AAAACOFYAAGABIBMABCQBKBMABCUCOFYAAGABIBMAABIBKBMAABMCOFYAAGAB\D]AEABAACCBIB[HUCKBKAIBADNAAB]COFYAAGABLCIAAB]BLD[HTFCAABYBADMABC]BIAVBKBNAAAECOFYAAGAB\D]AEABAACCBIB[HUA_BKAIBQD]AAAACOFYAAGABIBMABDABKBMABDECOFYAAGABIBMAABIBKBMAABMCOFYAAGAB\D]AEABAACCBIB[HTHSBKAIBADNAAB]COFYAAGABLCIAAB]BLD[HTCKAABYBADMABDMBIBNAAAIBKBNAAAMCOFYAAGABIBMABDQBKBMABDUCOFYAAGAB\D]AEABAACCBIB[HTFYBKAIBADNAAB]COFYAAGABLCIAAB]BLD[HTAQAABYBQD]AAAABIBNAAAIBKBNAAAMCOFYAAGABIBMABDABKBMABDECOFYAAGABIBMAABIBKBMAABMCOFYAAGAB\D]AEABAACCBIB[HTDSBKAIBADMABD]COFYAAGABIBMABEABKBMABEECOFYAAGAB\D]AEABAACCBIB[HTCSBKAIBQD]AAAACOFYAAGABIBNAABIBKBNAABMCOFYAAGABIBMAABIBKBMAABMCOFYAAGAB\D]AEABAACCBIB[HTBGBKAIBQD]AAAACOFYAAGABIBMABEABKBMABEECOFYAAGAB\D]AEABAACCBIB[HTAGBKAIBQD]AAAACOFYAAGABIBMABCQBKBMABCUCOFYAAGABIBMAABIBKBMAABMCOFYAAGAB\D]AEABAACCBIB[HSG[BKAIBADNAAB]COFYAAGABMHMABCQBMHMABCUBMHNAABABMHNAABEBIB]AAAAACCHD[ACBLCIAAB]BLD[HSA[AABYCOFYAAH]BQB]AGCHBIAABKAIBQD]AAAACOFYAAGABMHMABDABMHMABDEBMHNAABABMHNAABEBIB[H`GKD[ACBLCIAACEBLD[HRHGAACACOFYAAH]BQB]AGCHBIAABKAIBADNAACECOFYAAGABLCIAACEBLD[HRGIAACABADMABEMBIBNAAAQBKBNAAAUCOFYAAGABIBMABEQBKBMABEUCOFYAAGAB\D]AEABAACKBIB[HSBWBKAIBQD]AAAACOFYAAGABIBMABEYBKBMABE]COFYAAGAB\D]ABABAACKBIB[HREABKAIBADNAACECOFYAAGAB\D]ABABAACCBIB[HRDMBKAIBADNAAB]COFYAAGABIBMABFABKBMABFECOFYAAGAB\D]AEABAAB[BIB[HRHCBKAIBADNAABUCOFYAAGABIBMABAQBKBMABAUCOFYAAGAB\D]ABABAABSBIB[HRBMBKAIBQD]AAAACOFYAAGABLCIAABUBLD[HRA[AABQBQD]AAAABIBNAAAIBKBNAAAMCOFYAAGABLCIAAB]BLD[HRAAAABYBADMAAFMBIBNAAAQBKBNAAAUCOFYAAGABIBMABFIBKBMABFMCOFYAAGAB\D]AEABAACCBIB[HRDOBKAIBADNAAB]COFYAAGAB\D]ABABAAB[BIB[HQGEBKAIBADNAABUCOFYAAGABIBMAADYBKBMAAD]COFYAAGABAB[HRCACOHYAAFOAAAAAAAA| quicksort-macro-IMSUBR (.LEFT) NTH
   6 LEFT-VAL SET (.RIGHT) RIGHT-VAL (.RIGHT .LEFT-VAL) PUT (.LEFT .RIGHT-VAL)
   7 RETURN <+ .RIGHT 1> .RIGHT <G=? .LEFT .RIGHT> COND (.PARTITION) (<RETURN>) <SET
   8 LEFT <+ .LEFT 1>> REPEAT <SET RIGHT <- .RIGHT 1>> (1) + RIGHT:FIX - LEFT:FIX
   9 PARTITION L? (<1 .A> <1 .B>) (<PUTREST .C .A> <SET A <REST <SET C .A>>> <COND (
  10 <EMPTY? .A> <PUTREST .C .B> <RETURN>)>) ((ELSE <PUTREST .C .B> <SET B <REST <
  11 SET C .B>>> <COND (<EMPTY? .B> <PUTREST .C .A> <RETURN>)>)) (.B) C (<SET B <
  12 REST .B>> <COND (<EMPTY? .B> <PUTREST .C .A> <RETURN T .PROG-ACT>)>) ELSE (.A)
  13 (<SET A <REST .A>> <COND (<EMPTY? .A> <PUTREST .C .B> <RETURN T .PROG-ACT>)>) (
  14 C:LIST) PROG-ACT PROG (.LEN/2) .B B (.A .LEN/2) A (()) PUTREST (<- .LEN/2 1>)
  15 REST (2) / LEN/2:FIX BIND L=? LIST ]>
  16 <SETG \1aQUICKSORT-MACRO #MSUBR [quicksort-macro-IMSUBR QUICKSORT-MACRO ("VALUE"
  17 FORM "QUOTE" ATOM "QUOTE" <OR LVAL ADECL> "QUOTE" <OR LVAL ADECL> "QUOTE" <OR
  18 LVAL ADECL> "QUOTE" ATOM ATOM "ARGS" <LIST [REST <OR LVAL ADECL>]>) 0]>
  19 <COND (<AND <GASSIGNED? QUICKSORT-MACRO> <NOT <TYPE? ,QUICKSORT-MACRO MACRO>>>
  20 <SETG QUICKSORT-MACRO <CHTYPE (,QUICKSORT-MACRO) MACRO>>)>
  21 <SETG \1aMERGESORT-MACRO #MSUBR [quicksort-macro-IMSUBR MERGESORT-MACRO ("VALUE"
  22 FORM "QUOTE" ATOM "QUOTE" <OR LVAL ADECL> "QUOTE" <OR LVAL ADECL> "QUOTE" ATOM)
  23  2388]>
  24 <COND (<AND <GASSIGNED? MERGESORT-MACRO> <NOT <TYPE? ,MERGESORT-MACRO MACRO>>>
  25 <SETG MERGESORT-MACRO <CHTYPE (,MERGESORT-MACRO) MACRO>>)>
  26 <ENDPACKAGE>