import Miranda 2.066 from upstream

37 files changed, 1609 insertions, 0 deletions

diff --git a/miralib/ex/README b/miralib/ex/README
new file mode 100644
index 0000000..3a68794
--- /dev/null
+++ b/miralib/ex/README
@@ -0,0 +1,54 @@
+This directory contains a (fairly random) collection of  simple  scripts
+written in Miranda.  To try one out (eg fibs.m) say
+	mira fibs
+as a UNIX command - or if you are already inside a Miranda session, say
+	/f fibs
+to  make (e.g.) fibs.m your current script.  To get into this directory,
+while in a Miranda session, say
+	/cd <ex>
+
+Each script has some explanatory comments in it.  To  read  the  current
+script from within a Miranda session say
+	/e
+which  invokes the editor on the current script.  The scripts are listed
+in groups, with some more advanced examples towards the end.   The  ones
+marked (*) may be useful as libraries.
+
+ack.m         the ackermann function
+divmodtest.m  tests properties of div and mod
+fibs.m        tabulates fibonacci numbers
+hanoi.m       solves the problem `towers of hanoi'
+powers.m      prints a table of powers
+primes.m      infinite list of prime numbers
+pyths.m       generates pythagorean triangles
+
+hamming.m     prints hamming numbers
+queens.m      all solutions to the eight queens problem
+queens1.m     finds one solution to the eight queens problem
+quicksort.m   Miranda definition of quicksort
+selflines.m   curiosity - a self describing scroll of lines
+stack.m       defines stack as an abstract data type
+treesort.m    Miranda definition of treesort
+
+parafs.m      Enumerates isomers of alkanes in pictorial form
+graphics.m    Rectangular graphics package used by parafs.m
+keith.m	      Checks that floating point overflow is trapped
+barry.m       Math calculations that stress the garbage collector
+bigscript.m   Tests gc during compilation
+makebig.m     Creates bigscript.m of any chosen size
+
+edigits.m     infinite decimal expansion of the digits of `e' (literate script)
+rational.m    package for doing rational arithmetic (*)
+refoliate.m   a tree problem (literate script)
+topsort.m     topological sort
+matrix.m      matrix package (*)
+set.m         defines set as an abstract data type (*)
+kate.lit.m    a Miranda script that is also a LaTeX source file
+
+genmat.m      parameterised version of matrix package (*)
+just.m        text formatting program
+mrev          (executable) Miranda version of the UNIX `rev' command
+box.m         (executable) program for reboxing Miranda comments
+box           symbolic link to box.m
+polish.m      testbed for unify.m
+unify.m       package for doing 1st order unification (*)
diff --git a/miralib/ex/ack.m b/miralib/ex/ack.m
new file mode 100644
index 0000000..8a743eb
--- /dev/null
+++ b/miralib/ex/ack.m
@@ -0,0 +1,9 @@
+||defines ackermann's function, beloved of recursion theorists.  Example
+||	ack 3 3
+||should  yield 61, after doing a huge amount of recursion.  Can only be
+||called for small arguments, because the values get so big.
+
+ack 0 n = n+1
+ack (m+1) 0 = ack m 1
+ack (m+1) (n+1) = ack m (ack (m+1) n)
+ack m n = error "ack applied to -ve or fractional arg"
diff --git a/miralib/ex/barry.m b/miralib/ex/barry.m
new file mode 100644
index 0000000..f93af80
--- /dev/null
+++ b/miralib/ex/barry.m
@@ -0,0 +1,31 @@
+||from Barry Brown, Sierra College -- Aug 2009
+||the critical case is test5, below
+
+|| Given a number, return the next number in the Collatz sequence
+collatz :: num -> num
+collatz n = n div 2, if (n mod 2 = 0)
+          = 3*n+1, if (n mod 2 = 1)
+
+|| Given a number, return the whole Collatz sequence starting with that	
+|| number. Note that it does not include the '1' on the end, but  that's OK
+|| since we're only interested in the length.
+collatzseq n = takewhile (>1) (iterate collatz n)
+
+|| Given a number, return a tuple with the starting number and the
+|| length of the Collatz sequence. We'll find the maximum tuple using the
+|| next function. The number returned will be 1 less than the actual
+|| Collatz sequence length, but that's OK for our purposes. One one of them
+|| will be the longest.
+collatzpair n = (n, #(collatzseq n))
+
+|| Given two tuples, return the greater based on the second term.
+maxtuple :: (*,**)->(*,**)->(*,**)
+maxtuple x y = x, if (snd x > snd y)
+             = y, otherwise
+
+
+test1 = map collatzpair [1..9]
+test2 = foldr maxtuple (1,0) (map collatzpair [1..9])
+test3 = foldr maxtuple (1,0) (map collatzpair [1..999])
+test4 = foldr maxtuple (1,0) (map collatzpair [1..9999])
+test5 = foldl maxtuple (1,0) (map collatzpair [1..999999]) ||segfaults, ok with foldl
diff --git a/miralib/ex/box b/miralib/ex/box
new file mode 120000
index 0000000..be14d99
--- /dev/null
+++ b/miralib/ex/box
@@ -0,0 +1 @@
+box.m
\ No newline at end of file
diff --git a/miralib/ex/box.m b/miralib/ex/box.m
new file mode 100755
index 0000000..87d404c
--- /dev/null
+++ b/miralib/ex/box.m
@@ -0,0 +1,244 @@
+#! /home/dat/mira/states/src/miranda/mira -exec
+|| Contributed by John Cupitt, University of Kent
+
+||A while ago Steve Hill (I think) appealed for useful Miranda programs
+||-- well, here is the greatest productivity aid for Miranda hackers
+||since ball-point pens.  A 'vi' type filter to *rebox your comments*!!
+||Amazing. It turns dull, unexciting notes like:
+
+|| Given a node in the tree,
+||examine the branches and chose the exit with the
+|| highest score.
+
+||into:
+
+||----------------------------------------------------------------------||
+|| Given a node in the tree, examine the branches and chose the exit 	||
+|| with the highest score.						||
+||----------------------------------------------------------------------||
+
+||Any comments welcome -- my Miranda is not as hot as it could be ...
+
+||John
+
+||----------------------------------------------------------------------||
+|| Box up Miranda comments. A filter from stdin to stdout
+||	do_box :: [char] -> [char]					||
+||		- Strip ||s, reformat, rebox.				||
+||----------------------------------------------------------------------||
+
+main = [Stdout (do_box $-)]
+
+||----------------------------------------------------------------------||
+|| Reboxing done in a pipeline of five stages.				||
+||	- Split the input into lines					||
+||	- Strip '||'s from input					||
+||	- Lex the input, breaking into tokens				||
+||	- Rejig tokens to produce fmted type output			||
+||	- Output tokens as [char] with a box drawn around them		||
+|| Formatting rules:							||
+||	- Lines starting '||-' are deleted				||
+||	- Leading & trailing '||' removed				||
+||	- Lines starting with a tab are not reformatted			||
+||	- Blank lines are 'new paragraph'				||
+||----------------------------------------------------------------------||
+
+||----------------------------------------------------------------------||
+|| First a few types and useful little functions.			||
+||----------------------------------------------------------------------||
+
+|| Useful constants
+outWid = 68			|| Width of the text in our boxes
+boxWid = 72			|| Size of the box we draw
+
+|| A token
+tok ::=	Word [char] | Newpara | Line [char]
+
+|| Useful character classifier
+whitespace :: char -> bool
+whitespace ch
+      =	True, if ch = '\n' \/ ch = '\t' \/ ch = ' '
+      =	False, otherwise
+
+|| An edge of a box boxWid across
+edge :: [char]
+edge  =	"||" ++ (rep (boxWid-2) '-') ++ "||\n"
+
+|| Find the length of a line containing tabs
+len :: [char] -> num
+len str
+      = len' 0 str
+	where
+	len' n []
+	      = n
+	len' n (a:rest)
+	      =	len' (n+tab_space) rest, if a = '\t'
+	      =	len' (n+1) rest, otherwise
+		where
+		tab_space
+		      =	8 - (n mod 8)
+
+|| Useful when doing output --- only attach first param if its not [].
+no_blank :: [char] -> [[char]] -> [[char]]
+no_blank a b
+      = a : b, if a ~= []
+      = b, otherwise
+
+||----------------------------------------------------------------------||
+|| The main function. Call from a shell script in your /bin directory	||
+|| looking something like:						||
+||	#! /usr/bin/mira -exec						||
+||	main = [Stdout (do_box $-)]					||
+||	%include "../mira/box/box.m"					||
+||----------------------------------------------------------------------||
+
+do_box :: [char] -> [char]
+do_box input
+      =	edge ++ rejig input ++ edge
+	where
+	rejig =	re_box . format . lex_start . strip_start . split
+
+||----------------------------------------------------------------------||
+|| The first stage in processing. Split the input [char] into lines as	||
+|| [[char]].								||
+||----------------------------------------------------------------------||
+
+|| Split the text into a list of lines
+split :: [char] -> [[char]]
+split input
+      =	split' [] input
+	where
+	split' sofar (a:input)
+	      =	sofar : split input, if a = '\n'
+	      = split' (sofar ++ [a]) input, otherwise
+	split' sofar []
+	      = no_blank sofar []			|| No extra blank lines!
+
+||----------------------------------------------------------------------||
+|| The next stage ... strip old '||'s from the input. Remove:		||
+||	- Lines starting '||-'						||
+||	- Strip leading '||'s						||
+||	- Strip trailing '||'s & trailing spaces			||
+||----------------------------------------------------------------------||
+
+|| At the start of a line:
+strip_start :: [[char]] -> [[char]]
+strip_start ([]:input)
+      =	[] : strip_start input			|| Keep blank lines
+strip_start (('|':'|':line):input)
+      = strip_start' line
+	where
+	strip_start' ('-':rest)
+	      = strip_start input		|| Strip '||---||' lines
+	strip_start' rest
+	      =	strip_rest rest input		|| Strip leading '||'
+strip_start (line:input)
+      = strip_rest line input			|| Pass rest through
+strip_start []
+      = []
+
+|| Scan along the rest of the line looking for trailing '||'s to strip.
+strip_rest :: [char] -> [[char]] -> [[char]]
+strip_rest line input
+      =	strip_rest' (rev line) input
+	where
+	strip_rest' ('|':'|':rest) input
+	      =	strip_rest' rest input			|| Strip trailing ||
+	strip_rest' (x:rest) input
+	      = strip_rest' rest input, if whitespace x
+	strip_rest' line input
+	      =	(rev line) : strip_start input
+
+|| Efficient(ish) reverse
+rev list
+      =	rev' [] list
+	where
+	rev' sofar (a:x)
+	      =	rev' (a:sofar) x
+	rev' sofar []
+	      = sofar
+
+||----------------------------------------------------------------------||
+|| The next stage ... Break the input into Word, Newpara and Line	||
+|| tokens. Newpara for blank lines and line starting with space; Line	||
+|| for lines starting with a tab.					||
+||----------------------------------------------------------------------||
+
+|| At the start of a line.
+lex_start :: [[char]] -> [tok]
+lex_start ([]:input)
+      = Newpara : lex_start input		|| Preserve blank lines
+lex_start (('\t':rest):input)
+      =	Line ('\t':rest) : lex_start input	|| Don't format tab lines
+lex_start (line:input)
+      = lex_rest (strip_ws line) input		|| Lex to eol
+lex_start []
+      =	[]
+
+|| In the middle of a line. Try to take words off the front of what we
+|| have so far. 
+lex_rest :: [char] -> [[char]] -> [tok]
+lex_rest [] input
+      =	lex_start input
+lex_rest sofar input
+      =	Word wd : lex_rest (strip_ws rest) input
+	where
+	(wd, rest)
+	      =	break_word sofar
+
+|| Strip ws from the start of the line
+strip_ws (a:input)
+      =	(a:input), if ~whitespace a
+      = strip_ws input, otherwise
+strip_ws []
+      =	[]
+
+|| Break the word from the front of a line of text. Return the remains
+|| of the line along with the word.
+break_word :: [char] -> ([char], [char])
+break_word (a:line)
+      =	([a] ++ rest, tag), if ~whitespace a
+      =	([], (a:line)), otherwise
+	where
+	(rest, tag)
+	      =	break_word line
+break_word []
+      =	([],[])
+
+||----------------------------------------------------------------------||
+|| Almost the last stage ... Turn [tok] back into [[char]]. Format	||
+|| onto outWid character lines.						||
+||----------------------------------------------------------------------||
+
+format :: [tok] -> [[char]]
+format input
+      =	format' [] input
+	where
+	format' sofar (Word wd:rest)
+	      =	format' (sofar ++ " " ++ wd) rest, if #sofar + #wd < outWid
+	      = sofar : format' (" " ++ wd) rest, otherwise
+	format' sofar (Newpara:rest)
+	      = no_blank sofar ([] : format rest)
+	format' sofar (Line line:rest)
+	      = no_blank sofar (line : format rest)
+	format' sofar []
+	      = no_blank sofar []
+
+||----------------------------------------------------------------------||
+|| The final stage. Box up a list of formatted lines. Try to be clever	||
+|| about using tabs on the ends of lines.				||
+||----------------------------------------------------------------------||
+
+|| Draw a box boxWid across.
+re_box :: [[char]] -> [char]
+re_box (line:rest)
+      =	"||" ++ line ++ padding ++ "||\n" ++ (re_box rest)
+	where
+	padding
+	      =	rep n_tab '\t'
+	n_tab
+	      =	(boxWid - line_length + 7) div 8
+	line_length
+	      =	len ("||" ++ line)
+re_box []
+      =[]
diff --git a/miralib/ex/divmodtest.m b/miralib/ex/divmodtest.m
new file mode 100644
index 0000000..28b5e03
--- /dev/null
+++ b/miralib/ex/divmodtest.m
@@ -0,0 +1,11 @@
+||This script defines tests for three properties of div and mod, each
+||checked over a small range of values including various combinations
+||of signs.  Each test  should  yield  the  result  True, or there is
+||something wrong with the arithmetic on your machine!
+
+test1 = and [a div b = entier (a/b) | a,b <- [-15..15]; b~=0]
+test2 = and [b*(a div b) + a mod b = a | a,b <- [-15..15]; b~=0]
+test3 = and [ ok a b | a,b <- [-15..15]; b~=0]
+	where
+        ok a b = 0 <= a mod b < b, if b>0
+	       = b < a mod b <= 0, if b<0
diff --git a/miralib/ex/edigits.m b/miralib/ex/edigits.m
new file mode 100644
index 0000000..216757f
--- /dev/null
+++ b/miralib/ex/edigits.m
@@ -0,0 +1,73 @@
+> ||note that this is a literate script
+
+Programming example - generating the digits of `e'
+
+We wish to write a program to generate the (decimal) digits of  `e',  as
+an  infinite  string.   Fact  -  the  value  of `e', the base of natural
+logarithms, is given by the series
+
+e = 1 + 1/1! + 1/2! + 1/3! + ...
+
+where by n! we mean the factorial of n, = n*(n-1)...*2*1.  Now,  we  can
+choose  to represent fractional numbers using a peculiar base system, in
+which the weight of the i'th digit after the point is 1/i! (so note that
+the  `carry factor' by which we must multiply a unit from the i'th digit
+when carrying it back to the i-1'th is i).  Written to this funny  base,
+`e' is just
+        2.1111111111............
+so  the  string we require may be obtained by converting fractional part
+of the above numeral from the `funny base' to decimal.  Thus
+
+>  edigits = "2." ++ convert (repeat 1)
+
+The function `convert' takes for its argument a fraction  in  the  funny
+base  (here  represented as an infinite list of numbers) and returns its
+value in decimal, as an infinite list  of  digits.   The  algorithm  for
+converting  a  fraction from another base to decimal, is as follows: (i)
+multiply all digits by ten, and renormalise, using the appropriate carry
+factors (ii) the whole number part of the result gives the first decimal
+digit (iii) repeat the process on the fractional part of the  result  to
+generate the remaining digits.  Thus
+
+>  convert x = mkdigit (hd x'):convert (tl x')
+>              where x' = norm 2 (0:map (10*) x)
+>  mkdigit n = decode(n + code '0'), if n<10
+
+It remains to define the function `norm' which does renormalisation.  A 
+naive (and almost correct) definition is
+
+   norm c (d:x) = d + e' div c: e' mod c : x'
+                  where
+                  (e':x') = norm (c+1) x
+
+However, this is not a well-founded  recursion,  since  it  must  search
+arbitrarily  far  to  the  right in the fraction being normalised before
+printing the first digit.  If you try printing `edigits' with the  above
+as  your  definition  of  norm,  you  will  get  "2." followed by a long
+silence.
+
+We need a theorem which will limit the distance from which a  carry  can
+propagate.   Fact:  during  the  conversion of this fraction the maximum
+possible carry from a digit to its leftward neighbour is 9.  (The  proof
+of  this,  left  as  a  (not  very hard) exercise for the mathematically
+minded reader, is by induction on the number  of  times  the  conversion
+algorithm  is  applied.)  This  leads  us to the following slightly more
+cautious definition of `norm'
+
+>  norm c (d:e:x) = d + e div c: e' mod c : x', if e mod c + 9 < c
+>                 = d + e' div c : e' mod c : x', otherwise
+>                   where
+>                   (e':x') = norm (c+1) (e:x)
+
+Our solution is now complete.  To see the results, enter mira with  this
+file as the current script and say
+        edigits
+Hit  control-C (interrupt) when you have seen enough digits. 
+
+[Note: If nothing happens until you interrupt the evaluation,  this  may
+be   because   the  output  from  Miranda  to  your  terminal  is  being
+line-buffered, so the characters are not appearing  on  your  screen  as
+Miranda  prints  them, but being saved up until there is a whole line to
+print.  Output from the computer to your terminal  should  not  be  line
+buffered  when  Miranda is running - ask someone how to disable the line
+buffering, if this is the case.]
diff --git a/miralib/ex/fib.m b/miralib/ex/fib.m
new file mode 100644
index 0000000..d84d33f
--- /dev/null
+++ b/miralib/ex/fib.m
@@ -0,0 +1,4 @@
+||fib n computes the n'th fibonacci number
+||by using /count you can estimate the asymptotic limit of (fib n/time to compute fib n)
+fib n = 1,                   if n<=2
+      = fib(n-1) + fib(n-2), otherwise
diff --git a/miralib/ex/fibs.m b/miralib/ex/fibs.m
new file mode 100644
index 0000000..39c805d
--- /dev/null
+++ b/miralib/ex/fibs.m
@@ -0,0 +1,16 @@
+||This program tabulates the values of `fib i' a function for computing
+||fibonacci numbers, in a list `fibs'.  Because the function is memoised
+||(i.e. it uses table lookup when it recurses) it runs in linear time.
+||To see the fibonacci numbers say.
+||	test
+
+fibs = map fib [0..]
+fib 0 = 0
+fib 1 = 1
+fib (n+2) = fibs!(n+1) + fibs!n
+
+test = layn (map shownum fibs)
+
+||P.S. There is a more direct way of defining fibs, using a list comprehension
+||	fibs = [a | (a,b) <- (0,1), (b,a+b) .. ] 
+||this also runs in linear time
diff --git a/miralib/ex/genmat.m b/miralib/ex/genmat.m
new file mode 100644
index 0000000..27c2f88
--- /dev/null
+++ b/miralib/ex/genmat.m
@@ -0,0 +1,84 @@
+||The matrix package again, but this time parameterised over an arbitrary
+||element type, with a zero, a unit and four functions of arithmetic.
+||Example - to instantiate this package with numbers as the element type,
+||in another script, say:-
+||    %include <ex/genmat> { elem==num; zero=0; unit=1; 
+||                           plus=+; minus=-; times=*; divide=/; }
+
+||However another possibility would be to use the package to do matrix
+||calculations over rationals (as defined in <ex/rat>) thus:-
+||    %include <ex/genmat>
+||             { elem==rational; zero=mkrat 0; unit=mkrat 1; 
+||               plus=rplus; minus=rminus; times=rtimes; divide=rdiv; }
+
+%export matrix idmat matadd matsub matmult prescalmult postscalmult
+	mkrow mkcol det adjoint inv
+
+%free { elem::type; zero,unit::elem; 
+	plus,minus,times,divide::elem->elem->elem;
+      }
+
+matrix == [[elem]]
+
+idmat :: num->matrix ||identity matrix of given size
+idmat n = [[delta i j|j<-[1..n]]|i<-[1..n]]
+          where
+	  delta i j = unit, if i=j
+		    = zero, otherwise
+
+matadd :: matrix->matrix->matrix
+matadd x y = map2 vadd x y
+             where
+	     vadd x y = map2 plus x y
+
+matsub :: matrix->matrix->matrix
+matsub x y = map2 vsub x y
+             where
+	     vsub = map2 minus
+
+matmult :: matrix->matrix->matrix
+matmult x y = outer inner x (transpose y)  ||*
+inner x y = summate (map2 times x y)
+outer f x y = [[f a b|b<-y]|a<-x]
+
+||*note that transpose is already defined in the standard environment
+
+summate = foldl plus zero
+
+prescalmult :: elem->matrix->matrix ||premultiply a matrix by a scalar
+prescalmult n x = map (map (times n)) x
+
+postscalmult :: elem->matrix->matrix ||postmultiply a matrix by a scalar
+postscalmult n x = map (map ($times n)) x
+
+||we need both the above because element multiplication may not be
+||commutative
+
+mkrow :: [elem]->matrix ||make vector into matrix with a single row
+mkrow x = [x]
+
+mkcol :: [elem]->matrix ||make vector into matrix with a single column
+mkcol x = map (:[]) x
+
+det :: matrix->elem ||determinant, of square matrix
+det [[a]] = a
+det xs = summate [(xs!0!i) $times cofactor 0 i xs|i<-index xs], if #xs=#xs!0
+       = error "det of nonsquare matrix", otherwise
+cofactor i j xs = parity (i+j) $times det (minor i j xs)
+minor i j xs = [omit j x | x<-omit i xs]
+omit i x = take i x ++ drop (i+1) x
+
+parity::num->elem
+parity i = unit, if i mod 2 = 0
+         = zero $minus unit, otherwise
+
+adjoint :: matrix->matrix ||adjoint, of square matrix
+adjoint xs = transpose[[cofactor i j xs | j<-index xs] | i <- index xs]
+
+inv :: matrix->matrix ||inverse, of non-singular square matrix
+inv xs = transpose[[cofactor i j xs $divide h | j<-index xs] | i <- index xs]
+	 where
+	 h = det xs
+||The above is a literal transcription of the mathematical definition of
+||matrix inverse.  A less naive version of the package would rewrite 
+||this to use Gaussian elimination.
diff --git a/miralib/ex/graphics.m b/miralib/ex/graphics.m
new file mode 100644
index 0000000..ca2f09a
--- /dev/null
+++ b/miralib/ex/graphics.m
@@ -0,0 +1,164 @@
+||package for developing rectangular pictures composed of ascii characters
+||DT Jan 84
+||all pictures are conceived as lying in an infinite plane with origin at (0,0)
+||and filled with blanks except where non-blank chars have been specified
+query * ::= FAIL | SUCCEED *
+||generic union type, often useful -- should probably be in library
+picture ::= MKPIC (num,num)! [[char]] | EMPTYPIC
+||MKPIC holds a figure with its north west corner at the given coordinates
+frame :: picture->(num,num,num,num)
+||returns (left,right,low,high) of smallest rectangle containing the figure
+frame(MKPIC (x,y) a) = (x,x+#a!0-1,y-#a+1,y)
+||it is an error to apply frame to the empty picture
+printpic :: picture->[char]  ||prints pic with frame north west justified
+printpic EMPTYPIC = []
+printpic (MKPIC (x,y) a) = concat[p ++ "\n" | p <- a]
+printpic1 :: picture->[char]  ||likewise, right shifted 8
+printpic1 EMPTYPIC = []
+printpic1 (MKPIC (x,y) a) = concat["        "++p ++ "\n" | p <- a]
+alignpic :: num->num->picture->[char]
+||prints picture as seen looking south east from the given cooordinates --
+||only parts of the figure onside from this position appear of course
+alignpic x y EMPTYPIC = []
+alignpic x y (MKPIC (x1,y1) a)
+    = newlines (y-y1) ++ concat a1, if y>y1
+    = concat(drop (y1-y) a1), if y<y1
+    = concat a1, otherwise
+      where
+      a1 = [drop (x-x1) p ++ "\n" | p <- a], if x>x1
+         = [spaces (x1-x) ++ p ++ "\n" | p <- a], if x<x1
+         = [p ++ "\n" | p <- a], otherwise
+translate :: num->num->picture->picture ||move picture x right and y up
+translate x y EMPTYPIC = EMPTYPIC
+translate x y (MKPIC (x1,y1) a) = MKPIC (x+x1,y+y1) a
+rotate :: num->picture->picture
+||rotate the picture by n*pi/2 radians anticlockwise about (0,0)
+rotate n EMPTYPIC = EMPTYPIC
+rotate 0 = id
+rotate 1 = reflect 3.reflect 2  ||result from group theory
+rotate 2 (MKPIC (x,y) a) =
+       MKPIC (-(x+#a!0-1),-(y-#a+1)) (reverse (map reverse a))
+rotate 3 = reflect 2.reflect 3  ||group theory
+rotate n = rotate (n mod 4)  ||other values of n
+reflect :: num->picture->picture
+||reflect about a line inclined at n*pi/4 to the x axis
+reflect n EMPTYPIC = EMPTYPIC
+reflect 0 (MKPIC (x,y) a) = MKPIC (x,-(y-#a+1)) (reverse a)
+reflect 1 = reflect 3.rotate 2  ||group theory
+reflect 2 (MKPIC (x,y) a) = MKPIC (-(x+#a!0-1),y) (map reverse a)
+reflect 3 (MKPIC (x,y) a) = MKPIC (-y,-x) (transpose a')
+                            where a' = map(map f)a
+				  f '-' = '|'
+				  f '|' = '-'
+				  f etc = etc
+reflect n = reflect (n mod 4)  ||other values of n
+composepic :: [picture]->query picture
+||tries to combine the given list of pictures to yield a composite picture
+|| -- fails if any parts of the figures overlap
+composepic = foldr apic (SUCCEED EMPTYPIC)
+compositions :: [[picture]]->[picture]
+||finds all possible ways of composing a picture (with no overlaps) with
+||one component from each of the given picture lists
+||this will probably be more useful in practice than composepic
+compositions [] = [EMPTYPIC]
+compositions (xx:etc) = f[apic1 x r // x <- xx; r <- compositions etc]
+                        where
+                        f [] = []
+                        f (FAIL:x) = f x
+                        f (SUCCEED a:x) = a: f x
+overlaypic :: [picture]->picture
+||similar to the above but allows pictures earlier in the given list to hide
+||details of later ones, so the result is always a picture
+overlaypic = foldr opic EMPTYPIC
+apic :: picture->query picture->query picture  ||picture addition
+p $apic SUCCEED EMPTYPIC = SUCCEED p
+p $apic FAIL = FAIL
+EMPTYPIC $apic q = q
+MKPIC (x1,y1) a $apic SUCCEED (MKPIC (x2,y2) b)
+        = FAIL, if xx=FAIL
+        = SUCCEED (MKPIC (x,y) (f xx)), otherwise
+          where
+          x = min[x1,x2]
+          y = max[y1,y2]
+          xx = pointwiseadd a1 b1
+          a1 = sidepad (x1-x) (-rjut) (toppad (y-y1) a)
+          b1 = sidepad (x2-x) rjut (toppad (y-y2) b)
+          rjut = x1+#a!0-x2-#b!0
+          f(SUCCEED c) = c
+apic1 :: picture->picture->query picture  ||picture addition mark2
+p $apic1 EMPTYPIC = SUCCEED p
+EMPTYPIC $apic1 q = SUCCEED q
+MKPIC (x1,y1) a $apic1 MKPIC (x2,y2) b
+        = FAIL, if xx=FAIL
+        = SUCCEED (MKPIC (x,y) (f xx)), otherwise
+          where
+          x = min[x1,x2]
+          y = max[y1,y2]
+          xx = pointwiseadd a1 b1
+          a1 = sidepad (x1-x) (-rjut) (toppad (y-y1) a)
+          b1 = sidepad (x2-x) rjut (toppad (y-y2) b)
+          rjut = x1+#a!0-x2-#b!0
+          f(SUCCEED c) = c
+opic :: picture->picture->picture  ||picture superposition
+p $opic EMPTYPIC = p
+EMPTYPIC $opic q = q
+MKPIC (x1,y1) a $opic MKPIC (x2,y2) b
+        = MKPIC (x,y) (pointwiseoverlay a1 b1)
+          where
+          x = min[x1,x2]
+          y = max[y1,y2]
+          a1 = sidepad (x1-x) (-rjut) (toppad (y-y1) a)
+          b1 = sidepad (x2-x) rjut (toppad (y-y2) b)
+          rjut = x1+#a!0-x2-#b!0
+sidepad n r a = [spaces n ++ p ++ spaces r | p <- a]
+toppad n a = f n
+             where
+             f n = a, if n<=0
+                 = spaces (#a!0):f (n-1), otherwise
+pointwiseoverlay :: [[char]]->[[char]]->[[char]]
+pointwiseoverlay a b = f a b
+                       where
+                       f [] b = b
+                       f a [] = a
+                       f (p:a) (q:b) = g p q:f a b
+                       g [] q = q
+                       g p [] = p
+                       g (c1:p) (c2:q) = c2:g p q, if c1=' '
+                                       = c1:g p q, otherwise
+pointwiseadd :: [[char]]->[[char]]->query [[char]]
+pointwiseadd a b = SUCCEED c, if and [~member z clashchar | z<-c]
+                 = FAIL, otherwise
+                   where
+                   c = f a b
+                   f [] b = b
+                   f a [] = a
+                   f (p:a) (q:b) = g p q:f a b
+                   g [] q = q
+                   g p [] = p
+                   g (c1:p) (c2:q) = c2:g p q, if c1=' '
+                                   = c1:g p q, if c2=' '
+                                   = clashchar:g p q, otherwise
+clashchar = '\0'  ||assumed not to be present in any normal picture
+pic :: num->num->[[char]]->picture
+||takes a rectangular array of chars and turns it into a picture with its north
+||west corner at the given x y position
+pic x y a = EMPTYPIC, if and[p=[]|p<-a]
+	    ||covers both a=[] and elements a all []
+          = pic x (y-1) (tl a), if and[c=' ' | c<-hd a]
+	    ||strip blank rows
+          = pic (x+1) y (map tl a), if and[hd p=' ' | p <- a] 
+	    ||strip blank cols
+          = MKPIC (x,y) a, otherwise 
+	  ||what about east and south trimming? -- fix later
+||we have assumed given a rectangular and not containing control chars, we
+||ought perhaps to check this when a picture is formed -- fix later
+
+newlines n = rep n '\n'
+closure :: (*->[*])->[*]->[*];
+||takes the closure of a set under a pointwise function that returns
+||increments to the set
+closure f s = g s s
+              where
+              g r t = [], if t=[]
+                    = t ++ g(r ++ t)(mkset[x|x<-concat(map f t);~member r x]),
+		      otherwise
diff --git a/miralib/ex/hamming.m b/miralib/ex/hamming.m
new file mode 100644
index 0000000..3ebb6ce
--- /dev/null
+++ b/miralib/ex/hamming.m
@@ -0,0 +1,19 @@
+||this is a problem described by Dijkstra in his book, A Discipline of
+||Programming, and attributed by him to Dr Hamming, of Bell Labs.
+||Print in ascending order all numbers of the form
+|| 2**a.3**b.5**c        a,b,c all >=0
+||the solution here is based on a method using communicating processes.
+||ham is the list of numbers, to see them, say
+||  ham
+||hit control-C (interrupt) when you have seen enough!
+
+ham = 1 : foldr1 merge [mult 2 ham, mult 3 ham, mult 5 ham]
+      where
+      mult n x = [n*a|a<-x]
+      merge (a:x) (b:y) = a : merge x y,     if a=b
+			= a : merge x (b:y), if a<b
+			= b : merge (a:x) y, if a>b
+
+||Note  that  there  is  a  function  called  `merge'  in  the  standard
+||environment,  but  unlike  the  one  defined  above it does not remove
+||duplicates from the lists being merged.
diff --git a/miralib/ex/hanoi.m b/miralib/ex/hanoi.m
new file mode 100644
index 0000000..b927ca3
--- /dev/null
+++ b/miralib/ex/hanoi.m
@@ -0,0 +1,11 @@
+||This script generates a solution to the well known `Towers of Hanoi'
+||problem.  To see the moves (for a game with 12 discs) say
+||	soln
+
+soln = title++hanoi 12 "A" "B" "C"
+title = "SOLUTION TO TOWERS OF HANOI WITH 8 DISCS\n\n"
+hanoi 0 a b c = [] 
+hanoi (n+1) a b c = hanoi n a c b
+	            ++ move a b ++
+	            hanoi n c b a
+move a b = "move the top disc from "++a++" to "++b++"\n"
diff --git a/miralib/ex/just.m b/miralib/ex/just.m
new file mode 100644
index 0000000..9dca373
--- /dev/null
+++ b/miralib/ex/just.m
@@ -0,0 +1,98 @@
+||Text formatting program (DT)
+||Reformats text to a specified width, with line-fill
+
+%export just 
+
+||To try this out from within a Miranda session, say e.g.
+||	just 60 (read "file")
+||where "file" contains some text you want to reformat.
+
+||You could also make it into a UNIX filter -- see the example `mrev'.
+
+||----------------------------------------------------------------------||
+|| in this program we move between three different representations of	||
+|| text - as a flat list of characters, including spaces and newlines	||
+|| - as a list of lines (containing spaces but not newlines)            ||
+|| - and as a list of list of words.					||
+||----------------------------------------------------------------------||
+
+text == [char]
+line == [char]
+word == [char]
+
+just::num->text->text  ||the main function
+just n = concat.map(reformat n).paras.map words.lines
+
+||lines::text->[line]
+||lines is defined in <stdenv> - it breaks a string into lines,
+||removing the newline characters
+
+paras::[[word]]->[[word]]
+||make each paragraph into one long line, by joining adjacent 
+||non-blank lines
+paras (a:b:x) = paras ((a++b):x), if a~=[]~=b
+              = a:paras (b:x), otherwise
+paras (a:[]) = a:[]
+paras [] = []
+
+reformat::num->[word]->text
+||reformat a paragraph to width n
+reformat n [] = "\n"  ||the empty paragraph represents a blank line
+reformat n x = lay(justify n (partition n x))
+
+||lay::[line]->text
+||lay is defined in <stdenv> - it is the inverse of lines
+
+justify::num->[[word]]->[line]
+justify n para = map(fill_line n)(init para)++[unwords(last para)]
+
+partition::num->[word]->[[word]]
+||break a paragraph into lines, with as many words as will fit in width
+||n on each line (except the last)
+partition n [] = []
+partition n x  = x1 : partition n rest
+		 where
+		 (x1,rest) = grab [] x
+		 grab y (w:x) = grab (w:y) x, if sum(map(#)y)+#y+#w <= n
+			      = (reverse y,w:x), otherwise
+		 grab y [] = (reverse y,[])
+
+fill_line :: num->[word]->line
+||make words into a line of length n exactly, by inserting enough spaces
+fill_line n words 
+    = (concat.concat) (transpose [words,mkspaces (w-1) (n-sw)])
+      where
+      w = #words
+      sw = sum(map (#) words)
+
+mkspaces :: num->num->[[char]]
+||return s spaces broken into n groups
+mkspaces n s = map f [1..n], if n mod 2=0  ||see note
+	     = map f [n,n-1..1], otherwise
+               where
+	       f i = rep (s div n + delta) ' '
+		     where
+		     delta = 1, if i<=s mod n
+			   = 0, otherwise
+||note: we put the extra spaces in sometimes from the left and sometimes 
+||from the right, depending on the parity of n.  This is to avoid 
+||visually unbalancing the text by having all the extra spaces towards
+||one margin.  Using the parity of n to decide this is arbitrary.
+
+words :: line->[word]
+||break a line into words
+words = filter (~=[]) . foldr (breakon ' ') [[]]
+
+unwords :: [word]->line
+||join words to make a line, inserting one space as separator
+unwords = foldr1 (insert ' ')
+
+insert :: *->[*]->[*]->[*]
+insert a x y = x ++ [a] ++ y
+
+breakon :: *->*->[[*]]->[[*]]
+breakon c a x = []:x, if a=c
+	      = (a:hd x):tl x, otherwise
+
+||These definitions of `words' and `unwords' are due to Richard Bird,  see
+||Bird and Wadler (1988), page 91.
diff --git a/miralib/ex/kate.lit.m b/miralib/ex/kate.lit.m
new file mode 100644
index 0000000..7deb3cc
--- /dev/null
+++ b/miralib/ex/kate.lit.m
@@ -0,0 +1,138 @@
+\documentclass[10pt]{article}
+\title{{\tt kate.lit.m} --- KaTify text}
+\author{J. Cupitt}
+\date{July 21st, 1989}
+% turn off para indents
+\setlength{\parindent}{0in}
+% put some space between paras
+\setlength{\parskip}{0.05in}
+\begin{document}
+\maketitle
+
+%An example of a Miranda literate script that is also a LaTeX source
+%file.  Note that the lines of formal program text are surrounded by
+%LaTeX verbatim directives.  Contributed by John Cupitt, of the
+%University of Kent.
+
+There is a group on USENET called \verb"rec.music.gaffa", dedicated to the
+singer Kate Bush. A running joke in this group is to pretend fanatical
+devotion to Kate And Her Works --- this reaches an extreme form in some
+posters, who capitalise all the Ks and Ts in their articles in reference both
+to KaTe herself and to the Knights Templar. This Miranda\footnote{Miranda is a 
+trademark of Research Software Ltd.} script can be used as a {\sc 
+Unix}\footnote{UNIX is a trademark of AT\&T in the USA and other
+countries.} filter to prepare your articles for posting to \verb"gaffa".
+The main function is called \verb"kate" and is at the end.
+
+Do some simple maps on text. We do:
+
+\begin{center}
+\begin{tabular}{rcl}
+        c,C,k & $\rightarrow $ & K \\
+        t & $\rightarrow $ & T \\
+        qu,Qu & $\rightarrow $ & Kw \\
+        ck & $\rightarrow $ & K \\
+        ch,Ch & $\rightarrow $ & Khe
+\end{tabular}
+\end{center}
+
+We also look for Kommon words that can be easily swapped for something with
+more ks and ts. 
+
+The dictionary we use to look for common words. This is very small at the
+moment! I should perhaps find a thesaurus and fix this up properly.
+
+\begin{verbatim}
+
+> kateMap
+>      = [(["interpose", "insert"],
+>                "interject"),
+>         (["frequent", "general", "usual", "normal"],
+>                "common"),
+>         (["program", "file"],
+>                "script"),
+>         (["name"],
+>                "appelation"),
+>         (["however"],
+>                "though"),
+>         (["serve"],
+>                "officiate"),
+>         (["intersperse"],
+>                "punctuate")
+>        ]
+
+\end{verbatim}
+
+First map. Very easy!
+
+\begin{verbatim}
+
+> swapCase :: [char] -> [char]
+> swapCase ('c':'k':x) = 'K':swapCase x
+> swapCase ('c':'h':x) = 'K':'h':'e':swapCase x
+> swapCase ('C':'h':x) = 'K':'h':'e':swapCase x
+> swapCase ('c':x) = 'K':swapCase x
+> swapCase ('C':x) = 'K':swapCase x
+> swapCase ('k':x) = 'K':swapCase x
+> swapCase ('t':x) = 'T':swapCase x
+> swapCase ('q':'u':x) = 'K':'w':swapCase x
+> swapCase ('Q':'u':x) = 'K':'w':swapCase x
+> swapCase (a:x) = a: swapCase x
+> swapCase [] = []
+
+\end{verbatim}
+
+Second map. We loop down the input again, chopping out words. Each one gets
+put through tryMap.
+
+\begin{verbatim}
+
+> swapWords :: [char] -> [char]
+> swapWords [] = []
+> swapWords inp
+>      = punk ++ tryMap word ++ swapWords tail
+>        where
+>        punk = takewhile ((~) . letter) inp
+>        start = dropwhile ((~) . letter) inp
+>        word = takewhile letter start
+>        tail = dropwhile letter start
+
+\end{verbatim}
+
+Try to map a word through the KaTe thesaurus we defined earlier. We try to be
+clever about what we swap. For example, we want \verb"insert" to be mapped to
+\verb"interject", and \verb"inserting" to be mapped to \verb"interjecting".
+This isn't always the most sensible way to do it \ldots
+
+\begin{verbatim}
+
+> tryMap :: [char] -> [char]
+> tryMap word
+>      = word, if maps = []
+>      = hd maps, otherwise
+>        where
+>        maps = [ to ++ drop (#x) word | 
+>                        (from, to) <- kateMap; x <- from; 
+>                        x $isprefix word ]
+
+\end{verbatim}
+
+Test for first argument a prefix of the second argument.
+
+\begin{verbatim}
+
+> isprefix :: [*] -> [*] -> bool
+> isprefix a b = take (#a) b = a
+
+\end{verbatim}
+
+And our entry point. We just pipe stuff first through swapWords, then through
+swapCase.
+
+\begin{verbatim}
+
+> kate :: [char] -> [char]
+> kate = swapCase . swapWords
+
+\end{verbatim}
+\end{document}
diff --git a/miralib/ex/kate.pdf b/miralib/ex/kate.pdf
new file mode 100644
index 0000000..606a4c8
--- /dev/null
+++ b/miralib/ex/kate.pdf
diff --git a/miralib/ex/kate.tex b/miralib/ex/kate.tex
new file mode 120000
index 0000000..8da0f90
--- /dev/null
+++ b/miralib/ex/kate.tex
@@ -0,0 +1 @@
+kate.lit.m
\ No newline at end of file
diff --git a/miralib/ex/keith.m b/miralib/ex/keith.m
new file mode 100644
index 0000000..b743de9
--- /dev/null
+++ b/miralib/ex/keith.m
@@ -0,0 +1,31 @@
+> ||this tests that floating point overflow is handled correctly
+
+Date:          Mon, 16 Apr 90 17:15:03 CST
+From:          mccrosky@ishmael.usask.ca
+
+Sorry for the delay in sending my bignum problem,  I've been out of town.
+ 
+> keith n = (shownum n) ++ " " ++ (shownum ((log (sumterm n))/n)) where
+>           sumterm n = sum (map prodterm [0..entier (n/2)]) where
+>                       prodterm p = prod (map term [0..p-1]) where
+>                                    term j = x*(x-1)/((p-j)^2) where
+>                                             x = n-(2*j)
+> prod = foldr (*) 1
+> lim = lay (from 1) where from n = (keith n):(from (n*2))
+ 
+ 
+******** This is the execution:
+         (We believe the results up to n=256 are correct).
+ 
+Miranda lim
+1 0.0
+2 0.549306144334
+4 0.736109744792
+8 0.876176116589
+16 0.966470019952
+32 1.021895160467
+64 1.054884461071
+128 1.07405223475
+256 1.084981322415
+512
+should trap floating point overflow here
diff --git a/miralib/ex/makebug.m b/miralib/ex/makebug.m
new file mode 100644
index 0000000..b32d4bb
--- /dev/null
+++ b/miralib/ex/makebug.m
@@ -0,0 +1,18 @@
+> makebug size = [Tofile "/tmp/big.m" (big_def size)]
+> big_def n = "big_list\n=[\n" ++ lay (rep n "  \"hello\",") ++ "  \"hello\"]\n"
+
+This tests garbage collection during compilation.  First turn on gc
+reports by saying
+	/gc
+
+To generate /tmp/big.m of chosen size say, e.g.
+	makebug 10000
+to get mira to compile the result say
+	/f /tmp/big
+Saying this repeatedly (or /f %) will force recompilations
+Or from the command line after quitting mira
+	rm /tmp/big.x   #to force recompilation
+	mira -make -gc /tmp/big
+
+If the heap becomes corrupted  you  will  see  strange  type  errors  or
+"impossible event" messages.  From Rick Morgan at Durham, May 1990.
diff --git a/miralib/ex/matrix.m b/miralib/ex/matrix.m
new file mode 100644
index 0000000..46abbaf
--- /dev/null
+++ b/miralib/ex/matrix.m
@@ -0,0 +1,70 @@
+||very simple matrix package (DT)
+||note that to include this in one of your own scripts, you can say
+||	%include <ex/matrix>
+
+%export matrix idmat matadd matsub matmult scalmult mkrow mkcol det
+        adjoint inv
+
+matrix == [[num]]
+
+idmat :: num->matrix ||identity matrix of given size
+idmat n = [[delta i j|j<-[1..n]]|i<-[1..n]]
+          where
+	  delta i j = 1, if i=j
+		    = 0, otherwise
+
+matadd :: matrix->matrix->matrix
+matadd x y = map2 vadd x y
+             where
+	     vadd x y = map2 (+) x y
+
+matsub :: matrix->matrix->matrix
+matsub x y = map2 vsub x y
+             where
+	     vsub = map2 (-)
+
+matmult :: matrix->matrix->matrix
+matmult x y = outer inner x (transpose y)  ||*
+inner x y = sum (map2 (*) x y)
+outer f x y = [[f a b|b<-y]|a<-x]
+
+||*note that transpose is already defined in the standard environment
+
+scalmult :: num->matrix->matrix ||multiply a matrix by a scalar
+scalmult n x = map (map (*n)) x
+
+mkrow :: [num]->matrix ||make vector into matrix with a single row
+mkrow x = [x]
+
+mkcol :: [num]->matrix ||make vector into matrix with a single column
+mkcol x = map (:[]) x
+
+det :: matrix->num ||determinant, of square matrix
+det [[a]] = a
+det xs = sum [xs!0!i*cofactor 0 i xs|i<-index xs], if #xs=#xs!0
+       = error "det of nonsquare matrix", otherwise
+cofactor i j xs = (-1)^(i+j) * det (minor i j xs)
+minor i j xs = [omit j x | x<-omit i xs]
+omit i x = take i x ++ drop (i+1) x
+
+adjoint :: matrix->matrix ||adjoint, of square matrix
+adjoint xs = transpose[[cofactor i j xs | j<-index xs] | i <- index xs]
+
+inv :: matrix->matrix ||inverse, of non-singular square matrix
+inv xs = transpose[[cofactor i j xs/h | j<-index xs] | i <- index xs]
+	 where
+	 h = det xs
+||The above is a literal transcription of the mathematical definition of
+||matrix  inverse.   A  less  naive version of the package would rewrite
+||this to use Gaussian elimination.
+
+||a few test matrices (these are not exported from the script, but  will
+||be in scope if this is your current script)
+a = [[1,2],[3,4]]
+b = [[1,1,1],[1,2,3],[2,4,8]]
+c = [[0,1,2,3],[1,2,3,4],[2,3,4,0],[3,4,0,1]]
+i2 = idmat 2
+i3 = idmat 3
+i4 = idmat 4
+
+test = matmult b (inv b)
diff --git a/miralib/ex/mrev b/miralib/ex/mrev
new file mode 100755
index 0000000..85b3dc6
--- /dev/null
+++ b/miralib/ex/mrev
@@ -0,0 +1,22 @@
+#! /usr/bin/mira -exec
+main :: [sys_message]
+main = map f (tl $*),          if # $* > 1 ||$* is equivalent to argv
+     = [Stdout (revlines $-)], otherwise   ||no files, use stdin ($-)
+
+f :: [char]->sys_message
+f fil = Stderr ("mrev: cannot open "++fil++"\n"), if badfile
+      = Stdout (revlines (read fil)), otherwise
+	where
+	badfile = ~ member (filemode fil) 'r'
+
+revlines :: [char]->[char]
+revlines = lay.map reverse.lines
+
+||The usage of this command (from a UNIX shell) is
+||	mrev [file] ...
+||If no files given, takes data from stdin.  This is a  Miranda  version
+||of the UNIX command `rev' which reverses each line of its input.
+
+||This example is a template for turning any Miranda  function  of  type
+||[char]->[char]  into  a  UNIX filter.  Replace `revlines' in the above
+||text, by your chosen function.
diff --git a/miralib/ex/parafs.m b/miralib/ex/parafs.m
new file mode 100644
index 0000000..be6af05
--- /dev/null
+++ b/miralib/ex/parafs.m
@@ -0,0 +1,33 @@
+||program for printing isomers of the alkanes -- D.A.Turner
+||say `output' to run
+mol ::= H | C[mol]  ||new type -- alkane molecules and radicals
+c p = C (sort p)    ||place subcomponents in a standard order
+molecules n = mkset [ mk_molecule x | x <- radicals n ]
+mk_molecule(C p) = canonical_orientation (C(H:p))
+radicals 0 = [H]
+radicals n = (map rads [1..])!(n-1)  || make rads a memo function
+rads n = mkset [ c[x,y,z] | i <- [0..(n-1)div 3]; j <- [i..(n-1-i)div 2];
+                 x <- radicals i; y <- radicals j; z <- radicals(n-1-i-j) ]
+canonical_orientation x = min (closure reorientations [x])
+reorientations (C p) =  [ invert (p--[x]) x | x <- p; x ~= H ]
+                        where
+                        invert p (C q) = c (c p:q)
+output = concat (map out [1..])
+out n = title n ++ concat(map prettyprint (molecules n))
+title n = "isomers of " ++ prefix!(n-1) ++ "ane\n"
+prefix = ["meth","eth","prop","but","pent","hex","hept","oct","non",
+	  "dec"] ++ [show i++"-"|i<-[11..]]
+
+||below this line is concerned with drawing pictures of the molecules
+%include "graphics.m"
+prettyprint x = printpic1 (hd (molpics x)) ++ "\n"
+molpics (C p) = compositions ([centre]:map f [1..# p] )
+                where
+                f i = map (reflect (direction!(i-1))) (subpics i)
+                subpics i = [q1|q<-molpics (p!(i-1));
+                                q1<-shift(translate 1 0 q),shift q1..]
+molpics H = [pic 0 0 ["H"]]
+direction = [1,-1,0,2]
+shift p = translate 1 0 (overlaypic[bond,p])
+bond = pic 0 0 ["-"]
+centre = pic 0 0 ["C"]
diff --git a/miralib/ex/polish.m b/miralib/ex/polish.m
new file mode 100644
index 0000000..21e58a5
--- /dev/null
+++ b/miralib/ex/polish.m
@@ -0,0 +1,34 @@
+||very simple testbed for Miranda unification package, "unify.m"
+
+||The expressions to be unified here are strings  written  in  (forward)
+||polish  notation,  such  as  "*+12-xy"  -  meaning  (1+2)*(x-y).   The
+||operators are + - * / with single letter variables, and  single  digit
+||constants.   We provide bindings for the free identifiers of "unify.m"
+||corresponding to this syntax.
+
+%include "unify.m"
+         { expr==[char]; operator==char; var==char;
+           isvar=isvar; getvar=getvar; putvar=putvar;
+           rator=rator; rands=rands; construct=construct;
+         }
+
+isvar e = letter (hd e)
+getvar = hd
+putvar = (:[])
+rator = hd
+rands (c:[]) = [], if digit c
+rands (c:e) = [a,b], if member "+-*/" c & e2=[]
+            = error "illegal string", otherwise
+              where 
+              (a,e1) = get e
+              (b,e2) = get e1
+              get [] = error "illegal string"
+              get (c:x) = ([c],x), if letter c \/ digit c
+                        = ([c]++a++b,x2), otherwise
+                          where
+                          (a,x1) = get x
+                          (b,x2) = get x1
+construct c xs = c:concat xs
+
+test = unifyexprs "*+x3/7x" "*+1y/z1" ||the result should be "*+13/71"
+test1 = unifyexprs "*+x3/7x" "*+1y/y1" ||not unifiable
diff --git a/miralib/ex/powers.m b/miralib/ex/powers.m
new file mode 100644
index 0000000..019a139
--- /dev/null
+++ b/miralib/ex/powers.m
@@ -0,0 +1,15 @@
+||prints a table of powers 2 to 5 of the numbers 1 to 20
+||to see the table, say
+||	output
+
+output = title ++ captions ++ concat (map line [1..20])
+
+title = cjustify 60 "A TABLE OF POWERS" ++ "\n\n"
+
+captions = format "N" ++ concat (map caption [2..5]) ++ "\n"
+
+caption i = format ("N^" ++ shownum i)
+
+format = rjustify 12
+
+line n = concat [format (show(n^i)) | i<-[1..5]] ++ "\n"
diff --git a/miralib/ex/primes.m b/miralib/ex/primes.m
new file mode 100644
index 0000000..2a7c5df
--- /dev/null
+++ b/miralib/ex/primes.m
@@ -0,0 +1,7 @@
+||The infinite list of all prime numbers, by the sieve of Eratosthenes.
+||To see the list, just say `primes', or if you prefer
+||	lay(map show primes)
+||will print them one per line.  Hit control-C (interrupt) to stop.
+
+primes = sieve[2..]
+sieve (p:x) = p:sieve[n|n<-x;n mod p~=0]
diff --git a/miralib/ex/pyths.m b/miralib/ex/pyths.m
new file mode 100644
index 0000000..8301e47
--- /dev/null
+++ b/miralib/ex/pyths.m
@@ -0,0 +1,9 @@
+||Finds all pythagorean triangles (right triangles with  integer  sides)
+||Note  the use of a diagonalising list comprehension, with `//' instead
+||of `|'.  To see the triangles, say
+||	output
+
+output = lay (map show pyths)
+pyths = [(a, b, intsqrt (a*a+b*b)) // a <- [3..]; b<-[a+1..]; is_sq (a*a+b*b)]
+intsqrt x = entier (sqrt x)
+is_sq y = (intsqrt y) ^ 2 = y
diff --git a/miralib/ex/queens.m b/miralib/ex/queens.m
new file mode 100644
index 0000000..2ed5734
--- /dev/null
+++ b/miralib/ex/queens.m
@@ -0,0 +1,22 @@
+||this generates all solutions to the 8 queens problem -- say
+||      solns
+||and it will print the solutions one per line - all 92 of  them.   This
+||is  a  good  program  for testing the garbage collector.  Say `/gc' to
+||switch on garbage collector diagnostics.
+
+solns = layn(map show (queens 8))
+queens 0 = [[]]
+queens (n+1) = [q:b|b<-queens n;q<-[1..8];safe q b]
+safe q b = and[~checks q b i|i<-index b]
+checks q b i = q=b!i \/ abs(q-b!i)=i+1
+
+||Note that the function `queens n' returns a list of all  solutions  to
+||the n queens problem (placing queens in the first n columns of a chess
+||board, so that no queen gives check  to  another).   A  board  with  n
+||queens  is represented as a list of n numbers, namely the positions of
+||the queens in each column
+
+||This  example  exhibits  a  basic   technique   of   lazy   functional
+||programming,  which is to eliminate backtracking from a search problem
+||by working at the level of a list of  all  solutions,  rather  than  a
+||single solution.
diff --git a/miralib/ex/queens1.m b/miralib/ex/queens1.m
new file mode 100644
index 0000000..79b52a8
--- /dev/null
+++ b/miralib/ex/queens1.m
@@ -0,0 +1,16 @@
+||This finds one solution to the eight queens problem,  using  a
+||different method from that of the previous script, "queens.m".
+||To run it, say
+||	output
+||This time the backtracking is programmed explicitly
+
+output = concat [c:shownum r++" "|(c,r)<-zip2 "rnbqkbnr" soln]
+soln = until full extend emptyboard
+extend board = until safe alter (addqueen board)
+addqueen board = 1:board
+emptyboard = []
+full board = # board=8
+alter (q:board) = q+1:board, if q<8
+                = alter board, otherwise ||backtrack
+safe (q:board) = and [~checks q board i|i<-index board]
+checks q board i = q=board!i \/ abs(q-board!i)=i+1
diff --git a/miralib/ex/quicksort.m b/miralib/ex/quicksort.m
new file mode 100644
index 0000000..2da7d55
--- /dev/null
+++ b/miralib/ex/quicksort.m
@@ -0,0 +1,12 @@
+||this is a functional version of quicksort, to see it work, say:
+||	qsort testdata
+||the reason we have to call the function `qsort' rather than `sort' is
+||because there is a `sort' already defined in the standard environment
+
+qsort [] = []
+qsort (a:x) = qsort [b|b<-x;b<=a] ++ [a] ++ qsort[b|b<-x;b>a]
+
+testdata = f 10
+f n = concat(transpose [[0,2..2*n],[2*n-1,2*n-3..1]])
+
+||note that the sort included in the standard environment is merge-sort
diff --git a/miralib/ex/rational.m b/miralib/ex/rational.m
new file mode 100644
index 0000000..8b432d1
--- /dev/null
+++ b/miralib/ex/rational.m
@@ -0,0 +1,56 @@
+||rational numbers as an abstract data type, say
+||	%include <ex/rat>
+||to include this in one of your own scripts.  Quoting the  filename  in
+||this form makes the %include directive work from any directory.
+
+abstype rational
+with ratio :: num -> num -> rational
+     mkrat :: num->rational
+     rplus, rminus, rtimes, rdiv :: rational -> rational -> rational
+     rpow :: num -> rational -> rational
+     numerator, denominator :: rational -> num
+     rparts :: rational -> (num,num)
+     showrational :: rational -> [char]
+
+rational == (num,num)
+
+||a rational is represented as a pair of integers
+||note that rationals are kept in their lowest terms, with positive
+||denominator, and (0,1) is the unique representation of zero
+
+ratio p q = error "illegal ratio", if  q=0\/~integer p\/~integer q
+          = ratio (-p) (-q), if q<0
+          = (0,1), if  p=0
+          = (p div h,q div h), otherwise
+            where
+            h = hcf (abs p) q
+            hcf a b = hcf b a, if  a>b
+	            = b, if a=0
+	            = hcf (b mod a) a, otherwise
+
+mkrat n = ratio n 1, if integer n
+	= error ("mkrat "++shownum n), otherwise
+
+(a,b) $rplus (c,d) = ratio (a*d+c*b) (b*d)
+(a,b) $rminus (c,d) = ratio (a*d-c*b) (b*d)
+(a,b) $rtimes (c,d) = ratio (a*c) (b*d)
+(a,b) $rdiv (c,d) = ratio (a*d) (b*c)
+
+rpow 0 x = (1,1)
+rpow n x = thing, if n mod 2 = 0
+         = x $rtimes thing, otherwise
+           where
+	   thing = rpow (n div 2) (x $rtimes x)
+
+numerator = fst
+denominator = snd
+rparts = id
+
+showrational (a,b) = "(ratio "++shownum1 a++" "++shownum1 b++")"
+shownum1 n = "("++shownum n++")", if n<0
+           = shownum n, otherwise
+
+||Attempts to print a rational will automatically pick up  the  function
+||called showrational - see manual section on abstract data types.  Note
+||that we have chosen to print rationals in such a way that Miranda  can
+||read them back in again at the same type.
diff --git a/miralib/ex/refoliate.m b/miralib/ex/refoliate.m
new file mode 100644
index 0000000..028f362
--- /dev/null
+++ b/miralib/ex/refoliate.m
@@ -0,0 +1,60 @@
+> tree ::= Leaf num | Fork tree tree
+
+PROBLEM: write down the definition of a function which takes a tree  and
+returns a tree of the SAME SHAPE, containing the same data, but with the
+leaves moved around so that the data appears in  ascending  order,  when
+the tree is scanned from left to right.
+
+> reorder :: tree->tree
+> reorder t = refoliate t (sort (fringe t))
+
+Our  idea  here  is that `fringe' extracts a list of all the data in the
+tree, while `refoliate' takes a tree and a list of  data,  and  replaces
+the  leaves of the tree with the given data, preserving the shape of the
+tree.  We define fringe first, as it is the easiest.
+
+> fringe :: tree->[num]
+> fringe (Leaf n) = [n]
+> fringe (Fork s t) = fringe s ++ fringe t
+
+Aside - there is a trivial change to the  last  line  which  alters  the
+behaviour of fringe so that the call to sort is no longer necessary.  We
+can replace `++' by a call to the library function `merge'.  This  would
+improve the efficiency of the solution.
+
+We define `refoliate' in terms of an auxiliary function  which  takes  a
+subtree  and  the  list  of  replacement  data, and returns a pair - the
+refoliated subtree, and the unused part of the list.
+
+> refoliate :: tree->[num]->tree
+> refoliate t x = fst (refol t x)
+
+> refol :: tree->[num]->(tree,[num])
+> refol (Leaf n) (a:x) = (Leaf a,x)
+> refol (Fork s t) x = (Fork s1 t1,x'')
+> 		       where
+> 		       (s1,x') = refol s x
+> 		       (t1,x'') = refol t x'
+
+Here  is  an  example  tree  on which to call `reorder', to see that the
+algorithm works.
+
+> t1 = mktree [19,0,17,2,15,4,13,6,11,8,9,10,7,12,5,14,3,16,1,18]
+
+mktree takes a list and builds a (well-balanced) tree from it.
+
+> mktree :: [num]->tree
+> mktree [] = error "cannot have empty tree"
+> mktree [a] = Leaf a
+> mktree x = Fork (mktree (take n x)) (mktree (drop n x))
+> 	     where n = # x div 2
+
+Finally, we define a function same_shape, which can be used  to  confirm
+that reorder holds the shape constant.
+
+> same_shape :: tree->tree->bool
+> same_shape (Leaf a) (Leaf b) = True
+> same_shape (Fork s t) (Fork s1 t1) = same_shape s s1 & same_shape t t1
+> same_shape s t = False ||all other cases
+
+> test = same_shape t1 (reorder t1)
diff --git a/miralib/ex/selflines.m b/miralib/ex/selflines.m
new file mode 100644
index 0000000..cf3d016
--- /dev/null
+++ b/miralib/ex/selflines.m
@@ -0,0 +1,32 @@
+||this produces an endless self describing scroll of lines, as follows
+||	the 1st line is
+||	"the 1st line is"
+||	the 2nd line is
+||	""the 1st line is""
+||	the 3rd line is
+||	"the 2nd line is"
+||	etc...
+||To see the result, say
+||	output
+||Hit control-C (interrupt) when you have seen enough.
+||If you would like to send the output to a file, say
+||	output &> fil
+||where `fil' is the name of the file in which you want to put it
+||this will create a background job
+
+output = concat[l++"\n"|l<-selflines]
+
+selflines = mklines 1
+
+mklines n = ("the "++ord n++" line is:"):
+	    ("\""++selflines!(n-1)++"\""):
+	    mklines(n+1)
+
+ord n = show n++suffix n
+
+suffix 1 = "st"
+suffix 2 = "nd"
+suffix 3 = "rd"
+suffix n = "th", if n=0 \/ 3<=n&n<=9
+         = "th", if (n mod 100)div 10 = 1 ||because of 11,12,13
+         = suffix(n mod 10), otherwise
diff --git a/miralib/ex/set.m b/miralib/ex/set.m
new file mode 100644
index 0000000..c6a52f9
--- /dev/null
+++ b/miralib/ex/set.m
@@ -0,0 +1,64 @@
+||definition of finite sets as an abstract data type, say
+||	%include <ex/set>
+||to include this in one of your own scripts.
+
+abstype set *
+with  makeset::[*]->set * ||converts list to set
+      enum::set *->[*] ||converts set to list
+      empty::set * ||empty set
+      mem::set *->*->bool ||does set contain element?
+      pincludes,includes::set *->set *->bool ||(proper) set inclusion
+      union::[set *]->set * ||union of a list of sets
+      intersect::[set *]->set * ||intersection of a list of sets
+      setdiff::set *->set *->set * ||set difference of two sets
+      union2::set *->set *->set * ||union of two sets
+      intersect2::set *->set *->set * ||intersection of two sets
+      add1::*->set *->set * ||add a single element to a set
+      sub1::*->set *->set * ||remove an element from a set (if present)
+      pick::set *->* ||pick some element from a set
+      rest::set *->set * ||remainder of set, without element got by pick
+      showset::(*->[char])->set *->[char]  ||to make sets printable
+
+set * == [*]        ||a set is represented as a list without duplicates
+makeset = uniq.sort ||for efficiency the lists are kept sorted
+enum = id
+empty = []
+mem (a:x) b = a=b \/ a<b & mem x b
+mem [] b = False
+includes x y = (setdiff y x = [])
+pincludes x y = x~=y & (setdiff y x = [])
+union2 x y = uniq(merge x y)
+union = foldr union2 empty
+setdiff (a:x) (b:y) = a:setdiff x (b:y), if a<b
+                    = setdiff (a:x) y, if a>b
+		    = setdiff x y, otherwise
+setdiff x y = x
+intersect2 (a:x) (b:y) = intersect2 x (b:y), if a<b
+                       = intersect2 (a:x) y, if a>b
+                       = a : intersect2 x y, otherwise
+intersect2 x y = []
+intersect = foldl1 intersect2
+add1 a (b:x) = a:b:x, if a<b
+             = b:x, if a=b
+             = b:add1 a x, otherwise
+add1 a [] = [a]
+sub1 a (b:x) = b:x, if a<b
+             = x, if a=b
+             = b:sub1 a x, otherwise
+sub1 a [] = []
+pick (a:x) = a
+pick [] = error "pick empty"
+rest (a:x) = x
+rest [] = error "pick empty"
+showset f [] = "{}"
+showset f (a:x) = "{"++f a++concat(map g x)++"}"
+                  where
+                  g a = ',':f a
+
+%export -uniq
+||we have used the following auxiliary function, which removes adjacent
+||duplicates from a list  (this is not exported from the script)
+uniq::[*]->[*]
+uniq (a:b:x) = uniq (a:x), if a=b
+             = a:uniq (b:x), otherwise
+uniq x = x
diff --git a/miralib/ex/stack.m b/miralib/ex/stack.m
new file mode 100644
index 0000000..d7a1af2
--- /dev/null
+++ b/miralib/ex/stack.m
@@ -0,0 +1,19 @@
+||This script defines stack, as an abstract data type based on lists.
+||Note that there is a show function for stacks, causing them to print
+||in a sensible way.
+
+abstype stack *
+with empty::stack *; push::*->stack *->stack *;
+     pop::stack *->stack *; top::stack *->*; isempty::stack *->bool;
+     showstack::(*->[char])->stack *->[char]
+
+stack * == [*]
+empty = []
+push a x = a:x
+pop(a:x) = x
+top(a:x) = a
+isempty x = (x=[])
+showstack f [] = "empty"
+showstack f (a:x) = "(push " ++ f a ++ " " ++ showstack f x ++ ")"
+
+teststack = push 1(push 2(push 3 empty))
diff --git a/miralib/ex/topsort.m b/miralib/ex/topsort.m
new file mode 100644
index 0000000..88e96ee
--- /dev/null
+++ b/miralib/ex/topsort.m
@@ -0,0 +1,32 @@
+||Miranda programming example - topological sort
+topsort :: [(*,*)] -> [*]
+
+||topsort takes a list of pairs representing a partial  order - where 
+||the presence  of (u,v) in the list means that u precedes v in the
+||ordering  -  and  returns  a  total  ordering  consistent   with   the
+||information given - that is if (u,v) is in the input data, then u will
+||come before v in the output list.
+
+topsort rel = tsort (carrier rel) rel
+||the carrier of a relation is the set of all the elements related by it
+
+tsort c r = [], if c=[]
+          = error "inconsistent data for tsort",       if m=[]
+	  = a : tsort (c--[a]) [(u,v)|(u,v)<-r; u~=a], otherwise
+            where
+	    a = hd m
+	    m = (c -- ran r)
+||remarks on the above
+|| - it is an invariant that c contains the carrier of relation r
+|| - m is the set of elements of c with no predecessor in r
+
+||the error case will arise if the input data contains a cycle - i.e.
+||if there is an element that directly or indirectly precedes itself.
+
+||a set is here represented as a list without duplicates
+||the standard function mkset removes duplicates from a list
+
+dom r = mkset [u|(u,v)<-r]  ||domain of a relation
+ran r = mkset [v|(u,v)<-r]  ||range of a relation
+carrier r = union (dom r) (ran r)
+union x y = mkset (x++y)
diff --git a/miralib/ex/treesort.m b/miralib/ex/treesort.m
new file mode 100644
index 0000000..e5b946b
--- /dev/null
+++ b/miralib/ex/treesort.m
@@ -0,0 +1,20 @@
+|| Here is another sorting algorithm, this time treesort.
+|| to try it out, say: 	treesort testdata
+
+tree * ::= NILT | NODE * (tree *) (tree *)
+
+treesort = flatten.build
+
+build::[*]->tree *
+build = foldr insert NILT
+
+insert b NILT = NODE b NILT NILT
+insert b (NODE a x y) = NODE a (insert b x) y, if b<=a
+		      = NODE a x (insert b y), if b>a
+
+flatten::tree *->[*]
+flatten NILT = []
+flatten (NODE a x y) = flatten x ++ [a] ++ flatten y
+
+testdata = [1..5]++[20,19..16]++[6..10]++[15,14..11]
+
diff --git a/miralib/ex/unify.m b/miralib/ex/unify.m
new file mode 100644
index 0000000..1ce4034
--- /dev/null
+++ b/miralib/ex/unify.m
@@ -0,0 +1,79 @@
+||Package for doing  (first  order)  unification,  parameterised  on  an
+||abstract theory of expressions.  (DT)
+
+||see the file <ex/polish> for an example of the use of this package.
+
+%free { expr,operator,var::type;
+        isvar::expr->bool; getvar::expr->var; putvar::var->expr;
+        rator::expr->operator; rands::expr->[expr];
+        construct::operator->[expr]->expr;
+      }
+
+||Our theory of expressions is as follows - an expression  is  either  a
+||variable,  or  else  it  consists  of  a rator together with a list of
+||rands.  So for example a constant will be viewed as a rator which  has
+||an  empty  list of rands.  The nature of variables, and the collection
+||of possible rators and their arities, is determined at %include  time.
+||This enables us to use the same code  for  performing  unification  in
+||quite different object languages.
+
+||for each e::expr, one of the following propositions will be true
+||either    isvar e & e = putvar(getvar e)
+||or       ~isvar e & e = construct(rator e)(rands e)
+
+%export unifyexprs unify ult q
+
+q * ::= FAIL | SUCCEED *  ||useful type operator
+
+unifyexprs :: expr->expr->q expr  ||convenient for testing
+
+unify :: subst->expr->expr->q subst
+
+||this implements the unification algorithm  -  it  takes  a  substition
+||(mapping from variables to expressions) and a pair of expressions, and
+||returns the least  extension  of  the  substitution  under  which  the
+||expressions become the same - or FAIL if there is none.
+
+ult :: subst->expr->expr
+
+||computes the result of applying a substitution to an expression.
+
+unifyexprs x y = f(unify [] x y)
+		 where
+		 f FAIL = FAIL
+		 f (SUCCEED s) = SUCCEED (ult s x)
+			         ||note that (ult s y) = (ult s y)
+				 ||if the unification succeeds
+
+subst == [(var,expr)]
+
+||We represent a substitution as a list  of  variable-expression  pairs.
+||The  representation  is  lazy,  in  the sense that the expressions may
+||contain occurrences of the variables in the domain of the substitution
+||- this is taken care of in the definition of ult.
+
+unify s x y
+    = unifier s (ult s x) (ult s y)
+      where
+      unifier s x y = SUCCEED s, if x=y
+                    = SUCCEED((getvar x,y):s), if isvar x & ~occurs x y
+                    = SUCCEED((getvar y,x):s), if isvar y & ~occurs y x
+                    = unifylist (SUCCEED s) (rands x) (rands y),
+			  if ~isvar x & ~isvar y & conforms x y 
+                    = FAIL, otherwise
+      unifylist qs [] [] = qs
+      unifylist (SUCCEED s) (a:x) (b:y) = unifylist (unify s a b) x y
+      unifylist FAIL x y = FAIL
+
+ult s x = lookup s (getvar x), if isvar x
+        = construct(rator x)(map (ult s) (rands x)), otherwise
+          where
+          lookup [] a = putvar a
+          lookup ((a,y):t) a = ult s y  ||note recursive call of ult
+          lookup ((b,y):t) a = lookup t a
+
+occurs y x        || does subexpression y occur in formula x ?
+       = x=y, if isvar x
+       = or (map (occurs y) (rands x)), otherwise
+
+conforms x y = rator x = rator y & #rands x = #rands y