diff --git a/doc/iphi.html b/doc/iphi.html
new file mode 100755
index 0000000..369c506
--- /dev/null
+++ b/doc/iphi.html
@@ -0,0 +1,229 @@
+<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 — 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 {("&" | "|") RelExpr}
+ | "!" BoolExpr
+ | "(" BoolExpr ")".
+
+RelExpr ::= NumExpr (">" | "<" | ">=" | "<=" | "=" | "/=") 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>
diff --git a/src/AST.hs b/src/AST.hs
new file mode 100755
index 0000000..c6b2265
--- /dev/null
+++ b/src/AST.hs
@@ -0,0 +1,70 @@
+--
+-- 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)
diff --git a/src/Check.hs b/src/Check.hs
new file mode 100755
index 0000000..fe23e71
--- /dev/null
+++ b/src/Check.hs
@@ -0,0 +1,153 @@
+--
+-- 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
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100755
index 0000000..49c4aec
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,143 @@
+--
+-- 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"
diff --git a/src/Makefile b/src/Makefile
new file mode 100755
index 0000000..72721dc
--- /dev/null
+++ b/src/Makefile
@@ -0,0 +1,55 @@
+# 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
diff --git a/src/Map.hs b/src/Map.hs
new file mode 100755
index 0000000..6dc52f1
--- /dev/null
+++ b/src/Map.hs
@@ -0,0 +1,68 @@
+--
+-- 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
diff --git a/src/MonadInterp.hs b/src/MonadInterp.hs
new file mode 100755
index 0000000..a89bb6f
--- /dev/null
+++ b/src/MonadInterp.hs
@@ -0,0 +1,153 @@
+--
+-- 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
diff --git a/src/Parser.hs b/src/Parser.hs
new file mode 100755
index 0000000..246affe
--- /dev/null
+++ b/src/Parser.hs
@@ -0,0 +1,310 @@
+--
+-- 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)
diff --git a/src/Primitive.hs b/src/Primitive.hs
new file mode 100755
index 0000000..f51a258
--- /dev/null
+++ b/src/Primitive.hs
@@ -0,0 +1,69 @@
+--
+-- 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
diff --git a/src/PureInterp.hs b/src/PureInterp.hs
new file mode 100755
index 0000000..cc9c674
--- /dev/null
+++ b/src/PureInterp.hs
@@ -0,0 +1,104 @@
+--
+-- 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
diff --git a/src/Scanner.hs b/src/Scanner.hs
new file mode 100755
index 0000000..21a3649
--- /dev/null
+++ b/src/Scanner.hs
@@ -0,0 +1,181 @@
+--
+-- 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)
+
diff --git a/test/01.iphi b/test/01.iphi
new file mode 100755
index 0000000..1719034
--- /dev/null
+++ b/test/01.iphi
@@ -0,0 +1,3 @@
+(* Test 'var ... in ...' and assignment *)
+
+var k in k := 5
diff --git a/test/01.out b/test/01.out
new file mode 100755
index 0000000..4c72835
--- /dev/null
+++ b/test/01.out
@@ -0,0 +1 @@
+k=5
diff --git a/test/02.iphi b/test/02.iphi
new file mode 100755
index 0000000..6c8a1c8
--- /dev/null
+++ b/test/02.iphi
@@ -0,0 +1,6 @@
+(* Test 'begin ... end' *)
+
+var k in begin
+ k := 5;
+ k := k + 1
+end
diff --git a/test/02.out b/test/02.out
new file mode 100755
index 0000000..05d9858
--- /dev/null
+++ b/test/02.out
@@ -0,0 +1 @@
+k=6
diff --git a/test/03.iphi b/test/03.iphi
new file mode 100755
index 0000000..5fcb2cf
--- /dev/null
+++ b/test/03.iphi
@@ -0,0 +1,10 @@
+(* 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
diff --git a/test/03.out b/test/03.out
new file mode 100755
index 0000000..7eaa5e5
--- /dev/null
+++ b/test/03.out
@@ -0,0 +1,3 @@
+j=6
+i=15
+k=5
diff --git a/test/04.iphi b/test/04.iphi
new file mode 100755
index 0000000..df70583
--- /dev/null
+++ b/test/04.iphi
@@ -0,0 +1,9 @@
+(* 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
diff --git a/test/04.out b/test/04.out
new file mode 100755
index 0000000..c11f14b
--- /dev/null
+++ b/test/04.out
@@ -0,0 +1,2 @@
+j=3
+i=2
diff --git a/test/05.iphi b/test/05.iphi
new file mode 100755
index 0000000..b6d3ff0
--- /dev/null
+++ b/test/05.iphi
@@ -0,0 +1,10 @@
+(* 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
diff --git a/test/05.out b/test/05.out
new file mode 100755
index 0000000..e185103
--- /dev/null
+++ b/test/05.out
@@ -0,0 +1,2 @@
+j=12
+i=2
diff --git a/test/06.iphi b/test/06.iphi
new file mode 100755
index 0000000..ca0ba59
--- /dev/null
+++ b/test/06.iphi
@@ -0,0 +1,10 @@
+(* 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
diff --git a/test/06.out b/test/06.out
new file mode 100755
index 0000000..4506b3d
--- /dev/null
+++ b/test/06.out
@@ -0,0 +1,2 @@
+i=0
+j=5050
diff --git a/test/07.iphi b/test/07.iphi
new file mode 100755
index 0000000..3cf7690
--- /dev/null
+++ b/test/07.iphi
@@ -0,0 +1,14 @@
+(* 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
diff --git a/test/07.out b/test/07.out
new file mode 100755
index 0000000..958bcee
--- /dev/null
+++ b/test/07.out
@@ -0,0 +1,3 @@
+a=0
+c=140982598893793678070294688422804665931354981644880911847733136248186424030732278900819020480668973702640170212905160639132296847654374706155245147715674612235227680384069415566749494180212370357849936526549755341591854042821940420766722160615645816921368300
+b=140982598893793678070294688422804665931354981644880911847733136248186424030732278900819020480668973702640170212905160639132296847278898210361175931159590631877400396153764977561991761037132722898953457959352992281368361865140291306311370294857131871923863552
diff --git a/test/08.iphi b/test/08.iphi
new file mode 100755
index 0000000..3e0566a
--- /dev/null
+++ b/test/08.iphi
@@ -0,0 +1,8 @@
+(* 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
diff --git a/test/08.out b/test/08.out
new file mode 100755
index 0000000..c29ec0b
--- /dev/null
+++ b/test/08.out
@@ -0,0 +1,3 @@
+c=5
+b=2
+a=10
diff --git a/test/09.iphi b/test/09.iphi
new file mode 100755
index 0000000..db10540
--- /dev/null
+++ b/test/09.iphi
@@ -0,0 +1,8 @@
+(* 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
diff --git a/test/09.out b/test/09.out
new file mode 100755
index 0000000..6804887
--- /dev/null
+++ b/test/09.out
@@ -0,0 +1,3 @@
+c=8
+b=2
+a=10
diff --git a/test/10.iphi b/test/10.iphi
new file mode 100755
index 0000000..b932f44
--- /dev/null
+++ b/test/10.iphi
@@ -0,0 +1,3 @@
+(* Test 'let ... in ...' *)
+
+var a in a := let b = 7 in 10 - b;
diff --git a/test/10.out b/test/10.out
new file mode 100755
index 0000000..cee2fd0
--- /dev/null
+++ b/test/10.out
@@ -0,0 +1 @@
+a=3
diff --git a/test/11.iphi b/test/11.iphi
new file mode 100755
index 0000000..3c4087c
--- /dev/null
+++ b/test/11.iphi
@@ -0,0 +1,8 @@
+(* Test 'valueof ... in ...' *)
+
+var a in var b in begin
+ a := 10;
+ b := valueof c in begin
+ c := a * 2
+ end + 7
+end
diff --git a/test/11.out b/test/11.out
new file mode 100755
index 0000000..57f722a
--- /dev/null
+++ b/test/11.out
@@ -0,0 +1,2 @@
+b=27
+a=10
diff --git a/test/12.iphi b/test/12.iphi
new file mode 100755
index 0000000..812e42f
--- /dev/null
+++ b/test/12.iphi
@@ -0,0 +1,9 @@
+(* Test that 'var ... in ...' does not shadow *)
+
+var a in var b in
+begin
+ a := 1;
+ b := 2;
+ var a in
+ a := 3
+end
diff --git a/test/12.out b/test/12.out
new file mode 100755
index 0000000..b4b6e50
--- /dev/null
+++ b/test/12.out
@@ -0,0 +1 @@
+["Variable a already declared"]
diff --git a/test/13.iphi b/test/13.iphi
new file mode 100755
index 0000000..d41578e
--- /dev/null
+++ b/test/13.iphi
@@ -0,0 +1,8 @@
+(* 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
diff --git a/test/13.out b/test/13.out
new file mode 100755
index 0000000..47f85fe
--- /dev/null
+++ b/test/13.out
@@ -0,0 +1,2 @@
+a=14
+b=3
diff --git a/test/14.iphi b/test/14.iphi
new file mode 100755
index 0000000..f1828d6
--- /dev/null
+++ b/test/14.iphi
@@ -0,0 +1,11 @@
+(* 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
diff --git a/test/14.out b/test/14.out
new file mode 100755
index 0000000..8b28cc2
--- /dev/null
+++ b/test/14.out
@@ -0,0 +1 @@
+a=120
diff --git a/test/Makefile b/test/Makefile
new file mode 100755
index 0000000..203a76a
--- /dev/null
+++ b/test/Makefile
@@ -0,0 +1,25 @@
+# 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
diff --git a/test/cat.iphi b/test/cat.iphi
new file mode 100755
index 0000000..ea3f284
--- /dev/null
+++ b/test/cat.iphi
@@ -0,0 +1,7 @@
+(* Echo input to output until the first space *)
+var x in
+ while x /= 32 do
+ begin
+ x := input c in c;
+ print x
+ end
diff --git a/test/hello.iphi b/test/hello.iphi
new file mode 100755
index 0000000..fdcc6b4
--- /dev/null
+++ b/test/hello.iphi
@@ -0,0 +1,8 @@
+(* "Hello, world!" (or actually just "Hello") in Iphigeneia *)
+begin
+ print 72;
+ print 101;
+ print 108;
+ print 108;
+ print 111
+end