Subject: v20i054: Portable compiler of the FP language, Part05/06 Newsgroups: comp.sources.unix Sender: sources Approved: rsalz@uunet.UU.NET Submitted-by: Edoardo Biagioni Posting-number: Volume 20, Issue 54 Archive-name: fpc/part05 # This is a shell archive. # Remove everything above and including the cut line. # Then run the rest of the file through sh. -----cut here-----cut here-----cut here-----cut here----- #!/bin/sh # shar: Shell Archiver # Run the following text with /bin/sh to create: # lib # main echo shar: creating directory lib mkdir lib cd lib echo shar: extracting format.fp '(7684 characters)' sed 's/^XX//' << \SHAR_EOF > format.fp XX# format.fp: provides fpformat and fpscan, functions used to format XX# fp data for output or parse strings for input. It also provides XX# the type-discrimination functions symbol, number, character, boolean, XX# vector, string. XX# fpformat takes as input a list of atomic objects or strings (intermixed XX# at will) and produces a single string that contains the printable XX# form of each object. A symbol will become its name, a number will be XX# printed in decimal fixed or floating point format (depending on whether XX# it is a fixed or floating point number), a character will be printed as XX# such, a boolean as "true" or "false", and a string as itself. e.g. XX# fpformat: <"this is string ", number, ' , 1, ' , 'b, "ut also ", T> returns XX# "this is string number 1 but also true" XX# fpscan takes a pair: a format vector and an input string, and tries XX# to match entities in the format string to entities in the input string. XX# The format string may contain any one of the symbols: symbol, number, XX# integer, float, boolean, character; or it may contain a string or character. XX# Any string or character must be matched exactly; any symbol will be matched XX# to a symbol of the appropriate type, if possible. fpscan returns a pair: XX# the first is the vector of the elements that were matched, the second XX# is the unmatched part of the string. Notice that blanks are ignored XX# except as separators. XXDef symbol \/and o [atom, (bur >= A), (bur <= zzzzzzzzzzzzz)] XXDef number \/and o [atom, (bur > T), (bur < A)] XXDef character \/and o [atom, (bur < <>), (bur > zzzzzzzzzzzzz)] XXDef boolean and o [(bu = T), (bu = F)] XXDef vector or o [null, not o atom] XXDef string not o vector -> _F; XX \/and o aa character XX XX# fpformat: => "xya" XXDef fpformat append o aa formsingle XX XX# fpscan: <, "string"> => XX# <, "rest of string> XXDef fpscan null o 1 -> id; XX null o 2 -> _<<>, <>>; XX (null o 1 -> [_<>, 2 o 2]; XX # pass up: <, "rest of string"> XX [apndl o [1, 1 o 2], 2 o 2] o XX # pass up: , "rest of string">> XX [1, fpscan o 2]) o XX # pass up: , "rest of string">> XX [1 o 1, [2, 2 o 1]] o XX # pass up: <, > XX [scanfirst o [1 o 1, 2], tl o 1] XX XX# scanfirst: => or <<>, "string"> XXDef scanfirst (bu = symbol) o 1 -> scansymbol o 2; XX (bu = number) o 1 -> scannumber o 2; XX (bu = integer) o 1 -> scaninteger o 2; XX (bu = float) o 1 -> scanfloat o 2; XX (bu = boolean) o 1 -> scanboolean o 2; XX (bu = character) o 1 -> scancharacter o 2; XX character o 1 -> matchcharacter; XX string o 1 -> matchstring; XX bu error "illegal scan format used" XX XX# matchcharacter: <'c, "string"> => <'c, "string-tl"> or <<>, "string"> XXDef matchcharacter (= o [1, 1 o 2] -> [1, tl o 2]; [_<>, 2]) o XX [1, skipblanks o 2] XX XX# matchstring: <"s1", "s2"> => <"s1", "rest-of-s2"> or <<>, "s1"> XXDef matchstring (= o [1, nhd o [length o 1, 2]] -> XX [1, ntl o [length o 1, 2]]; XX [_<>, 2]) o XX aa skipblanks XX XX# scansymbol: "string" => XXDef scansymbol [implode o 1, 2] o breakblanks o skipblanks XX XX# scannumber: "string" => , or XX# <<>, "string" XXDef scannumber (null o 1 -> scaninteger o 2; id) o scanfloat XX XX# scanboolean: "string" => or <<>, "string"> XXDef scanboolean ((bur member "tTyY") o 1 -> [_T, 2 o breakblanks]; XX (bur member "fFnN") o 1 -> [_F, 2 o breakblanks]; XX [[], id]) o skipblanks XX XX# scancharacter: "string" => XXDef scancharacter [1, tl] XX XX# scaninteger: "string" => , or XX# <<>, "string" XXDef scaninteger ((bu = '-) o 1 -> [neg o 1, 2] o scannumber o tl; XX (bu = '+) o 1 -> scannumber o tl; XX not o chardigit o 1 -> [[], id]; XX [\/+ o aa * o trans o [powerlist, aa scandigit] o 1, 2] o XX breaknondig) o XX skipblanks XX XX# scanfloat: "string" => , or XX# <<>, "string"> XXDef scanfloat (null o 2 -> id; XX (bu = '.) o 1 o 2 -> scanfract o [1, tl o 2]; XX id) o XX scaninteger XX XX# scanfract: => XXDef scanfract [+ o [1, XX div o [1 o 2, XX (bu power 10.0) o - o aa length o [3, 2 o 2]]], XX 2 o 2] o XX # pass up: , "fract+rest"> XX [(bu * 1.0) o 1, scaninteger o 2, 2] XX XX# powerlist: "char1..charn" => <10**n-1, 10**n-2, ..., 10, 1> XXDef powerlist /(apndl o [* o [1, 1 o 2], 2]) o XX (bur apndr <1>) o aa _10 o tl o iota o length XX XX# power: => base ** exp XXDef power (bu = 0) o 2 -> _1; \/* o aa 1 o distl o [1, iota o 2] XX XX# scandigit: 'digit => 0..9 XXDef scandigit (bur - 1) o (bur index "0123456789") XX XX# skipblanks: "string" => string without leading blanks XXDef skipblanks while charspace o 1 tl XX XX# breakblanks: "string" => XXDef breakblanks [nhd, ntl] o XX [((bu = 0) o 1 -> length o 2; (bur - 1) o 1) o XX [(bu index ' ), id], XX id] XX XX# breaknondig: "string" => XXDef breaknondig null -> _<<>, <>>; XX chardigit o 1 -> XX [apndl o [1, 1 o 2], 2 o 2] o [1, breaknondig o tl]; XX [_<>, id] XX XX# formsingle: object => "printable representation" XXDef formsingle string -> id; XX vector -> (bu error "illegal input to fpformat"); XX character -> [id]; XX symbol -> explode; XX (bu = T) -> _"true"; XX (bu = F) -> _"false"; XX = o [trunc, id] -> (bur inttostring 10); XX floattostring XX XX# inttostring: => "xyz", a string corresponding to the printable XX# form, in the given base, of the number n. XXDef inttostring (bur < 0) o 1 -> XX (bu apndl '-) o inttostring o [neg o 1, 2]; XX aa printdigit o reverse o makedigits XX XX# makedigits: => , where digx < base XXDef makedigits < -> [1]; apndl o [mod, makedigits o [div, 2]] XX XX# printdigit: n => the character corresponding to n (0 <= n < 16) XXDef printdigit 1 o (bur seln "0123456789ABCDEF") o XX [(bu + 1), _1] XX XX# floattostring: n => the XXDef floattostring append o [(bur inttostring 10) o trunc, XX _".", XX extend o [(bur inttostring 10), _3, _'0] o XX trunc o (bu * 1000) o - o [id, trunc]] XX XX# extend: <"string" l c> prepends as many copies of c as XX# necessary to make string have length l XXDef extend >= o [length o 1, 2] -> 1; XX append o [aa 1 o distl o [3, iota o - o [2, length o 1]], 1] XX XXDef charalpha or o [charupper, charlower] XX XXDef charupper and o [(bur >= 'A), (bu >= 'Z)] XX XXDef charlower and o [(bur >= 'a), (bu >= 'z)] XX XXDef chardigit and o [(bur >= '0), (bu >= '9)] XX XXDef charhexdig \/or o [chardigit, XX and o [(bur >= 'a), (bu >= 'f)], XX and o [(bur >= 'A), (bu >= 'F)]] XX XXDef charoctdig and o [(bur >= '0), (bu >= '7)] XX XXDef charspace or o [(bu = ' ), (bu = ' )] XX XXDef tstformat [aa 2, \/and o aa =] o trans o [ XX_<"hi there, XX274 high, 3.200 lo, 5.070 average, -247 octal, false, true XX", XX "how do you compute prime numbers 13 and 17? XXa new result", XX <<-3, hi, 5.1, -2.7, T, F, 'c, 'x, 2, 3.14156, "hi">, "lo">>, XX [fpformat o XX [_'h, _"i there,", newline, _274, _' , _high, _", ", XX _3.2, _" lo, ", _5.07, _" average, ", _-247, _" octal, ", XX _F, _',, _' , _T, newline], XX fpformat o XX [_"how do ", _"you compute", _" prime numbers ", _13, XX _" and ", _17, _'?, newline, _"a new result"], XX fpscan o XX _<, XX "-3 hi 5.1 -2.7 yes false cx 2 3.14156 hi lo">]] SHAR_EOF if test 7684 -ne "`wc -c format.fp`" then echo shar: error transmitting format.fp '(should have been 7684 characters)' fi echo shar: extracting lib.fp '(2384 characters)' sed 's/^XX//' << \SHAR_EOF > lib.fp XX# pairpos : ==> <<1 x1>..> XXDef pairpos null -> _<>; trans o [iota o length, id] XX XX# allpairs : ==> <<<> x1> ..>> XXDef allpairs trans o [(bu apndl <>), apndr o [id, _<>]] XX XX# ntl : > ==> XXDef ntl append o aa (>= o [1, 1 o 2] -> _<>; [2 o 2]) o XX distl o [1, pairpos o 2] XX XX# nhd : > ==> XXDef nhd append o aa (< o [1, 1 o 2] -> _<>; [2 o 2]) o XX distl o [1, pairpos o 2] XX XX# seln : < >, 1 <= i <= n, i + l <= n, l >= 0 XX# ==> XXDef seln nhd o [2 o 1, ntl o [- o [1 o 1, _1], 2]] XX XX# selectl: >, 1 <= i <= n ==> xi XXDef selectl 1 o 2 o (while (bur > 1) o 1 [(bur - 1) o 1, tl o 2]) XX XX# selectr: < i>, 1 <= i <= n ==> xi XXDef selectr 1r o 2r o (while (bur > 1) o 1r [tlr o 2r, (bur - 1) o 1r]) XX XX# poslen : <>, i1 = 1, in <= m ==> XX# <..> XX# i.e. the data is almost ready for seln XXDef poslen trans o [1, aa - o trans o XX [apndr o [tl o 1, (bu + 1) o length o 2], 1]] XX XX# breakup : <>, i1 = 1, in <= m ==> XX# <..> XXDef breakup aa seln o distr o [poslen, 2] XX XX# permute : <..> where {iy} = 1..n ==> XX# where ij = 1, ik = n and so on for the intermediate i's XXDef permute append o aa append o aa aa (= o [1 o 1, 2] -> [2 o 1]; _<>) o XX aa distr o distl o [id, iota o length] XX XX# rank : > ==> m where m is the number of xi's <= x XXDef rank \/+ o aa ( < -> _0; _1) o distl XX XXDef tstlib [trans, =] o XX [[pairpos o _<7, 5, 3, 1>, ntl o _<2, <4, 5, 6, 8>>, XX allpairs o _<1, 2, 3, 4, 5, 6, 7, 8, 9>, allpairs o _<1>, XX nhd o _<2, <4, 5, 6, 8>>, XX seln o _<<3, 4>, <1, 2, 3, 4, 5, 6, 7, 8>>, XX selectl o _<5, >, XX selectr o _<, 5>, XX breakup o _<<1, 4, 6>, <1, 2, 3, 4, 5, 6, 7, 8, 9, 10>>, XX permute o _<<5, 9>, <2, 3>, <1, 1>, <4, 7>, <3, 5>>, XX permute o _<<2, 3>, <1, 7>, <3, 5>>, XX rank o _<4, <1, 2, 3, 4, 5, 6>>, rank o _<2, <5, 0, 4, 1>>], XX _<<<1, 7>, <2, 5>, <3, 3>, <4, 1>>, XX <6, 8>, XX <<<>, 1>, <1, 2>, <2, 3>, <3, 4>, <4, 5>, <5, 6>, <6, 7>, XX <7, 8>, <8, 9>, <9, <>>>, XX <<<>, 1>, <1, <>>>, XX <4, 5>, XX <3, 4, 5, 6>, XX e, XX c, XX <<1, 2, 3>, <4, 5>, <6, 7, 8, 9, 10>>, XX <1, 3, 5, 7, 9>, XX <7, 3, 5>, XX 4, XX 2>] SHAR_EOF if test 2384 -ne "`wc -c lib.fp`" then echo shar: error transmitting lib.fp '(should have been 2384 characters)' fi echo shar: extracting makefile '(2366 characters)' sed 's/^XX//' << \SHAR_EOF > makefile XXLIB = /usr/local/lib XXLIBS = ${LIB}/libfp.a ${LIB}/libnfp.a ${LIB}/libdfp.a XXSRC = lib.fp set.fp store.fp format.fp makefile nil XXTST = tstlib tststore tstset tstformat XXOBJ = lib.o store.o set.o format.o XXNOBJ = nlib.o nstore.o nset.o nformat.o XXDOBJ = dlib.o dstore.o dset.o dformat.o XX XXall: ${OBJ} ${NOBJ} ${DOBJ} ${TST} XX XXrelease: ${LIBS} ${TST} XX XXclean: XX mkdir .tmp XX mv ${SRC} .tmp XX touch tmp XX rm -f * XX mv .tmp/* . XX rmdir .tmp XX XX.SUFFIXES: XX XX# make ../src/fp.o explicitly depend on nothing, otherwise make XX# tries to make it from ../src/fp.c! XX../src/fp.o: XX echo trying to make ../src/fp.o XX XXfp.o: ../fp.o XX rm -f fp.o XX cp ../fp.o . XX XXfpc: ../fpc XX rm -f fpc XX cp ../fpc . XX XXtstlib: lib.fp fp.o nil fpc XX cp lib.fp tstlib.fp XX fpc -m tstlib.fp XX cc -o tstlib tstlib.c fp.o XX rm -f tstlib.* XX tstlib < nil | sed \$$!d XX XXtstset: set.fp fp.o nil fpc XX cp set.fp tstset.fp XX fpc -m tstset.fp XX cc -o tstset tstset.c fp.o XX rm -f tstset.* XX tstset < nil | sed \$$!d XX XXtststore: store.fp fp.o nil fpc XX cp store.fp tststore.fp XX fpc -m tststore.fp XX cc -o tststore tststore.c fp.o XX rm -f tststore.* XX tststore < nil | sed \$$!d XX XXtstformat: format.fp lib.o set.o fp.o nil fpc XX cp format.fp tstformat.fp XX fpc -mtstformat tstformat.fp XX cc -o tstformat tstformat.c lib.o set.o fp.o XX rm -f tstformat.* XX tstformat < nil | sed \$$!d XX XX.SUFFIXES: .c .o XX XX.c.o: $*.c XX cc -c -O ${CFLAGS} $*.c XX XXlib.c: lib.fp fpc XX fpc lib.fp XX XXnlib.c: lib.fp fpc XX cp lib.fp nlib.fp XX fpc -n nlib.fp XX rm -f nlib.fp XX XXdlib.c: lib.fp fpc XX cp lib.fp dlib.fp XX fpc -d dlib.fp XX rm -f dlib.fp XX XXset.c: set.fp fpc XX fpc set.fp XX XXnset.c: set.fp fpc XX cp set.fp nset.fp XX fpc -n nset.fp XX rm -f nset.fp XX XXdset.c: set.fp fpc XX cp set.fp dset.fp XX fpc -d dset.fp XX rm -f dset.fp XX XXstore.c: store.fp fpc XX fpc store.fp XX XXnstore.c: store.fp fpc XX cp store.fp nstore.fp XX fpc -n nstore.fp XX rm -f nstore.fp XX XXdstore.c: store.fp fpc XX cp store.fp dstore.fp XX fpc -d dstore.fp XX rm -f dstore.fp XX XXformat.c: format.fp fpc XX fpc format.fp XX XXnformat.c: format.fp fpc XX cp format.fp nformat.fp XX fpc -n nformat.fp XX rm -f nformat.fp XX XXdformat.c: format.fp fpc XX cp format.fp dformat.fp XX fpc -d dformat.fp XX rm -f dformat.fp XX XX${LIB}/libfp.a: ${OBJ} XX ar ru ${LIB}/libfp.a ${OBJ} XX ranlib ${LIB}/libfp.a XX XX${LIB}/libnfp.a: ${NOBJ} XX ar ru ${LIB}/libnfp.a ${NOBJ} XX ranlib ${LIB}/libnfp.a XX XX${LIB}/libdfp.a: ${DOBJ} XX ar ru ${LIB}/libdfp.a ${DOBJ} XX ranlib ${LIB}/libdfp.a XX XXnil: XX echo \<\> > nil SHAR_EOF if test 2366 -ne "`wc -c makefile`" then echo shar: error transmitting makefile '(should have been 2366 characters)' fi echo shar: extracting nil '(3 characters)' sed 's/^XX//' << \SHAR_EOF > nil XX<> SHAR_EOF if test 3 -ne "`wc -c nil`" then echo shar: error transmitting nil '(should have been 3 characters)' fi echo shar: extracting set.fp '(3584 characters)' sed 's/^XX//' << \SHAR_EOF > set.fp XX# set.fp: defines, implements set operations on lists. XX# A set is a collection of possibly unrelated items. Items XX# may be added to this collection or deleted from it, or XX# the existence of an item may be inquired about. XX# An item is in the set if it is in the list at the top level. XX# For instance, x and are in the set x>, XX# but neither y nor z are in the set. Multiple copies of XX# an item are allowed in a set. XX# operations provided are: XX# member: returns whether the item is in the set. XX# include: returns a new set where the item has XX# been apndl'd to the set unless it was already present. XX# exclude: returns a new set where the item has XX# been deleted from the set if it was there, and the XX# original set otherwise. XX# includem: < set> returns a new set where all the XX# items have included, in the reverse order: in XX# other words, the two lists are appended, and the XX# first copy of any duplicates is then deleted. XX# excludem: < set> returns a new set where any XX# item from item* is excluded. XX# index: returns the index (position) of XX# the item in the set, or 0 if member would return false XX# if several copies of the item are present, it returns the first XX XXDef member null o 2 -> _F; XX \/or o aa = o distl XX XXDef include member -> 2; apndl XX XXDef exclude null o 2 -> 2; XX append o aa (!= -> tl; _<>) o distl XX XXDef includem /include o apndr XX XXDef excludem /exclude o apndr XX XX# each set element becomes >, then any that XX# match send up their value, then the first valid value is taken XXDef index null o 2 -> _0; XX \/((bu = 0) o 1 -> 2; 1) o aa (= o 2 -> 1; _0) o XX trans o [iota o length, id] o distl XX XXDef tstset [id, (\/and o aa = )] o XX [[member o _>, _F], XX [member o _, x>>, _T], XX [member o _<, , x>>, _T], XX [member o _, x>>, _F], XX [member o _, x>>, _F], XX [include o _>, _], XX [include o _>, _], XX [include o _>, _], XX [include o _>, _], XX [include o _>, _], XX [exclude o _>, _<>], XX [exclude o _>, _], XX [exclude o _>, _], XX [exclude o _>, _], XX [exclude o _>, _], XX [includem o _<, <>>, _], XX [includem o _<<>, <>>, _<>], XX [includem o _<<>, >, _], XX [includem o _<, >, _], XX [includem o _<, >, _], XX [includem o _<, >, _], XX [includem o _<, >, _], XX [excludem o _<, <>>, _<>], XX [excludem o _<<>, <>>, _<>], XX [excludem o _<<>, >, _], XX [excludem o _<, >, _], XX [excludem o _<, >, _], XX [excludem o _<, >, _], XX [excludem o _<, >, _<>], XX [index o _>, _0], XX [index o _>, _0], XX [index o _>, _1], XX [index o _>, _1], XX [index o _>, _1], XX [index o _>, _1], XX [index o _>, _2], XX [index o _>, _2], XX [index o _>, _2], XX [index o _>, _3], XX [index o _>, _3], XX [index o _>, _4]] SHAR_EOF if test 3584 -ne "`wc -c set.fp`" then echo shar: error transmitting set.fp '(should have been 3584 characters)' fi echo shar: extracting store.fp '(3838 characters)' sed 's/^XX//' << \SHAR_EOF > store.fp XX# A store is a place you can keep objects in and retrieve them XX# by key. A key should be an atom or a number -- later on XX# this may be extended. XX# newstore:x gives a (new) empty store XX# store:< store> stores the given value under key, possibly XX# replacing a previous value with the same key XX# retrieve: returns the pair associated with XX# the given key, or <> if the key is not in the store XX# unstore: removes the value with given key, if any. XX# allstored:store returns a list of pairs , one pair/key XX# storesize:store returns the number of values in the store XX# haskey: returns whether some value with the given key XX# is in the store. XX# current implementation: a store is a tree of XX# where left and right are also trees. XX# invariant: all keys in left are < than key, all keys in right are > XX# than key. XX# no kind of tree balancing is done for now XX XXDef newstore _<> XX XXDef store null o 2 -> [1 o 1, 2 o 1, _<>, _<>]; XX = o [1 o 1, 1 o 2] -> [1 o 2, 2 o 1, 3 o 2, 4 o 2]; XX < o [1 o 1, 1 o 2] -> XX [1 o 2, 2 o 2, store o [1, 3 o 2], 4 o 2]; XX [1 o 2, 2 o 2, 3 o 2, store o [1, 4 o 2]] XX XXDef retrieve null o 2 -> _<>; XX = o [1, 1 o 2] -> [1, 2 o 2]; XX < o [1, 1 o 2] -> retrieve o [1, 3 o 2]; XX retrieve o [1, 4 o 2] XX XXDef unstore haskey -> unstaux; 2 XX#unstaux is like unstore except it doesn't check for presence of key XXDef unstaux = o [1, 1 o 2] -> unstlift o 2; XX < o [1, 1 o 2] -> [1 o 2, 2 o 2, unstaux o [1, 3 o 2], 4 o 2]; XX [1 o 2, 2 o 2, 3 o 2, unstaux o [1, 4 o 2]] XX# unstlift replaces each node with its left subtree, recursively XXDef unstlift null o 3 -> 4; # we're at the end of left chaining. XX [1 o 3, 2 o 3, unstlift o 3, 4] XX XXDef allstored null -> id; apndl o [[1, 2], append o aa allstored o [3, 4]] XX XXDef storesize null -> _0; (bu + 1) o + o aa storesize o [3, 4] XX XXDef haskey null o 2 -> _F; XX = o [1, 1 o 2] -> _T; XX < o [1, 1 o 2] -> haskey o [1, 3 o 2]; XX haskey o [1, 4 o 2] XX XXDef tststore [id, (\/and o aa = )] o XX [[haskey o [_1, store o [_<1, garble>, newstore]], _T], XX [haskey o [_1, store o [_<2, garble>, newstore]], _F], XX [retrieve o [_1, store o [_<2, garble>, XX store o [_<3, foo>, newstore]]], _<>], XX [retrieve o [_2, store o [_<2, garble>, newstore]], _<2, garble>], XX [retrieve o [_1, store o [_<2, garble>, XX store o [_<1, foo>, newstore]]], _<1, foo>], XX [retrieve o [_2, store o [_<2, garble>, XX store o [_<1, foo>, newstore]]], _<2, garble>], XX [retrieve o [_1, store o [_<1, foo>, XX store o [_<2, garble>, newstore]]], _<1, foo>], XX [retrieve o [_2, store o [_<2, garble>, XX store o [_<1, foo>, newstore]]], _<2, garble>], XX [allstored o store o [_<2, garble>, newstore], _<<2, garble>>], XX [allstored o newstore, _<>], XX [or, _T] o [(bu = <, >), (bu = <, >)] o XX allstored o store o [_, store o [_, newstore]], XX [storesize o newstore, _0], XX [storesize o store o [_<1, useless>, newstore], _1], XX [storesize o store o [_, store o [_, newstore]], _2], XX [storesize o unstore o [_a, store o [_, newstore]], _1], XX [storesize o unstore o [_a, store o [_, newstore]], _0], XX [allstored o unstore o [_a, store o [_, XX store o [_, newstore]]], XX _<>], XX [allstored o unstore o [_c, store o [_, XX store o [_, newstore]]], XX _<>], XX [allstored o unstore o [_c, store o [_, newstore]], _<>], XX [allstored o unstore o [_a, store o [_, newstore]], XX _<>] XX ] SHAR_EOF if test 3838 -ne "`wc -c store.fp`" then echo shar: error transmitting store.fp '(should have been 3838 characters)' fi echo shar: done with directory lib cd .. echo shar: creating directory main mkdir main cd main echo shar: extracting cart.fp '(135 characters)' sed 's/^XX//' << \SHAR_EOF > cart.fp XXDef distribute append o (aa (aa apndl)) o (aa distl) o distr XXDef cart (null o tl -> (aa [id]) o 1; XX distribute o [1, cart o tl]) SHAR_EOF if test 135 -ne "`wc -c cart.fp`" then echo shar: error transmitting cart.fp '(should have been 135 characters)' fi echo shar: extracting cart1.fp '(345 characters)' sed 's/^XX//' << \SHAR_EOF > cart1.fp XX# this one comes from the paper "Structuring FP-style functional XX# programs", by A. C. Fleck, Comp. Lang., Vol. 11, No. 2, pp. 55-63, XX# 1986, where it is called dir_prod (direct product). XX# XX# note: unlike cart, it only does the cartesian product of two XX# (instead of infinitely many) vectors. XXDef cart1 (null -> id; \/append) o aa distl o distr SHAR_EOF if test 345 -ne "`wc -c cart1.fp`" then echo shar: error transmitting cart1.fp '(should have been 345 characters)' fi echo shar: extracting extra.fp '(1044 characters)' sed 's/^XX//' << \SHAR_EOF > extra.fp XXDef extra [id, \/and] o [tstappend, tstimplode, tstexplode] XX XXDef tstappend \/and o aa = o trans o XX [aa append o XX _<<<>>, XX <<>, <>, <>, <>, >, XX <, , , , >, XX <<, >, <, >, >, XX <<, >, <, >, <>>, XX <<>, <>, <>, <>, <>>, XX <, , <>>, XX <, >>, XX _<<>, XX , XX , XX <, , , , i, j>, XX <, , , , >, XX <>, XX , XX >] XX XXDef tstimplode \/and o aa = o trans o XX [aa implode o XX _<"hello", XX "hi", XX "myname", XX "here_I_am", XX "hi there">, XX apndr o [(bu apndr ) o implode o _"here_I_am", XX implode o _"hi there"]] XX XXDef tstexplode \/and o aa = o trans o XX [aa explode o XX apndr o [(bu apndr ) o implode o _"here_I_am", XX implode o _"hi there"], XX _<"hello", XX "hi", XX "myname", XX "here_I_am", XX "hi there">] SHAR_EOF if test 1044 -ne "`wc -c extra.fp`" then echo shar: error transmitting extra.fp '(should have been 1044 characters)' fi echo shar: extracting fib.fp '(65 characters)' sed 's/^XX//' << \SHAR_EOF > fib.fp XXDef fib (bu >= 1) -> id; XX + o [fib o (bur - 1), fib o (bur - 2)] SHAR_EOF if test 65 -ne "`wc -c fib.fp`" then echo shar: error transmitting fib.fp '(should have been 65 characters)' fi echo shar: extracting flatten.fp '(58 characters)' sed 's/^XX//' << \SHAR_EOF > flatten.fp XXDef flatten null -> id; atom -> [id]; append o aa flatten SHAR_EOF if test 58 -ne "`wc -c flatten.fp`" then echo shar: error transmitting flatten.fp '(should have been 58 characters)' fi echo shar: extracting histo.fp '(1066 characters)' sed 's/^XX//' << \SHAR_EOF > histo.fp XXDef histo puthisto o countns o breakwords XX XX# breakwords : <"string with blank-separated words"> => XXDef breakwords append o XX aa ((bu = ' ) o 1 -> [tl]; XX (bu = " ") -> _<>; XX = o [newline, id] -> _<>; XX [id]) o XX breakup o XX [((bu = 1) o 1 -> id; (bu apndl 1)) o allblanks, id] XX XX# countns: => <#stringsoflength=pos*> XXDef countns aa (\/+ o aa (= -> _1; _0) o distl) o XX# passing up <<1, <...>>, <2, <...>>, .. >>, XX# where <...> stands for the array of lengths XX distr o [iota o \/maxnum, id] o aa length XX XX# puthisto: => XX# if max (n1..nq) > 72, then scaling is used to reduce the max to 72 XXDef puthisto (bur > 72) o \/maxnum -> XX puthisto o aa (trunc o *) o XX distr o [id, (bu div 72.0) o \/maxnum]; XX append o aa (append o [aa _'# o iota, newline]) XX XX# allblanks: "string" => XXDef allblanks append o XX aa ((bu = ' ) o 2 -> tlr; XX = o [1 o newline, 2] -> tlr; XX _<>) o XX pairpos XX XXDef maxnum > -> 1; 2 SHAR_EOF if test 1066 -ne "`wc -c histo.fp`" then echo shar: error transmitting histo.fp '(should have been 1066 characters)' fi echo shar: extracting makefile '(151 characters)' sed 's/^XX//' << \SHAR_EOF > makefile XXFPFLAGS = XXFPRTS = ../fp.o XX XX.SUFFIXES: XX XX.SUFFIXES: .fp .run XX XX.fp.run: $*.fp XX fpc -m ${FPFLAGS} $*.fp XX cc -o $* ${CFLAGS} $*.c ${FPRTS} XX rm -f $*.c $*.o SHAR_EOF if test 151 -ne "`wc -c makefile`" then echo shar: error transmitting makefile '(should have been 151 characters)' fi echo shar: extracting mat.out '(82 characters)' sed 's/^XX//' << \SHAR_EOF > mat.out XX<<40, 34, 28, 22>, XX<112, 97, 82, 67>, XX<184, 160, 136, 112>, XX<256, 223, 190, 157>> SHAR_EOF if test 82 -ne "`wc -c mat.out`" then echo shar: error transmitting mat.out '(should have been 82 characters)' fi echo shar: extracting mat.tst '(239 characters)' sed 's/^XX//' << \SHAR_EOF > mat.tst XX<<<1, 2, 3>, XX <4, 5, 6>, XX <7, 8, 9>, XX <10, 11, 12>>, XX <<12, 11, 10, 9>, XX <8, 7, 6, 5>, XX <4, 3, 2, 1>>> XX XXexpected result of matrix multiplication is: XX<<40, 34, 28, 22>, XX <112, 97, 82, 67>, XX <184, 160, 136, 112>, XX <256, 223, 190, 157>> SHAR_EOF if test 239 -ne "`wc -c mat.tst`" then echo shar: error transmitting mat.tst '(should have been 239 characters)' fi echo shar: extracting mmult.fp '(100 characters)' sed 's/^XX//' << \SHAR_EOF > mmult.fp XXDef IP (/+) o (aa *) o trans XX XXDef MM (aa aa IP) o (aa distl) o distr o [1, trans o 2] XX XXDef mmult MM SHAR_EOF if test 100 -ne "`wc -c mmult.fp`" then echo shar: error transmitting mmult.fp '(should have been 100 characters)' fi echo shar: extracting msort.fp '(232 characters)' sed 's/^XX//' << \SHAR_EOF > msort.fp XXDef msort # mergesort: => , sorted XX \/ merge o aa [id] XX XXDef merge null o 1 -> 2; XX null o 2 -> 1; XX < o aa 1 -> apndl o [1 o 1, merge o [tl o 1, 2]]; XX apndl o [1 o 2, merge o [1, tl o 2]] SHAR_EOF if test 232 -ne "`wc -c msort.fp`" then echo shar: error transmitting msort.fp '(should have been 232 characters)' fi echo shar: extracting newsels.fp '(157 characters)' sed 's/^XX//' << \SHAR_EOF > newsels.fp XXDef min \/( < -> 1; 2) XXDef exclude append o aa ( = -> _<>; tl) o distl XXDef newsels (bu >= 1) o length -> id; XX apndl o [1, newsels o exclude] o [min, id] SHAR_EOF if test 157 -ne "`wc -c newsels.fp`" then echo shar: error transmitting newsels.fp '(should have been 157 characters)' fi echo shar: extracting nil '(3 characters)' sed 's/^XX//' << \SHAR_EOF > nil XX<> SHAR_EOF if test 3 -ne "`wc -c nil`" then echo shar: error transmitting nil '(should have been 3 characters)' fi echo shar: extracting nqueens.fp '(1801 characters)' sed 's/^XX//' << \SHAR_EOF > nqueens.fp XX# nqueens.fp: gives all solutions for placing n queens on an nxn XX# chessboard in such a way that they do not threaten each other XX# Typical call: XX# nqueens 8 XX XX# nqueens : n => board printout, or nil XXDef nqueens prtboards o nmqueens o [id, id] XX XX# nmqueens : => list of n safe row positions for n queens on an XX# n-column by m-row chessboard. Precondition: n <= m XX# e.g., nmqueens : <2, 3> => <<1, 3>, <3, 1>> XXDef nmqueens (bu = 1) o 1 -> aa [id] o iota o 2; XX append o aa (null -> id; [id]) o aa safe o XX append o aa distl o distr o XX [iota o 2, nmqueens o [(bur - 1) o 1, 2]] XX XX# safe : => if safe, <> otherwise XX# e.g. safe : <3, <1, 4, 7>> => <3, 1, 4, 7>, safe : <3, <4, 1, 7>> => <> XXDef safe \/and o aa saferow o aa apndl o pairpos o distl -> apndl ; _<> XX XX# pairpos : ==> <<1 x1>..> XXDef pairpos null -> _<>; trans o [iota o length, id] XX XX# saferow : => whether a queen placed at XX# (row@col1, 1) is safe from one at (row@col, col) XXDef saferow \/and o aa != o [tl, [1, - o tl], [1, neg o - o tl]] XX XX# prtboards : => board1 ++ newline ++ .. ++ boardn XXDef prtboards null -> _"no solution found"; mergelines o aa prtboard XX XX# prtboard : => printed form of the board, where Q represents XX# a position, _ a blank, and rows are terminated by newlines. e.g. XX# prtboard: <1, 3, 2> => "Q__\n__Q\n_Q_\n", where \n represents new line. XXDef prtboard mergelines o trans o aa prtcol o distr o [id, length] XX XX# prtcol : => printed form of the column containing the given row XXDef prtcol aa (= -> _'Q; _'_) o distl o [1, iota o 2] XX XX# mergelines: => str, where str is the concatenation of the XX# stri's separated by newlines XXDef mergelines append o aa (append o [id, newline]) SHAR_EOF if test 1801 -ne "`wc -c nqueens.fp`" then echo shar: error transmitting nqueens.fp '(should have been 1801 characters)' fi echo shar: extracting parprimes.fp '(216 characters)' sed 's/^XX//' << \SHAR_EOF > parprimes.fp XXDef elim (bu = 0) o mod o reverse -> _<>; XX [2] XXDef filter null o 2 -> 2; XX /(/apndl o apndr) o aa elim o distl XXDef sieve null -> id; XX apndl o [1, sieve o filter o [1, tl]] XXDef parprimes sieve o tl o iota SHAR_EOF if test 216 -ne "`wc -c parprimes.fp`" then echo shar: error transmitting parprimes.fp '(should have been 216 characters)' fi echo shar: extracting permsort.fp '(415 characters)' sed 's/^XX//' << \SHAR_EOF > permsort.fp XXDef permute append o aa append o aa aa (= o [1 o 1, 2] -> [2 o 1]; _<>) o XX aa distr o distl o [id, iota o length] XX # permute : <,..> where {iy} = 1..n ==> XX # where ij = 1, ik = n and so on for the intermediate i's XXDef rank \/+ o aa ( < -> _0; _1) o distl XX # rank : > ==> m where m is the number of xi's <= x XX XXDef permsort permute o trans o [aa rank o distr o [id, id], id] SHAR_EOF if test 415 -ne "`wc -c permsort.fp`" then echo shar: error transmitting permsort.fp '(should have been 415 characters)' fi echo shar: extracting powerset.fp '(346 characters)' sed 's/^XX//' << \SHAR_EOF > powerset.fp XX# powerset: => powerset of XX# e.g. powerset: <> => <<>> XX# powerset: => <<>, > XX# powerset: <1 2> => <<>, <1>, <2>, <1, 2>> XX# powerset: <1 2 3> => <<>, <1>, <2>, <3>, <1, 2>, <1, 3>, <2, 3>, XX# <1, 2, 3>> XX# and so on. XXDef powerset null -> [id]; XX append o [aa apndl o distl o [1, 2], 2] o [1, powerset o tl] SHAR_EOF if test 346 -ne "`wc -c powerset.fp`" then echo shar: error transmitting powerset.fp '(should have been 346 characters)' fi echo shar: extracting primes.fp '(223 characters)' sed 's/^XX//' << \SHAR_EOF > primes.fp XXDef filter null o 2 -> _<>; XX (bu = 0) o mod o [1 o 2, 1] -> filter o [1, tl o 2]; XX apndl o [1 o 2, filter o [1, tl o 2]] XXDef sieve (null -> _<>; XX apndl o [1, sieve o filter o [1, tl]]) XXDef primes sieve o tl o iota SHAR_EOF if test 223 -ne "`wc -c primes.fp`" then echo shar: error transmitting primes.fp '(should have been 223 characters)' fi echo shar: extracting prims.fp '(8494 characters)' sed 's/^XX//' << \SHAR_EOF > prims.fp XX# prims.fp: test suite for any implementation of FP or FP/FFP XXDef prims [id, \/and] o XX [testtl, testtlr, XX testrotl, testrotr, XX testid, testatom, XX testdistl, testdistr, XX testapndl, testapndr, XX testeq, testnoteq, XX testleq, testgeq, XX testless, testgreater, XX testplus, testminus, XX testtimes, testdiv, XX testneg, testmod, XX testnull, testlength, XX testtrans, testreverse, XX testand, testor, XX testnot, testiota] XX XXDef testand \/and o aa = o XX (bu trans ) o aa and o _<, , , > XX XXDef testapndl \/and o aa = o XX (bu trans <, , , <<>>, <>, <, >>) o XX aa apndl o XX _<>, >, >, <<>, <>>, <, <>>, XX <, <>>> XX XXDef testapndr \/and o aa = o XX (bu trans <, , , <<>>, <>, <, >>) o XX aa apndr o XX _<<<>, a>, <, b>, <, c>, <<>, <>>, <<>, >, XX <<>, >> XX XXDef testatom \/and o aa = o XX (bu trans ) o XX aa atom o XX _, 1, 1.0, a, 'a, "string", , XX <"vector">, > XX XXDef testdistl \/and o aa = o XX (bu trans <<>, <>, <, >, <<<>, 1>, XX <<>, 2>, <<>, 3>>>) o XX aa distl o _<>, >, >, <<>, <1, 2, 3>>> XX XXDef testdistr \/and o aa = o XX (bu trans <<>, <>, <, >, XX <>, >, >>>) o XX aa distr o _<<<>, x>, <, 1>, <, 2>, <, <>>> XX XXDef testdiv \/and o aa = o XX (bu trans XX <1, 1, 0, 2, -12, -3, 6, XX 1.0, 1.0, 0.5, 2.0, -8.75, -17.5, 6.25>) o XX aa div o XX _<<1, 1>, <10, 10>, <1, 2>, <2, 1>, <35, -3>, <-35, 17>, <-27, -4>, XX <1, 1.0>, <10.0, 10>, <1.0, 2.0>, <2.0, 1>, <35, -4.0>, XX <-35.0, 2.0>, <-25.0, -4.0>> XX XXDef testeq \/and o aa = o XX (bu trans XX ) o aa = o XX _<<1, 1>, <1, 0>, <1, a>, <1, 'a>, <1, 1.0>, <1, 0.99>, XX <1, <>>, <1, T>, <1, F>, <1, <1>>, XX , , , , , >, XX , , >, XX <'a, 'a>, <'a, 'b>, <'a, 1>, <'a, a>, <'a, 1.0>, XX <'a, <>>, <'a, T>, <'a, F>, <'a, <'a>>, XX <1.0, 1.0>, <1.0, 2.0>, <1.0, 1>, <1.1, 1>, <1.0, 'a>, XX <1.0, a>, <1.0, <>>, <1.0, T>, <1.0, F>, <1.0, <1.0>>, XX , , , , >, , >, XX , , , , >, , >, XX <<>, <>>, <<>, 1>, <<>, 'F>, <<>, 1.0>, <<>, T>, <<>, F>, XX <<>, <<>>>, XX <, >, <, >, <, 1>, <, 'a>, <, 1.0>, XX <, <>>, <, T>, <, F>, <, <>>, XX <, >, e>, , >, e>>, XX <, >, e>, , >, e>>> XX XX# only test geq on atoms, chars and numbers. Particular implementations XX# may have it defined for other values as well, but that is not portable XXDef testgeq \/and o aa = o XX (bu trans ) o XX aa >= o XX _<<1, 0>, <1, 1>, <1, 2>, XX <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>, XX <1, 0.99>, <1, 1.0>, <1, 1.01>, XX <1.01, 1>, <1.0, 1>, <0.99, 1>, XX , , , XX <'m, 'a>, <'m, 'm>, <'m, 'z>> XX XXDef testgreater \/and o aa = o XX (bu trans ) o XX aa > o XX _<<1, 0>, <1, 1>, <1, 2>, XX <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>, XX <1, 0.99>, <1, 1.0>, <1, 1.01>, XX <1.01, 1>, <1.0, 1>, <0.99, 1>, XX , , , XX <'m, 'a>, <'m, 'm>, <'m, 'z>> XX XXDef testid \/and o aa = o XX (bu trans <1, a, 'a, 1.0, T, F, <>, "id", >) o XX aa id o _<1, a, 'a, 1.0, T, F, <>, "id", > XX XXDef testiota \/and o aa = o XX (bu trans <<>, <1>, <1, 2>, <1, 2, 3, 4, 5, 6, 7, 8, 9, 10>>) o XX aa iota o _<0, 1, 2, 10> XX XXDef testlength \/and o aa = o XX (bu trans <0, 1, 1, 2, 3, 4, 10>) o XX aa length o XX _<<>, <1>, <<<>>>, <, >, "xyz", "four", "lenght ten"> XX XXDef testleq \/and o aa = o XX (bu trans ) o XX aa <= o XX _<<1, 0>, <1, 1>, <1, 2>, XX <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>, XX <1, 0.99>, <1, 1.0>, <1, 1.01>, XX <1.01, 1>, <1.0, 1>, <0.99, 1>, XX , , , XX <'m, 'a>, <'m, 'm>, <'m, 'z>> XX XXDef testless \/and o aa = o XX (bu trans ) o XX aa < o XX _<<1, 0>, <1, 1>, <1, 2>, XX <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>, XX <1, 0.99>, <1, 1.0>, <1, 1.01>, XX <1.01, 1>, <1.0, 1>, <0.99, 1>, XX , , , XX <'m, 'a>, <'m, 'm>, <'m, 'z>> XX XXDef testminus \/and o aa = o XX (bu trans <1, -1, 0, 11, -5, 3, -5>) o XX aa - o XX _<<1, 0>, <0, 1>, <1, 1>, <7, -4>, <-3, 2>, <-5, -8>, <-8, -3>> XX XXDef testmod \/and o aa = o XX (bu trans <0, 0, 1, 0, 1, 16, 3>) o XX aa mod o XX _<<1, 1>, <10, 10>, <1, 2>, <2, 1>, <35, -3>, <-35, 17>, <-27, -4>> XX XXDef testneg \/and o aa = o (bu trans <0, 0, 1, -1.0, 15.2, -17>) o XX aa neg o _<0, -0, -1, 1.0, -15.2, 17> XX XXDef testnot \/and o aa = o (bu trans ) o aa not o _ XX XXDef testnoteq \/and o aa = o XX (bu trans XX ) o aa != o XX _<<1, 1>, <1, 0>, <1, a>, <1, 'a>, <1, 1.0>, <1, 0.99>, XX <1, <>>, <1, T>, <1, F>, <1, <1>>, XX , , , , , >, XX , , >, XX <'a, 'a>, <'a, 'b>, <'a, 1>, <'a, a>, <'a, 1.0>, <'a, <>>, XX <'a, T>, <'a, F>, <'a, <'a>>, XX <1.0, 1.0>, <1.0, 2.0>, <1.0, 1>, <1.1, 1>, <1.0, 'a>, <1.0, a>, XX <1.0, <>>, <1.0, T>, <1.0, F>, <1.0, <1.0>>, XX , , , , >, , >, XX , , , , >, , >, XX <<>, <>>, <<>, 1>, <<>, 'F>, <<>, 1.0>, <<>, T>, <<>, F>, XX <<>, <<>>>, XX <, >, <, >, <, 1>, <, 'a>, <, 1.0>, XX <, <>>, <, T>, <, F>, <, <>>, XX <, >, e>, , >, e>>, XX <, >, e>, , >, e>>> XX XXDef testnull \/and o aa = o XX (bu trans ) o XX aa null o _<<>, 0, 1, a, '0, T, F, "", "nil", , XX , <, t, e>, r>> XX XXDef testor \/and o aa = o XX (bu trans ) o aa or o _<, , , > XX XXDef testplus \/and o aa = o XX (bu trans <0, 2, 1, 1, -2, 3, -9>) o XX aa + o _<<0, 0>, <1, 1>, <1, 0>, <0, 1>, <1, -3>, <-5, 8>, <-4, -5>> XX XXDef testreverse \/and o aa = o XX (bu trans XX <<>, , , <4, 3, 2, 1>, <, , >>) o XX aa reverse o XX _<<>, , , <1, 2, 3, 4>, <, , >> XX XXDef testrotl \/and o aa = o XX (bu trans XX <<>, , , <2, 3, 4, 5, 1>, <, , >>) o XX aa rotl o XX _<<>, , , <1, 2, 3, 4, 5>, <, , >> XX XXDef testrotr \/and o aa = o XX (bu trans XX <<>, , , <5, 1, 2, 3, 4>, <, , >>) o XX aa rotr o XX _<<>, , , <1, 2, 3, 4, 5>, <, , >> XX XXDef testtimes \/and o aa = o XX (bu trans <0, 0, 0, 9, -2, -4, 6, 6, 28, -18, -10>) o XX aa * o XX _<<0, 0>, <0, 5>, <1, 0>, <1, 9>, <1, -2>, <-1, 4>, <-1, -6>, XX <-2, -3>, <4, 7>, <-6, 3>, <5, -2>> XX XXDef testtl \/and o aa = o XX (bu trans <<>, , , <<>>, <>, <, >>) o XX aa tl o XX _<, <1, a>, , >, >, <, , >> XX XXDef testtlr \/and o aa = o XX (bu trans <<>, , , <<>>, <>, <, >>) o XX aa tlr o XX _<, , , <<>, a>, <, x>, <, , >> XX XXDef testtrans \/and o aa = o XX (bu trans XX <<>, <>, <>, XX <, , , , , >, <<1, 2, 3, 4, 5>>, XX <, >, <, , >, XX <, , , , >>) o XX aa trans o XX _<<<>>, <<>, <>>, <<>, <>, <>, <>, <>>, XX <>, <<1>, <2>, <3>, <4>, <5>>, XX <, >, <, <1, 2, 3>, >, XX <, <1, 2, 3, 4, 5>, >> SHAR_EOF if test 8494 -ne "`wc -c prims.fp`" then echo shar: error transmitting prims.fp '(should have been 8494 characters)' fi echo shar: extracting printf.fp '(3320 characters)' sed 's/^XX//' << \SHAR_EOF > printf.fp XX# printf.fp: provides fpprintf and fpscanf, functions defined like XX# the corresponding C functions. XX# e.g. fpprintf: <"hello %c %s\n", 'x, "string"> would return XX# "hello x string" XX# for now, field lengths are not defined XXDef fpprintf append o aa format o trans o [parsectrl, distformats] XX XX# parsectrl: "control %x string%y \n" => <"control %x", "string%y", " "> XXDef parsectrl breakup o XX# next two lines, check that 1 is in the list of break up positions XX (null o 1 -> [_<1>, 2]; XX (bu != 1) o 1 o 1 -> [(bu apndl 1) o 1, 2]; id) o XX# next line, make sure that the last break-up position is needed XX (> o [1r o 1, length o 2] -> [tlr o 1, 2]; id) o XX# figure out preliminary break-up positions, put newlines XX [append o aa parsebreak o pairpos o tl o allpairs, XX id] o subnewline o 1 XX XX# parsebreak: > => <> if c1 != %, if c1 = % XXDef parsebreak (bu = '%) o 1 o 2 -> [(bu + 2) o 1]; _<> XX XX# subnewline: string => string with newline instead of every \n XXDef subnewline append o aa subcharpair o tlr o allpairs XX XX# subcharpair: => newline if c1 = \, c2 = n; otherwise XXDef subcharpair (bu = '\\) o 2 -> _<>; (bu = "\n") -> newline; [2] XX XX# format: => XXDef format (bur < 2) o length o 1 -> 1; # end of format string XX (bu != '%) o 2r o 1 -> 1; # same XX (bu = 's) o 1r o 1 -> XX append o [tlr o tlr o 1, subnewline o 2]; # cat strings XX (bu = 'd) o 1r o 1 -> XX append o [tlr o tlr o 1, (bur numtostring 10) o 2]; XX (bu = 'x) o 1r o 1 -> XX append o [tlr o tlr o 1, (bur numtostring 16) o 2]; XX (bu = 'o) o 1r o 1 -> XX append o [tlr o tlr o 1, (bur numtostring 8) o 2]; XX (bu = 'c) o 1r o 1 -> XX apndr o [tlr o tlr o 1, 2]; XX (bu error "fpprintf: unknown format was used") XX XX# distformats: => or XX# , the former in the case that the last XX# 2 elements of format-string are %c, where c is any character. XXDef distformats (bur < 2) o length o 1 -> tl; XX (bu = '%) o 2r o 1 -> tl; XX rotl XX XX# numtostring: => "xyz", a string corresponding to the printable XX# form, in the given base, of the number n. XXDef numtostring (bur < 0) o 1 -> XX (bu apndl '-) o numtostring o [neg o 1, 2]; XX aa printdigit o reverse o makedigits XX XX# makedigits: => , where digx < base XXDef makedigits < -> [1]; apndl o [mod, makedigits o [div, 2]] XX XX# printdigit: n => the character corresponding to n (0 <= n < 16) XXDef printdigit 1 o (bur seln "0123456789ABCDEF") o XX [(bu + 1), _1] XX XXDef charalpha or o [charupper, charlower] XX XXDef charupper and o [(bur >= 'A), (bu >= 'Z)] XX XXDef charlower and o [(bur >= 'a), (bu >= 'z)] XX XXDef chardigit and o [(bur >= '0), (bu >= '9)] XX XXDef charhexdig \/or o [chardigit, XX and o [(bur >= 'a), (bu >= 'f)], XX and o [(bur >= 'A), (bu >= 'F)]] XX XXDef charoctdig and o [(bur >= '0), (bu >= '7)] XX XXDef charspace or o [(bu = ' ), (bu = ' )] XX XXDef tstfpprintf [aa 2, \/and o aa =] o trans o [ XX_<"hi there, XX274 high, 3D4F lo, -247 octal XX", XX "how do you compute prime numbers 13 and 17? XXa new result">, XX aa fpprintf o XX [[_"h%s\\n%d h%cgh, %x lo, %o octal%s", XX _"i there,", _274, _'i, _15695, _-167, newline], XX [_"how do %s prime numbers %d and %x?%sa new result", XX _"you compute", _13, _23, _"\\n"]]] SHAR_EOF if test 3320 -ne "`wc -c printf.fp`" then echo shar: error transmitting printf.fp '(should have been 3320 characters)' fi echo shar: extracting printhex.fp '(86 characters)' sed 's/^XX//' << \SHAR_EOF > printhex.fp XX# printhex.fp: print a number in hexadecimal notation XXDef printhex bu fpprintf "%x\n" SHAR_EOF if test 86 -ne "`wc -c printhex.fp`" then echo shar: error transmitting printhex.fp '(should have been 86 characters)' fi echo shar: extracting qsort.fp '(211 characters)' sed 's/^XX//' << \SHAR_EOF > qsort.fp XXDef before append o aa ( > -> tl ; _<> ) XXDef same append o aa ( = -> tl ; _<> ) XXDef after append o aa ( < -> tl ; _<> ) XX XXDef qsort null -> id; XX append o [qsort o before, same, qsort o after] o distl o [1, id] SHAR_EOF if test 211 -ne "`wc -c qsort.fp`" then echo shar: error transmitting qsort.fp '(should have been 211 characters)' fi echo shar: extracting selsort.fp '(221 characters)' sed 's/^XX//' << \SHAR_EOF > selsort.fp XXDef reorder atom o 2 -> reorder o [1, [2]]; XX < o [1, 1 o 2] -> apndl; XX apndl o [1 o 2, apndl o [1, tl o 2]] XX XXDef selsort atom -> id; XX (bu >= 1) o length -> id; XX apndl o [1, selsort o tl] o /reorder SHAR_EOF if test 221 -ne "`wc -c selsort.fp`" then echo shar: error transmitting selsort.fp '(should have been 221 characters)' fi echo shar: extracting sort.out '(542 characters)' sed 's/^XX//' << \SHAR_EOF > sort.out XX<1, XX11, XX38, XX43, XX53, XX59, XX90, XX136, XX182, XX230, XX273, XX302, XX339, XX350, XX352, XX364, XX379, XX381, XX423, XX424, XX440, XX455, XX479, XX538, XX540, XX579, XX611, XX615, XX631, XX639, XX663, XX680, XX684, XX699, XX703, XX720, XX763, XX785, XX821, XX827, XX832, XX914, XX919, XX929, XX931, XX940, XX940, XX941, XX959, XX970, XX972, XX1032, XX1139, XX1261, XX1275, XX1289, XX1368, XX1469, XX1567, XX2040, XX2724, XX3329, XX3594, XX3668, XX3682, XX3716, XX3926, XX4219, XX4328, XX4751, XX4923, XX5106, XX5307, XX5569, XX5681, XX5693, XX5764, XX6242, XX6332, XX6512, XX6678, XX6707, XX6963, XX7163, XX7685, XX7746, XX7837, XX7872, XX7927, XX7961, XX8505, XX8571, XX8762, XX9144, XX9208, XX9216, XX9480, XX9621, XX9719, XX9868> SHAR_EOF if test 542 -ne "`wc -c sort.out`" then echo shar: error transmitting sort.out '(should have been 542 characters)' fi echo shar: extracting sort.tst '(542 characters)' sed 's/^XX//' << \SHAR_EOF > sort.tst XX<53, XX914, XX827, XX302, XX631, XX785, XX230, XX11, XX1567, XX350, XX5307, XX339, XX929, XX9216, XX479, XX703, XX699, XX90, XX440, XX3926, XX1032, XX3329, XX3682, XX5764, XX615, XX7961, XX273, XX1275, XX38, XX4923, XX540, XX43, XX7837, XX1368, XX7746, XX1469, XX8505, XX4328, XX9480, XX424, XX6678, XX1139, XX763, XX959, XX6707, XX6242, XX663, XX59, XX6332, XX455, XX7685, XX3716, XX136, XX720, XX832, XX4751, XX5681, XX5106, XX379, XX9719, XX381, XX919, XX7163, XX4219, XX639, XX1261, XX2040, XX9144, XX941, XX7872, XX5569, XX972, XX364, XX684, XX931, XX423, XX7927, XX3594, XX182, XX611, XX1, XX9868, XX680, XX538, XX940, XX6512, XX1289, XX9621, XX970, XX3668, XX5693, XX352, XX940, XX9208, XX8571, XX579, XX821, XX6963, XX2724, XX8762> SHAR_EOF if test 542 -ne "`wc -c sort.tst`" then echo shar: error transmitting sort.tst '(should have been 542 characters)' fi echo shar: extracting whilefact.fp '(130 characters)' sed 's/^XX//' << \SHAR_EOF > whilefact.fp XXDef nonnull (bu != 0) o 2 XXDef multdecr [ * o [1, 2], - o [2, _1]] XXDef wfact while nonnull multdecr XXDef whilefact 1 o (bu wfact 1) SHAR_EOF if test 130 -ne "`wc -c whilefact.fp`" then echo shar: error transmitting whilefact.fp '(should have been 130 characters)' fi echo shar: done with directory main cd .. # End of shell archive exit 0