Commits

Cat's Eye Technologies  committed c828654

Initial import of Iphigeneia version 1.0 revision 2007.1125 sources.

  • Participants
  • Tags rel_1_0_2007_1125

Comments (0)

Files changed (42)

File doc/iphi.html

+<html>
+<head><title>The Iphigeneia Programming Language</title></head>
+<body>
+
+<h1>The Iphigeneia Programming Language</h1>
+
+<p>Language version 1.0, distribution version 2007.1125</p>
+
+<h2>Introduction</h2>
+
+<p>The Iphigeneia programming language was designed as a workbench for an exercise in
+transliterating between single-assignment (functional) and mutable-variable (imperative)
+program forms.  As such, the language contains features paradigmatic to both forms.</p>
+
+<p>As languages go, Iphigeneia is not particularly esoteric, nor is it particularly
+practical; it's more academic, resembling those exciting languages
+with inspired names like <b>Imp</b> and <b>Fun</b> that you're apt to find in
+textbooks on formal semantics.</p>
+
+<p>Note that this document only covers the Iphigeneia language itself,
+not the transliteration process.  This is because I still haven't fully worked
+out the details of the transliteration, and that shortly after designing the
+language, I changed my mind and decided that, for clarity, it would probably
+be better to do the transliteration between two <em>distinct</em> languages,
+rather than within a single language.  So Iphigeneia wanders a little bit
+from the original design goal, and reflects a couple of design choices that are
+simply on whim rather than strictly in support of the transliteration idea.</p>
+
+<p>Note also that this document is an <em>informal</em> description
+of the language that relies on the reader's intuition as a computer programmer.
+I would like to write a formal semantics of Iphigeneia someday, since it's
+a simple enough language that this isn't an unthinkably complex task.  In the meantime,
+you may wish to refer to the reference implementation
+of the Iphigeneia interpreter for a more formal definition
+(if you believe Haskell is sufficiently formally defined.)</p>
+
+<p>The name Iphigeneia comes from the name of Agamemnon's daughter in Greek
+mythology.  The name was not chosen because of any particular significance
+this figure holds &mdash; I just think it's a nice name.  However, I suppose
+if you wanted to force an interpretation, you could say that Iphigeneia
+has two natures, princess and priestess, and so does her namesake: imperative
+and functional.</p>
+
+<h2>Language</h2>
+
+<p>The language constructs are generally straightforward to understand if you've had any
+experience with the usual assortment of imperative and functional languages, so forgive
+me if I'm a bit sketchy on the details here and there, even to the point of just
+mentioning, rather than describing, run-of-the-mill constructs like <code>while</code>.</p>
+
+<p>The basic constructs of Iphigeneia are <em>expressions</em>, which evaluate to
+a single value, and <em>commands</em>, which transform a store (a map between
+variable names and values.)  Expressions
+relate to the functional or single-assignment side of things, and commands provide
+the imperative or mutable-variable aspect of the language.</p>
+
+<p>There are only two kinds of values in Iphigeneia: boolean values and
+unbounded integer values.  In addition, only integers can be "denoted" (be
+stored in variables or have names bound to them); boolean expressions
+can only appear in conditional tests.
+To keep things simple, there are no subroutines, function values, pointers, references,
+arrays, structures, or anything like that.</p>
+
+<p>Constructs relating to the single-assignment side of things include <code>let</code>,
+<code>loop</code>, <code>repeat</code>, and <code>valueof</code>.  Imperative constructs
+include <code>begin</code> blocks, <code>while</code> loops, and of course destructive
+variable update with the <code>:=</code> operator.
+The lowly <code>if</code> makes sense in both "worlds", and so leads a double life:
+one flavour appears in expressions and has branches that are also expressions,
+and the other is a command and has branches that are also commands.</p>
+
+<p>Iphigeneia supports input and output.  However, to further emphasize the "split" in
+the language (and for no other good reason,) input is considered "functional", leading
+to an <code>input</code> ... <code>in</code> form, while output is considered "imperative",
+leading to a <code>print</code> command.</p>
+
+<h3>Expressions</h3>
+
+<p>Expressions are formed from the usual assortment of infix operators with their
+normative meaning and precedence.  There are two kinds of expressions, boolean
+expressions and integer expressions.
+Boolean expressions only appear in tests (<code>if</code> and <code>while</code>).
+Integer expressions appear everywhere else, and can also contain some more involved
+forms which are explained in the remainder of this section.</p>
+
+<p>Expressions are generally evaluated eagerly, left-to-right, innermost-to-outermost.
+This only affects order of output with the <code>print</code> command, however,
+since evaluation of an expression can never side-effect a store.
+(Command sequences embedded in expressions always work exclusively on
+their own, local store.)</p>
+
+<h4><code>let</code> name <code>=</code> expr<sub>0</sub> <code>in</code> expr<sub>1</sub></h4>
+
+<p>The <code>let</code> construct establishes a new binding.  The expression
+expr<sub>0</sub> is evaluated, and the result is associated with the given
+name during the evaluation of expr<sub>1</sub>.  That is, where-ever the name
+appears in expr<sub>1</sub> or any sub-expression of expr<sub>1</sub>, it
+is treated as if it had the value of expr<sub>0</sub>.  Note however
+that embedded commands (such as those appearing in a <code>valueof</code>)
+are not considered to be sub-expressions, and the influence of <code>let</code>
+bindings does not descend into them.</p>
+
+<p>Let bindings shadow any enclosing let bindings with the same name.</p>
+
+<h4><code>valueof</code> name <code>in</code> cmd</h4>
+
+<p>The <code>valueof</code> construct was a late addition, and is not
+strictly necessary, although it adds a nice symmetry to the language.
+I decided that, since there was already a (completely traditional) way to embed
+expressions in commands (namely the <code>:=</code> assignment operator,)
+there ought to be a complementary way to embed commands in expressions.</p>
+
+<p><code>valueof</code> blocks are evaluated in a completely new
+store; no other stores or let bindings are visible within the block.
+There is no need to declare the name with a <code>var</code> inside
+the block; the <code>valueof</code> counts as a <code>var</code>,
+declaring the name in the new store.</p>
+
+<h4><code>loop</code> ... <code>repeat</code></h4>
+
+<p>The <code>loop</code> construct is modelled after Scheme's "named <code>let</code>"
+form.  When <code>repeat</code> executed, the innermost enclosing <code>loop</code>
+expression is re-evaluated in the current environment.  Since <code>loop</code> expressions
+do not take arguments like a "named <code>let</code>", the values of bindings are
+instead altered on subsequent iterations by enclosing the <code>repeat</code> in a
+<code>let</code> expression, which gives new bindings to the names.</p>
+
+<p>A <code>repeat</code> with an unmatched <code>loop</code> is a runtime error that aborts the
+program.  Also, the influence of a <code>loop</code> does not extend down through a
+<code>valueof</code> expression.  That is, the following <code>repeat</code> is not
+matched: <code>loop valueof x in x := repeat</code>.</p>
+
+<h4><code>input</code> name <code>in</code> expr</h4>
+
+<p>Works like <code>let</code>, except that the program waits for
+a character from the standard input channel, and associates the ASCII
+value of this character to the name when evaluating expr.</p>
+
+<h3>Commands</h3>
+
+<h4><code>begin</code> ... <code>end</code></h4>
+
+<p>Commands can be sequentially composed into a single compound command
+by the <code>begin</code>...<code>end</code> construct.</p>
+
+<h4><code>var</code> name <code>in</code> cmd</h4>
+
+<p>The <code>var</code> construct declares a new updatable variable.
+Variables must be declared before they are used or assigned.</p>
+
+<h4><code>print</code> expr</h4>
+
+<p>The <code>print</code> command evaluates expr and, if the result is
+between 0 and 255, produces a character with that ASCII value on the
+standard output channel.  The behaviour for other integers is not
+defined.</p>
+
+<h2>Grammar</h2>
+
+<pre>Command ::= "if" BoolExpr "then" Command "else" Command
+          | "while" BoolExpr "do" Command
+          | "begin" Command {";" Command} "end"
+          | "var" VarName "in" Command
+          | "print" NumExpr
+          | VarName ":=" NumExpr.
+
+BoolExpr ::= RelExpr {("&amp;" | "|") RelExpr}
+	   | "!" BoolExpr
+	   | "(" BoolExpr ")".
+
+RelExpr ::= NumExpr ("&gt;" | "&lt;" | "&gt;=" | "&lt;=" | "=" | "/=") NumExpr.
+NumExpr ::= MulExpr {("+" | "-") MulExpr}.
+MulExpr ::= Primitive {("*" | "/") Primitive}.
+
+Primitive ::= "(" NumExpr ")"
+            | "if" BoolExpr "then" NumExpr "else" NumExpr
+            | "let" VarName "=" NumExpr "in" NumExpr
+	    | "valueof" VarName "in" Command
+	    | "loop" NumExpr
+	    | "repeat"
+            | "input" VarName "in" NumExpr
+            | VarName
+	    | NumConst.</pre>
+
+<p>An Iphigeneia program, at the topmost level, is a command.  (One idiom
+for giving "functional" Iphigeneia programs is <code>var r in r := <var>expr</var></code>,
+or even just <code>print <var>expr</var></code>.)
+Comments can be given anywhere in an Iphigeneia program by enclosing them in
+<code>(*</code> and <code>*)</code>.  Do not expect comments to nest.</p>
+
+<h2>Implementation</h2>
+
+<p>There is a reference implementation of Iphigeneia written in Haskell 98.
+It has been tested with ghc and Hugs, against a series of test cases which are
+included with the distribution.</p>
+
+<p>The reference implementation actually contains two interpreters.
+One is a monadic interpreter, which supports the I/O facilities of Iphigeneia.
+The other is a "pure" interpreter, which is written without the use of
+monadic types; it does not support I/O, but its code may be easier to
+follow.  The pure interpreter always binds the name that occurs in a
+<code>input</code> construct to zero, and it does not even evaluate the expressions
+in <code>print</code> commands.</p>
+
+<p>Compiling the reference implementation with ghc produces an executable
+<code>iphi</code> which takes the following command-line options:</p>
+
+<ul>
+<li><code>-p</code> uses the pure interpreter instead of the default monadic
+interpreter.</li>
+<li><code>-q</code> suppresses the output of the final state of the program
+upon termination.</li>
+</ul>
+
+<p>The reference interpreter is mostly written in a straightforward
+(sometimes painfully straightforward) manner (except for, arguably, <code>Main.hs</code>,
+which does some ugly things with continuations.)  It provides its own implementation
+of maps (environments) in <code>Map.hs</code>, instead of using Haskell's
+<code>Data.Map</code>, to make the definition of the language more explicit.
+The code is also released under a BSD-style license.
+So, even though Iphigeneia is not a particularly exciting language, this interpreter
+might serve as a good starting point for experimenting with unusual features to add
+to an otherwise relatively vanilla imperative and/or functional language.</p>
+
+<p>-Chris Pressey
+<br />November 25, 2007
+<br />Chicago, Illinois</p>
+
+</body></html>
+--
+-- Copyright (c)2007 Chris Pressey, 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.
+--
+
+-----------------------------------------------------------------------
+-- ============================== AST ============================== --
+-----------------------------------------------------------------------
+
+module AST where
+
+import Primitive
+
+data VarName = VarName String
+              deriving (Eq, Ord)
+
+instance Show VarName where
+    show (VarName s) = s
+
+data BoolExpr = BoolOp BoolOp BoolExpr BoolExpr
+              | RelOp RelOp NumExpr NumExpr
+              | Not BoolExpr
+              | BoolConst Bool
+              deriving (Eq, Ord, Show)
+
+data NumExpr = NumOp NumOp NumExpr NumExpr
+             | NumConst Integer
+             | IfExpr BoolExpr NumExpr NumExpr
+             | VarRef VarName
+             | ValueOf VarName Statement
+             | Let VarName NumExpr NumExpr
+             | Loop NumExpr
+             | Repeat
+             | Input VarName NumExpr
+             deriving (Eq, Ord, Show)
+
+data Statement = Block [Statement]
+               | Var VarName Statement
+               | Assign VarName NumExpr
+               | IfStmt BoolExpr Statement Statement
+               | While BoolExpr Statement
+               | Print NumExpr
+               deriving (Eq, Ord, Show)

File src/Check.hs

+--
+-- Copyright (c)2007 Chris Pressey, 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.
+--
+
+-----------------------------------------------------------------------
+-- ==================== Static Semantic Checker ==================== --
+-----------------------------------------------------------------------
+
+--
+-- The static semantic checker returns a list of errors.
+--
+
+module Check where
+
+import Map
+import AST
+
+data VarInfo = Undeclared
+             | Updatable
+             | SingleAssignment
+             deriving (Eq, Show)
+
+--
+-- Helper functions
+--
+
+checkExists v env
+    | (get v env Undeclared) == Undeclared =
+        ["Variable " ++ (show v) ++ " not in scope"]
+    | otherwise =
+        []
+
+checkAvailable v env
+    | (get v env Undeclared) /= Undeclared =
+        ["Variable " ++ (show v) ++ " already declared"]
+    | otherwise =
+        []
+
+checkStore v env
+    | (get v env Undeclared) == Undeclared =
+        ["Variable " ++ (show v) ++ " not in scope"]
+    | (get v env Undeclared) /= Updatable =
+        ["Variable " ++ (show v) ++ " not updatable"]
+    | otherwise =
+        []
+
+--
+-- The checker proper
+--
+
+--
+-- Currently we allow shadowing in let, valueof, and input, but not in var.
+-- We could disallow it everywhere by adding:
+--         declErrs = checkAvailable v env
+-- in checkNumExpr (Let ...) and (ValueOf ...),
+--
+
+checkBoolExpr (BoolOp op b1 b2) env = (checkBoolExpr b1 env) ++ (checkBoolExpr b2 env)
+checkBoolExpr (RelOp op e1 e2) env  = (checkNumExpr e1 env) ++ (checkNumExpr e2 env)
+checkBoolExpr (Not b) env           = checkBoolExpr b env
+checkBoolExpr (BoolConst b) env     = []
+
+checkNumExpr (NumOp op e1 e2) env = (checkNumExpr e1 env) ++ (checkNumExpr e2 env)
+checkNumExpr (NumConst i) env     = []
+checkNumExpr (VarRef v) env       = checkExists v env
+checkNumExpr (IfExpr b e1 e2) env = (checkBoolExpr b env) ++
+                                    (checkNumExpr e1 env) ++ (checkNumExpr e2 env)
+checkNumExpr (Let v e1 e2) env    =
+    let
+        exprErrs = checkNumExpr e1 env
+        newEnv = set v SingleAssignment env
+        bodyErrs = checkNumExpr e2 newEnv
+    in
+        exprErrs ++ bodyErrs
+
+checkNumExpr (ValueOf v s) env    =
+    let
+        newEnv = set v Updatable env
+        bodyErrs = checkStatement s newEnv
+    in
+        bodyErrs
+
+checkNumExpr (Input v e) env    =
+    let
+        newEnv = set v SingleAssignment env
+        bodyErrs = checkNumExpr e newEnv
+    in
+        bodyErrs
+
+checkNumExpr (Loop e) env        = checkNumExpr e env
+checkNumExpr (Repeat) env        = []
+
+checkStatement (Block []) env =
+    []
+checkStatement (Block (s:rest)) env =
+    (checkStatement s env) ++ (checkStatement (Block rest) env)
+
+checkStatement (Var v s) env =
+    let
+        declErrs = checkAvailable v env
+        newEnv = set v Updatable env
+        stmtErrs = checkStatement s newEnv
+    in
+        declErrs ++ stmtErrs
+
+checkStatement (Assign v e) env =
+    (checkNumExpr e env) ++ (checkStore v env)
+
+checkStatement (IfStmt b s1 s2) env =
+    let
+        exprErrs = checkBoolExpr b env
+        s1Errs   = checkStatement s1 env
+        s2Errs   = checkStatement s2 env
+    in
+        exprErrs ++ s1Errs ++ s2Errs
+
+checkStatement (While b s) env =
+    let
+        exprErrs = checkBoolExpr b env
+        bodyErrs = checkStatement s env
+    in
+        exprErrs ++ bodyErrs
+
+checkStatement (Print e) env =
+    checkNumExpr e env
+--
+-- Copyright (c)2007 Chris Pressey, 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.
+--
+
+-----------------------------------------------------------------------
+-- ============================== Main ============================= --
+-----------------------------------------------------------------------
+
+import System
+
+import Map
+import AST
+import qualified PureInterp
+import qualified MonadInterp
+import Parser
+import Check
+
+--
+-- Utilities
+--
+
+--
+-- Wrap the pure interpreter in a token monad (token in the sense of
+-- inconsequential :) so that it has a type compatible with the monadic
+-- interpreter.
+--
+
+pureInterpret prog map = do return (PureInterp.interpret prog map)
+
+--
+-- Parse and check the program.  If it's all OK, execute the given executor
+-- function (continuation) on the resultant AST.  If it's not, execute the
+-- given failure function (another continuation) on the resultant error list.
+--
+
+parseThen programText executor failureHandler =
+    let
+        (_, program) = parse programText
+        errors = checkStatement program EmptyMap
+    in
+        case errors of
+            [] ->
+                executor program
+            _ ->
+                failureHandler errors
+
+--
+-- Useful functions to call from the Hugs interactive prompt.
+--
+
+run programText =
+    runWith programText MonadInterp.interpret False
+
+parseFile fileName = do
+    programText <- readFile fileName
+    (_, program) <- do return (parse programText)
+    putStr (show program)
+
+--
+-- Program execution
+--
+
+runWith programText interpreter quiet =
+    parseThen programText executor failureHandler
+    where
+        executor program = do
+            result <- interpreter program EmptyMap
+            putStr (if quiet then "" else (show result))
+        failureHandler errors = do
+            putStr ((show errors) ++ "\n")
+
+runFileWith fileName interpreter quiet = do
+    programText <- readFile fileName
+    runWith programText interpreter quiet
+
+--
+-- Main entry point, so that we can build an executable using ghc.
+-- When running the interpreter under hugs, it's not needed, as the
+-- run function can be called directly from the interactive prompt.
+--
+
+main = do
+    args <- getArgs
+    (interpreter, quiet, fileName)
+        <- processArgs args (MonadInterp.interpret) False ""
+    case fileName of
+        "" ->
+            usage
+        _ ->
+            runFileWith fileName interpreter quiet
+
+processArgs ("-p":rest) _ quiet fileName =
+    processArgs rest (pureInterpret) quiet fileName
+
+processArgs ("-q":rest) interpreter _ fileName =
+    processArgs rest interpreter True fileName
+
+processArgs (('-':unknownFlag):rest) interpreter quiet _ = do
+    putStr ("Unknown command-line option: " ++ unknownFlag ++ "\n")
+    return (interpreter, quiet, "")
+
+processArgs (fileName:rest) interpreter quiet _ = do
+    processArgs rest interpreter quiet fileName
+
+processArgs [] interpreter quiet fileName = do
+    return (interpreter, quiet, fileName)
+
+usage = do
+    putStr "iphi 2007.1125 - reference interpreter for Iphigeneia 1.0\n"
+    putStr "(c)2007 Cat's Eye Technologies.  All rights reserved.\n\n"
+    putStr "Usage:\n"
+    putStr "    iphi [-p] [-q] filename\n"
+    putStr "where\n"
+    putStr "    -p: use pure interpreter (no IO)\n"
+    putStr "    -q: don't dump final state of program to output\n"

File src/Makefile

+# Makefile for iphi.
+# $Id$
+
+HC=ghc
+# -O
+HCFLAGS=
+O=.o
+PROG=iphi
+
+OBJS=	AST${O} \
+	Check${O} \
+	PureInterp${O} \
+	MonadInterp${O} \
+	Map${O} \
+	Main${O} \
+	Parser${O} \
+	Primitive${O} \
+	Scanner${O}
+
+all: ${PROG}
+
+AST${O}: AST.hs Primitive${O}
+	${HC} ${HCFLAGS} -c $*.hs
+
+Check${O}: Check.hs Map${O} AST${O}
+	${HC} ${HCFLAGS} -c $*.hs
+
+Map${O}: Map.hs
+	${HC} ${HCFLAGS} -c $*.hs
+
+Main${O}: Main.hs Check${O} Parser${O} PureInterp${O}
+	${HC} ${HCFLAGS} -c $*.hs
+
+PureInterp${O}: PureInterp.hs Map${O} Primitive${O} AST${O}
+	${HC} ${HCFLAGS} -c $*.hs
+
+MonadInterp${O}: MonadInterp.hs Map${O} Primitive${O} AST${O}
+	${HC} ${HCFLAGS} -c $*.hs
+
+Scanner${O}: Scanner.hs
+	${HC} ${HCFLAGS} -c $*.hs
+
+Parser${O}: Parser.hs Scanner${O}
+	${HC} ${HCFLAGS} -c $*.hs
+
+Primitive${O}: Primitive.hs
+	${HC} ${HCFLAGS} -c $*.hs
+
+
+${PROG}: ${OBJS}
+	${HC} -o ${PROG} -O ${OBJS}
+	strip ${PROG}
+
+clean:
+	rm -rf *.o *.hi iphi
+--
+-- Copyright (c)2007 Chris Pressey, 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.
+--
+
+-----------------------------------------------------------------------
+-- ============================== Maps ============================= --
+-----------------------------------------------------------------------
+
+--
+-- These can be used as environments, stores, etc.
+--
+
+module Map where
+
+data Map k v = Binding k v (Map k v)
+             | EmptyMap
+             deriving (Eq, Ord)
+
+get _ EmptyMap def = def
+get key (Binding key' val map) def
+    | key == key' = val
+    | otherwise   = get key map def
+
+set key val map = Binding key val (strip key map)
+
+strip key EmptyMap = EmptyMap
+strip key (Binding key' val map)
+    | key == key' = strip key map
+    | otherwise   = Binding key' val (strip key map)
+
+--
+-- Entries in second map override those in first map.
+--
+merge map EmptyMap = map
+merge map (Binding key val rest) =
+    merge (set key val map) rest
+
+instance (Show k, Show v) => Show (Map k v) where
+    show EmptyMap = ""
+    show (Binding k v map) = (show k) ++ "=" ++ (show v) ++ "\n" ++ show map

File src/MonadInterp.hs

+--
+-- Copyright (c)2007 Chris Pressey, 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.
+--
+
+-----------------------------------------------------------------------
+-- ======================= Monadic Interpreter ===================== --
+-----------------------------------------------------------------------
+
+--
+-- This interpreter performs I/O.  It is not as straightforward as
+-- PureInterp, as it must frame every function in terms of IO monads,
+-- which tends to obscure the logic of the interpreter somewhat.
+--
+
+module MonadInterp where
+
+import qualified Data.Char as Char
+
+import Map
+import AST
+import Primitive
+
+--
+-- The eval* functions are passed a store and a continuation (cc).
+--
+-- The store maps VarName objects to their values (Integers).
+--
+-- The continuation is used with the loop and repeat constructs.
+-- It is not a full-blown continuation in the sense of being a
+-- function which represents the entire rest of the computation.
+-- Rather, it represents only the matchings between occurrences
+-- of loop and occurrences of repeat.
+--
+-- The continuation is implemented as list of NumExprs, where the
+-- head NumExpr is the most recently encountered (innermost) loop
+-- expression.  Each loop expression extends the continuation with
+-- the expression being looped around, and a repeat expression
+-- executes the continuation.
+--
+
+evalBool :: BoolExpr -> Map VarName Integer -> [NumExpr] -> IO Bool
+
+evalBool (BoolOp op b1 b2) store cc = do
+    val1 <- evalBool b1 store cc
+    val2 <- evalBool b2 store cc
+    return (applyBoolOp op val1 val2)
+
+evalBool (RelOp op e1 e2) store cc  = do
+    val1 <- evalNum e1 store cc
+    val2 <- evalNum e2 store cc
+    return (applyRelOp op val1 val2)
+
+evalBool (Not b) store cc           = do
+    val <- evalBool b store cc
+    return (not val)
+
+evalBool (BoolConst b) store cc     = do
+    return b
+
+
+evalNum :: NumExpr -> Map VarName Integer -> [NumExpr] -> IO Integer
+
+evalNum (NumOp op e1 e2) store cc = do
+    val1 <- evalNum e1 store cc
+    val2 <- evalNum e2 store cc
+    return (applyNumOp op val1 val2)
+
+evalNum (NumConst i) store cc     = do
+    return i
+
+evalNum (IfExpr b e1 e2) store cc = do
+    result <- evalBool b store cc
+    evalNum (if result then e1 else e2) store cc
+
+evalNum (VarRef v) store cc       = do
+    return (get v store 0)
+
+evalNum (Let v e1 e2) store cc    = do
+    val <- evalNum e1 store cc
+    evalNum e2 (set v val store) cc
+
+evalNum (Loop e) store cc         = evalNum e store ((Loop e):cc)
+evalNum (Repeat) store cc         = evalNum (head cc) store (tail cc)
+
+evalNum (ValueOf v s) store cc    = do
+    newStore <- interpret s store
+    return (get v newStore 0)
+
+evalNum (Input v e) store cc      = do
+    symbol <- getChar
+    evalNum e (set v (Prelude.fromIntegral (Char.ord symbol)) store) cc
+
+
+interpret :: Statement -> Map VarName Integer -> IO (Map VarName Integer)
+
+interpret (Block []) store = do
+    return store
+interpret (Block (s:rest)) store = do
+    newStore <- interpret s store
+    interpret (Block rest) newStore
+
+interpret (Var v s) store = interpret s store
+
+interpret (Assign v e) store = do
+    val <- evalNum e store []
+    return (set v val store)
+
+interpret (IfStmt b s1 s2) store = do
+    result <- evalBool b store []
+    interpret (if result then s1 else s2) store
+
+interpret (While b s) store = do
+    result <- evalBool b store []
+    loop result
+  where
+    loop True = do
+          newStore <- interpret s store
+          interpret (While b s) newStore
+    loop False = do
+          return store
+
+interpret (Print e) store = do
+    val <- evalNum e store []
+    putChar (Char.chr (Prelude.fromIntegral val))
+    return store

File src/Parser.hs

+--
+-- Copyright (c)2007 Chris Pressey, 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.
+--
+
+-----------------------------------------------------------------------
+-- ============================== Parser =========================== --
+-----------------------------------------------------------------------
+
+module Parser where
+
+import Scanner
+import Primitive
+import AST
+
+--
+-- Utility
+--
+
+expect [] l = l
+expect (x:xs) (y:ys)
+    | x == y =
+        expect xs ys
+
+--
+-- Statement ::= "if" BoolExpr "then" Statement "else" Statement
+--             | "while" BoolExpr "do" Statement
+--             | "begin" Statement {";" Statement} "end"
+--             | "var" VarName "in" Statement
+--             | "print" NumExpr
+--             | VarName ":=" NumExpr
+--
+
+parseStatement (IfToken:tokens) =
+    let
+        (tokens2, be) = parseBoolExpr tokens
+        tokens3 = expect [ThenToken] tokens2
+        (tokens4, s1) = parseStatement tokens3
+        tokens5 = expect [ElseToken] tokens4
+        (tokens6, s2) = parseStatement tokens5
+    in
+        (tokens6, IfStmt be s1 s2)
+
+parseStatement (VarToken:tokens) =
+    let
+        ((Ident ident):tokens2) = tokens
+        v = VarName ident
+        tokens3 = expect [InToken] tokens2
+        (tokens4, s) = parseStatement tokens3
+    in
+        (tokens4, Var v s)
+
+parseStatement (WhileToken:tokens) =
+    let
+        (tokens2, be) = parseBoolExpr tokens
+        tokens3 = expect [DoToken] tokens2
+        (tokens4, s) = parseStatement tokens3
+    in
+        (tokens4, While be s)
+
+parseStatement (PrintToken:tokens) =
+    let
+        (tokens2, ne) = parseNumExpr tokens
+    in
+        (tokens2, Print ne)
+
+parseStatement ((Ident s):tokens) =
+    let
+        v = VarName s
+        tokens2 = expect [BecomesToken] tokens
+        (tokens3, ne) = parseNumExpr tokens2
+    in
+        (tokens3, Assign v ne)
+
+parseStatement (BeginToken:tokens) =
+    let
+        (tokens2, stmtList) = parseStmtList tokens []
+    in
+        (tokens2, Block (reverse stmtList))
+
+parseStmtList tokens acc =
+    let
+        (tokens2, s) = parseStatement tokens
+    in
+        case tokens2 of
+            (StmtSepToken:rest) ->
+                parseStmtList rest (s : acc)
+            (EndToken:rest) ->
+                (rest, (s:acc))
+
+--
+-- NumExpr ::= AddExpr.
+--
+
+parseNumExpr tokens = parseAddExpr tokens
+
+--
+-- AddExpr ::= MulExpr {("+" | "-") MulExpr}.
+--
+
+parseAddExpr tokens =
+    let
+        (tokens2, lhs) = parseMulExpr tokens
+    in
+        parseAddExprTail tokens2 lhs
+
+parseAddExprTail (AddToken:tokens) lhs =
+    let
+        (tokens2, rhs) = parseMulExpr tokens
+        newLhs = NumOp Add lhs rhs
+    in
+        parseAddExprTail tokens2 newLhs
+
+parseAddExprTail (SubtractToken:tokens) lhs =
+    let
+        (tokens2, rhs) = parseMulExpr tokens
+        newLhs = NumOp Subtract lhs rhs
+    in
+        parseAddExprTail tokens2 newLhs
+
+parseAddExprTail tokens e = (tokens, e)
+
+--
+-- MulExpr ::= Primitive {("*" | "/") Primitive}.
+--
+
+parseMulExpr tokens =
+    let
+        (tokens2, lhs) = parsePrimitive tokens
+    in
+        parseMulExprTail tokens2 lhs
+
+parseMulExprTail (MultiplyToken:tokens) lhs =
+    let
+        (tokens2, rhs) = parsePrimitive tokens
+        newLhs = NumOp Multiply lhs rhs
+    in
+        parseMulExprTail tokens2 newLhs
+
+parseMulExprTail (DivideToken:tokens) lhs =
+    let
+        (tokens2, rhs) = parsePrimitive tokens
+        newLhs = NumOp Divide lhs rhs
+    in
+        parseMulExprTail tokens2 newLhs
+
+parseMulExprTail tokens e = (tokens, e)
+
+--
+-- Primitive ::= "(" NumExpr ")"
+--             | "if" BoolExpr "then" NumExpr "else" NumExpr
+--             | "let" VarName "=" NumExpr "in" NumExpr
+--             | "valueof" VarName "in" Statement
+--             | "loop" NumExpr
+--             | "repeat"
+--             | "input" VarName "in" NumExpr
+--             | VarName
+--             | NumConst.
+--
+
+parsePrimitive (OpenParenToken:tokens) =
+    let
+        (tokens2, ne) = parseNumExpr tokens
+        tokens3 = expect [CloseParenToken] tokens2
+    in
+        (tokens3, ne)
+
+parsePrimitive (IfToken:tokens) =
+    let
+        (tokens2, be) = parseBoolExpr tokens
+        tokens3 = expect [ThenToken] tokens2
+        (tokens4, e1) = parseNumExpr tokens3
+        tokens5 = expect [ElseToken] tokens4
+        (tokens6, e2) = parseNumExpr tokens5
+    in
+        (tokens6, IfExpr be e1 e2)
+
+parsePrimitive (LetToken:tokens) =
+    let
+        ((Ident ident):tokens2) = tokens
+        v = VarName ident
+        tokens3 = expect [EqualToken] tokens2
+        (tokens4, e1) = parseNumExpr tokens3
+        tokens5 = expect [InToken] tokens4
+        (tokens6, e2) = parseNumExpr tokens5
+    in
+        (tokens6, Let v e1 e2)
+
+parsePrimitive (ValueOfToken:tokens) =
+    let
+        ((Ident ident):tokens2) = tokens
+        v = VarName ident
+        tokens3 = expect [InToken] tokens2
+        (tokens4, s) = parseStatement tokens3
+    in
+        (tokens4, ValueOf v s)
+
+parsePrimitive (LoopToken:tokens) =
+    let
+        (tokens2, e) = parseNumExpr tokens
+    in
+        (tokens2, Loop e)
+
+parsePrimitive (RepeatToken:tokens) = (tokens, Repeat)
+
+parsePrimitive (InputToken:tokens) =
+    let
+        ((Ident ident):tokens2) = tokens
+        v = VarName ident
+        tokens3 = expect [InToken] tokens2
+        (tokens4, ne) = parseNumExpr tokens3
+    in
+        (tokens4, Input v ne)
+
+parsePrimitive ((IntLit i):tokens) = (tokens, NumConst i)
+
+parsePrimitive ((Ident s):tokens) = (tokens, (VarRef (VarName s)))
+
+--
+-- BoolExpr ::= RelExpr {("&" | "|") RelExpr}
+--            | "not" BoolExpr
+--            | "(" BoolExpr ")".
+--
+
+parseBoolExpr (NotToken:tokens) =
+    let
+        (tokens2, be) = parseBoolExpr tokens
+    in
+        (tokens2, Not be)
+
+parseBoolExpr (OpenParenToken:tokens) =
+    let
+        (tokens2, be) = parseBoolExpr tokens
+        tokens3 = expect [CloseParenToken] tokens2
+    in
+        (tokens3, be)
+
+parseBoolExpr tokens =
+    let
+        (tokens2, lhs) = parseRelExpr tokens
+    in
+        parseBoolExprTail tokens2 lhs
+
+parseBoolExprTail (AndToken:tokens) lhs =
+    let
+        (tokens2, rhs) = parseRelExpr tokens
+        newLhs = BoolOp And lhs rhs
+    in
+        parseBoolExprTail tokens2 newLhs
+
+parseBoolExprTail (OrToken:tokens) lhs =
+    let
+        (tokens2, rhs) = parseRelExpr tokens
+        newLhs = BoolOp Or lhs rhs
+    in
+        parseBoolExprTail tokens2 newLhs
+
+parseBoolExprTail tokens be = (tokens, be)
+
+--
+-- RelExpr ::= NumExpr (">" | "<" | ">=" | "<=" | "=" | "/=") NumExpr.
+--
+
+parseRelExpr tokens =
+    let
+        (tokens2, lhs) = parseNumExpr tokens
+        (tokens3, relOp) = relOpForSym tokens2
+        (tokens4, rhs) = parseNumExpr tokens3
+    in
+        (tokens4, RelOp relOp lhs rhs)
+
+relOpForSym (GreaterThanToken:tokens)        = (tokens, GreaterThan)
+relOpForSym (GreaterThanOrEqualToken:tokens) = (tokens, GreaterThanOrEqual)
+relOpForSym (EqualToken:tokens)              = (tokens, Equal)
+relOpForSym (NotEqualToken:tokens)           = (tokens, NotEqual)
+relOpForSym (LessThanToken:tokens)           = (tokens, LessThan)
+relOpForSym (LessThanOrEqualToken:tokens)    = (tokens, LessThanOrEqual)
+
+--
+-- Driver
+--
+
+parse string = parseStatement (tokenize string)

File src/Primitive.hs

+--
+-- Copyright (c)2007 Chris Pressey, 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.
+--
+
+-----------------------------------------------------------------------
+-- ===================== Primitive Operations ====================== --
+-----------------------------------------------------------------------
+
+module Primitive where
+
+data NumOp = Add | Subtract | Multiply | Divide
+             deriving (Eq, Ord, Show)
+
+applyNumOp Add a b = a + b
+applyNumOp Subtract a b = a - b
+applyNumOp Multiply a b = a * b
+applyNumOp Divide a b = a `div` b
+
+data RelOp = GreaterThan | GreaterThanOrEqual
+           | Equal | NotEqual | LessThan | LessThanOrEqual
+             deriving (Eq, Ord, Show)
+
+applyRelOp GreaterThan a b        = a > b
+applyRelOp GreaterThanOrEqual a b = a >= b
+applyRelOp Equal a b              = a == b
+applyRelOp NotEqual a b           = a /= b
+applyRelOp LessThan a b           = a < b
+applyRelOp LessThanOrEqual a b    = a <= b
+
+dualRelOp GreaterThan = LessThanOrEqual
+dualRelOp GreaterThanOrEqual = LessThan
+dualRelOp Equal = NotEqual
+dualRelOp NotEqual = Equal
+dualRelOp LessThan = GreaterThanOrEqual
+dualRelOp LessThanOrEqual = GreaterThan
+
+data BoolOp = And | Or
+             deriving (Eq, Ord, Show)
+
+applyBoolOp And a b = a && b
+applyBoolOp Or a b = a || b

File src/PureInterp.hs

+--
+-- Copyright (c)2007 Chris Pressey, 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.
+--
+
+-----------------------------------------------------------------------
+-- ======================== Pure Interpreter ======================= --
+-----------------------------------------------------------------------
+
+--
+-- This interpreter does not do any input or output.  Its purpose
+-- is to present a very straightforward functional explication of
+-- the language, uncluttered by monads.
+--
+
+module PureInterp where
+
+import Map
+import AST
+import Primitive
+
+--
+-- The eval* functions are passed a store and a continuation (cc).
+--
+-- The store maps VarName objects to their values (Integers).
+--
+-- The continuation is used with the loop and repeat constructs.
+-- It is not a full-blown continuation in the sense of being a
+-- function which represents the entire rest of the computation.
+-- Rather, it represents only the matchings between occurrences
+-- of loop and occurrences of repeat.
+--
+-- The continuation is implemented as list of NumExprs, where the
+-- head NumExpr is the most recently encountered (innermost) loop
+-- expression.  Each loop expression extends the continuation with
+-- the expression being looped around, and a repeat expression
+-- executes the continuation.
+--
+
+evalBool (BoolOp op b1 b2) store cc = applyBoolOp op (evalBool b1 store cc) (evalBool b2 store cc)
+evalBool (RelOp op e1 e2) store cc  = applyRelOp op (evalNum e1 store cc) (evalNum e2 store cc)
+evalBool (Not b) store cc           = not (evalBool b store cc)
+evalBool (BoolConst b) store cc     = b
+
+evalNum (NumOp op e1 e2) store cc = applyNumOp op (evalNum e1 store cc) (evalNum e2 store cc)
+evalNum (NumConst i) store cc     = i
+evalNum (IfExpr b e1 e2) store cc
+    | evalBool b store cc         = evalNum e1 store cc
+    | otherwise                   = evalNum e2 store cc
+
+evalNum (VarRef v) store cc       = get v store 0
+evalNum (Let v e1 e2) store cc    = evalNum e2 (set v (evalNum e1 store cc) store) cc
+
+evalNum (Loop e) store cc         = evalNum e store ((Loop e):cc)
+evalNum (Repeat) store cc         = evalNum (head cc) store (tail cc)
+
+evalNum (ValueOf v s) store cc    = get v (interpret s store) 0
+
+evalNum (Input v e) store cc      = evalNum e (set v 0 store) cc
+
+interpret (Block []) store = store
+interpret (Block (s:rest)) store =
+    interpret (Block rest) (interpret s store)
+
+interpret (Var v s) store = interpret s store
+
+interpret (Assign v e) store = set v (evalNum e store []) store
+
+interpret (IfStmt b s1 s2) store
+    | evalBool b store [] = interpret s1 store
+    | otherwise           = interpret s2 store
+
+interpret (While b s) store
+    | evalBool b store [] = interpret (While b s) (interpret s store)
+    | otherwise           = store
+
+interpret (Print e) store = store

File src/Scanner.hs

+--
+-- Copyright (c)2007 Chris Pressey, 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.
+--
+
+-----------------------------------------------------------------------
+-- ============================= Scanner =========================== --
+-----------------------------------------------------------------------
+
+module Scanner where
+
+import Char
+
+data Token = Ident String
+           | IntLit Integer
+           | OpenCommentToken
+           | CloseCommentToken
+           | BecomesToken
+           | GreaterThanToken
+           | GreaterThanOrEqualToken
+           | EqualToken
+           | NotEqualToken
+           | LessThanOrEqualToken
+           | LessThanToken
+           | StmtSepToken
+           | AndToken
+           | OrToken
+           | NotToken
+           | AddToken
+           | SubtractToken
+           | MultiplyToken
+           | DivideToken
+           | OpenParenToken
+           | CloseParenToken
+           | IfToken
+           | ThenToken
+           | ElseToken
+           | WhileToken
+           | DoToken
+           | BeginToken
+           | EndToken
+           | InputToken
+           | PrintToken
+           | LetToken
+           | InToken
+           | VarToken
+           | LoopToken
+           | RepeatToken
+           | ValueOfToken
+           | TokenizerError
+           deriving (Show, Read, Eq)
+
+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
+
+tokens = [("(*", OpenCommentToken),
+          ("*)", CloseCommentToken),
+          (":=", BecomesToken),
+          (">=", GreaterThanOrEqualToken),
+          ("<=", LessThanOrEqualToken),
+          (">", GreaterThanToken),
+          ("<", LessThanToken),
+          ("=", EqualToken),
+          ("/=", NotEqualToken),
+          (";", StmtSepToken),
+          ("&", AndToken),
+          ("|", OrToken),
+          ("!", NotToken),
+          ("+", AddToken),
+          ("-", SubtractToken),
+          ("*", MultiplyToken),
+          ("/", DivideToken),
+          ("(", OpenParenToken),
+          (")", CloseParenToken),
+          ("if", IfToken),
+          ("then", ThenToken),
+          ("else", ElseToken),
+          ("while", WhileToken),
+          ("do", DoToken),
+          ("begin", BeginToken),
+          ("end", EndToken),
+          ("input", InputToken),
+          ("print", PrintToken),
+          ("let", LetToken),
+          ("in", InToken),
+          ("var", VarToken),
+          ("loop", LoopToken),
+          ("repeat", RepeatToken),
+          ("valueof", ValueOfToken)]
+
+findToken string [] =
+    (Nothing, string)
+findToken string ((tokenString, token):rest)
+    | (take len string) == tokenString =
+        (Just token, (drop len string))
+    | otherwise =
+        findToken string rest
+    where
+        len = length tokenString
+
+tokenize [] = []
+tokenize string@(char:chars)
+    | isSpace char =
+        tokenize chars
+    | isDigit char =
+        tokenizeIntLit string 0
+    | foundToken == Just OpenCommentToken =
+        let
+            newRestOfString = gobble CloseCommentToken restOfString
+        in
+            tokenize newRestOfString
+    | foundToken /= Nothing =
+        let
+            (Just token) = foundToken
+        in
+            token:(tokenize restOfString)
+    | isAlpha char =
+        tokenizeIdent string ""
+    | otherwise =
+        [TokenizerError]
+    where
+        (foundToken, restOfString) = findToken string tokens
+
+gobble token [] = []
+gobble token string@(char:chars)
+    | foundToken == Just token =
+        restOfString
+    | otherwise =
+        gobble token chars
+    where
+        (foundToken, restOfString) = findToken string tokens
+
+tokenizeIntLit [] num = [IntLit num]
+tokenizeIntLit string@(char:chars) num
+    | isDigit char =
+        tokenizeIntLit chars (num * 10 + digitVal char)
+    | otherwise =
+        IntLit num:(tokenize string)
+
+tokenizeIdent [] id = [Ident (reverse id)]
+tokenizeIdent string@(char:chars) id
+    | isAlpha char =
+        tokenizeIdent chars (char:id)
+    | otherwise =
+        Ident (reverse id):(tokenize string)
+

File test/01.iphi

+(* Test 'var ... in ...' and assignment *)
+
+var k in k := 5
+k=5

File test/02.iphi

+(* Test 'begin ... end' *)
+
+var k in begin
+    k := 5;
+    k := k + 1
+end
+k=6

File test/03.iphi

+(* Test nested 'var ... in ...' and arithmetic operators *)
+
+var i in var j in var k in begin
+    i := 2;
+    j := 3;
+    k := i + j;   (*  5 *)
+    i := j * k;   (* 15 *)
+    j := i / 2;   (*  7 *)
+    j := j - 1    (*  6 *)
+end
+j=6
+i=15
+k=5

File test/04.iphi

+(* Test 'if ... then ... else' command with negative result *)
+
+var i in var j in begin
+    i := 2;
+    if i > 4 then
+      j := i * 2
+    else
+      j := i + 1
+end
+j=3
+i=2

File test/05.iphi

+(* Test 'if ... then ... else' command with positive result *)
+
+var i in var j in begin
+    i := 2;
+    j := 1;
+    if i < 4 & j = 1 then
+      j := i * 6
+    else
+      j := i + 1
+end
+j=12
+i=2

File test/06.iphi

+(* Test 'while ... do ...' *)
+
+var i in var j in begin
+    i := 100;
+    j := 0;
+    while i > 0 do begin
+        j := j + i;
+	i := i - 1
+    end
+end
+i=0
+j=5050

File test/07.iphi

+(* Test 'while ... do ...' *)
+
+var a in var b in var c in
+begin
+    a := 10;
+    b := 1;
+    c := 2;
+    while a > 0 do
+        begin
+	    b := b * c;
+	    c := c + b;
+	    a := a - 1
+	end
+end
+a=0
+c=140982598893793678070294688422804665931354981644880911847733136248186424030732278900819020480668973702640170212905160639132296847654374706155245147715674612235227680384069415566749494180212370357849936526549755341591854042821940420766722160615645816921368300
+b=140982598893793678070294688422804665931354981644880911847733136248186424030732278900819020480668973702640170212905160639132296847278898210361175931159590631877400396153764977561991761037132722898953457959352992281368361865140291306311370294857131871923863552

File test/08.iphi

+(* Test 'if ... then ... else' expression with negative result *)
+
+var a in var b in var c in
+begin
+    a := 10;
+    b := 2;
+    c := if a > 20 then a - b else a / b
+end
+c=5
+b=2
+a=10

File test/09.iphi

+(* Test 'if ... then ... else' expression with positive result *)
+
+var a in var b in var c in
+begin
+    a := 10;
+    b := 2;
+    c := if a < 20 then a - b else a / b
+end
+c=8
+b=2
+a=10

File test/10.iphi

+(* Test 'let ... in ...' *)
+
+var a in a := let b = 7 in 10 - b;
+a=3

File test/11.iphi

+(* Test 'valueof ... in ...' *)
+
+var a in var b in begin
+    a := 10;
+    b := valueof c in begin
+        c := a * 2
+    end + 7
+end
+b=27
+a=10

File test/12.iphi

+(* Test that 'var ... in ...' does not shadow *)
+
+var a in var b in
+begin
+    a := 1;
+    b := 2;
+    var a in
+        a := 3
+end
+["Variable a already declared"]

File test/13.iphi

+(* Test that 'let ... in ...' does shadow *)
+
+var a in var b in
+begin
+    a := 2;
+    b := 3;
+    a := let b = 7 in a * b
+end
+a=14
+b=3

File test/14.iphi

+(* Test 'loop ...' and 'repeat' *)
+
+var a in a :=
+    let c = 5 in let d = 1 in
+        loop
+	    if c = 0 then
+	        d
+	    else
+	        let d = d * c in
+	            let c = c - 1 in
+		        repeat
+a=120

File test/Makefile

+# Makefile for Iphigeneia regression test suite.
+# $Id$
+
+# This Makefile currently assumes GNU make.
+
+# The suffixes are:
+# .iphi  Iphigeneia source code
+# .out	 Program run output  - used with 'diff' to check 'run'
+
+IPHI?=../src/iphi
+DIFF?=diff -u
+
+TESTS=01.run 02.run 03.run 04.run 05.run 06.run 07.run 08.run 09.run 10.run \
+      11.run 12.run 13.run 14.run
+
+all: ${TESTS}
+
+.PHONY: %.run
+
+%.run: %.iphi %.out
+	${IPHI} $< >OUTPUT
+	${DIFF} OUTPUT $*.out
+
+clean:
+	rm -rf OUTPUT

File test/cat.iphi

+(* Echo input to output until the first space *)
+var x in
+  while x /= 32 do
+    begin
+      x := input c in c;
+      print x
+    end

File test/hello.iphi

+(* "Hello, world!" (or actually just "Hello") in Iphigeneia *)
+begin
+  print 72;
+  print 101;
+  print 108;
+  print 108;
+  print 111
+end