Import to github.

16 files changed, 585 insertions, 0 deletions

diff --git a/progs/demo/prolog/Engine.hs b/progs/demo/prolog/Engine.hs
new file mode 100644
index 0000000..a269503
--- /dev/null
+++ b/progs/demo/prolog/Engine.hs
@@ -0,0 +1,61 @@
+--
+-- Stack based Prolog inference engine
+-- Mark P. Jones November 1990
+--
+-- uses Haskell B. version 0.99.3
+--
+module Engine(prove) where
+
+import PrologData
+import Subst
+
+--- Calculation of solutions:
+
+-- the stack based engine maintains a stack of triples (s,goal,alts)
+-- corresponding to backtrack points, where s is the substitution at that
+-- point, goal is the outstanding goal and alts is a list of possible ways
+-- of extending the current proof to find a solution.  Each member of alts
+-- is a pair (tp,u) where tp is a new subgoal that must be proved and u is
+-- a unifying substitution that must be combined with the substitution s.
+--
+-- the list of relevant clauses at each step in the execution is produced
+-- by attempting to unify the head of the current goal with a suitably
+-- renamed clause from the database.
+
+type Stack = [ (Subst, [Term], [Alt]) ]
+type Alt   = ([Term], Subst)
+
+alts       :: Database -> Int -> Term -> [Alt]
+alts db n g = [ (tp,u) | (tm:*tp) <- renClauses db n g, u <- unify g tm ]
+      
+-- The use of a stack enables backtracking to be described explicitly,
+-- in the following `state-based' definition of prove:
+
+prove      :: Database -> [Term] -> [Subst]
+prove db gl = solve 1 nullSubst gl []
+ where
+   solve :: Int -> Subst -> [Term] -> Stack -> [Subst]
+   solve n s []     ow          = s : backtrack n ow
+   solve n s (g:gs) ow
+                    | g==theCut = solve n s gs (cut ow)
+                    | otherwise = choose n s gs (alts db n (apply s g)) ow
+
+   choose :: Int -> Subst -> [Term] -> [Alt] -> Stack -> [Subst]
+   choose n s gs []          ow = backtrack n ow
+   choose n s gs ((tp,u):rs) ow = solve (n+1) (u@@s) (tp++gs) ((s,gs,rs):ow)
+
+   backtrack                   :: Int -> Stack -> [Subst]
+   backtrack n []               = []
+   backtrack n ((s,gs,rs):ow)   = choose (n-1) s gs rs ow
+
+
+--- Special definitions for the cut predicate:
+
+theCut    :: Term
+theCut     = Struct "!" []
+
+cut                  :: Stack -> Stack
+cut (top:(s,gl,_):ss) = top:(s,gl,[]):ss
+cut ss                = ss
+
+--- End of Engine.hs
diff --git a/progs/demo/prolog/Engine.hu b/progs/demo/prolog/Engine.hu
new file mode 100644
index 0000000..5a64277
--- /dev/null
+++ b/progs/demo/prolog/Engine.hu
@@ -0,0 +1,3 @@
+Engine.hs
+PrologData.hu
+Subst.hu
diff --git a/progs/demo/prolog/Interact.hs b/progs/demo/prolog/Interact.hs
new file mode 100644
index 0000000..c8bf516
--- /dev/null
+++ b/progs/demo/prolog/Interact.hs
@@ -0,0 +1,76 @@
+--
+-- Interactive utility functions
+-- Mark P. Jones November 1990
+--
+-- uses Haskell B. version 0.99.3
+--
+module Interact(Interactive(..), skip, end, readln, writeln, readch) where
+
+-- The functions defined in this module provide basic facilities for
+-- writing line-oriented interactive programs (i.e. a function mapping
+-- an input string to an appropriate output string).  These definitions
+-- are an enhancement of thos in B+W 7.8
+--
+-- skip p         is an interactive program which consumes no input, produces
+--                no output and then behaves like the interactive program p.
+-- end            is an interactive program which ignores the input and
+--                produces no output.
+-- writeln txt p  is an interactive program which outputs the message txt
+--                and then behaves like the interactive program p
+-- readch act def is an interactive program which reads the first character c
+--                from the input stream and behaves like the interactive
+--                program act c.  If the input character stream is empty,
+--                readch act def prints the default string def and terminates.
+-- 
+-- readln p g     is an interactive program which prints the prompt p and
+--                reads a line (upto the first carriage return, or end of
+--                input) from the input stream.  It then behaves like g line.
+--                Backspace characters included in the input stream are
+--                interpretted in the usual way.
+
+type Interactive = String -> String
+
+--- Interactive program combining forms:
+
+skip                 :: Interactive -> Interactive
+skip p inn             = p inn    -- a dressed up identity function
+
+end                  :: Interactive
+end inn                = ""
+
+writeln              :: String -> Interactive -> Interactive
+writeln txt p inn      = txt ++ p inn
+
+readch               :: (Char -> Interactive) -> String -> Interactive
+readch act def ""     = def
+readch act def (c:cs) = act c cs
+
+readln               :: String -> (String -> Interactive) -> Interactive
+readln prompt g inn    = prompt ++ lineOut 0 line ++ "\n"
+                               ++ g (noBackSpaces line) input'
+                        where line     = before '\n' inn
+                              input'   = after  '\n' inn
+                              after x  = tail . dropWhile (x/=)
+                              before x = takeWhile (x/=)
+
+--- Filter out backspaces etc:
+
+rubout  :: Char -> Bool
+rubout c = (c=='\DEL' || c=='\BS')
+
+lineOut                      :: Int -> String -> String
+lineOut n ""                  = ""
+lineOut n (c:cs)
+          | n>0  && rubout c  = "\BS \BS" ++ lineOut (n-1) cs
+          | n==0 && rubout c  = lineOut 0 cs
+          | otherwise         = c:lineOut (n+1) cs
+
+noBackSpaces :: String -> String
+noBackSpaces  = reverse . delete 0 . reverse
+                where delete n ""          = ""
+                      delete n (c:cs)
+                               | rubout c  = delete (n+1) cs
+                               | n>0       = delete (n-1) cs
+                               | otherwise = c:delete 0 cs
+
+--- End of Interact.hs
diff --git a/progs/demo/prolog/Interact.hu b/progs/demo/prolog/Interact.hu
new file mode 100644
index 0000000..41ebb9d
--- /dev/null
+++ b/progs/demo/prolog/Interact.hu
@@ -0,0 +1,2 @@
+Interact.hs
+
diff --git a/progs/demo/prolog/Main.hs b/progs/demo/prolog/Main.hs
new file mode 100644
index 0000000..56d83a8
--- /dev/null
+++ b/progs/demo/prolog/Main.hs
@@ -0,0 +1,87 @@
+--
+-- Prolog interpreter top level module
+-- Mark P. Jones November 1990
+--
+-- uses Haskell B. version 0.99.3
+--
+module Main(main) where
+
+import PrologData
+import Parse
+import Interact
+import Subst
+import Engine
+import Version
+
+--- Command structure and parsing:
+
+data Command = Fact Clause | Query [Term] | Show | Error | Quit | NoChange
+
+command :: Parser Command
+command  = just (sptok "bye" `orelse` sptok "quit") `do` (\quit->Quit)
+               `orelse`
+           just (okay NoChange)
+               `orelse`
+           just (sptok "??") `do` (\show->Show)
+               `orelse`
+           just clause `do` Fact
+               `orelse`
+           just (sptok "?-" `seq` termlist) `do` (\(q,ts)->Query ts)
+               `orelse`
+           okay Error
+
+--- Main program read-solve-print loop:
+
+signOn           :: String
+signOn            = "Mini Prolog Version 1.5 (" ++ version ++ ")\n\n"
+
+main             :: Dialogue
+main              = --echo False abort
+                    (appendChan stdout signOn abort
+                    (appendChan stdout ("Reading " ++ stdlib ++ "...") abort
+                    (readFile stdlib
+                      (\fail -> appendChan stdout "not found\n" abort
+                                (interpreter ""))
+                      (\lib  -> appendChan stdout "done\n"      abort
+                                (interpreter lib))
+                    )))
+
+stdlib           :: String
+stdlib            = "$HASKELL/progs/demo/prolog/stdlib"
+
+interpreter      :: String -> Dialogue
+interpreter lib   = readChan stdin abort
+                    (\inn -> appendChan stdout (loop startDb inn) abort done)
+                    where startDb = foldl addClause emptyDb clauses
+                          clauses = [r | ((r,""):_)<-map clause (lines lib)]
+
+loop             :: Database -> String -> String
+loop db           = readln "> " (exec db . fst . head . command)
+
+exec             :: Database -> Command -> String -> String
+exec db (Fact r)  = skip                              (loop (addClause db r))
+exec db (Query q) = demonstrate db q
+exec db Show      = writeln (show db)                 (loop db)
+exec db Error     = writeln "I don't understand\n"    (loop db)
+exec db Quit      = writeln "Thank you and goodbye\n" end
+exec db NoChange  = skip                              (loop db)
+
+--- Handle printing of solutions etc...
+
+solution      :: [Id] -> Subst -> [String]
+solution vs s  = [ show (Var i) ++ " = " ++ show v
+                                | (i,v) <- [ (i,s i) | i<-vs ], v /= Var i ]
+
+demonstrate     :: Database -> [Term] -> Interactive
+demonstrate db q = printOut (map (solution vs) (prove db q))
+ where vs               = (nub . concat . map varsIn) q
+       printOut []      = writeln "no.\n"     (loop db)
+       printOut ([]:bs) = writeln "yes.\n"    (loop db)
+       printOut (b:bs)  = writeln (doLines b) (nextReqd bs)
+       doLines          = foldr1 (\xs ys -> xs ++ "\n" ++ ys)
+       nextReqd bs      = writeln " "
+                            (readch (\c->if c==';'
+                                           then writeln ";\n" (printOut bs)
+                                           else writeln "\n"  (loop db)) "")
+
+--- End of Main.hs
diff --git a/progs/demo/prolog/Main.hu b/progs/demo/prolog/Main.hu
new file mode 100644
index 0000000..a936ca6
--- /dev/null
+++ b/progs/demo/prolog/Main.hu
@@ -0,0 +1,6 @@
+Main.hs
+Parse.hu
+PrologData.hu
+Interact.hu
+Engine.hu
+Version.hu
diff --git a/progs/demo/prolog/Parse.hs b/progs/demo/prolog/Parse.hs
new file mode 100644
index 0000000..0487432
--- /dev/null
+++ b/progs/demo/prolog/Parse.hs
@@ -0,0 +1,116 @@
+--
+-- General parsing library, based on Richard Bird's parselib.orw for Orwell
+-- (with a number of extensions)
+-- Mark P. Jones November 1990
+--
+-- uses Haskell B. version 0.99.3
+--
+module Parse(Parser(..), fail, okay, tok, sat, orelse, seq, do,
+             sptok, just, listOf, many, sp, many1) where
+
+infixr 6 `seq`
+infixl 5 `do`
+infixr 4 `orelse`
+
+--- Type definition:
+
+type Parser a = [Char] -> [(a,[Char])]
+
+-- A parser is a function which maps an input stream of characters into
+-- a list of pairs each containing a parsed value and the remainder of the
+-- unused input stream.  This approach allows us to use the list of
+-- successes technique to detect errors (i.e. empty list ==> syntax error).
+-- it also permits the use of ambiguous grammars in which there may be more
+-- than one valid parse of an input string.
+
+--- Primitive parsers:
+
+-- fail     is a parser which always fails.
+-- okay v   is a parser which always succeeds without consuming any characters
+--          from the input string, with parsed value v.
+-- tok w    is a parser which succeeds if the input stream begins with the
+--          string (token) w, returning the matching string and the following
+--          input.  If the input does not begin with w then the parser fails.
+-- sat p    is a parser which succeeds with value c if c is the first input
+--          character and c satisfies the predicate p.
+
+fail        :: Parser a 
+fail inn      = []
+
+okay        :: a -> Parser a  
+okay v inn    = [(v,inn)]
+
+tok         :: [Char] -> Parser [Char]
+tok w inn     = [(w, drop n inn) | w == take n inn]
+               where n = length w
+
+sat         :: (Char -> Bool) -> Parser Char 
+sat p []     = []
+sat p (c:inn) = [ (c,inn) | p c ]
+
+--- Parser combinators:
+
+-- p1 `orelse` p2 is a parser which returns all possible parses of the input
+--                string, first using the parser p1, then using parser p2.
+-- p1 `seq` p2    is a parser which returns pairs of values (v1,v2) where
+--                v1 is the result of parsing the input string using p1 and
+--                v2 is the result of parsing the remaining input using p2.
+-- p `do` f       is a parser which behaves like the parser p, but returns
+--                the value f v wherever p would have returned the value v.
+--
+-- just p         is a parser which behaves like the parser p, but rejects any
+--                parses in which the remaining input string is not blank.
+-- sp p           behaves like the parser p, but ignores leading spaces.
+-- sptok w        behaves like the parser tok w, but ignores leading spaces.
+--
+-- many p         returns a list of values, each parsed using the parser p.
+-- many1 p        parses a non-empty list of values, each parsed using p.
+-- listOf p s     parses a list of input values using the parser p, with
+--                separators parsed using the parser s.
+
+orelse             :: Parser a -> Parser a -> Parser a 
+p1 `orelse` p2     = \inn->p1 inn ++ p2 inn
+ 
+seq                :: Parser a -> Parser b -> Parser (a,b)
+p1 `seq` p2        = \inn->[((v1,v2),inn2) | (v1,inn1) <- p1 inn, (v2,inn2) <- p2 inn1]
+
+do                 :: Parser a -> (a -> b) -> Parser b 
+p `do` f           = \inn->[(f v, inn1) | (v,inn1) <- p inn]
+
+just               :: Parser a -> Parser a
+just p inn           = [ (v,"") | (v,inn')<- p inn, dropWhile (' '==) inn' == "" ]
+
+sp                 :: Parser a -> Parser a
+sp p                = p . dropWhile (' '==)
+
+sptok              :: [Char] -> Parser [Char]
+sptok               =  sp . tok
+
+many               :: Parser a  -> Parser [a]
+many p              = q
+                      where q = ((p `seq` q) `do` makeList) `orelse` (okay [])
+
+many1              :: Parser a -> Parser [a]
+many1 p             = p `seq` many p `do` makeList
+
+listOf             :: Parser a -> Parser b -> Parser [a]
+listOf p s          = p `seq` many (s `seq` p) `do` nonempty
+                      `orelse` okay []
+                      where nonempty (x,xs) = x:(map snd xs)
+
+--- Internals:
+
+makeList       :: (a,[a]) -> [a]
+makeList (x,xs) = x:xs
+
+{-
+-- an attempt to optimise the performance of the standard prelude function
+-- `take' in Haskell B 0.99.3 gives the wrong semantics.  The original
+-- definition, given below works correctly and is used in the above.
+
+safetake              :: (Integral a) => a -> [b] -> [b]
+safetake  _     []     =  []
+safetake  0     _      =  []
+safetake (n+1) (x:xs)  =  x : safetake n xs
+-}
+--- End of Parse.hs
diff --git a/progs/demo/prolog/Parse.hu b/progs/demo/prolog/Parse.hu
new file mode 100644
index 0000000..44cc302
--- /dev/null
+++ b/progs/demo/prolog/Parse.hu
@@ -0,0 +1 @@
+Parse.hs
diff --git a/progs/demo/prolog/PrologData.hs b/progs/demo/prolog/PrologData.hs
new file mode 100644
index 0000000..4ff3173
--- /dev/null
+++ b/progs/demo/prolog/PrologData.hs
@@ -0,0 +1,121 @@
+--
+-- Representation of Prolog Terms, Clauses and Databases
+-- Mark P. Jones November 1990
+--
+-- uses Haskell B. version 0.99.3
+--
+module PrologData(Id(..), Atom(..), Term(..), term, termlist, varsIn,
+                  Clause((:*)), clause,
+                  Database, emptyDb, renClauses, addClause) where
+
+import Parse
+
+infix 6 :*
+
+--- Prolog Terms:
+
+type Id       = (Int,String)
+type Atom     = String
+data Term     = Var Id | Struct Atom [Term]
+                deriving Eq
+data Clause   = Term :* [Term]
+data Database = Db [(Atom,[Clause])]
+
+--- Determine the list of variables in a term:
+
+varsIn              :: Term -> [Id]
+varsIn (Var i)       = [i]
+varsIn (Struct i ts) = (nub . concat . map varsIn) ts
+
+renameVars                  :: Int -> Term -> Term
+renameVars lev (Var (n,s))   = Var (lev,s)
+renameVars lev (Struct s ts) = Struct s (map (renameVars lev) ts)
+
+--- Functions for manipulating databases (as an abstract datatype)
+
+emptyDb      :: Database
+emptyDb       = Db []
+
+renClauses                  :: Database -> Int -> Term -> [Clause]
+renClauses db n (Var _)      = []
+renClauses db n (Struct a _) = [ r tm:*map r tp | (tm:*tp)<-clausesFor a db ]
+                               where r = renameVars n
+
+clausesFor           :: Atom -> Database -> [Clause]
+clausesFor a (Db rss) = case dropWhile (\(n,rs) -> n<a) rss of
+                         []         -> []
+                         ((n,rs):_) -> if a==n then rs else []
+
+addClause :: Database -> Clause -> Database
+addClause (Db rss) r@(Struct a _ :* _)
+         = Db (initialPart ++
+               case lastPart of
+                 []            -> [(a,[r])]
+                 ((n,rs):rss') -> if a==n then (n,rs++[r]):rss'
+                                          else (a,[r]):lastPart)
+           where (initialPart,lastPart) = span (\(n,rs) -> n<a) rss
+
+--- Output functions (defined as instances of Text):
+
+instance Text Term where
+  showsPrec p (Var (n,s))
+              | n==0        = showString s
+              | otherwise   = showString s . showChar '_' . shows n
+  showsPrec p (Struct a []) = showString a
+  showsPrec p (Struct a ts) = showString a . showChar '('
+                                           . showWithSep "," ts
+                                           . showChar ')'
+
+instance Text Clause where
+   showsPrec p (t:*[]) = shows t . showChar '.'
+   showsPrec p (t:*gs) = shows t . showString ":-"
+                                 . showWithSep "," gs
+                                 . showChar '.'
+
+instance Text Database where
+    showsPrec p (Db [])  = showString "-- Empty Database --\n"
+    showsPrec p (Db rss) = foldr1 (\u v-> u . showChar '\n' . v)
+                                  [ showWithTerm "\n" rs | (i,rs)<-rss ]
+
+--- Local functions for use in defining instances of Text:
+
+showWithSep          :: Text a => String -> [a] -> ShowS
+showWithSep s [x]     = shows x
+showWithSep s (x:xs)  = shows x . showString s . showWithSep s xs
+
+showWithTerm         :: Text a => String -> [a] -> ShowS
+showWithTerm s xs     = foldr1 (.) [shows x . showString s | x<-xs]
+
+--- String parsing functions for Terms and Clauses:
+--- Local definitions:
+
+letter       :: Parser Char
+letter        = sat (\c -> isAlpha c || isDigit c || c `elem` ":;+=-*&%$#@?/.~!")
+
+variable     :: Parser Term
+variable      = sat isUpper `seq` many letter `do` makeVar
+                where makeVar (initial,rest) = Var (0,(initial:rest))
+
+struct       :: Parser Term
+struct        = many letter `seq` (sptok "(" `seq` termlist `seq` sptok ")"
+                                       `do` (\(o,(ts,c))->ts)
+                                  `orelse`
+                                   okay [])
+                `do` (\(name,terms)->Struct name terms)
+
+--- Exports:
+
+term         :: Parser Term
+term          = sp (variable `orelse` struct)
+
+termlist     :: Parser [Term]
+termlist      = listOf term (sptok ",")
+
+clause       :: Parser Clause
+clause        = sp struct `seq` (sptok ":-" `seq` listOf term (sptok ",")
+                                 `do` (\(from,body)->body)
+                                `orelse` okay [])
+                          `seq` sptok "."
+                     `do` (\(head,(goals,dot))->head:*goals)
+
+--- End of PrologData.hs
diff --git a/progs/demo/prolog/PrologData.hu b/progs/demo/prolog/PrologData.hu
new file mode 100644
index 0000000..362d35f
--- /dev/null
+++ b/progs/demo/prolog/PrologData.hu
@@ -0,0 +1,2 @@
+PrologData.hs
+Parse.hu
diff --git a/progs/demo/prolog/README b/progs/demo/prolog/README
new file mode 100644
index 0000000..73dbc1b
--- /dev/null
+++ b/progs/demo/prolog/README
@@ -0,0 +1,3 @@
+This is a mini prolog interpreter written my Mark Jones.  It
+was slightly adapted from version in the hbc release.
+
diff --git a/progs/demo/prolog/Subst.hs b/progs/demo/prolog/Subst.hs
new file mode 100644
index 0000000..f96e462
--- /dev/null
+++ b/progs/demo/prolog/Subst.hs
@@ -0,0 +1,65 @@
+--
+-- Substitutions and Unification of Prolog Terms
+-- Mark P. Jones November 1990
+--
+-- uses Haskell B. version 0.99.3
+--
+module Subst(Subst(..), nullSubst, (>!), (@@), apply, unify) where
+
+import PrologData
+
+infixr 3 @@
+infix  4 >!
+
+--- Substitutions:
+
+type Subst = Id -> Term
+
+-- substitutions are represented by functions mapping identifiers to terms.
+--
+-- apply s   extends the substitution s to a function mapping terms to terms
+-- nullSubst is the empty substitution which maps every identifier to the
+--           same identifier (as a term).
+-- i >! t   is the substitution which maps the identifier i to the term t,
+--           but otherwise behaves like nullSubst.
+-- s1 @@ s2  is the composition of substitutions s1 and s2
+--           N.B.  apply is a monoid homomorphism from (Subst,nullSubst,(@@))
+--           to (Term -> Term, id, (.)) in the sense that:
+--                  apply (s1 @@ s2) = apply s1 . apply s2
+--                    s @@ nullSubst = s = nullSubst @@ s
+
+apply                   :: Subst -> Term -> Term
+apply s (Var i)          = s i
+apply s (Struct a ts)    = Struct a (map (apply s) ts)
+
+nullSubst               :: Subst
+nullSubst i              = Var i
+
+(>!)                  :: Id -> Term -> Subst
+(>!) i t j | j==i       = t
+            | otherwise  = Var j
+
+(@@)                    :: Subst -> Subst -> Subst
+s1 @@ s2                 = apply s1 . s2 
+
+--- Unification:
+
+-- unify t1 t2 returns a list containing a single substitution s which is
+--             the most general unifier of terms t1 t2.  If no unifier
+--             exists, the list returned is empty.
+
+unify :: Term -> Term -> [Subst]
+unify (Var x)       (Var y)       = if x==y then [nullSubst] else [x>!Var y]
+unify (Var x)       t2            = [ x >! t2 | not (x `elem` varsIn t2) ]
+unify t1            (Var y)       = [ y >! t1 | not (y `elem` varsIn t1) ]
+unify (Struct a ts) (Struct b ss) = [ u | a==b, u<-listUnify ts ss ]
+
+listUnify :: [Term] -> [Term] -> [Subst]
+listUnify []     []     = [nullSubst]
+listUnify []     (r:rs) = []
+listUnify (t:ts) []     = []
+listUnify (t:ts) (r:rs) = [ u2 @@ u1 | u1<-unify t r,
+                                       u2<-listUnify (map (apply u1) ts)
+                                                     (map (apply u1) rs) ]
+
+--- End of Subst.hs
diff --git a/progs/demo/prolog/Subst.hu b/progs/demo/prolog/Subst.hu
new file mode 100644
index 0000000..1bb92fb
--- /dev/null
+++ b/progs/demo/prolog/Subst.hu
@@ -0,0 +1,2 @@
+Subst.hs
+PrologData.hu
diff --git a/progs/demo/prolog/Version.hs b/progs/demo/prolog/Version.hs
new file mode 100644
index 0000000..c580f4b
--- /dev/null
+++ b/progs/demo/prolog/Version.hs
@@ -0,0 +1 @@
+module Version where version="tree based"
diff --git a/progs/demo/prolog/Version.hu b/progs/demo/prolog/Version.hu
new file mode 100644
index 0000000..244a511
--- /dev/null
+++ b/progs/demo/prolog/Version.hu
@@ -0,0 +1 @@
+Version.hs
diff --git a/progs/demo/prolog/stdlib b/progs/demo/prolog/stdlib
new file mode 100644
index 0000000..76d2b8c
--- /dev/null
+++ b/progs/demo/prolog/stdlib
@@ -0,0 +1,38 @@
+This file contains a list of predicate definitions that will automatically
+be read into Mini Prolog at the beginning of a session.  Each clause in this
+file must be entered on a single line and lines containing syntax errors are
+always ignored.  This includes the first few lines of this file and provides
+a simple way to include comments.
+
+append(nil,X,X).
+append(cons(X,Y),Z,cons(X,W)):-append(Y,Z,W).
+
+equals(X,X).
+
+not(X):-X,!,false.
+not(X).
+
+or(X,Y):-X.
+or(X,Y):-Y.
+
+and(X,Y):-X,Y.
+
+reverse(nil,nil).
+reverse(cons(A,X),Y):-and(reverse(X,Z),append(Z,cons(A,nil),Y)).
+
+palindromes(X):-and(reverse(X,Y),equals(X,Y)).
+
+mul2(A,B):-append(A,A,B).
+mul4(A,B):-and(mul2(A,C),mul2(C,B)).
+mul8(A,B):-and(mul4(A,C),mul2(C,B)).
+mul16(A,B):-and(mul8(A,C),mul2(C,B)).
+mul32(A,B):-and(mul16(A,C),mul2(C,B)).
+mul64(A,B):-and(mul32(A,C),mul2(C,B)).
+mul128(A,B):-and(mul64(A,C),mul2(C,B)).
+mul256(A,B):-and(mul128(A,C),mul2(C,B)).
+mul512(A,B):-and(mul256(A,C),mul2(C,B)).
+mul1024(A,B):-and(mul512(A,C),mul2(C,B)).
+
+true.
+
+End of stdlib