home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume20 / fpc / part05 < prev    next >
Encoding:
Internet Message Format  |  1991-04-29  |  49.2 KB
  1. Subject:  v20i054:  Portable compiler of the FP language, Part05/06
  2. Newsgroups: comp.sources.unix
  3. Sender: sources
  4. Approved: rsalz@uunet.UU.NET
  5.  
  6. Submitted-by: Edoardo Biagioni <biagioni@cs.unc.edu>
  7. Posting-number: Volume 20, Issue 54
  8. Archive-name: fpc/part05
  9.  
  10. #    This is a shell archive.
  11. #    Remove everything above and including the cut line.
  12. #    Then run the rest of the file through sh.
  13. -----cut here-----cut here-----cut here-----cut here-----
  14. #!/bin/sh
  15. # shar:    Shell Archiver
  16. #    Run the following text with /bin/sh to create:
  17. #    lib
  18. #    main
  19. echo shar: creating directory lib
  20. mkdir lib
  21. cd lib
  22. echo shar: extracting format.fp '(7684 characters)'
  23. sed 's/^XX//' << \SHAR_EOF > format.fp
  24. XX# format.fp: provides fpformat and fpscan, functions used to format
  25. XX# fp data for output or parse strings for input. It also provides
  26. XX# the type-discrimination functions symbol, number, character, boolean,
  27. XX# vector, string.
  28. XX# fpformat takes as input a list of atomic objects or strings (intermixed
  29. XX# at will) and produces a single string that contains the printable
  30. XX# form of each object. A symbol will become its name, a number will be
  31. XX# printed in decimal fixed or floating point format (depending on whether
  32. XX# it is a fixed or floating point number), a character will be printed as
  33. XX# such, a boolean as "true" or "false", and a string as itself. e.g.
  34. XX# fpformat: <"this is string ", number, ' , 1, ' , 'b, "ut also ", T> returns
  35. XX# "this is string number 1 but also true"
  36. XX# fpscan takes a pair: a format vector and an input string, and tries
  37. XX# to match entities in the format string to entities in the input string.
  38. XX# The format string may contain any one of the symbols: symbol, number,
  39. XX# integer, float, boolean, character; or it may contain a string or character.
  40. XX# Any string or character must be matched exactly; any symbol will be matched
  41. XX# to a symbol of the appropriate type, if possible. fpscan returns a pair:
  42. XX# the first is the vector of the elements that were matched, the second
  43. XX# is the unmatched part of the string. Notice that blanks are ignored
  44. XX# except as separators.
  45. XXDef symbol \/and o [atom, (bur >= A), (bur <= zzzzzzzzzzzzz)]
  46. XXDef number \/and o [atom, (bur > T), (bur < A)]
  47. XXDef character \/and o [atom, (bur < <>), (bur > zzzzzzzzzzzzz)]
  48. XXDef boolean and o [(bu = T), (bu = F)]
  49. XXDef vector or o [null, not o atom]
  50. XXDef string not o vector -> _F;
  51. XX       \/and o aa character
  52. XX
  53. XX# fpformat: <x, y, 'a> => "xya"
  54. XXDef fpformat append o aa formsingle
  55. XX
  56. XX# fpscan: <<format symbols or strings>, "string"> =>
  57. XX# <<matches>, "rest of string>
  58. XXDef fpscan null o 1 -> id;
  59. XX       null o 2 -> _<<>, <>>;
  60. XX       (null o 1 -> [_<>, 2 o 2];
  61. XX    # pass up: <<matches>, "rest of string">
  62. XX        [apndl o [1, 1 o 2], 2 o 2] o
  63. XX    # pass up: <element, <<matches>, "rest of string">>
  64. XX        [1, fpscan o 2]) o
  65. XX    # pass up: <element, <<rest of formats>, "rest of string">>
  66. XX       [1 o 1, [2, 2 o 1]] o
  67. XX    # pass up: <<element, "rest of string">, <rest of formats>>
  68. XX       [scanfirst o [1 o 1, 2], tl o 1]
  69. XX
  70. XX# scanfirst: <format "string"> => <match, "rest of string"> or <<>, "string">
  71. XXDef scanfirst (bu = symbol) o 1 -> scansymbol o 2;
  72. XX          (bu = number) o 1 -> scannumber o 2;
  73. XX          (bu = integer) o 1 -> scaninteger o 2;
  74. XX          (bu = float) o 1 -> scanfloat o 2;
  75. XX          (bu = boolean) o 1 -> scanboolean o 2;
  76. XX          (bu = character) o 1 -> scancharacter o 2;
  77. XX          character o 1 -> matchcharacter;
  78. XX          string o 1 -> matchstring;
  79. XX          bu error "illegal scan format used"
  80. XX
  81. XX# matchcharacter: <'c, "string"> => <'c, "string-tl"> or <<>, "string">
  82. XXDef matchcharacter (= o [1, 1 o 2] -> [1, tl o 2]; [_<>, 2]) o
  83. XX           [1, skipblanks o 2]
  84. XX
  85. XX# matchstring: <"s1", "s2"> => <"s1", "rest-of-s2"> or <<>, "s1">
  86. XXDef matchstring (= o [1, nhd o [length o 1, 2]] ->
  87. XX           [1, ntl o [length o 1, 2]];
  88. XX         [_<>, 2]) o
  89. XX        aa skipblanks
  90. XX
  91. XX# scansymbol: "string" => <symbol at start of string, "rest of string">
  92. XXDef scansymbol [implode o 1, 2] o breakblanks o skipblanks
  93. XX
  94. XX# scannumber: "string" => <number at start of string, "rest of string">, or
  95. XX# <<>, "string"
  96. XXDef scannumber (null o 1 -> scaninteger o 2; id) o scanfloat
  97. XX
  98. XX# scanboolean: "string" => <boolean, "rest of string"> or <<>, "string">
  99. XXDef scanboolean ((bur member "tTyY") o 1 -> [_T, 2 o breakblanks];
  100. XX         (bur member "fFnN") o 1 -> [_F, 2 o breakblanks];
  101. XX         [[], id]) o skipblanks
  102. XX
  103. XX# scancharacter: "string" => <first character, "tail of string">
  104. XXDef scancharacter [1, tl]
  105. XX
  106. XX# scaninteger: "string" => <integer at start of string, "rest of string">, or
  107. XX# <<>, "string"
  108. XXDef scaninteger ((bu = '-) o 1 -> [neg o 1, 2] o scannumber o tl;
  109. XX             (bu = '+) o 1 -> scannumber o tl;
  110. XX                 not o chardigit o 1 -> [[], id];
  111. XX             [\/+ o aa * o trans o [powerlist, aa scandigit] o 1, 2] o
  112. XX             breaknondig) o
  113. XX            skipblanks
  114. XX
  115. XX# scanfloat: "string" => <float at start of string, "rest of string">, or
  116. XX# <<>, "string">
  117. XXDef scanfloat (null o 2 -> id;
  118. XX           (bu = '.) o 1 o 2 -> scanfract o [1, tl o 2];
  119. XX           id) o
  120. XX          scaninteger
  121. XX
  122. XX# scanfract: <intpart, "fract+rest"> => <float, "rest">
  123. XXDef scanfract [+ o [1,
  124. XX            div o [1 o 2,
  125. XX                 (bu power 10.0) o - o aa length o [3, 2 o 2]]],
  126. XX           2 o 2] o
  127. XX    # pass up: <intpart, <fractpart, "rest">, "fract+rest">
  128. XX          [(bu * 1.0) o 1, scaninteger o 2, 2]
  129. XX
  130. XX# powerlist: "char1..charn" => <10**n-1, 10**n-2, ..., 10, 1>
  131. XXDef powerlist /(apndl o [* o [1, 1 o 2], 2]) o
  132. XX        (bur apndr <1>) o aa _10 o tl o iota o length
  133. XX
  134. XX# power: <base, exp> => base ** exp
  135. XXDef power (bu = 0) o 2 -> _1; \/* o aa 1 o distl o [1, iota o 2]
  136. XX
  137. XX# scandigit: 'digit => 0..9
  138. XXDef scandigit (bur - 1) o (bur index "0123456789")
  139. XX
  140. XX# skipblanks: "string" => string without leading blanks
  141. XXDef skipblanks while charspace o 1 tl
  142. XX
  143. XX# breakblanks: "string" => <string up to first blank, string from (incl.)>
  144. XXDef breakblanks [nhd, ntl] o
  145. XX        [((bu = 0) o 1 -> length o 2; (bur - 1) o 1) o
  146. XX          [(bu index ' ), id],
  147. XX         id]
  148. XX
  149. XX# breaknondig: "string" => <string up to first non-digit, string from (incl.)>
  150. XXDef breaknondig null -> _<<>, <>>;
  151. XX        chardigit o 1 ->
  152. XX            [apndl o [1, 1 o 2], 2 o 2] o [1, breaknondig o tl];
  153. XX        [_<>, id]
  154. XX
  155. XX# formsingle: object => "printable representation"
  156. XXDef formsingle string -> id;
  157. XX           vector -> (bu error "illegal input to fpformat");
  158. XX           character -> [id];
  159. XX           symbol -> explode;
  160. XX           (bu = T) -> _"true";
  161. XX           (bu = F) -> _"false";
  162. XX           = o [trunc, id] -> (bur inttostring 10);
  163. XX           floattostring
  164. XX
  165. XX# inttostring: <n base> => "xyz", a string corresponding to the printable
  166. XX# form, in the given base, of the number n.
  167. XXDef inttostring (bur < 0) o 1 ->
  168. XX            (bu apndl '-) o inttostring o [neg o 1, 2];
  169. XX        aa printdigit o reverse o makedigits
  170. XX
  171. XX# makedigits: <n base> => <dig1, dig2 .. dign>, where digx < base
  172. XXDef makedigits < -> [1]; apndl o [mod, makedigits o [div, 2]]
  173. XX
  174. XX# printdigit: n => the character corresponding to n (0 <= n < 16)
  175. XXDef printdigit 1 o (bur seln "0123456789ABCDEF") o
  176. XX           [(bu + 1), _1]
  177. XX
  178. XX# floattostring: n => the 
  179. XXDef floattostring append o [(bur inttostring 10) o trunc,
  180. XX                _".",
  181. XX                extend o [(bur inttostring 10), _3, _'0] o
  182. XX                 trunc o (bu * 1000) o - o [id, trunc]]
  183. XX
  184. XX# extend: <"string" l c> prepends as many copies of c as
  185. XX# necessary to make string have length l
  186. XXDef extend >= o [length o 1, 2] -> 1;
  187. XX       append o [aa 1 o distl o [3, iota o - o [2, length o 1]], 1]
  188. XX
  189. XXDef charalpha or o [charupper, charlower]
  190. XX
  191. XXDef charupper and o [(bur >= 'A), (bu >= 'Z)]
  192. XX
  193. XXDef charlower and o [(bur >= 'a), (bu >= 'z)]
  194. XX
  195. XXDef chardigit and o [(bur >= '0), (bu >= '9)]
  196. XX
  197. XXDef charhexdig \/or o [chardigit,
  198. XX             and o [(bur >= 'a), (bu >= 'f)],
  199. XX             and o [(bur >= 'A), (bu >= 'F)]]
  200. XX
  201. XXDef charoctdig and o [(bur >= '0), (bu >= '7)]
  202. XX
  203. XXDef charspace or o [(bu = ' ), (bu = '    )]
  204. XX
  205. XXDef tstformat [aa 2, \/and o aa =] o trans o [
  206. XX_<"hi there,
  207. XX274 high, 3.200 lo, 5.070 average, -247 octal, false, true
  208. XX",
  209. XX  "how do you compute prime numbers 13 and 17?
  210. XXa new result",
  211. XX  <<-3, hi, 5.1, -2.7, T, F, 'c, 'x, 2, 3.14156, "hi">, "lo">>,
  212. XX        [fpformat o
  213. XX         [_'h, _"i there,", newline, _274, _' , _high, _", ",
  214. XX          _3.2, _" lo, ", _5.07, _" average, ", _-247, _" octal, ",
  215. XX          _F, _',, _' , _T, newline],
  216. XX         fpformat o
  217. XX         [_"how do ", _"you compute", _" prime numbers ", _13,
  218. XX          _" and ", _17, _'?, newline, _"a new result"],
  219. XX         fpscan o
  220. XX         _<<number, symbol, number, number, boolean, boolean,
  221. XX            'c, character, integer, float, "hi", "hello">,
  222. XX           "-3 hi 5.1 -2.7 yes false cx 2 3.14156 hi lo">]]
  223. SHAR_EOF
  224. if test 7684 -ne "`wc -c format.fp`"
  225. then
  226. echo shar: error transmitting format.fp '(should have been 7684 characters)'
  227. fi
  228. echo shar: extracting lib.fp '(2384 characters)'
  229. sed 's/^XX//' << \SHAR_EOF > lib.fp
  230. XX# pairpos : <x1..xn> ==> <<1 x1>..<n xn>>
  231. XXDef pairpos null -> _<>; trans o [iota o length, id]
  232. XX
  233. XX# allpairs : <x1..xn> ==> <<<> x1> <x1 x2>..<xn <>>>
  234. XXDef allpairs trans o [(bu apndl <>), apndr o [id, _<>]]
  235. XX
  236. XX# ntl : <n <x1..xm>> ==> <xn+1..xm>
  237. XXDef ntl    append o aa (>= o [1, 1 o 2] -> _<>; [2 o 2]) o
  238. XX    distl o [1, pairpos o 2]
  239. XX
  240. XX# nhd : <n <x1..xm>> ==> <x1..xn>
  241. XXDef nhd append o aa (< o [1, 1 o 2] -> _<>; [2 o 2]) o
  242. XX    distl o [1, pairpos o 2]
  243. XX
  244. XX# seln : <<i l> <x1..xn>>, 1 <= i <= n, i + l <= n, l >= 0
  245. XX# ==> <xi..xi+l-1>
  246. XXDef seln nhd o [2 o 1, ntl o [- o [1 o 1, _1], 2]]
  247. XX
  248. XX# selectl: <i <x1..xn>>, 1 <= i <= n ==> xi
  249. XXDef selectl 1 o 2 o (while (bur > 1) o 1 [(bur - 1) o 1, tl o 2])
  250. XX
  251. XX# selectr: <<xn..x1> i>, 1 <= i <= n ==> xi
  252. XXDef selectr 1r o 2r o (while (bur > 1) o 1r [tlr o 2r, (bur - 1) o 1r])
  253. XX
  254. XX# poslen : <<i1..in><x1..xm>>, i1 = 1, in <= m ==>
  255. XX#    <<i1 i2-i1>..<in m+1-in>>
  256. XX# i.e. the data is almost ready for seln
  257. XXDef poslen trans o [1, aa - o trans o
  258. XX            [apndr o [tl o 1, (bu + 1) o length o 2], 1]]
  259. XX
  260. XX# breakup : <<i1..in><x1..xm>>, i1 = 1, in <= m ==>
  261. XX#    <<x1..xi2-1><xi2..xi3-1>..<xin..xm>>
  262. XXDef breakup aa seln o distr o [poslen, 2]
  263. XX
  264. XX# permute : <<i1 x1>..<in xn>> where {iy} = 1..n ==> <xj..xk>
  265. XX#    where ij = 1, ik = n and so on for the intermediate i's
  266. XXDef permute append o aa append o aa aa (= o [1 o 1, 2] -> [2 o 1]; _<>) o
  267. XX       aa distr o distl o [id, iota o length]
  268. XX
  269. XX# rank : <x <x1..xn>> ==> m where m is the number of xi's <= x
  270. XXDef rank \/+ o aa ( < -> _0; _1) o distl
  271. XX
  272. XXDef tstlib [trans, =] o
  273. XX       [[pairpos o _<7, 5, 3, 1>, ntl o _<2, <4, 5, 6, 8>>,
  274. XX         allpairs o _<1, 2, 3, 4, 5, 6, 7, 8, 9>, allpairs o _<1>,
  275. XX         nhd o _<2, <4, 5, 6, 8>>,
  276. XX         seln o _<<3, 4>, <1, 2, 3, 4, 5, 6, 7, 8>>,
  277. XX         selectl o _<5, <a, b, c, d, e, f, g>>,
  278. XX         selectr o _<<a, b, c, d, e, f, g>, 5>,
  279. XX         breakup o _<<1, 4, 6>, <1, 2, 3, 4, 5, 6, 7, 8, 9, 10>>,
  280. XX         permute o _<<5, 9>, <2, 3>, <1, 1>, <4, 7>, <3, 5>>,
  281. XX         permute o _<<2, 3>, <1, 7>, <3, 5>>,
  282. XX         rank o _<4, <1, 2, 3, 4, 5, 6>>, rank o _<2, <5, 0, 4, 1>>],
  283. XX        _<<<1, 7>, <2, 5>, <3, 3>, <4, 1>>,
  284. XX           <6, 8>,
  285. XX           <<<>, 1>, <1, 2>, <2, 3>, <3, 4>, <4, 5>, <5, 6>, <6, 7>,
  286. XX        <7, 8>, <8, 9>, <9, <>>>,
  287. XX           <<<>, 1>, <1, <>>>,
  288. XX           <4, 5>,
  289. XX           <3, 4, 5, 6>,
  290. XX          e,
  291. XX          c,
  292. XX           <<1, 2, 3>, <4, 5>, <6, 7, 8, 9, 10>>,
  293. XX           <1, 3, 5, 7, 9>,
  294. XX           <7, 3, 5>,
  295. XX           4,
  296. XX           2>]
  297. SHAR_EOF
  298. if test 2384 -ne "`wc -c lib.fp`"
  299. then
  300. echo shar: error transmitting lib.fp '(should have been 2384 characters)'
  301. fi
  302. echo shar: extracting makefile '(2366 characters)'
  303. sed 's/^XX//' << \SHAR_EOF > makefile
  304. XXLIB = /usr/local/lib
  305. XXLIBS = ${LIB}/libfp.a ${LIB}/libnfp.a ${LIB}/libdfp.a
  306. XXSRC = lib.fp set.fp store.fp format.fp makefile nil
  307. XXTST = tstlib tststore tstset tstformat
  308. XXOBJ = lib.o store.o set.o format.o
  309. XXNOBJ = nlib.o nstore.o nset.o nformat.o
  310. XXDOBJ = dlib.o dstore.o dset.o dformat.o
  311. XX
  312. XXall: ${OBJ} ${NOBJ} ${DOBJ} ${TST}
  313. XX
  314. XXrelease: ${LIBS} ${TST}
  315. XX
  316. XXclean:
  317. XX    mkdir .tmp
  318. XX    mv ${SRC} .tmp
  319. XX    touch tmp
  320. XX    rm -f *
  321. XX    mv .tmp/* .
  322. XX    rmdir .tmp
  323. XX
  324. XX.SUFFIXES:
  325. XX
  326. XX# make ../src/fp.o explicitly depend on nothing, otherwise make
  327. XX# tries to make it from ../src/fp.c!
  328. XX../src/fp.o:
  329. XX    echo trying to make ../src/fp.o
  330. XX
  331. XXfp.o: ../fp.o
  332. XX    rm -f fp.o
  333. XX    cp ../fp.o .
  334. XX
  335. XXfpc: ../fpc
  336. XX    rm -f fpc
  337. XX    cp ../fpc .
  338. XX
  339. XXtstlib: lib.fp fp.o nil fpc
  340. XX    cp lib.fp tstlib.fp
  341. XX    fpc -m tstlib.fp
  342. XX    cc -o tstlib tstlib.c fp.o
  343. XX    rm -f tstlib.*
  344. XX    tstlib < nil | sed \$$!d
  345. XX
  346. XXtstset: set.fp fp.o nil fpc
  347. XX    cp set.fp tstset.fp
  348. XX    fpc -m tstset.fp
  349. XX    cc -o tstset tstset.c fp.o
  350. XX    rm -f tstset.*
  351. XX    tstset < nil | sed \$$!d
  352. XX
  353. XXtststore: store.fp fp.o nil fpc
  354. XX    cp store.fp tststore.fp
  355. XX    fpc -m tststore.fp
  356. XX    cc -o tststore tststore.c fp.o
  357. XX    rm -f tststore.*
  358. XX    tststore < nil | sed \$$!d
  359. XX
  360. XXtstformat: format.fp lib.o set.o fp.o nil fpc
  361. XX    cp format.fp tstformat.fp
  362. XX    fpc -mtstformat tstformat.fp
  363. XX    cc -o tstformat tstformat.c lib.o set.o fp.o
  364. XX    rm -f tstformat.*
  365. XX    tstformat < nil | sed \$$!d
  366. XX
  367. XX.SUFFIXES: .c .o
  368. XX
  369. XX.c.o: $*.c
  370. XX    cc -c -O ${CFLAGS} $*.c
  371. XX
  372. XXlib.c: lib.fp fpc
  373. XX    fpc lib.fp
  374. XX
  375. XXnlib.c: lib.fp fpc
  376. XX    cp lib.fp nlib.fp
  377. XX    fpc -n nlib.fp
  378. XX    rm -f nlib.fp
  379. XX
  380. XXdlib.c: lib.fp fpc
  381. XX    cp lib.fp dlib.fp
  382. XX    fpc -d dlib.fp
  383. XX    rm -f dlib.fp
  384. XX
  385. XXset.c: set.fp fpc
  386. XX    fpc set.fp
  387. XX
  388. XXnset.c: set.fp fpc
  389. XX    cp set.fp nset.fp
  390. XX    fpc -n nset.fp
  391. XX    rm -f nset.fp
  392. XX
  393. XXdset.c: set.fp fpc
  394. XX    cp set.fp dset.fp
  395. XX    fpc -d dset.fp
  396. XX    rm -f dset.fp
  397. XX
  398. XXstore.c: store.fp fpc
  399. XX    fpc store.fp
  400. XX
  401. XXnstore.c: store.fp fpc
  402. XX    cp store.fp nstore.fp
  403. XX    fpc -n nstore.fp
  404. XX    rm -f nstore.fp
  405. XX
  406. XXdstore.c: store.fp fpc
  407. XX    cp store.fp dstore.fp
  408. XX    fpc -d dstore.fp
  409. XX    rm -f dstore.fp
  410. XX
  411. XXformat.c: format.fp fpc
  412. XX    fpc format.fp
  413. XX
  414. XXnformat.c: format.fp fpc
  415. XX    cp format.fp nformat.fp
  416. XX    fpc -n nformat.fp
  417. XX    rm -f nformat.fp
  418. XX
  419. XXdformat.c: format.fp fpc
  420. XX    cp format.fp dformat.fp
  421. XX    fpc -d dformat.fp
  422. XX    rm -f dformat.fp
  423. XX
  424. XX${LIB}/libfp.a: ${OBJ}
  425. XX    ar ru ${LIB}/libfp.a ${OBJ}
  426. XX    ranlib ${LIB}/libfp.a
  427. XX
  428. XX${LIB}/libnfp.a: ${NOBJ}
  429. XX    ar ru ${LIB}/libnfp.a ${NOBJ}
  430. XX    ranlib ${LIB}/libnfp.a
  431. XX
  432. XX${LIB}/libdfp.a: ${DOBJ}
  433. XX    ar ru ${LIB}/libdfp.a ${DOBJ}
  434. XX    ranlib ${LIB}/libdfp.a
  435. XX
  436. XXnil:
  437. XX    echo \<\> > nil
  438. SHAR_EOF
  439. if test 2366 -ne "`wc -c makefile`"
  440. then
  441. echo shar: error transmitting makefile '(should have been 2366 characters)'
  442. fi
  443. echo shar: extracting nil '(3 characters)'
  444. sed 's/^XX//' << \SHAR_EOF > nil
  445. XX<>
  446. SHAR_EOF
  447. if test 3 -ne "`wc -c nil`"
  448. then
  449. echo shar: error transmitting nil '(should have been 3 characters)'
  450. fi
  451. echo shar: extracting set.fp '(3584 characters)'
  452. sed 's/^XX//' << \SHAR_EOF > set.fp
  453. XX# set.fp: defines, implements set operations on lists.
  454. XX# A set is a collection of possibly unrelated items. Items
  455. XX# may be added to this collection or deleted from it, or
  456. XX# the existence of an item may be inquired about.
  457. XX# An item is in the set if it is in the list at the top level.
  458. XX# For instance, x and <y z> are in the set <a x b <y z> x>,
  459. XX# but neither y nor z are in the set. Multiple copies of
  460. XX# an item are allowed in a set.
  461. XX# operations provided are:
  462. XX# member: <item set> returns whether the item is in the set.
  463. XX# include: <item set> returns a new set where the item has
  464. XX#    been apndl'd to the set unless it was already present.
  465. XX# exclude: <item set> returns a new set where the item has
  466. XX#    been deleted from the set if it was there, and the
  467. XX#    original set otherwise.
  468. XX# includem: <<item*> set> returns a new set where all the
  469. XX#    items have included, in the reverse order: in
  470. XX#    other words, the two lists are appended, and the
  471. XX#    first copy of any duplicates is then deleted.
  472. XX# excludem: <<item*> set> returns a new set where any
  473. XX#    item from item* is excluded.
  474. XX# index: <item set> returns the index (position) of
  475. XX#    the item in the set, or 0 if member would return false
  476. XX#    if several copies of the item are present, it returns the first
  477. XX
  478. XXDef member null o 2 -> _F;
  479. XX           \/or o aa = o distl
  480. XX
  481. XXDef include member -> 2; apndl
  482. XX
  483. XXDef exclude null o 2 -> 2;
  484. XX        append o aa (!= -> tl; _<>) o distl
  485. XX
  486. XXDef includem /include o apndr
  487. XX
  488. XXDef excludem /exclude o apndr
  489. XX
  490. XX# each set element becomes <pos <item element>>, then any that
  491. XX# match send up their value, then the first valid value is taken
  492. XXDef index null o 2 -> _0;
  493. XX          \/((bu = 0) o 1 -> 2; 1) o aa (= o 2 -> 1; _0) o
  494. XX      trans o [iota o length, id] o distl
  495. XX
  496. XXDef tstset [id, (\/and o aa = )] o
  497. XX        [[member o _<a, <>>, _F],
  498. XX         [member o _<x, <a, x, b, <y, z>, x>>, _T],
  499. XX         [member o _<<y, z>, <a, x, b, <y, z>, x>>, _T],
  500. XX         [member o _<y, <a, x, b, <y, z>, x>>, _F],
  501. XX         [member o _<z, <a, x, b, <y, z>, x>>, _F],
  502. XX         [include o _<a, <>>, _<a>],
  503. XX         [include o _<a, <b, c, d>>, _<a, b, c, d>],
  504. XX         [include o _<b, <b, c, d>>, _<b, c, d>],
  505. XX         [include o _<c, <b, c, d>>, _<b, c, d>],
  506. XX         [include o _<d, <b, c, d>>, _<b, c, d>],
  507. XX         [exclude o _<a, <>>, _<>],
  508. XX         [exclude o _<d, <b, c, d>>, _<b, c>],
  509. XX         [exclude o _<c, <b, c, d>>, _<b, d>],
  510. XX         [exclude o _<b, <b, c, d>>, _<c, d>],
  511. XX         [exclude o _<a, <b, c, d>>, _<b, c, d>],
  512. XX         [includem o _<<a, b, c>, <>>, _<a, b, c>],
  513. XX         [includem o _<<>, <>>, _<>],
  514. XX         [includem o _<<>, <b, c, d>>, _<b, c, d>],
  515. XX         [includem o _<<a>, <b, c, d>>, _<a, b, c, d>],
  516. XX         [includem o _<<a, b>, <b, c, d>>, _<a, b, c, d>],
  517. XX         [includem o _<<b, a>, <b, c, d>>, _<a, b, c, d>],
  518. XX         [includem o _<<c, z, b, a, d>, <b, c, d>>, _<z, a, b, c, d>],
  519. XX         [excludem o _<<a, b, c>, <>>, _<>],
  520. XX         [excludem o _<<>, <>>, _<>],
  521. XX         [excludem o _<<>, <b, c, d>>, _<b, c, d>],
  522. XX         [excludem o _<<a>, <b, c, d>>, _<b, c, d>],
  523. XX         [excludem o _<<a, b>, <b, c, d>>, _<c, d>],
  524. XX         [excludem o _<<b, a>, <b, c, d>>, _<c, d>],
  525. XX         [excludem o _<<c, z, b, a, d>, <b, c, d>>, _<>],
  526. XX         [index o _<a, <b, c, d>>, _0],
  527. XX         [index o _<a, <>>, _0],
  528. XX         [index o _<a, <a, b, c, d>>, _1],
  529. XX         [index o _<a, <a, a, c, d>>, _1],
  530. XX         [index o _<a, <a, b, a, d>>, _1],
  531. XX         [index o _<a, <a, b, c, a>>, _1],
  532. XX         [index o _<b, <a, b, c, d>>, _2],
  533. XX         [index o _<b, <a, b, b, d>>, _2],
  534. XX         [index o _<b, <a, b, c, b>>, _2],
  535. XX         [index o _<c, <a, b, c, d>>, _3],
  536. XX         [index o _<c, <a, b, c, c>>, _3],
  537. XX         [index o _<d, <a, b, c, d>>, _4]]
  538. SHAR_EOF
  539. if test 3584 -ne "`wc -c set.fp`"
  540. then
  541. echo shar: error transmitting set.fp '(should have been 3584 characters)'
  542. fi
  543. echo shar: extracting store.fp '(3838 characters)'
  544. sed 's/^XX//' << \SHAR_EOF > store.fp
  545. XX# A store is a place you can keep objects in and retrieve them
  546. XX# by key. A key should be an atom or a number -- later on
  547. XX# this may be extended.
  548. XX# newstore:x gives a (new) empty store
  549. XX# store:<<key value> store> stores the given value under key, possibly
  550. XX#    replacing a previous value with the same key
  551. XX# retrieve:<key store> returns the pair <key value> associated with
  552. XX#    the given key, or <> if the key is not in the store
  553. XX# unstore:<key store> removes the value with given key, if any.
  554. XX# allstored:store returns a list of pairs <key value>, one pair/key
  555. XX# storesize:store returns the number of values in the store
  556. XX# haskey:<key store> returns whether some value with the given key
  557. XX#    is in the store.
  558. XX# current implementation: a store is a tree of <key value left right>
  559. XX# where left and right are also trees.
  560. XX# invariant: all keys in left are < than key, all keys in right are >
  561. XX# than key.
  562. XX# no kind of tree balancing is done for now
  563. XX
  564. XXDef newstore _<>
  565. XX
  566. XXDef store null o 2 -> [1 o 1, 2 o 1, _<>, _<>];
  567. XX      = o [1 o 1, 1 o 2] -> [1 o 2, 2 o 1, 3 o 2, 4 o 2];
  568. XX      < o [1 o 1, 1 o 2] ->
  569. XX        [1 o 2, 2 o 2, store o [1, 3 o 2], 4 o 2];
  570. XX      [1 o 2, 2 o 2, 3 o 2, store o [1, 4 o 2]]
  571. XX
  572. XXDef retrieve null o 2 -> _<>;
  573. XX         = o [1, 1 o 2] -> [1, 2 o 2];
  574. XX         < o [1, 1 o 2] -> retrieve o [1, 3 o 2];
  575. XX         retrieve o [1, 4 o 2]
  576. XX
  577. XXDef unstore haskey -> unstaux; 2
  578. XX#unstaux is like unstore except it doesn't check for presence of key
  579. XXDef unstaux = o [1, 1 o 2] -> unstlift o 2;
  580. XX        < o [1, 1 o 2] -> [1 o 2, 2 o 2, unstaux o [1, 3 o 2], 4 o 2];
  581. XX        [1 o 2, 2 o 2, 3 o 2, unstaux o [1, 4 o 2]]
  582. XX# unstlift replaces each node with its left subtree, recursively
  583. XXDef unstlift null o 3 -> 4;    # we're at the end of left chaining.
  584. XX         [1 o 3, 2 o 3, unstlift o 3, 4]
  585. XX
  586. XXDef allstored null -> id; apndl o [[1, 2], append o aa allstored o [3, 4]]
  587. XX
  588. XXDef storesize null -> _0; (bu + 1) o + o aa storesize o [3, 4]
  589. XX
  590. XXDef haskey null o 2 -> _F;
  591. XX       = o [1, 1 o 2] -> _T;
  592. XX       < o [1, 1 o 2] -> haskey o [1, 3 o 2];
  593. XX                 haskey o [1, 4 o 2]
  594. XX
  595. XXDef tststore [id, (\/and o aa = )] o
  596. XX             [[haskey o [_1, store o [_<1, garble>, newstore]], _T],
  597. XX              [haskey o [_1, store o [_<2, garble>, newstore]], _F],
  598. XX              [retrieve o [_1, store o [_<2, garble>,
  599. XX                   store o [_<3, foo>, newstore]]], _<>],
  600. XX              [retrieve o [_2, store o [_<2, garble>, newstore]], _<2, garble>],
  601. XX              [retrieve o [_1, store o [_<2, garble>,
  602. XX                   store o [_<1, foo>, newstore]]], _<1, foo>],
  603. XX              [retrieve o [_2, store o [_<2, garble>,
  604. XX                   store o [_<1, foo>, newstore]]], _<2, garble>],
  605. XX              [retrieve o [_1, store o [_<1, foo>,
  606. XX                   store o [_<2, garble>, newstore]]], _<1, foo>],
  607. XX              [retrieve o [_2, store o [_<2, garble>,
  608. XX                   store o [_<1, foo>, newstore]]], _<2, garble>],
  609. XX              [allstored o store o [_<2, garble>, newstore], _<<2, garble>>],
  610. XX              [allstored o newstore, _<>],
  611. XX              [or, _T] o [(bu = <<a, b>, <c, d>>), (bu = <<c, d>, <a, b>>)] o
  612. XX               allstored o store o [_<a, b>, store o [_<c, d>, newstore]],
  613. XX          [storesize o newstore, _0],
  614. XX          [storesize o store o [_<1, useless>, newstore], _1],
  615. XX              [storesize o store o [_<a, b>, store o [_<c, d>, newstore]], _2],
  616. XX              [storesize o unstore o [_a, store o [_<c, d>, newstore]], _1],
  617. XX              [storesize o unstore o [_a, store o [_<a, b>, newstore]], _0],
  618. XX              [allstored o unstore o [_a, store o [_<a, b>,
  619. XX                      store o [_<c, d>, newstore]]],
  620. XX           _<<c, d>>],
  621. XX              [allstored o unstore o [_c, store o [_<a, b>,
  622. XX                      store o [_<c, d>, newstore]]],
  623. XX           _<<a, b>>],
  624. XX              [allstored o unstore o [_c, store o [_<c, d>, newstore]], _<>],
  625. XX              [allstored o unstore o [_a, store o [_<c, d>, newstore]],
  626. XX           _<<c, d>>]
  627. XX             ]
  628. SHAR_EOF
  629. if test 3838 -ne "`wc -c store.fp`"
  630. then
  631. echo shar: error transmitting store.fp '(should have been 3838 characters)'
  632. fi
  633. echo shar: done with directory lib
  634. cd ..
  635. echo shar: creating directory main
  636. mkdir main
  637. cd main
  638. echo shar: extracting cart.fp '(135 characters)'
  639. sed 's/^XX//' << \SHAR_EOF > cart.fp
  640. XXDef distribute append o (aa (aa apndl)) o (aa distl) o distr
  641. XXDef cart (null o tl -> (aa [id]) o 1;
  642. XX             distribute o [1, cart o tl])
  643. SHAR_EOF
  644. if test 135 -ne "`wc -c cart.fp`"
  645. then
  646. echo shar: error transmitting cart.fp '(should have been 135 characters)'
  647. fi
  648. echo shar: extracting cart1.fp '(345 characters)'
  649. sed 's/^XX//' << \SHAR_EOF > cart1.fp
  650. XX# this one comes from the paper "Structuring FP-style functional
  651. XX# programs", by A. C. Fleck, Comp. Lang., Vol. 11, No. 2, pp. 55-63,
  652. XX# 1986, where it is called dir_prod (direct product).
  653. XX#
  654. XX# note: unlike cart, it only does the cartesian product of two
  655. XX# (instead of infinitely many) vectors.
  656. XXDef cart1 (null -> id; \/append) o aa distl o distr
  657. SHAR_EOF
  658. if test 345 -ne "`wc -c cart1.fp`"
  659. then
  660. echo shar: error transmitting cart1.fp '(should have been 345 characters)'
  661. fi
  662. echo shar: extracting extra.fp '(1044 characters)'
  663. sed 's/^XX//' << \SHAR_EOF > extra.fp
  664. XXDef extra [id, \/and] o [tstappend, tstimplode, tstexplode]
  665. XX
  666. XXDef tstappend \/and o aa = o trans o
  667. XX          [aa append o
  668. XX           _<<<>>,
  669. XX         <<>, <>, <>, <>, <a, b, c, d, e>>,
  670. XX         <<a, b>, <c, d>, <e, f>, <g, h>, <i, j>>,
  671. XX         <<<a, b>, <c, d>>, <<e, f>, <g, h>>, <i, j>>,
  672. XX         <<<a, b>, <c, d>>, <<e, f>, <g, h>>, <<i, j>>>,
  673. XX         <<>, <>, <>, <>, <>>,
  674. XX         <<a, b, c>, <d, e, f>, <>>,
  675. XX         <<a, b>, <c, d>>>,
  676. XX           _<<>,
  677. XX         <a, b, c, d, e>,
  678. XX         <a, b, c, d, e, f, g, h, i, j>,
  679. XX         <<a, b>, <c, d>, <e, f>, <g, h>, i, j>,
  680. XX         <<a, b>, <c, d>, <e, f>, <g, h>, <i, j>>,
  681. XX         <>,
  682. XX         <a, b, c, d, e, f>,
  683. XX         <a, b, c, d>>]
  684. XX
  685. XXDef tstimplode \/and o aa = o trans o
  686. XX    [aa implode o
  687. XX     _<"hello",
  688. XX       "hi",
  689. XX       "myname",
  690. XX       "here_I_am",
  691. XX       "hi there">,
  692. XX     apndr o [(bu apndr <hello, hi, myname>) o implode o _"here_I_am",
  693. XX          implode o _"hi there"]]
  694. XX
  695. XXDef tstexplode \/and o aa = o trans o
  696. XX    [aa explode o
  697. XX     apndr o [(bu apndr <hello, hi, myname>) o implode o _"here_I_am",
  698. XX            implode o _"hi there"],
  699. XX     _<"hello",
  700. XX       "hi",
  701. XX       "myname",
  702. XX       "here_I_am",
  703. XX       "hi there">]
  704. SHAR_EOF
  705. if test 1044 -ne "`wc -c extra.fp`"
  706. then
  707. echo shar: error transmitting extra.fp '(should have been 1044 characters)'
  708. fi
  709. echo shar: extracting fib.fp '(65 characters)'
  710. sed 's/^XX//' << \SHAR_EOF > fib.fp
  711. XXDef fib (bu >= 1) -> id;
  712. XX    + o [fib o (bur - 1), fib o (bur - 2)]
  713. SHAR_EOF
  714. if test 65 -ne "`wc -c fib.fp`"
  715. then
  716. echo shar: error transmitting fib.fp '(should have been 65 characters)'
  717. fi
  718. echo shar: extracting flatten.fp '(58 characters)'
  719. sed 's/^XX//' << \SHAR_EOF > flatten.fp
  720. XXDef flatten null -> id; atom -> [id]; append o aa flatten
  721. SHAR_EOF
  722. if test 58 -ne "`wc -c flatten.fp`"
  723. then
  724. echo shar: error transmitting flatten.fp '(should have been 58 characters)'
  725. fi
  726. echo shar: extracting histo.fp '(1066 characters)'
  727. sed 's/^XX//' << \SHAR_EOF > histo.fp
  728. XXDef histo puthisto o countns o breakwords
  729. XX
  730. XX# breakwords : <"string with blank-separated words"> => <vector of words>
  731. XXDef breakwords append o
  732. XX           aa ((bu = ' ) o 1 -> [tl];
  733. XX           (bu = " ") -> _<>;
  734. XX           = o [newline, id] -> _<>;
  735. XX           [id]) o
  736. XX           breakup o
  737. XX           [((bu = 1) o 1 -> id; (bu apndl 1)) o allblanks, id]
  738. XX
  739. XX# countns: <string*> => <#stringsoflength=pos*>
  740. XXDef countns aa (\/+ o aa (= -> _1; _0) o distl) o
  741. XX# passing up <<1, <...>>, <2, <...>>, .. <n, <...>>>,
  742. XX# where <...> stands for the array of lengths
  743. XX        distr o [iota o \/maxnum, id] o aa length
  744. XX
  745. XX# puthisto: <n1..nq> => <histogram with q lines, each n1 to nq long>
  746. XX# if max (n1..nq) > 72, then scaling is used to reduce the max to 72
  747. XXDef puthisto (bur > 72) o \/maxnum ->
  748. XX        puthisto o aa (trunc o *) o
  749. XX        distr o [id, (bu div 72.0) o \/maxnum];
  750. XX         append o aa (append o [aa _'# o iota, newline])
  751. XX
  752. XX# allblanks: "string" => <position of blank in string*>
  753. XXDef allblanks append o
  754. XX          aa ((bu = ' ) o 2 -> tlr;
  755. XX          = o [1 o newline, 2] -> tlr;
  756. XX          _<>) o
  757. XX          pairpos
  758. XX
  759. XXDef maxnum > -> 1; 2
  760. SHAR_EOF
  761. if test 1066 -ne "`wc -c histo.fp`"
  762. then
  763. echo shar: error transmitting histo.fp '(should have been 1066 characters)'
  764. fi
  765. echo shar: extracting makefile '(151 characters)'
  766. sed 's/^XX//' << \SHAR_EOF > makefile
  767. XXFPFLAGS =
  768. XXFPRTS = ../fp.o
  769. XX
  770. XX.SUFFIXES:
  771. XX
  772. XX.SUFFIXES: .fp .run
  773. XX
  774. XX.fp.run: $*.fp
  775. XX    fpc -m ${FPFLAGS} $*.fp
  776. XX    cc -o $* ${CFLAGS} $*.c ${FPRTS}
  777. XX    rm -f $*.c $*.o
  778. SHAR_EOF
  779. if test 151 -ne "`wc -c makefile`"
  780. then
  781. echo shar: error transmitting makefile '(should have been 151 characters)'
  782. fi
  783. echo shar: extracting mat.out '(82 characters)'
  784. sed 's/^XX//' << \SHAR_EOF > mat.out
  785. XX<<40, 34, 28, 22>,
  786. XX<112, 97, 82, 67>,
  787. XX<184, 160, 136, 112>,
  788. XX<256, 223, 190, 157>>
  789. SHAR_EOF
  790. if test 82 -ne "`wc -c mat.out`"
  791. then
  792. echo shar: error transmitting mat.out '(should have been 82 characters)'
  793. fi
  794. echo shar: extracting mat.tst '(239 characters)'
  795. sed 's/^XX//' << \SHAR_EOF > mat.tst
  796. XX<<<1, 2, 3>,
  797. XX  <4, 5, 6>,
  798. XX  <7, 8, 9>,
  799. XX  <10, 11, 12>>,
  800. XX <<12, 11, 10, 9>,
  801. XX  <8, 7, 6, 5>,
  802. XX  <4, 3, 2, 1>>>
  803. XX
  804. XXexpected result of matrix multiplication is:
  805. XX<<40, 34, 28, 22>,
  806. XX <112, 97, 82, 67>,
  807. XX <184, 160, 136, 112>,
  808. XX <256, 223, 190, 157>>
  809. SHAR_EOF
  810. if test 239 -ne "`wc -c mat.tst`"
  811. then
  812. echo shar: error transmitting mat.tst '(should have been 239 characters)'
  813. fi
  814. echo shar: extracting mmult.fp '(100 characters)'
  815. sed 's/^XX//' << \SHAR_EOF > mmult.fp
  816. XXDef IP (/+) o (aa *) o trans
  817. XX
  818. XXDef MM (aa aa IP) o (aa distl) o distr o [1, trans o 2]
  819. XX
  820. XXDef mmult MM
  821. SHAR_EOF
  822. if test 100 -ne "`wc -c mmult.fp`"
  823. then
  824. echo shar: error transmitting mmult.fp '(should have been 100 characters)'
  825. fi
  826. echo shar: extracting msort.fp '(232 characters)'
  827. sed 's/^XX//' << \SHAR_EOF > msort.fp
  828. XXDef msort    # mergesort: <n1, n2, .., nx> => <ni, nj, .., nq>, sorted
  829. XX    \/ merge o aa [id]
  830. XX
  831. XXDef merge null o 1 -> 2;
  832. XX      null o 2 -> 1;
  833. XX      < o aa 1 -> apndl o [1 o 1, merge o [tl o 1, 2]];
  834. XX                apndl o [1 o 2, merge o [1, tl o 2]]
  835. SHAR_EOF
  836. if test 232 -ne "`wc -c msort.fp`"
  837. then
  838. echo shar: error transmitting msort.fp '(should have been 232 characters)'
  839. fi
  840. echo shar: extracting newsels.fp '(157 characters)'
  841. sed 's/^XX//' << \SHAR_EOF > newsels.fp
  842. XXDef min \/( < -> 1; 2)
  843. XXDef exclude append o aa ( = -> _<>; tl) o distl
  844. XXDef newsels (bu >= 1) o length -> id;
  845. XX        apndl o [1, newsels o exclude] o [min, id]
  846. SHAR_EOF
  847. if test 157 -ne "`wc -c newsels.fp`"
  848. then
  849. echo shar: error transmitting newsels.fp '(should have been 157 characters)'
  850. fi
  851. echo shar: extracting nil '(3 characters)'
  852. sed 's/^XX//' << \SHAR_EOF > nil
  853. XX<>
  854. SHAR_EOF
  855. if test 3 -ne "`wc -c nil`"
  856. then
  857. echo shar: error transmitting nil '(should have been 3 characters)'
  858. fi
  859. echo shar: extracting nqueens.fp '(1801 characters)'
  860. sed 's/^XX//' << \SHAR_EOF > nqueens.fp
  861. XX# nqueens.fp: gives all solutions for placing n queens on an nxn
  862. XX# chessboard in such a way that they do not threaten each other
  863. XX# Typical call:
  864. XX# nqueens 8
  865. XX
  866. XX# nqueens : n => board printout, or nil
  867. XXDef nqueens prtboards o nmqueens o [id, id]
  868. XX
  869. XX# nmqueens : <n, m> => list of n safe row positions for n queens on an
  870. XX# n-column by m-row chessboard. Precondition: n <= m
  871. XX# e.g., nmqueens : <2, 3> => <<1, 3>, <3, 1>>
  872. XXDef nmqueens (bu = 1) o 1 -> aa [id] o iota o 2;
  873. XX         append o aa (null -> id; [id]) o aa safe o
  874. XX        append o aa distl o distr o
  875. XX        [iota o 2, nmqueens o [(bur - 1) o 1, 2]]
  876. XX
  877. XX# safe : <row, rowpositions> => <row | rowpositions> if safe, <> otherwise
  878. XX# e.g. safe : <3, <1, 4, 7>> => <3, 1, 4, 7>, safe : <3, <4, 1, 7>> => <>
  879. XXDef safe \/and o aa saferow o aa apndl o pairpos o distl -> apndl ; _<>
  880. XX
  881. XX# pairpos : <x1..xn> ==> <<1 x1>..<n xn>>
  882. XXDef pairpos null -> _<>; trans o [iota o length, id]
  883. XX
  884. XX# saferow : <col, row@col1, row@col> => whether a queen placed at
  885. XX# (row@col1, 1) is safe from one at (row@col, col)
  886. XXDef saferow \/and o aa != o [tl, [1, - o tl], [1, neg o - o tl]]
  887. XX
  888. XX# prtboards : <rowlist1..rowlistn> => board1 ++ newline ++ .. ++ boardn
  889. XXDef prtboards null -> _"no solution found"; mergelines o aa prtboard
  890. XX
  891. XX# prtboard : <row1..rown> => printed form of the board, where Q represents
  892. XX# a position, _ a blank, and rows are terminated by newlines. e.g.
  893. XX# prtboard: <1, 3, 2> => "Q__\n__Q\n_Q_\n", where \n represents new line.
  894. XXDef prtboard mergelines o trans o aa prtcol o distr o [id, length]
  895. XX
  896. XX# prtcol : <row size> => printed form of the column containing the given row
  897. XXDef prtcol aa (= -> _'Q; _'_) o distl o [1, iota o 2]
  898. XX
  899. XX# mergelines: <str1..strn> => str, where str is the concatenation of the
  900. XX# stri's separated by newlines
  901. XXDef mergelines append o aa (append o [id, newline])
  902. SHAR_EOF
  903. if test 1801 -ne "`wc -c nqueens.fp`"
  904. then
  905. echo shar: error transmitting nqueens.fp '(should have been 1801 characters)'
  906. fi
  907. echo shar: extracting parprimes.fp '(216 characters)'
  908. sed 's/^XX//' << \SHAR_EOF > parprimes.fp
  909. XXDef elim (bu = 0) o mod o reverse -> _<>;
  910. XX     [2]
  911. XXDef filter null o 2 -> 2;
  912. XX           /(/apndl o apndr) o aa elim o distl
  913. XXDef sieve null -> id;
  914. XX      apndl o [1, sieve o filter o [1, tl]]
  915. XXDef parprimes sieve o tl o iota
  916. SHAR_EOF
  917. if test 216 -ne "`wc -c parprimes.fp`"
  918. then
  919. echo shar: error transmitting parprimes.fp '(should have been 216 characters)'
  920. fi
  921. echo shar: extracting permsort.fp '(415 characters)'
  922. sed 's/^XX//' << \SHAR_EOF > permsort.fp
  923. XXDef permute append o aa append o aa aa (= o [1 o 1, 2] -> [2 o 1]; _<>) o
  924. XX       aa distr o distl o [id, iota o length]
  925. XX    # permute : <<i1, x1>,..<in, xn>> where {iy} = 1..n ==> <xj,..xk>
  926. XX    #    where ij = 1, ik = n and so on for the intermediate i's
  927. XXDef rank \/+ o aa ( < -> _0; _1) o distl
  928. XX    # rank : <x, <x1,..xn>> ==> m where m is the number of xi's <= x
  929. XX
  930. XXDef permsort permute o trans o [aa rank o distr o [id, id], id]
  931. SHAR_EOF
  932. if test 415 -ne "`wc -c permsort.fp`"
  933. then
  934. echo shar: error transmitting permsort.fp '(should have been 415 characters)'
  935. fi
  936. echo shar: extracting powerset.fp '(346 characters)'
  937. sed 's/^XX//' << \SHAR_EOF > powerset.fp
  938. XX# powerset: <el1..eln> => powerset of <el1..eln>
  939. XX# e.g.    powerset: <>      => <<>>
  940. XX#    powerset: <e>      => <<>, <e>>
  941. XX#    powerset: <1 2>      => <<>, <1>, <2>, <1, 2>>
  942. XX#    powerset: <1 2 3> => <<>, <1>, <2>, <3>, <1, 2>, <1, 3>, <2, 3>,
  943. XX#                <1, 2, 3>>
  944. XX# and so on.
  945. XXDef powerset null -> [id];
  946. XX         append o [aa apndl o distl o [1, 2], 2] o [1, powerset o tl]
  947. SHAR_EOF
  948. if test 346 -ne "`wc -c powerset.fp`"
  949. then
  950. echo shar: error transmitting powerset.fp '(should have been 346 characters)'
  951. fi
  952. echo shar: extracting primes.fp '(223 characters)'
  953. sed 's/^XX//' << \SHAR_EOF > primes.fp
  954. XXDef filter null o 2 -> _<>;
  955. XX       (bu = 0) o mod o [1 o 2, 1] -> filter o [1, tl o 2];
  956. XX       apndl o [1 o 2, filter o [1, tl o 2]]
  957. XXDef sieve (null -> _<>;
  958. XX       apndl o [1, sieve o filter o [1, tl]])
  959. XXDef primes sieve o tl o iota
  960. SHAR_EOF
  961. if test 223 -ne "`wc -c primes.fp`"
  962. then
  963. echo shar: error transmitting primes.fp '(should have been 223 characters)'
  964. fi
  965. echo shar: extracting prims.fp '(8494 characters)'
  966. sed 's/^XX//' << \SHAR_EOF > prims.fp
  967. XX# prims.fp: test suite for any implementation of FP or FP/FFP
  968. XXDef prims [id, \/and] o
  969. XX      [testtl, testtlr,
  970. XX       testrotl, testrotr,
  971. XX       testid, testatom,
  972. XX       testdistl, testdistr,
  973. XX       testapndl, testapndr,
  974. XX       testeq, testnoteq,
  975. XX       testleq, testgeq,
  976. XX       testless, testgreater,
  977. XX       testplus, testminus,
  978. XX       testtimes, testdiv,
  979. XX       testneg, testmod,
  980. XX       testnull, testlength,
  981. XX       testtrans, testreverse,
  982. XX       testand, testor,
  983. XX       testnot, testiota]
  984. XX
  985. XXDef testand \/and o aa = o
  986. XX       (bu trans <F, F, F, T>) o aa and o _<<F, F>, <F, T>, <T, F>, <T, T>>
  987. XX
  988. XXDef testapndl \/and o aa = o
  989. XX       (bu trans <<a>, <a, b>, <a, b, c>, <<>>, <<a>>, <<a>, <b>>>) o
  990. XX       aa apndl o
  991. XX         _<<a, <>>, <a, <b>>, <a, <b, c>>, <<>, <>>, <<a>, <>>,
  992. XX           <<a>, <<b>>>>
  993. XX
  994. XXDef testapndr \/and o aa = o
  995. XX       (bu trans <<a>, <a, b>, <a, b, c>, <<>>, <<a>>, <<a>, <b>>>) o
  996. XX       aa apndr o
  997. XX         _<<<>, a>, <<a>, b>, <<a, b>, c>, <<>, <>>, <<>, <a>>,
  998. XX           <<<a>>, <b>>>
  999. XX
  1000. XXDef testatom \/and o aa = o
  1001. XX       (bu trans <T, T, T, T, T, T, T, F, F, F, F>) o
  1002. XX       aa atom o
  1003. XX        _<T, F, <>, 1, 1.0, a, 'a, "string", <vector>,
  1004. XX          <"vector">, <v, e, c, t, o, r>>
  1005. XX
  1006. XXDef testdistl \/and o aa = o
  1007. XX       (bu trans <<>, <<a, 1>>, <<b, 1>, <b, 2>>, <<<>, 1>,
  1008. XX              <<>, 2>, <<>, 3>>>) o
  1009. XX       aa distl o _<<x, <>>, <a, <1>>, <b, <1, 2>>, <<>, <1, 2, 3>>>
  1010. XX
  1011. XXDef testdistr \/and o aa = o
  1012. XX       (bu trans <<>, <<a, 1>>, <<a, 2>, <b, 2>>,
  1013. XX              <<a, <>>, <b, <>>, <c, <>>>>) o
  1014. XX       aa distr o _<<<>, x>, <<a>, 1>, <<a, b>, 2>, <<a, b, c>, <>>>
  1015. XX
  1016. XXDef testdiv \/and o aa = o
  1017. XX       (bu trans
  1018. XX        <1,   1,   0,   2,   -12,   -3,    6,
  1019. XX          1.0, 1.0, 0.5, 2.0, -8.75, -17.5, 6.25>) o
  1020. XX       aa div o
  1021. XX       _<<1, 1>, <10, 10>, <1, 2>, <2, 1>, <35, -3>, <-35, 17>, <-27, -4>,
  1022. XX         <1, 1.0>, <10.0, 10>, <1.0, 2.0>, <2.0, 1>, <35, -4.0>,
  1023. XX         <-35.0, 2.0>, <-25.0, -4.0>>
  1024. XX
  1025. XXDef testeq \/and o aa = o
  1026. XX       (bu trans
  1027. XX        <T, F, F, F, T, F, F, F, F, F,
  1028. XX         T, F, F, F, F, F, F, F, F,
  1029. XX         T, F, F, F, F, F, F, F, F,
  1030. XX         T, F, T, F, F, F, F, F, F, F,
  1031. XX         T, F, F, F, F, F, F,
  1032. XX         T, F, F, F, F, F, F,
  1033. XX         T, F, F, F, F, F, F,
  1034. XX         T, F, F, F, F, F, F, F, F,
  1035. XX         T, F>) o aa = o
  1036. XX       _<<1, 1>, <1, 0>, <1, a>, <1, 'a>, <1, 1.0>, <1, 0.99>,
  1037. XX        <1, <>>, <1, T>, <1, F>, <1, <1>>,
  1038. XX         <a, a>, <a, b>, <a, 1>, <a, 'a>, <a, 1.0>, <a, <>>,
  1039. XX        <a, T>, <a, F>, <a, <a>>,
  1040. XX         <'a, 'a>, <'a, 'b>, <'a, 1>, <'a, a>, <'a, 1.0>,
  1041. XX        <'a, <>>, <'a, T>, <'a, F>, <'a, <'a>>,
  1042. XX         <1.0, 1.0>, <1.0, 2.0>, <1.0, 1>, <1.1, 1>, <1.0, 'a>,
  1043. XX        <1.0, a>, <1.0, <>>, <1.0, T>, <1.0, F>, <1.0, <1.0>>,
  1044. XX         <T, T>, <T, 1>, <T, 'T>, <T, 1.0>, <T, <>>, <T, F>, <T, <T>>,
  1045. XX         <F, F>, <F, 1>, <F, 'F>, <F, 1.0>, <F, <>>, <F, T>, <F, <F>>,
  1046. XX         <<>, <>>, <<>, 1>, <<>, 'F>, <<>, 1.0>, <<>, T>, <<>, F>,
  1047. XX        <<>, <<>>>,
  1048. XX         <<a>, <a>>, <<a>, <b>>, <<a>, 1>, <<a>, 'a>, <<a>, 1.0>,
  1049. XX        <<a>, <>>, <<a>, T>, <<a>, F>, <<a>, <<a>>>,
  1050. XX         <<a, <b>, <c, <d>>, e>, <a, <b>, <c, <d>>, e>>,
  1051. XX         <<a, <b>, <c, <d>>, e>, <a, <b>, <c, <f>>, e>>>
  1052. XX
  1053. XX# only test geq on atoms, chars and numbers. Particular implementations
  1054. XX# may have it defined for other values as well, but that is not portable
  1055. XXDef testgeq \/and o aa = o
  1056. XX       (bu trans <T, T, F, T, T, F, T, T, F, T, T, F, T, T, F, T, T, F>) o
  1057. XX       aa >= o
  1058. XX       _<<1, 0>, <1, 1>, <1, 2>,
  1059. XX         <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>,
  1060. XX         <1, 0.99>, <1, 1.0>, <1, 1.01>,
  1061. XX         <1.01, 1>, <1.0, 1>, <0.99, 1>,
  1062. XX         <m, a>, <m, m>, <m, z>,
  1063. XX         <'m, 'a>, <'m, 'm>, <'m, 'z>>
  1064. XX
  1065. XXDef testgreater \/and o aa = o
  1066. XX       (bu trans <T, F, F, T, F, F, T, F, F, T, F, F, T, F, F, T, F, F>) o
  1067. XX       aa > o
  1068. XX       _<<1, 0>, <1, 1>, <1, 2>,
  1069. XX         <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>,
  1070. XX         <1, 0.99>, <1, 1.0>, <1, 1.01>,
  1071. XX         <1.01, 1>, <1.0, 1>, <0.99, 1>,
  1072. XX         <m, a>, <m, m>, <m, z>,
  1073. XX         <'m, 'a>, <'m, 'm>, <'m, 'z>>
  1074. XX
  1075. XXDef testid \/and o aa = o
  1076. XX       (bu trans <1, a, 'a, 1.0, T, F, <>, "id", <id, 1, x>>) o
  1077. XX       aa id o  _<1, a, 'a, 1.0, T, F, <>, "id", <id, 1, x>>
  1078. XX
  1079. XXDef testiota \/and o aa = o
  1080. XX       (bu trans <<>, <1>, <1, 2>, <1, 2, 3, 4, 5, 6, 7, 8, 9, 10>>) o
  1081. XX       aa iota o _<0, 1, 2, 10>
  1082. XX
  1083. XXDef testlength \/and o aa = o
  1084. XX       (bu trans <0, 1, 1, 2, 3, 4, 10>) o
  1085. XX       aa length o
  1086. XX       _<<>, <1>, <<<>>>, <<a, b, c>, <d, e>>, "xyz", "four", "lenght ten">
  1087. XX
  1088. XXDef testleq \/and o aa = o
  1089. XX       (bu trans <F, T, T, F, T, T, F, T, T, F, T, T, F, T, T, F, T, T>) o
  1090. XX       aa <= o
  1091. XX       _<<1, 0>, <1, 1>, <1, 2>,
  1092. XX         <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>,
  1093. XX         <1, 0.99>, <1, 1.0>, <1, 1.01>,
  1094. XX         <1.01, 1>, <1.0, 1>, <0.99, 1>,
  1095. XX         <m, a>, <m, m>, <m, z>,
  1096. XX         <'m, 'a>, <'m, 'm>, <'m, 'z>>
  1097. XX
  1098. XXDef testless \/and o aa = o
  1099. XX       (bu trans <F, F, T, F, F, T, F, F, T, F, F, T, F, F, T, F, F, T>) o
  1100. XX       aa < o
  1101. XX       _<<1, 0>, <1, 1>, <1, 2>,
  1102. XX         <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>,
  1103. XX         <1, 0.99>, <1, 1.0>, <1, 1.01>,
  1104. XX         <1.01, 1>, <1.0, 1>, <0.99, 1>,
  1105. XX         <m, a>, <m, m>, <m, z>,
  1106. XX         <'m, 'a>, <'m, 'm>, <'m, 'z>>
  1107. XX
  1108. XXDef testminus \/and o aa = o
  1109. XX       (bu trans <1, -1, 0, 11, -5, 3, -5>) o
  1110. XX       aa - o
  1111. XX       _<<1, 0>, <0, 1>, <1, 1>, <7, -4>, <-3, 2>, <-5, -8>, <-8, -3>>
  1112. XX
  1113. XXDef testmod \/and o aa = o
  1114. XX       (bu trans <0, 0, 1, 0, 1, 16, 3>) o
  1115. XX       aa mod o
  1116. XX       _<<1, 1>, <10, 10>, <1, 2>, <2, 1>, <35, -3>, <-35, 17>, <-27, -4>>
  1117. XX
  1118. XXDef testneg \/and o aa = o (bu trans <0, 0, 1, -1.0, 15.2, -17>) o
  1119. XX       aa neg o _<0, -0, -1, 1.0, -15.2, 17>
  1120. XX
  1121. XXDef testnot \/and o aa = o (bu trans <T, F>) o aa not o _<F, T>
  1122. XX
  1123. XXDef testnoteq \/and o aa = o
  1124. XX       (bu trans
  1125. XX        <F, T, T, T, F, T, T, T, T, T,
  1126. XX         F, T, T, T, T, T, T, T, T,
  1127. XX         F, T, T, T, T, T, T, T, T,
  1128. XX         F, T, F, T, T, T, T, T, T, T,
  1129. XX         F, T, T, T, T, T, T,
  1130. XX         F, T, T, T, T, T, T,
  1131. XX         F, T, T, T, T, T, T,
  1132. XX         F, T, T, T, T, T, T, T, T,
  1133. XX         F, T>) o aa != o
  1134. XX       _<<1, 1>, <1, 0>, <1, a>, <1, 'a>, <1, 1.0>, <1, 0.99>,
  1135. XX        <1, <>>, <1, T>, <1, F>, <1, <1>>,
  1136. XX         <a, a>, <a, b>, <a, 1>, <a, 'a>, <a, 1.0>, <a, <>>,
  1137. XX        <a, T>, <a, F>, <a, <a>>,
  1138. XX         <'a, 'a>, <'a, 'b>, <'a, 1>, <'a, a>, <'a, 1.0>, <'a, <>>,
  1139. XX        <'a, T>, <'a, F>, <'a, <'a>>,
  1140. XX         <1.0, 1.0>, <1.0, 2.0>, <1.0, 1>, <1.1, 1>, <1.0, 'a>, <1.0, a>,
  1141. XX        <1.0, <>>, <1.0, T>, <1.0, F>, <1.0, <1.0>>,
  1142. XX         <T, T>, <T, 1>, <T, 'T>, <T, 1.0>, <T, <>>, <T, F>, <T, <T>>,
  1143. XX         <F, F>, <F, 1>, <F, 'F>, <F, 1.0>, <F, <>>, <F, T>, <F, <F>>,
  1144. XX         <<>, <>>, <<>, 1>, <<>, 'F>, <<>, 1.0>, <<>, T>, <<>, F>,
  1145. XX        <<>, <<>>>,
  1146. XX         <<a>, <a>>, <<a>, <b>>, <<a>, 1>, <<a>, 'a>, <<a>, 1.0>,
  1147. XX        <<a>, <>>, <<a>, T>, <<a>, F>, <<a>, <<a>>>,
  1148. XX         <<a, <b>, <c, <d>>, e>, <a, <b>, <c, <d>>, e>>,
  1149. XX         <<a, <b>, <c, <d>>, e>, <a, <b>, <c, <f>>, e>>>
  1150. XX
  1151. XXDef testnull \/and o aa = o
  1152. XX       (bu trans <T, F, F, F, F, F, F, T, F, F, F>) o
  1153. XX       aa null o _<<>, 0, 1, a, '0, T, F, "", "nil", <nil>,
  1154. XX               <m, <o, n>, <<s>, t, e>, r>>
  1155. XX
  1156. XXDef testor \/and o aa = o
  1157. XX       (bu trans <F, T, T, T>) o aa or o _<<F, F>, <F, T>, <T, F>, <T, T>>
  1158. XX
  1159. XXDef testplus \/and o aa = o
  1160. XX       (bu trans <0, 2, 1, 1, -2, 3, -9>) o
  1161. XX       aa + o _<<0, 0>, <1, 1>, <1, 0>, <0, 1>, <1, -3>, <-5, 8>, <-4, -5>>
  1162. XX
  1163. XXDef testreverse \/and o aa = o
  1164. XX       (bu trans
  1165. XX           <<>, <a>, <b, a>, <4, 3, 2, 1>, <<e, f>, <c, d>, <a, b>>>) o
  1166. XX       aa reverse o
  1167. XX       _<<>, <a>, <a, b>, <1, 2, 3, 4>, <<a, b>, <c, d>, <e, f>>>
  1168. XX
  1169. XXDef testrotl \/and o aa = o
  1170. XX       (bu trans
  1171. XX           <<>, <a>, <b, a>, <2, 3, 4, 5, 1>, <<r, s>, <t, u>, <p, q>>>) o
  1172. XX       aa rotl o
  1173. XX       _<<>, <a>, <a, b>, <1, 2, 3, 4, 5>, <<p, q>, <r, s>, <t, u>>>
  1174. XX
  1175. XXDef testrotr \/and o aa = o
  1176. XX       (bu trans
  1177. XX           <<>, <a>, <b, a>, <5, 1, 2, 3, 4>, <<t, u>, <p, q>, <r, s>>>) o
  1178. XX       aa rotr o
  1179. XX       _<<>, <a>, <a, b>, <1, 2, 3, 4, 5>, <<p, q>, <r, s>, <t, u>>>
  1180. XX
  1181. XXDef testtimes \/and o aa = o
  1182. XX       (bu trans <0, 0, 0, 9, -2, -4, 6, 6, 28, -18, -10>) o
  1183. XX       aa * o
  1184. XX       _<<0, 0>, <0, 5>, <1, 0>, <1, 9>, <1, -2>, <-1, 4>, <-1, -6>,
  1185. XX         <-2, -3>, <4, 7>, <-6, 3>, <5, -2>>
  1186. XX
  1187. XXDef testtl \/and o aa = o
  1188. XX       (bu trans <<>, <a>, <a, b, c>, <<>>, <<a>>, <<a>, <b>>>) o
  1189. XX       aa tl o
  1190. XX       _<<a>, <1, a>, <z, a, b, c>, <a, <>>, <x, <a>>, <<x>, <a>, <b>>>
  1191. XX
  1192. XXDef testtlr \/and o aa = o
  1193. XX       (bu trans <<>, <a>, <a, b, c>, <<>>, <<a>>, <<a>, <b>>>) o
  1194. XX       aa tlr o
  1195. XX       _<<a>, <a, b>, <a, b, c, d>, <<>, a>, <<a>, x>, <<a>, <b>, <c>>>
  1196. XX
  1197. XXDef testtrans \/and o aa = o
  1198. XX       (bu trans
  1199. XX        <<>, <>, <>,
  1200. XX         <<a>, <b>, <c>, <d>, <e>, <f>>, <<1, 2, 3, 4, 5>>,
  1201. XX         <<a, c>, <b, d>>, <<a, 1, x>, <b, 2, y>, <c, 3, z>>,
  1202. XX         <<a, 1, l>, <b, 2, m>, <c, 3, n>, <d, 4, o>, <e, 5, p>>>) o
  1203. XX       aa trans o
  1204. XX       _<<<>>, <<>, <>>, <<>, <>, <>, <>, <>>,
  1205. XX         <<a, b, c, d, e, f>>, <<1>, <2>, <3>, <4>, <5>>,
  1206. XX         <<a, b>, <c, d>>, <<a, b, c>, <1, 2, 3>, <x, y, z>>,
  1207. XX         <<a, b, c, d, e>, <1, 2, 3, 4, 5>, <l, m, n, o, p>>>
  1208. SHAR_EOF
  1209. if test 8494 -ne "`wc -c prims.fp`"
  1210. then
  1211. echo shar: error transmitting prims.fp '(should have been 8494 characters)'
  1212. fi
  1213. echo shar: extracting printf.fp '(3320 characters)'
  1214. sed 's/^XX//' << \SHAR_EOF > printf.fp
  1215. XX# printf.fp: provides fpprintf and fpscanf, functions defined like
  1216. XX# the corresponding C functions.
  1217. XX# e.g. fpprintf: <"hello %c %s\n", 'x, "string"> would return
  1218. XX#     "hello x string<newline>"
  1219. XX# for now, field lengths are not defined
  1220. XXDef fpprintf append o aa format o trans o [parsectrl, distformats]
  1221. XX
  1222. XX# parsectrl: "control %x string%y \n" => <"control %x", "string%y", " <nl>">
  1223. XXDef parsectrl breakup o
  1224. XX# next two lines, check that 1 is in the list of break up positions
  1225. XX          (null o 1 -> [_<1>, 2];
  1226. XX           (bu != 1) o 1 o 1 -> [(bu apndl 1) o 1, 2]; id) o
  1227. XX# next line, make sure that the last break-up position is needed
  1228. XX          (> o [1r o 1, length o 2] -> [tlr o 1, 2]; id) o
  1229. XX# figure out preliminary break-up positions, put newlines
  1230. XX          [append o aa parsebreak o pairpos o tl o allpairs,
  1231. XX           id] o subnewline o 1
  1232. XX
  1233. XX# parsebreak: <pos, <c1, c2>> => <> if c1 != %, <pos+2> if c1 = %
  1234. XXDef parsebreak (bu = '%) o 1 o 2 -> [(bu + 2) o 1]; _<>
  1235. XX
  1236. XX# subnewline: string => string with newline instead of every \n
  1237. XXDef subnewline append o aa subcharpair o tlr o allpairs
  1238. XX
  1239. XX# subcharpair: <c1, c2> => newline if c1 = \, c2 = n; <c1> otherwise
  1240. XXDef subcharpair (bu = '\\) o 2 -> _<>; (bu = "\n") -> newline; [2]
  1241. XX
  1242. XX# format: <ctrl-substring arg> => <new-substring>
  1243. XXDef format (bur < 2) o length o 1 -> 1;        # end of format string
  1244. XX       (bu != '%) o 2r o 1 -> 1;        # same
  1245. XX       (bu = 's) o 1r o 1 ->
  1246. XX        append o [tlr o tlr o 1, subnewline o 2];    # cat strings
  1247. XX       (bu = 'd) o 1r o 1 ->
  1248. XX        append o [tlr o tlr o 1, (bur numtostring 10) o 2];
  1249. XX       (bu = 'x) o 1r o 1 ->
  1250. XX        append o [tlr o tlr o 1, (bur numtostring 16) o 2];
  1251. XX       (bu = 'o) o 1r o 1 ->
  1252. XX        append o [tlr o tlr o 1, (bur numtostring 8) o 2];
  1253. XX       (bu = 'c) o 1r o 1 ->
  1254. XX        apndr o [tlr o tlr o 1, 2];
  1255. XX       (bu error "fpprintf: unknown format was used")
  1256. XX
  1257. XX# distformats: <format-string, other-args*> => <other-args*> or
  1258. XX# <other-args* format-string>, the former in the case that the last
  1259. XX# 2 elements of format-string are %c, where c is any character.
  1260. XXDef distformats (bur < 2) o length o 1 -> tl;
  1261. XX        (bu = '%) o 2r o 1 -> tl;
  1262. XX        rotl
  1263. XX
  1264. XX# numtostring: <n base> => "xyz", a string corresponding to the printable
  1265. XX# form, in the given base, of the number n.
  1266. XXDef numtostring (bur < 0) o 1 ->
  1267. XX            (bu apndl '-) o numtostring o [neg o 1, 2];
  1268. XX        aa printdigit o reverse o makedigits
  1269. XX
  1270. XX# makedigits: <n base> => <dig1, dig2 .. dign>, where digx < base
  1271. XXDef makedigits < -> [1]; apndl o [mod, makedigits o [div, 2]]
  1272. XX
  1273. XX# printdigit: n => the character corresponding to n (0 <= n < 16)
  1274. XXDef printdigit 1 o (bur seln "0123456789ABCDEF") o
  1275. XX           [(bu + 1), _1]
  1276. XX
  1277. XXDef charalpha or o [charupper, charlower]
  1278. XX
  1279. XXDef charupper and o [(bur >= 'A), (bu >= 'Z)]
  1280. XX
  1281. XXDef charlower and o [(bur >= 'a), (bu >= 'z)]
  1282. XX
  1283. XXDef chardigit and o [(bur >= '0), (bu >= '9)]
  1284. XX
  1285. XXDef charhexdig \/or o [chardigit,
  1286. XX            and o [(bur >= 'a), (bu >= 'f)],
  1287. XX            and o [(bur >= 'A), (bu >= 'F)]]
  1288. XX
  1289. XXDef charoctdig and o [(bur >= '0), (bu >= '7)]
  1290. XX
  1291. XXDef charspace or o [(bu = ' ), (bu = '    )]
  1292. XX
  1293. XXDef tstfpprintf [aa 2, \/and o aa =] o trans o [
  1294. XX_<"hi there,
  1295. XX274 high, 3D4F lo, -247 octal
  1296. XX",
  1297. XX  "how do you compute prime numbers 13 and 17?
  1298. XXa new result">,
  1299. XX        aa fpprintf o
  1300. XX        [[_"h%s\\n%d h%cgh, %x lo, %o octal%s",
  1301. XX          _"i there,", _274, _'i, _15695, _-167, newline],
  1302. XX         [_"how do %s prime numbers %d and %x?%sa new result",
  1303. XX          _"you compute", _13, _23, _"\\n"]]]
  1304. SHAR_EOF
  1305. if test 3320 -ne "`wc -c printf.fp`"
  1306. then
  1307. echo shar: error transmitting printf.fp '(should have been 3320 characters)'
  1308. fi
  1309. echo shar: extracting printhex.fp '(86 characters)'
  1310. sed 's/^XX//' << \SHAR_EOF > printhex.fp
  1311. XX# printhex.fp: print a number in hexadecimal notation
  1312. XXDef printhex bu fpprintf "%x\n"
  1313. SHAR_EOF
  1314. if test 86 -ne "`wc -c printhex.fp`"
  1315. then
  1316. echo shar: error transmitting printhex.fp '(should have been 86 characters)'
  1317. fi
  1318. echo shar: extracting qsort.fp '(211 characters)'
  1319. sed 's/^XX//' << \SHAR_EOF > qsort.fp
  1320. XXDef before append o aa ( > -> tl ; _<> )
  1321. XXDef same append o aa ( = -> tl ; _<> )
  1322. XXDef after append o aa ( < -> tl ; _<> )
  1323. XX
  1324. XXDef qsort null -> id;
  1325. XX      append o [qsort o before, same, qsort o after] o distl o [1, id]
  1326. SHAR_EOF
  1327. if test 211 -ne "`wc -c qsort.fp`"
  1328. then
  1329. echo shar: error transmitting qsort.fp '(should have been 211 characters)'
  1330. fi
  1331. echo shar: extracting selsort.fp '(221 characters)'
  1332. sed 's/^XX//' << \SHAR_EOF > selsort.fp
  1333. XXDef reorder atom o 2 -> reorder o [1, [2]];
  1334. XX            < o [1, 1 o 2] -> apndl;
  1335. XX        apndl o [1 o 2, apndl o [1, tl o 2]]
  1336. XX
  1337. XXDef selsort atom -> id;
  1338. XX        (bu >= 1) o length -> id;
  1339. XX        apndl o [1, selsort o tl] o /reorder
  1340. SHAR_EOF
  1341. if test 221 -ne "`wc -c selsort.fp`"
  1342. then
  1343. echo shar: error transmitting selsort.fp '(should have been 221 characters)'
  1344. fi
  1345. echo shar: extracting sort.out '(542 characters)'
  1346. sed 's/^XX//' << \SHAR_EOF > sort.out
  1347. XX<1,
  1348. XX11,
  1349. XX38,
  1350. XX43,
  1351. XX53,
  1352. XX59,
  1353. XX90,
  1354. XX136,
  1355. XX182,
  1356. XX230,
  1357. XX273,
  1358. XX302,
  1359. XX339,
  1360. XX350,
  1361. XX352,
  1362. XX364,
  1363. XX379,
  1364. XX381,
  1365. XX423,
  1366. XX424,
  1367. XX440,
  1368. XX455,
  1369. XX479,
  1370. XX538,
  1371. XX540,
  1372. XX579,
  1373. XX611,
  1374. XX615,
  1375. XX631,
  1376. XX639,
  1377. XX663,
  1378. XX680,
  1379. XX684,
  1380. XX699,
  1381. XX703,
  1382. XX720,
  1383. XX763,
  1384. XX785,
  1385. XX821,
  1386. XX827,
  1387. XX832,
  1388. XX914,
  1389. XX919,
  1390. XX929,
  1391. XX931,
  1392. XX940,
  1393. XX940,
  1394. XX941,
  1395. XX959,
  1396. XX970,
  1397. XX972,
  1398. XX1032,
  1399. XX1139,
  1400. XX1261,
  1401. XX1275,
  1402. XX1289,
  1403. XX1368,
  1404. XX1469,
  1405. XX1567,
  1406. XX2040,
  1407. XX2724,
  1408. XX3329,
  1409. XX3594,
  1410. XX3668,
  1411. XX3682,
  1412. XX3716,
  1413. XX3926,
  1414. XX4219,
  1415. XX4328,
  1416. XX4751,
  1417. XX4923,
  1418. XX5106,
  1419. XX5307,
  1420. XX5569,
  1421. XX5681,
  1422. XX5693,
  1423. XX5764,
  1424. XX6242,
  1425. XX6332,
  1426. XX6512,
  1427. XX6678,
  1428. XX6707,
  1429. XX6963,
  1430. XX7163,
  1431. XX7685,
  1432. XX7746,
  1433. XX7837,
  1434. XX7872,
  1435. XX7927,
  1436. XX7961,
  1437. XX8505,
  1438. XX8571,
  1439. XX8762,
  1440. XX9144,
  1441. XX9208,
  1442. XX9216,
  1443. XX9480,
  1444. XX9621,
  1445. XX9719,
  1446. XX9868>
  1447. SHAR_EOF
  1448. if test 542 -ne "`wc -c sort.out`"
  1449. then
  1450. echo shar: error transmitting sort.out '(should have been 542 characters)'
  1451. fi
  1452. echo shar: extracting sort.tst '(542 characters)'
  1453. sed 's/^XX//' << \SHAR_EOF > sort.tst
  1454. XX<53,
  1455. XX914,
  1456. XX827,
  1457. XX302,
  1458. XX631,
  1459. XX785,
  1460. XX230,
  1461. XX11,
  1462. XX1567,
  1463. XX350,
  1464. XX5307,
  1465. XX339,
  1466. XX929,
  1467. XX9216,
  1468. XX479,
  1469. XX703,
  1470. XX699,
  1471. XX90,
  1472. XX440,
  1473. XX3926,
  1474. XX1032,
  1475. XX3329,
  1476. XX3682,
  1477. XX5764,
  1478. XX615,
  1479. XX7961,
  1480. XX273,
  1481. XX1275,
  1482. XX38,
  1483. XX4923,
  1484. XX540,
  1485. XX43,
  1486. XX7837,
  1487. XX1368,
  1488. XX7746,
  1489. XX1469,
  1490. XX8505,
  1491. XX4328,
  1492. XX9480,
  1493. XX424,
  1494. XX6678,
  1495. XX1139,
  1496. XX763,
  1497. XX959,
  1498. XX6707,
  1499. XX6242,
  1500. XX663,
  1501. XX59,
  1502. XX6332,
  1503. XX455,
  1504. XX7685,
  1505. XX3716,
  1506. XX136,
  1507. XX720,
  1508. XX832,
  1509. XX4751,
  1510. XX5681,
  1511. XX5106,
  1512. XX379,
  1513. XX9719,
  1514. XX381,
  1515. XX919,
  1516. XX7163,
  1517. XX4219,
  1518. XX639,
  1519. XX1261,
  1520. XX2040,
  1521. XX9144,
  1522. XX941,
  1523. XX7872,
  1524. XX5569,
  1525. XX972,
  1526. XX364,
  1527. XX684,
  1528. XX931,
  1529. XX423,
  1530. XX7927,
  1531. XX3594,
  1532. XX182,
  1533. XX611,
  1534. XX1,
  1535. XX9868,
  1536. XX680,
  1537. XX538,
  1538. XX940,
  1539. XX6512,
  1540. XX1289,
  1541. XX9621,
  1542. XX970,
  1543. XX3668,
  1544. XX5693,
  1545. XX352,
  1546. XX940,
  1547. XX9208,
  1548. XX8571,
  1549. XX579,
  1550. XX821,
  1551. XX6963,
  1552. XX2724,
  1553. XX8762>
  1554. SHAR_EOF
  1555. if test 542 -ne "`wc -c sort.tst`"
  1556. then
  1557. echo shar: error transmitting sort.tst '(should have been 542 characters)'
  1558. fi
  1559. echo shar: extracting whilefact.fp '(130 characters)'
  1560. sed 's/^XX//' << \SHAR_EOF > whilefact.fp
  1561. XXDef nonnull (bu != 0) o 2
  1562. XXDef multdecr [ * o [1, 2], - o [2, _1]]
  1563. XXDef wfact while nonnull multdecr
  1564. XXDef whilefact 1 o (bu wfact 1)
  1565. SHAR_EOF
  1566. if test 130 -ne "`wc -c whilefact.fp`"
  1567. then
  1568. echo shar: error transmitting whilefact.fp '(should have been 130 characters)'
  1569. fi
  1570. echo shar: done with directory main
  1571. cd ..
  1572. #    End of shell archive
  1573. exit 0
  1574.  
  1575.