Commits

Anonymous committed ccaeb40

Initial import of Hev 1.0-2010.0427 sources.

  • Participants
  • Tags rel_1_0_2010_0427

Comments (0)

Files changed (2)

File doc/hev.html

+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
+<title>The Hev Programming Language</title>
+  <!-- begin html doc dynamic markup -->
+  <script type="text/javascript" src="/contrib/jquery-1.6.4.min.js"></script>
+  <script type="text/javascript" src="/scripts/documentation.js"></script>
+  <!-- end html doc dynamic markup -->
+</head>
+<body>
+
+<h1>The Hev Programming Language</h1>
+
+<h2>Introduction</h2>
+
+<p>Hey, does this thing look at all familiar?</p>
+
+<pre>()  []  -&gt;  .  ++  --                        Left to right
+++  --  +  -  !  ~  *  &amp;  (type)  sizeof     Right to left
+*  /  %                                      Left to right
++  -                                         Left to right
+&lt;&lt;  &gt;&gt;                                       Left to right
+&lt;  &lt;=  &gt;  &gt;=                                 Left to right
+==  !=                                       Left to right
+&amp;                                            Left to right
+^                                            Left to right
+|                                            Left to right
+&amp;&amp;                                           Left to right
+||                                           Left to right
+?:                                           Left to right
+=  +=  -=  *=  /=  %=  &amp;=  ^=  |=  &lt;&lt;=  &gt;&gt;=  Right to left
+,                                            Left to right</pre>
+
+<p>That's right: it's the precedence table for operators in the C language.
+OK, some of them (like <code>()</code>) are pretty easy to remember, I guess,
+but the logic behind most of these choices escapes me.
+Really, can you give me a <em>good</em> reason for why <code>&amp;</code>
+should have a higher precedence than <code>|</code>?  And why is <code>^</code> in-between?
+And why in the world are <code>-&gt;</code> and <code>++</code> on the same level?
+What I'm getting at is, how many times did you have to go and reference this
+chart before these arbitrary rules got burned into your nervous system somewhere
+between your brain and your fingers?</p>
+
+<p>And hey, you think that's bad?  Perl 5 has like 129 operators at like 24 levels of
+precedence.</p>
+
+<p>You may well ask: is there something that can save us from this insanity?</p>
+
+<p>Yes, there is.  In this document I will describe Hev, a <del>novel</del> <del>innovative</del>
+<del>radical</del> <del>revolutionary</del> totally gnarly new programming
+language which provides <strong>the infix you love</strong>
+with <strong>an unlimited number of operator precedence levels</strong>
+and <strong>absolutely no need for parentheses or memorization!</strong></p>
+
+<p>Sound too good to be true...?  Read on!</p>
+
+<h2>Syntax</h2>
+
+<p>Hev's breathtaking syntactic slight-of-hand is accomplished by a
+synergistic combination of two features:</p>
+
+<ul>
+<li>Have an unbounded number of infix binary operators.</li>
+<li>Make precedence explicit.</li>
+</ul>
+
+<p>To fit this bill, all we need is a single syntactic construct that can
+explicitly express an unbounded number of discrete operators, and at the
+same time, their precedence.</p>
+
+<p>Well, I chose integers.</p>
+
+<p>Positive integers, to be precise.  So <code>3</code> is an infix operator.
+So is <code>15</code>, and it has a higher precedence than <code>3</code>.
+So is <code>514229</code>, and it has an even higher precedence
+than <code>15</code>, but lower than <code>25852016738884976640000</code>.
+<em>See</em> how easy it is?  I can just name two operators at random,
+and you can tell me which one has the higher precedence without a second thought!</p>
+
+<p>Oh, but what good are operators if they don't have anything to operate on?
+We need values, too.  And since we have an unbounded number of operators, there's
+a certain sense to having only a bounded number of values.</p>
+
+<p>Well, why not the logical extreme: <em>no values at all</em>?  Well, OK, for the sake of syntax we need to have
+one value, but since there's nothing it can be differentiated against,
+it's effectively no values.  Syntactically, this value, or lack thereof, is
+denoted <code>,</code>.  (Yeah, that's a comma.)</p>
+
+<p>And, we'll probably need variables at some point, too, I'm guessing.
+We should probably have a nice big supply of those, just so we don't
+run into some artifical bound at some point that arbitrarily prevents Hev from
+being Turing-complete.  So, let's say that any string of consecutive symbols
+drawn from <code>+</code>, <code>-</code>, <code>*</code> and <code>/</code>
+is an identifier for a variable.  That should do nicely.</p>
+
+<p>There's still a bit of a problem, though -- those pesky parentheses.
+You might need to nest a <code>5</code>-expression into the LHS or the RHS
+of a <code>3</code>-expression, and that would seemingly require parentheses.
+How do we avoid this?  Well -- if we're
+flexible on what <code>3</code> and <code>5</code> actually <em>mean</em>,
+maybe we can just avoid this dilemma entirely!  This brings us to...</p>
+
+<h2>Semantics</h2>
+
+<p>So we have all these infix binary operators, and this one value which I insist is
+essentially a non-value, and we need to be able to make something sensible out of this mess --
+<em>without</em> using parentheses to do nesting.</p>
+
+<p>Well, what can we build?</p>
+
+<p>Trees.</p>
+
+<p>Yep, binary trees.  They're a bit unlike the "normal" trees of Computer Science,
+which almost universally have some sort of values stored at their leaves.
+These ones don't.  They're just... you know, trees.  But we can definately build them.
+And we don't need any parentheses.  If you want to nest some expression inside
+another, you just pick operators with higher precedence levels for that
+expression.</p>
+
+<p>So <code>,5,10,5,</code> is a tree - a complete binary tree with 3 levels -
+a root node (<code>10</code>), two intermediate nodes (both <code>5</code>)
+and four leaves (<code>,,,,</code>) with no values in them (or a single,
+meaningless value, repeated four times, if you like.)  And please realize that
+this is the <em>same</em> tree as <code>,1,3,2,</code> -- it's just that
+different operators were used to construct it.  Those operators aren't "in"
+the tree in any sense, and their magnitude is used only to determine their
+precedence.</p>
+
+<p>But now for the splendid part.
+We can put <em>variables</em> in these trees!  Which means, we can think of them
+as <em>patterns</em> that can match other trees.  Which means, we can specify <em>rules</em>
+as pairs of patterns and substitutions, to be substituted in when the pattern matches.
+Which means, we can construct a rule-based language!  A rewriting language, in fact.
+I think I'll call this approach <dfn>valueless tree rewriting</dfn>.</p>
+
+<p>So, for example, the tree <code>+10*</code> matches that tree
+<code>,5,10,5,</code> given above.  The variables <code>+</code>
+and <code>*</code> both unify with <code>,5,</code>.
+But note that this pattern matches <code>,41,76,</code> too,
+where <code>+</code> unifies with <code>,41,</code> and
+<code>*</code> unifies with <code>,</code>.
+And in fact it matches countless other possible valueless trees.</p>
+
+<h2>Execution Model</h2>
+
+<p>A Hev program consists of a valueless binary tree.  The left branch
+of the root leads to a ruleset; the right branch leads to a valueless binary
+tree which represents the data of the program: it is the state of the program,
+the thing that is being rewritten.  This data tree may not
+contain any variables: the leaves must be entirely <code>,</code>'s.</p>
+
+<p>A ruleset consists of a node where the left branch leads to either a ruleset
+or to a <code>,</code> and the right branch leads to a rule.  A rule is a node
+where the left branch is a pattern and the right branch is a substitution.
+The pattern is a valueless binary tree which may contain not only <code>,</code>'s
+but also any variables at its leaves.  The substitution may contain both
+<code>,</code>'s and variables, but it may not contain any variables which do
+not appear in the corresponding pattern of the rule.</p>
+
+<p>Each rule in the ruleset is considered in turn, starting with the rule
+nearest the root.  The pattern of the rule is matched against the data tree.
+The structure of the tree must match some subtree of the data tree;
+a variable can match any structure of the data tree, but no variable can
+match two different structures.  (The same variable identifier may appear
+multiple times in a pattern; all instances of that variable must match the
+same structure.)  If there are multiple subtrees of the data tree that match,
+only the <strong>topmost</strong> one is considered.  This is usually called
+"top-down rewriting".</p>
+
+<p>When a match occurs, the substitution of the rule is instantiated.
+Any variables occuring in the substitution are replaced with the structures
+that those variables matched in the pattern.  (This is why all the variables
+appearing in the substitution must also appear in the pattern.)
+The data tree is then modified: the subtree that was matched is removed and
+in its place the instantiated substitution is grafted.  The process
+then repeats (starting over with the topmost rule.)</p>
+
+<p>When a rule fails to match, the data tree is left alone and 
+the next rule (one node lower down in the ruleset) is tried.
+When there are no more rules to try in the ruleset, the program ends.</p>
+
+<h2>Miscellaneous Notes</h2>
+
+<p>You can leave out the <code>,</code> at the very beginning and very end
+of a Hev program.  It's implied.  Also, whitespace is allowed, even between
+the digits of an operator or the symbols of a variable... for whatever
+good it'll do you.</p>
+
+<h2>Implementation</h2>
+
+<p><code>hev.hs</code> is a reference implementation of Hev in Haskell.
+It can be used as something to check this language description against -
+any discrepancy is either a bug in the implementation, or an error in this
+document.  <code>hev.hs</code> shouldn't be used as an official reference
+for Hev behaviour that's not described in this document, but heck, it's
+better than nothing, right?</p>
+
+<h2>History</h2>
+
+<p>It was sometime in November of 2005 when I came up with the idea to try to
+"break the precedence barrier" and started writing Hev.  I continued to refine
+the idea and worked on it, on and off, after that.
+In October of 2006 I got a stubborn notion in my head that the parser should
+only make one pass over the program text, so I wasted a day trying to
+figure out how to code that in Haskell.  In June of 2007 I finally got down
+to writing test cases and debugging it.</p>
+
+<p>Happy <code>,</code>!</p>
+
+<p>-Chris Pressey
+<br />Cat's Eye Technologies
+<br />June 17, 2007
+<br />Vancouver, BC</p>
+
+</body>
+</html>
+--
+-- hev.hs
+-- Reference Interpreter for the Hev Programming Language
+-- Begun November 2005, fleshed out October 2006, polished off June 2007
+-- Chris Pressey, Cat's Eye Technologies
+--
+
+--
+-- Copyright (c)2005-2007 Cat's Eye Technologies.  All rights reserved.
+--
+-- Redistribution and use in source and binary forms, with or without
+-- modification, are permitted provided that the following conditions
+-- are met:
+--
+--  1. Redistributions of source code must retain the above copyright
+--     notices, this list of conditions and the following disclaimer.
+--  2. Redistributions in binary form must reproduce the above copyright
+--     notices, this list of conditions, and the following disclaimer in
+--     the documentation and/or other materials provided with the
+--     distribution.
+--  3. Neither the names of the copyright holders nor the names of their
+--     contributors may be used to endorse or promote products derived
+--     from this software without specific prior written permission. 
+--
+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+-- ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
+-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+-- FOR A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE
+-- COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-- POSSIBILITY OF SUCH DAMAGE.
+
+
+-----------------------------------------------------------------------
+-- ========================== Data types =========================== --
+-----------------------------------------------------------------------
+
+import Char
+
+--
+-- A data type giving the structure of the trees that Hev programs
+-- describe.  They contain no values, but the (sub)trees that will
+-- be used as pattern-matching rules can contain variables.
+--
+
+data Tree = TreeBranch Tree Tree
+          | TreeLeaf
+          | TreeVar String
+     deriving (Show, Read, Eq)
+
+--
+-- A data type describing unifiers.  Really, a unifier is just a
+-- list of name-value associations, like an environment.
+--
+
+data Unifier = UnifierBinding String Tree Unifier
+             | UnifierNil
+             | UnificationFailure
+     deriving (Show, Read, Eq)
+
+--
+-- A data type for possibly infinite numbers, so that various values
+-- in this evaluator (specifically, the "roof" parameter to buildTree)
+-- aren't artifically bounded.
+--
+-- I could probably do something fancy by overriding '>' in the
+-- Ord type class here, but for now at least, I won't.
+--
+
+data Num a => PossiblyInfinite a = Finite a
+                                 | Infinity
+     deriving (Show, Read, Eq)
+
+isGreater i (Finite j) = i > j
+isGreater i Infinity = False
+
+
+-----------------------------------------------------------------------
+-- ============================= Parser ============================ --
+-----------------------------------------------------------------------
+
+--
+-- Determine the integer value of a decimal digit character.
+--
+
+digitVal '0' = 0
+digitVal '1' = 1
+digitVal '2' = 2
+digitVal '3' = 3
+digitVal '4' = 4
+digitVal '5' = 5
+digitVal '6' = 6
+digitVal '7' = 7
+digitVal '8' = 8
+digitVal '9' = 9
+
+--
+-- Accumulate the value of a digit onto the end of a integer
+-- and return the result.
+--
+
+accumulate char num =
+    (num * 10) + digitVal char
+
+--
+-- Scan an integer in decimal notation at the start of
+-- a string; return a pair consisting of the integer
+-- and the rest of the string.
+--
+
+consumeOperator [] num = (num, [])
+consumeOperator string@(char:chars) num
+    | isSpace char =
+        consumeOperator chars num
+    | isDigit char =
+        consumeOperator chars (accumulate char num)
+    | otherwise =
+        (num, string)
+
+--
+-- Determine if a given character is suitable for use in an atom
+--
+
+isAtomSymbol ',' = True
+isAtomSymbol '+' = True
+isAtomSymbol '-' = True
+isAtomSymbol '*' = True
+isAtomSymbol '/' = True
+isAtomSymbol _   = False
+
+--
+-- Convert the textual representation of an atom to
+-- its internal representation.
+--
+
+stringToTree []     = TreeLeaf
+stringToTree ","    = TreeLeaf
+stringToTree string = TreeVar string
+
+--
+-- Scan a symbol from the start of a string; return a pair
+-- consisting of the corresponding tree representation of
+-- the atom, and the rest of the string.
+--
+
+consumeAtom [] acc =
+    (stringToTree acc, [])
+consumeAtom string@(char:chars) acc
+    | isSpace char =
+        consumeAtom chars acc
+    | isAtomSymbol char =
+        consumeAtom chars (acc ++ [char])
+    | otherwise =
+        (stringToTree acc, string)
+
+--
+-- Convert the textual representation of a Hev program to
+-- an internal representation (a list of operator-atom pairs.)
+--
+
+stringToPairs "" = []
+stringToPairs string =
+    let
+        (op, string2) = consumeOperator string 0
+        (atom, string3) = consumeAtom string2 []
+    in
+        ((op, atom) : (stringToPairs string3))
+
+--
+-- Be not deceived by the apparent simplicity of the following
+-- function!  It took me the better part of a day to get it right.
+--
+-- This function builds a tree corresponding to each of the
+-- operators in the list of (operator, atom) pairs, up until
+-- (and not including) the first operator in the list which
+-- exceeds a given maximum value (which we call the "roof".)
+-- Once this roof-exceeding value is found (or there are no
+-- more elements in the list,) this tree is returned (along
+-- with the unused portion of the list.)
+--
+-- The root of the tree so built corresponds to the largest
+-- operator found in the list.  The list is thus conceptually
+-- divided into a left sublist and a right sublist.
+-- Recursively, the left subtree of the root is associated
+-- with the largest operator in the left sublist, and the
+-- right subtree with the largest operator in the right sublist.
+--
+-- And in fact, the straightforward way to implement this
+-- function would be to do just that: search for the largest
+-- element of the list, split the list into two sublists, and
+-- process each of those sublists recursively.  However, there
+-- is a certain elegance (and presumably efficiency, although
+-- that's not the motivation here) that is derived from doing
+-- only one pass, left to right, through the list, and that's
+-- the approach I've chosen to take.  Thus we have the
+-- following implementation.
+--
+-- The function basically loops around, consuming the list from
+-- left to right while tracking some state:
+--
+--   roof     - as noted, the upper limit to the value of operator
+--              that we accept.  When we see it, we return the
+--              built tree and the rest of the list to our caller.
+--   bigOp    - the biggest operator we have seen in the list so
+--              far, locally speaking.  That is, it will always be
+--              smaller than the roof value.  It is used to decide
+--              when to start building a subtree.
+--   bigTree  - the tree value associated with bigOp; acts more or
+--              less like an accumulator.
+--   prevAtom - needed to get the variables into the leaves of the
+--              tree where they logically belong.  (The left
+--              subtree of the bottom branch actually needs the
+--              variable that is paired with the previous operator
+--              in the list.)
+--
+-- During the loop, behaviour is split into three cases:
+--
+-- Case 1: the operator exceeds the roof; return.
+-- Case 2: the operator is bigger than the biggest operator
+--         seen so far.  Use it as the biggest operator, construct
+--         a tree node for it for use as the biggest tree, and
+--         loop around to tackle the next operator in the list.
+-- Case 3: the operator is smaller than the biggest operator
+--         seen so far.  Create a subtree by recursively calling
+--         buildTreeLoop.  For this call, the roof value is given
+--         by the biggest operator, and the biggest operator is
+--         initially set back to zero.  The returned subtree is
+--         spliced into the biggest tree, as the right child.
+--         The loop then continues.  The altered biggest tree,
+--         and the amount of the list consumed by the creation of
+--         the subtree are taken into account for the next loop
+--         iteration, but the roof and biggest operator do not
+--         change.
+--
+
+buildTree [] roof bigOp bigTree prevAtom =
+    (bigTree, [])
+buildTree pairs@((op, atom):restOfPairs) roof bigOp bigTree prevAtom
+    | isGreater op roof =
+        (bigTree, pairs)
+    | op > bigOp =
+        let
+            newBigTree = TreeBranch bigTree atom
+        in
+            buildTree restOfPairs roof op newBigTree atom
+    | op < bigOp =
+        let
+            (subTree, newPairs) = buildTree pairs (Finite bigOp) 0 prevAtom atom
+            (TreeBranch bigTreeLeft bigTreeRight) = bigTree
+            newBigTree = (TreeBranch bigTreeLeft subTree)
+        in
+            buildTree newPairs roof bigOp newBigTree atom
+
+--
+-- Parse a Hev program into a valueless tree.
+--
+
+parse string =
+    fst (buildTree (stringToPairs string) Infinity 0 TreeLeaf TreeLeaf)
+
+
+-----------------------------------------------------------------------
+-- ======================= Static Checker ========================== --
+-----------------------------------------------------------------------
+
+--
+-- Return a list of all variables that occur in a given tree.
+--
+
+getVariables TreeLeaf = []
+getVariables (TreeVar var) = [var]
+getVariables (TreeBranch left right) =
+    (getVariables left) ++ (getVariables right)
+
+--
+-- Determine whether every element of the first list is also an element
+-- of the second list.
+--
+
+isSubset [] _ = True
+isSubset (first:rest) list =
+   (elem first list) && (isSubset rest list)
+   where
+      elem x [] = False
+      elem x (first:rest)
+          | x == first = True
+          | otherwise = elem x rest
+
+--
+-- Determine whether a tree is "ground", i.e. contains no variables.
+--
+
+isGround tree = getVariables tree == []
+
+--
+-- Determine whether a set of rules is complete (each rule is complete,
+-- and the tree by which the ruleset itself is represented doesn't have
+-- any variables.)
+--
+
+rulesComplete TreeLeaf = True
+rulesComplete (TreeVar _) = False
+rulesComplete (TreeBranch left right) =
+    ruleComplete right && rulesComplete left
+
+--
+-- Determine whether a rule is complete (it has has both a head and a
+-- body, and there are no variables in the body that aren't in the head.)
+--
+
+ruleComplete TreeLeaf = False
+ruleComplete (TreeVar _) = False
+ruleComplete (TreeBranch head body) =
+    isSubset (getVariables body) (getVariables head)
+
+--
+-- Parse and check a Hev program.  Returns an illegal tree (which will
+-- cause a Haskell runtime pattern-match error later on) if there are
+-- static errors detected in the Hev program.
+--
+
+compile string
+    | not (isGround stateTree) =
+        TreeLeaf
+    | not (rulesComplete ruleTree) =
+        TreeLeaf
+    | otherwise =
+        tree
+    where
+        tree@(TreeBranch ruleTree stateTree) = parse string
+
+
+-----------------------------------------------------------------------
+-- ======================= Tree rewriting ========================== --
+-----------------------------------------------------------------------
+
+--
+-- Given a variable and a unifier, get the value given in
+-- the unifier for than variable, or Nothing if it is not found.
+--
+
+getBinding _ UnificationFailure =
+    Nothing
+getBinding _ UnifierNil =
+    Nothing
+getBinding targetVar (UnifierBinding sourceVar tree unifier)
+    | targetVar == sourceVar =
+        Just tree
+    | otherwise =
+        getBinding targetVar unifier
+
+--
+-- Match a "pattern" tree (the first argument) to a "state" tree and
+-- return the most general unifier, or nothing.
+--
+
+match _ _ UnificationFailure = UnificationFailure
+match TreeLeaf TreeLeaf unifier = unifier
+match (TreeBranch left1 right1) (TreeBranch left2 right2) unifier =
+    let
+        unifier2 = match left1 left2 unifier
+        unifier3 = match right1 right2 unifier2
+    in
+        unifier3
+match (TreeVar var) subTree unifier
+    | binding == Nothing =
+        UnifierBinding var subTree unifier
+    | binding /= Just subTree =
+        UnificationFailure
+    | otherwise =
+        unifier
+    where
+        binding = getBinding var unifier
+match _ _ _ = UnificationFailure
+
+--
+-- Given a tree containing variables and a unifier, construct
+-- a "ground" tree (one with no variables) by replacing each
+-- variable with the value associated with it in the unifier.
+--
+
+expand TreeLeaf unifier = TreeLeaf
+expand (TreeBranch left right) unifier =
+    TreeBranch (expand left unifier) (expand right unifier)
+expand (TreeVar var) unifier =
+    let
+        (Just subTree) = getBinding var unifier
+    in
+        subTree
+
+--
+-- Try to match the given pattern (the head of a rule) in
+-- the given tree.  If there are multiple places where
+-- the pattern might match the tree, only the topmost leftmost
+-- one is chosen.  Then return a new tree with the matched
+-- portion replaced by the body (appropriately expanded
+-- with any matched variables) if a match succeeded, or
+-- the original tree if no match succeeded.  In either case,
+-- a boolean indicating whether the match succeeded is
+-- returned as well.
+--
+
+rewrite tree@(TreeBranch left right) head body
+    | unifier /= UnificationFailure =
+        (True, expand body unifier)
+    | successLeft =
+        (True, TreeBranch newSubTreeLeft right)
+    | successRight =
+        (True, TreeBranch left newSubTreeRight)
+    | otherwise =
+        (False, tree)
+    where
+        unifier = match head tree UnifierNil
+        (successLeft, newSubTreeLeft) = (rewrite left head body)
+        (successRight, newSubTreeRight) = (rewrite right head body)
+
+rewrite tree head body
+    | unifier /= UnificationFailure =
+        (True, expand body unifier)
+    | otherwise =
+        (False, tree)
+    where
+        unifier = match head tree UnifierNil
+
+
+-----------------------------------------------------------------------
+-- =========================== Execution =========================== --
+-----------------------------------------------------------------------
+
+--
+-- A program is represented by
+--
+--          _______root_______
+--         /                  \
+--        X               ...state...
+--       / \
+--      X   rule
+--     / \
+--  ...   rule
+--
+
+--
+-- Each rule is represented by
+--
+--           __rule__
+--          /        \
+--        head      body
+--
+-- where the head is the pattern which will be matched against the
+-- state, and the body is the replacement which will be substituted.
+--
+
+--
+-- Here's how the interpreter works:
+--
+-- Assemble a working list of rules (initially all rules.)
+--
+-- Pick the first available rule from the working list of rules.
+--
+-- Match the head of the rule against the state tree.
+--
+-- If there was a match, replace the matched portion with an
+-- appropriate instantiation of the body of the rule, and repeat
+-- from the very beginning.
+--
+-- If there was no match, remove this pattern from the working list of
+-- patterns and try again with the shorter working list.
+--
+-- If this was the last working pattern, end.
+--
+
+run (TreeBranch patternTree stateTree) =
+    loop patternTree patternTree stateTree
+    where
+        loop TreeLeaf all state = state
+        loop (TreeBranch rest pat@(TreeBranch head body)) all state
+            | matched =
+                loop all all state'
+            | otherwise =
+                loop rest all state
+            where
+                (matched, state') = rewrite state head body
+
+
+-----------------------------------------------------------------------
+-- ============================= Tests ============================= --
+-----------------------------------------------------------------------
+
+--
+-- Parsing Hev programs into trees
+--
+
+testParse1 = parse "1+2*3"
+testParse2 = parse "3+2*1"
+testParse3 = parse "1,3/2"
+testParse4 = parse "1,6*2,9*3,5*4"
+testParse5 = parse "1,9,2,13,3,10,4,15,5,11,6,14,7,12,8"
+testParse6 = parse "120,160,180,271,272,257,15,4,7,121"
+testParse7 = parse "120,160**180,271+-272,257+*15,4//7//121"
+
+--
+-- Parsing and statically checking Hev programs
+--
+
+testCompile1 = compile "43,13,23,53,33"  -- ok
+testCompile2 = compile "1,3,2"           -- bad (incomplete patterns)
+testCompile3 = compile "43,13,23,53+33"  -- bad (variables in state)
+testCompile4 = compile "43,13,23+53,33"  -- bad (variables in body but not head)
+
+--
+-- Bindings used in unifiers
+--
+
+testBindings = (UnifierBinding "-" TreeLeaf (UnifierBinding "+" (TreeBranch TreeLeaf TreeLeaf) UnifierNil))
+
+testGetBinding1 = getBinding "+" testBindings  -- Just (TreeBranch TreeLeaf TreeLeaf)
+testGetBinding2 = getBinding "-" testBindings  -- Just TreeLeaf
+testGetBinding3 = getBinding "*" testBindings  -- Nothing
+
+--
+-- Pattern matching
+--
+
+testMatch1 = match (TreeLeaf) (TreeLeaf) UnifierNil
+                   -- UnifierNil
+testMatch2 = match (TreeLeaf) (TreeBranch TreeLeaf TreeLeaf) UnifierNil
+                   -- UnificationFailure
+testMatch3 = match (TreeVar "+") (TreeBranch TreeLeaf TreeLeaf) UnifierNil
+                   -- "+" => (TreeBranch TreeLeaf TreeLeaf)
+testMatch4 = match (TreeBranch (TreeVar "+") TreeLeaf)
+                   (TreeBranch (TreeBranch TreeLeaf TreeLeaf) TreeLeaf)
+                   UnifierNil 
+                   -- "+" => (TreeBranch TreeLeaf TreeLeaf)
+testMatch5 = match (TreeBranch (TreeVar "+") TreeLeaf)
+                   (TreeBranch TreeLeaf TreeLeaf)
+                   UnifierNil 
+                   -- "+" => TreeLeaf
+testMatch6 = match (TreeBranch (TreeVar "+") TreeLeaf)
+                   (TreeBranch TreeLeaf (TreeBranch TreeLeaf TreeLeaf))
+                   UnifierNil
+                   -- UnificationFailure
+
+--
+-- Tree rewriting
+--
+
+testRewrite1 = rewrite (TreeBranch TreeLeaf TreeLeaf)
+                       (TreeBranch TreeLeaf TreeLeaf)
+                       TreeLeaf
+
+testRewrite2 = rewrite (TreeBranch TreeLeaf TreeLeaf)
+                       (TreeBranch (TreeVar "+") TreeLeaf)
+                       TreeLeaf
+
+testRewrite3 = rewrite (TreeBranch (TreeBranch TreeLeaf TreeLeaf) TreeLeaf)
+                       (TreeBranch (TreeVar "+") TreeLeaf)
+                       (TreeVar "+")
+
+--
+-- Hev execution
+--
+
+--
+-- Test a very simple (and completely ground) program.
+--
+
+--
+--           __(root)_X_53______
+-- (rule    /                   \
+--  list)  X 43               33 X   (state)
+--        / \                   / \
+-- (end) ,   \                 ,   ,
+--            \
+--             \
+--              \
+--            23 X  (rule)
+--              / \
+--             /   \
+--            /     \
+--           /       \
+--          /         \
+-- (head)  X 13        ,   (body)
+--        / \
+--       ,   ,
+
+testRun1 = run (compile "43,13,23,53,33")  -- TreeLeaf
+
+
+--
+-- Test pattern-matching with a variable, causing a single rewrite.
+--
+
+--
+--           __(root)_X_81______
+-- (rule    /                   \
+--  list)  X 49               73 X   (state)
+--        / \                   / \
+-- (end) ,   \              64 X   \
+--            \               / \   \
+--             \             ,   ,   X 17
+--              \                   / \
+--            36 X  (rule)         ,   X 4
+--              / \                   / \
+--             /   \                 ,   ,
+--            /     \
+--           /       \
+--          /         \
+-- (head)  X 25     16 X   (body)
+--        / \         / \
+--     9 X   +       +   ,
+--      / \
+--     ,   ,
+
+--
+-- One rewrite of state: + matches branch at 17, new state becomes:
+--
+--        X
+--       / \
+--   17 X   ,
+--     / \
+--    ,   X 4
+--       / \
+--      ,   ,
+-- 
+
+testRun2 = run (compile "49,9,25+36+16,81,64,73,17,4")
+        -- TreeBranch (TreeBranch TreeLeaf (TreeBranch TreeLeaf TreeLeaf)) TreeLeaf
+
+
+--
+-- Test several rewrites of state.  The state is reduced to a single leaf.
+--
+
+--
+--           __(root)_X_4_______
+-- (rule    /                   \
+--  list)  X 3                 2 X   (state)
+--        / \                   / \
+-- (end) ,   \                 /   \
+--            \               /     \
+--             \             X 1   1 X
+--              \           / \     / \
+--             2 X  (rule) ,   ,   ,   ,
+--              / \
+--             /   \
+--            /     \
+--           /       \
+--          /         \
+-- (head)  X 1         *   (body)
+--        / \
+--       *   *
+
+testRun3 = run (compile "3*1*2*4,1,2,1")    -- TreeLeaf
+
+
+--
+-- Test that rewriting is indeed top-down.
+-- For this program, a bottom-up strategy produces a double branch,
+-- while a top-down strategy produces a single branch.
+-- (Work it out by hand if you doubt me!)
+--
+
+--
+--           __(root)_X_99______
+-- (rule    /                   \
+--  list)  X 71                  \
+--        / \                     \
+-- (end) ,   \                     \
+--            \                     \
+--             \                     X 61 (state)
+--              \                   / \
+--            29 X  (rule)         /   \
+--              / \               /     \
+--             /   \          37 X       X 47
+--            /     \           / \     / \
+--           /       \         /   \   ,   ,
+--          /         \     6 X   7 X
+-- (head)  X 27 (body) *     / \   / \
+--        / \               ,   , ,   ,
+--       /   \
+--    8 X     X 19
+--     / \   / \
+--    +   * ,   ,
+
+
+testRun4 = run (compile "71+8*27,19,29*99,6,37,7,61,47")
+        -- (TreeBranch TreeLeaf TreeLeaf)
+
+--
+-- Unterminated rewriting.
+--
+
+--
+--           __(root)_X_26______
+-- (rule    /                   \
+--  list)  X 25                  X (state)
+--        / \                   / \
+-- (end) ,   \                 ,   ,
+--            \
+--             \
+--              \
+--            24 X  (rule)
+--              / \
+--             /   \
+--            /     \
+--           /       \
+--          /         \
+-- (head)  X   (body)  X 20
+--        / \         / \
+--       ,   *       ,   X 1
+--                      / \
+--                     ,   *
+
+testRun5 = run (compile "25,20*24,20,1*26,25")
+
+--
+-- This is a helper function intended for testing testRun5,
+-- analogous to Haskell's standard "take" function for lists.
+-- It works when run on infiniteTree, but doesn't work when
+-- run on testRun5, and I'm not certain why.
+--
+
+takeTree 0 tree = TreeLeaf
+takeTree n TreeLeaf = TreeLeaf
+takeTree n (TreeBranch left right) =
+    TreeBranch (takeTree (n-1) left) (takeTree (n-1) right)
+
+infiniteTree = TreeBranch infiniteTree infiniteTree
+
+--
+-- Test multiple rules.
+--
+
+--
+--                            _________(root)__X__188___________
+--                           /                                  \
+--             (rule list)  X 154                            111 X   (state)
+--                         / \                                  / \
+--                        /   \                                ,   X 91
+--                       /     \                                  / \
+--                      /       \                                ,   X 77
+--                     /         \                                  / \
+--                    /       137 X  (rule)                        ,   ,
+--                   /           / \
+--                  /           /   \
+--                 /    (head) X 6   , (body)
+--                /           / \
+--               /         2 X   ,
+--              /           / \
+-- (rule node) X 103       ,   ,
+--            / \
+--     (end) ,   X (rule) 86
+--              / \
+--             /   \
+--            /     \
+--    (head) X 5   9 X (body)
+--          / \     / \
+--         ,   X 4 -   ,
+--            / \
+--           ,   -
+
+testRun6 = run (compile "103,5,4-86-9,154,2,6,137,188,111,91,77")  -- TreeLeaf