rsalz@uunet.uu.net (Rich Salz) (10/24/89)
Submitted-by: Edoardo Biagioni <biagioni@cs.unc.edu>
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: <x, y, 'a> => "xya"
XXDef fpformat append o aa formsingle
XX
XX# fpscan: <<format symbols or strings>, "string"> =>
XX# <<matches>, "rest of string>
XXDef fpscan null o 1 -> id;
XX null o 2 -> _<<>, <>>;
XX (null o 1 -> [_<>, 2 o 2];
XX # pass up: <<matches>, "rest of string">
XX [apndl o [1, 1 o 2], 2 o 2] o
XX # pass up: <element, <<matches>, "rest of string">>
XX [1, fpscan o 2]) o
XX # pass up: <element, <<rest of formats>, "rest of string">>
XX [1 o 1, [2, 2 o 1]] o
XX # pass up: <<element, "rest of string">, <rest of formats>>
XX [scanfirst o [1 o 1, 2], tl o 1]
XX
XX# scanfirst: <format "string"> => <match, "rest of string"> 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" => <symbol at start of string, "rest of string">
XXDef scansymbol [implode o 1, 2] o breakblanks o skipblanks
XX
XX# scannumber: "string" => <number at start of string, "rest of string">, or
XX# <<>, "string"
XXDef scannumber (null o 1 -> scaninteger o 2; id) o scanfloat
XX
XX# scanboolean: "string" => <boolean, "rest of 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" => <first character, "tail of string">
XXDef scancharacter [1, tl]
XX
XX# scaninteger: "string" => <integer at start of string, "rest of 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" => <float at start of string, "rest of 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: <intpart, "fract+rest"> => <float, "rest">
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: <intpart, <fractpart, "rest">, "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> => 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" => <string up to first blank, string from (incl.)>
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" => <string up to first non-digit, string from (incl.)>
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: <n base> => "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: <n base> => <dig1, dig2 .. dign>, 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 _<<number, symbol, number, number, boolean, boolean,
XX 'c, character, integer, float, "hi", "hello">,
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 : <x1..xn> ==> <<1 x1>..<n xn>>
XXDef pairpos null -> _<>; trans o [iota o length, id]
XX
XX# allpairs : <x1..xn> ==> <<<> x1> <x1 x2>..<xn <>>>
XXDef allpairs trans o [(bu apndl <>), apndr o [id, _<>]]
XX
XX# ntl : <n <x1..xm>> ==> <xn+1..xm>
XXDef ntl append o aa (>= o [1, 1 o 2] -> _<>; [2 o 2]) o
XX distl o [1, pairpos o 2]
XX
XX# nhd : <n <x1..xm>> ==> <x1..xn>
XXDef nhd append o aa (< o [1, 1 o 2] -> _<>; [2 o 2]) o
XX distl o [1, pairpos o 2]
XX
XX# seln : <<i l> <x1..xn>>, 1 <= i <= n, i + l <= n, l >= 0
XX# ==> <xi..xi+l-1>
XXDef seln nhd o [2 o 1, ntl o [- o [1 o 1, _1], 2]]
XX
XX# selectl: <i <x1..xn>>, 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: <<xn..x1> 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..in><x1..xm>>, i1 = 1, in <= m ==>
XX# <<i1 i2-i1>..<in m+1-in>>
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..in><x1..xm>>, i1 = 1, in <= m ==>
XX# <<x1..xi2-1><xi2..xi3-1>..<xin..xm>>
XXDef breakup aa seln o distr o [poslen, 2]
XX
XX# permute : <<i1 x1>..<in xn>> where {iy} = 1..n ==> <xj..xk>
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 : <x <x1..xn>> ==> 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, <a, b, c, d, e, f, g>>,
XX selectr o _<<a, b, c, d, e, f, g>, 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 <y z> are in the set <a x b <y z> 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: <item set> returns whether the item is in the set.
XX# include: <item set> returns a new set where the item has
XX# been apndl'd to the set unless it was already present.
XX# exclude: <item set> 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: <<item*> 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: <<item*> set> returns a new set where any
XX# item from item* is excluded.
XX# index: <item set> 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 <pos <item element>>, 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 _<a, <>>, _F],
XX [member o _<x, <a, x, b, <y, z>, x>>, _T],
XX [member o _<<y, z>, <a, x, b, <y, z>, x>>, _T],
XX [member o _<y, <a, x, b, <y, z>, x>>, _F],
XX [member o _<z, <a, x, b, <y, z>, x>>, _F],
XX [include o _<a, <>>, _<a>],
XX [include o _<a, <b, c, d>>, _<a, b, c, d>],
XX [include o _<b, <b, c, d>>, _<b, c, d>],
XX [include o _<c, <b, c, d>>, _<b, c, d>],
XX [include o _<d, <b, c, d>>, _<b, c, d>],
XX [exclude o _<a, <>>, _<>],
XX [exclude o _<d, <b, c, d>>, _<b, c>],
XX [exclude o _<c, <b, c, d>>, _<b, d>],
XX [exclude o _<b, <b, c, d>>, _<c, d>],
XX [exclude o _<a, <b, c, d>>, _<b, c, d>],
XX [includem o _<<a, b, c>, <>>, _<a, b, c>],
XX [includem o _<<>, <>>, _<>],
XX [includem o _<<>, <b, c, d>>, _<b, c, d>],
XX [includem o _<<a>, <b, c, d>>, _<a, b, c, d>],
XX [includem o _<<a, b>, <b, c, d>>, _<a, b, c, d>],
XX [includem o _<<b, a>, <b, c, d>>, _<a, b, c, d>],
XX [includem o _<<c, z, b, a, d>, <b, c, d>>, _<z, a, b, c, d>],
XX [excludem o _<<a, b, c>, <>>, _<>],
XX [excludem o _<<>, <>>, _<>],
XX [excludem o _<<>, <b, c, d>>, _<b, c, d>],
XX [excludem o _<<a>, <b, c, d>>, _<b, c, d>],
XX [excludem o _<<a, b>, <b, c, d>>, _<c, d>],
XX [excludem o _<<b, a>, <b, c, d>>, _<c, d>],
XX [excludem o _<<c, z, b, a, d>, <b, c, d>>, _<>],
XX [index o _<a, <b, c, d>>, _0],
XX [index o _<a, <>>, _0],
XX [index o _<a, <a, b, c, d>>, _1],
XX [index o _<a, <a, a, c, d>>, _1],
XX [index o _<a, <a, b, a, d>>, _1],
XX [index o _<a, <a, b, c, a>>, _1],
XX [index o _<b, <a, b, c, d>>, _2],
XX [index o _<b, <a, b, b, d>>, _2],
XX [index o _<b, <a, b, c, b>>, _2],
XX [index o _<c, <a, b, c, d>>, _3],
XX [index o _<c, <a, b, c, c>>, _3],
XX [index o _<d, <a, b, c, d>>, _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:<<key value> store> stores the given value under key, possibly
XX# replacing a previous value with the same key
XX# retrieve:<key store> returns the pair <key value> associated with
XX# the given key, or <> if the key is not in the store
XX# unstore:<key store> removes the value with given key, if any.
XX# allstored:store returns a list of pairs <key value>, one pair/key
XX# storesize:store returns the number of values in the store
XX# haskey:<key store> returns whether some value with the given key
XX# is in the store.
XX# current implementation: a store is a tree of <key value left right>
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 = <<a, b>, <c, d>>), (bu = <<c, d>, <a, b>>)] o
XX allstored o store o [_<a, b>, store o [_<c, d>, newstore]],
XX [storesize o newstore, _0],
XX [storesize o store o [_<1, useless>, newstore], _1],
XX [storesize o store o [_<a, b>, store o [_<c, d>, newstore]], _2],
XX [storesize o unstore o [_a, store o [_<c, d>, newstore]], _1],
XX [storesize o unstore o [_a, store o [_<a, b>, newstore]], _0],
XX [allstored o unstore o [_a, store o [_<a, b>,
XX store o [_<c, d>, newstore]]],
XX _<<c, d>>],
XX [allstored o unstore o [_c, store o [_<a, b>,
XX store o [_<c, d>, newstore]]],
XX _<<a, b>>],
XX [allstored o unstore o [_c, store o [_<c, d>, newstore]], _<>],
XX [allstored o unstore o [_a, store o [_<c, d>, newstore]],
XX _<<c, d>>]
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 <<>, <>, <>, <>, <a, b, c, d, e>>,
XX <<a, b>, <c, d>, <e, f>, <g, h>, <i, j>>,
XX <<<a, b>, <c, d>>, <<e, f>, <g, h>>, <i, j>>,
XX <<<a, b>, <c, d>>, <<e, f>, <g, h>>, <<i, j>>>,
XX <<>, <>, <>, <>, <>>,
XX <<a, b, c>, <d, e, f>, <>>,
XX <<a, b>, <c, d>>>,
XX _<<>,
XX <a, b, c, d, e>,
XX <a, b, c, d, e, f, g, h, i, j>,
XX <<a, b>, <c, d>, <e, f>, <g, h>, i, j>,
XX <<a, b>, <c, d>, <e, f>, <g, h>, <i, j>>,
XX <>,
XX <a, b, c, d, e, f>,
XX <a, b, c, d>>]
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 <hello, hi, myname>) 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 <hello, hi, myname>) 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"> => <vector of 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: <string*> => <#stringsoflength=pos*>
XXDef countns aa (\/+ o aa (= -> _1; _0) o distl) o
XX# passing up <<1, <...>>, <2, <...>>, .. <n, <...>>>,
XX# where <...> stands for the array of lengths
XX distr o [iota o \/maxnum, id] o aa length
XX
XX# puthisto: <n1..nq> => <histogram with q lines, each n1 to nq long>
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" => <position of blank in 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: <n1, n2, .., nx> => <ni, nj, .., nq>, 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 : <n, m> => 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 : <row, rowpositions> => <row | rowpositions> 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 : <x1..xn> ==> <<1 x1>..<n xn>>
XXDef pairpos null -> _<>; trans o [iota o length, id]
XX
XX# saferow : <col, row@col1, row@col> => 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 : <rowlist1..rowlistn> => board1 ++ newline ++ .. ++ boardn
XXDef prtboards null -> _"no solution found"; mergelines o aa prtboard
XX
XX# prtboard : <row1..rown> => 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 : <row size> => printed form of the column containing the given row
XXDef prtcol aa (= -> _'Q; _'_) o distl o [1, iota o 2]
XX
XX# mergelines: <str1..strn> => 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 : <<i1, x1>,..<in, xn>> where {iy} = 1..n ==> <xj,..xk>
XX # where ij = 1, ik = n and so on for the intermediate i's
XXDef rank \/+ o aa ( < -> _0; _1) o distl
XX # rank : <x, <x1,..xn>> ==> 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: <el1..eln> => powerset of <el1..eln>
XX# e.g. powerset: <> => <<>>
XX# powerset: <e> => <<>, <e>>
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 <F, F, F, T>) o aa and o _<<F, F>, <F, T>, <T, F>, <T, T>>
XX
XXDef testapndl \/and o aa = o
XX (bu trans <<a>, <a, b>, <a, b, c>, <<>>, <<a>>, <<a>, <b>>>) o
XX aa apndl o
XX _<<a, <>>, <a, <b>>, <a, <b, c>>, <<>, <>>, <<a>, <>>,
XX <<a>, <<b>>>>
XX
XXDef testapndr \/and o aa = o
XX (bu trans <<a>, <a, b>, <a, b, c>, <<>>, <<a>>, <<a>, <b>>>) o
XX aa apndr o
XX _<<<>, a>, <<a>, b>, <<a, b>, c>, <<>, <>>, <<>, <a>>,
XX <<<a>>, <b>>>
XX
XXDef testatom \/and o aa = o
XX (bu trans <T, T, T, T, T, T, T, F, F, F, F>) o
XX aa atom o
XX _<T, F, <>, 1, 1.0, a, 'a, "string", <vector>,
XX <"vector">, <v, e, c, t, o, r>>
XX
XXDef testdistl \/and o aa = o
XX (bu trans <<>, <<a, 1>>, <<b, 1>, <b, 2>>, <<<>, 1>,
XX <<>, 2>, <<>, 3>>>) o
XX aa distl o _<<x, <>>, <a, <1>>, <b, <1, 2>>, <<>, <1, 2, 3>>>
XX
XXDef testdistr \/and o aa = o
XX (bu trans <<>, <<a, 1>>, <<a, 2>, <b, 2>>,
XX <<a, <>>, <b, <>>, <c, <>>>>) o
XX aa distr o _<<<>, x>, <<a>, 1>, <<a, b>, 2>, <<a, b, c>, <>>>
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 <T, F, F, F, T, F, F, F, F, F,
XX T, F, F, F, F, F, F, F, F,
XX T, F, F, F, F, F, F, F, F,
XX T, F, T, F, F, F, F, F, F, F,
XX T, F, F, F, F, F, F,
XX T, F, F, F, F, F, F,
XX T, F, F, F, F, F, F,
XX T, F, F, F, F, F, F, F, F,
XX T, F>) 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 <a, a>, <a, b>, <a, 1>, <a, 'a>, <a, 1.0>, <a, <>>,
XX <a, T>, <a, F>, <a, <a>>,
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 <T, T>, <T, 1>, <T, 'T>, <T, 1.0>, <T, <>>, <T, F>, <T, <T>>,
XX <F, F>, <F, 1>, <F, 'F>, <F, 1.0>, <F, <>>, <F, T>, <F, <F>>,
XX <<>, <>>, <<>, 1>, <<>, 'F>, <<>, 1.0>, <<>, T>, <<>, F>,
XX <<>, <<>>>,
XX <<a>, <a>>, <<a>, <b>>, <<a>, 1>, <<a>, 'a>, <<a>, 1.0>,
XX <<a>, <>>, <<a>, T>, <<a>, F>, <<a>, <<a>>>,
XX <<a, <b>, <c, <d>>, e>, <a, <b>, <c, <d>>, e>>,
XX <<a, <b>, <c, <d>>, e>, <a, <b>, <c, <f>>, 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 <T, T, F, T, T, F, T, T, F, T, T, F, T, T, F, T, T, F>) 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 <m, a>, <m, m>, <m, z>,
XX <'m, 'a>, <'m, 'm>, <'m, 'z>>
XX
XXDef testgreater \/and o aa = o
XX (bu trans <T, F, F, T, F, F, T, F, F, T, F, F, T, F, F, T, F, F>) 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 <m, a>, <m, m>, <m, z>,
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", <id, 1, x>>) o
XX aa id o _<1, a, 'a, 1.0, T, F, <>, "id", <id, 1, x>>
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>, <<<>>>, <<a, b, c>, <d, e>>, "xyz", "four", "lenght ten">
XX
XXDef testleq \/and o aa = o
XX (bu trans <F, T, T, F, T, T, F, T, T, F, T, T, F, T, T, F, T, T>) 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 <m, a>, <m, m>, <m, z>,
XX <'m, 'a>, <'m, 'm>, <'m, 'z>>
XX
XXDef testless \/and o aa = o
XX (bu trans <F, F, T, F, F, T, F, F, T, F, F, T, F, F, T, F, F, T>) 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 <m, a>, <m, m>, <m, z>,
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 <T, F>) o aa not o _<F, T>
XX
XXDef testnoteq \/and o aa = o
XX (bu trans
XX <F, T, T, T, F, T, T, T, T, T,
XX F, T, T, T, T, T, T, T, T,
XX F, T, T, T, T, T, T, T, T,
XX F, T, F, T, T, T, T, T, T, T,
XX F, T, T, T, T, T, T,
XX F, T, T, T, T, T, T,
XX F, T, T, T, T, T, T,
XX F, T, T, T, T, T, T, T, T,
XX F, T>) 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 <a, a>, <a, b>, <a, 1>, <a, 'a>, <a, 1.0>, <a, <>>,
XX <a, T>, <a, F>, <a, <a>>,
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 <T, T>, <T, 1>, <T, 'T>, <T, 1.0>, <T, <>>, <T, F>, <T, <T>>,
XX <F, F>, <F, 1>, <F, 'F>, <F, 1.0>, <F, <>>, <F, T>, <F, <F>>,
XX <<>, <>>, <<>, 1>, <<>, 'F>, <<>, 1.0>, <<>, T>, <<>, F>,
XX <<>, <<>>>,
XX <<a>, <a>>, <<a>, <b>>, <<a>, 1>, <<a>, 'a>, <<a>, 1.0>,
XX <<a>, <>>, <<a>, T>, <<a>, F>, <<a>, <<a>>>,
XX <<a, <b>, <c, <d>>, e>, <a, <b>, <c, <d>>, e>>,
XX <<a, <b>, <c, <d>>, e>, <a, <b>, <c, <f>>, e>>>
XX
XXDef testnull \/and o aa = o
XX (bu trans <T, F, F, F, F, F, F, T, F, F, F>) o
XX aa null o _<<>, 0, 1, a, '0, T, F, "", "nil", <nil>,
XX <m, <o, n>, <<s>, t, e>, r>>
XX
XXDef testor \/and o aa = o
XX (bu trans <F, T, T, T>) o aa or o _<<F, F>, <F, T>, <T, F>, <T, T>>
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 <<>, <a>, <b, a>, <4, 3, 2, 1>, <<e, f>, <c, d>, <a, b>>>) o
XX aa reverse o
XX _<<>, <a>, <a, b>, <1, 2, 3, 4>, <<a, b>, <c, d>, <e, f>>>
XX
XXDef testrotl \/and o aa = o
XX (bu trans
XX <<>, <a>, <b, a>, <2, 3, 4, 5, 1>, <<r, s>, <t, u>, <p, q>>>) o
XX aa rotl o
XX _<<>, <a>, <a, b>, <1, 2, 3, 4, 5>, <<p, q>, <r, s>, <t, u>>>
XX
XXDef testrotr \/and o aa = o
XX (bu trans
XX <<>, <a>, <b, a>, <5, 1, 2, 3, 4>, <<t, u>, <p, q>, <r, s>>>) o
XX aa rotr o
XX _<<>, <a>, <a, b>, <1, 2, 3, 4, 5>, <<p, q>, <r, s>, <t, u>>>
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 <<>, <a>, <a, b, c>, <<>>, <<a>>, <<a>, <b>>>) o
XX aa tl o
XX _<<a>, <1, a>, <z, a, b, c>, <a, <>>, <x, <a>>, <<x>, <a>, <b>>>
XX
XXDef testtlr \/and o aa = o
XX (bu trans <<>, <a>, <a, b, c>, <<>>, <<a>>, <<a>, <b>>>) o
XX aa tlr o
XX _<<a>, <a, b>, <a, b, c, d>, <<>, a>, <<a>, x>, <<a>, <b>, <c>>>
XX
XXDef testtrans \/and o aa = o
XX (bu trans
XX <<>, <>, <>,
XX <<a>, <b>, <c>, <d>, <e>, <f>>, <<1, 2, 3, 4, 5>>,
XX <<a, c>, <b, d>>, <<a, 1, x>, <b, 2, y>, <c, 3, z>>,
XX <<a, 1, l>, <b, 2, m>, <c, 3, n>, <d, 4, o>, <e, 5, p>>>) o
XX aa trans o
XX _<<<>>, <<>, <>>, <<>, <>, <>, <>, <>>,
XX <<a, b, c, d, e, f>>, <<1>, <2>, <3>, <4>, <5>>,
XX <<a, b>, <c, d>>, <<a, b, c>, <1, 2, 3>, <x, y, z>>,
XX <<a, b, c, d, e>, <1, 2, 3, 4, 5>, <l, m, n, o, p>>>
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<newline>"
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", " <nl>">
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: <pos, <c1, c2>> => <> if c1 != %, <pos+2> 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: <c1, c2> => newline if c1 = \, c2 = n; <c1> otherwise
XXDef subcharpair (bu = '\\) o 2 -> _<>; (bu = "\n") -> newline; [2]
XX
XX# format: <ctrl-substring arg> => <new-substring>
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: <format-string, other-args*> => <other-args*> or
XX# <other-args* format-string>, 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: <n base> => "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: <n base> => <dig1, dig2 .. dign>, 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
--
Please send comp.sources.unix-related mail to rsalz@uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.