Commit rel_1_0_2007_1125 - Iphigeneia - git @ Cat's Eye Technologies

+229

-0

doc/iphi.html less more

	0	<html>
	1	<head><title>The Iphigeneia Programming Language</title></head>
	2	<body>
	3
	4	<h1>The Iphigeneia Programming Language</h1>
	5
	6	<p>Language version 1.0, distribution version 2007.1125</p>
	7
	8	<h2>Introduction</h2>
	9
	10	<p>The Iphigeneia programming language was designed as a workbench for an exercise in
	11	transliterating between single-assignment (functional) and mutable-variable (imperative)
	12	program forms. As such, the language contains features paradigmatic to both forms.</p>
	13
	14	<p>As languages go, Iphigeneia is not particularly esoteric, nor is it particularly
	15	practical; it's more academic, resembling those exciting languages
	16	with inspired names like <b>Imp</b> and <b>Fun</b> that you're apt to find in
	17	textbooks on formal semantics.</p>
	18
	19	<p>Note that this document only covers the Iphigeneia language itself,
	20	not the transliteration process. This is because I still haven't fully worked
	21	out the details of the transliteration, and that shortly after designing the
	22	language, I changed my mind and decided that, for clarity, it would probably
	23	be better to do the transliteration between two <em>distinct</em> languages,
	24	rather than within a single language. So Iphigeneia wanders a little bit
	25	from the original design goal, and reflects a couple of design choices that are
	26	simply on whim rather than strictly in support of the transliteration idea.</p>
	27
	28	<p>Note also that this document is an <em>informal</em> description
	29	of the language that relies on the reader's intuition as a computer programmer.
	30	I would like to write a formal semantics of Iphigeneia someday, since it's
	31	a simple enough language that this isn't an unthinkably complex task. In the meantime,
	32	you may wish to refer to the reference implementation
	33	of the Iphigeneia interpreter for a more formal definition
	34	(if you believe Haskell is sufficiently formally defined.)</p>
	35
	36	<p>The name Iphigeneia comes from the name of Agamemnon's daughter in Greek
	37	mythology. The name was not chosen because of any particular significance
	38	this figure holds — I just think it's a nice name. However, I suppose
	39	if you wanted to force an interpretation, you could say that Iphigeneia
	40	has two natures, princess and priestess, and so does her namesake: imperative
	41	and functional.</p>
	42
	43	<h2>Language</h2>
	44
	45	<p>The language constructs are generally straightforward to understand if you've had any
	46	experience with the usual assortment of imperative and functional languages, so forgive
	47	me if I'm a bit sketchy on the details here and there, even to the point of just
	48	mentioning, rather than describing, run-of-the-mill constructs like <code>while</code>.</p>
	49
	50	<p>The basic constructs of Iphigeneia are <em>expressions</em>, which evaluate to
	51	a single value, and <em>commands</em>, which transform a store (a map between
	52	variable names and values.) Expressions
	53	relate to the functional or single-assignment side of things, and commands provide
	54	the imperative or mutable-variable aspect of the language.</p>
	55
	56	<p>There are only two kinds of values in Iphigeneia: boolean values and
	57	unbounded integer values. In addition, only integers can be "denoted" (be
	58	stored in variables or have names bound to them); boolean expressions
	59	can only appear in conditional tests.
	60	To keep things simple, there are no subroutines, function values, pointers, references,
	61	arrays, structures, or anything like that.</p>
	62
	63	<p>Constructs relating to the single-assignment side of things include <code>let</code>,
	64	<code>loop</code>, <code>repeat</code>, and <code>valueof</code>. Imperative constructs
	65	include <code>begin</code> blocks, <code>while</code> loops, and of course destructive
	66	variable update with the <code>:=</code> operator.
	67	The lowly <code>if</code> makes sense in both "worlds", and so leads a double life:
	68	one flavour appears in expressions and has branches that are also expressions,
	69	and the other is a command and has branches that are also commands.</p>
	70
	71	<p>Iphigeneia supports input and output. However, to further emphasize the "split" in
	72	the language (and for no other good reason,) input is considered "functional", leading
	73	to an <code>input</code> ... <code>in</code> form, while output is considered "imperative",
	74	leading to a <code>print</code> command.</p>
	75
	76	<h3>Expressions</h3>
	77
	78	<p>Expressions are formed from the usual assortment of infix operators with their
	79	normative meaning and precedence. There are two kinds of expressions, boolean
	80	expressions and integer expressions.
	81	Boolean expressions only appear in tests (<code>if</code> and <code>while</code>).
	82	Integer expressions appear everywhere else, and can also contain some more involved
	83	forms which are explained in the remainder of this section.</p>
	84
	85	<p>Expressions are generally evaluated eagerly, left-to-right, innermost-to-outermost.
	86	This only affects order of output with the <code>print</code> command, however,
	87	since evaluation of an expression can never side-effect a store.
	88	(Command sequences embedded in expressions always work exclusively on
	89	their own, local store.)</p>
	90
	91	<h4><code>let</code> name <code>=</code> expr<sub>0</sub> <code>in</code> expr<sub>1</sub></h4>
	92
	93	<p>The <code>let</code> construct establishes a new binding. The expression
	94	expr<sub>0</sub> is evaluated, and the result is associated with the given
	95	name during the evaluation of expr<sub>1</sub>. That is, where-ever the name
	96	appears in expr<sub>1</sub> or any sub-expression of expr<sub>1</sub>, it
	97	is treated as if it had the value of expr<sub>0</sub>. Note however
	98	that embedded commands (such as those appearing in a <code>valueof</code>)
	99	are not considered to be sub-expressions, and the influence of <code>let</code>
	100	bindings does not descend into them.</p>
	101
	102	<p>Let bindings shadow any enclosing let bindings with the same name.</p>
	103
	104	<h4><code>valueof</code> name <code>in</code> cmd</h4>
	105
	106	<p>The <code>valueof</code> construct was a late addition, and is not
	107	strictly necessary, although it adds a nice symmetry to the language.
	108	I decided that, since there was already a (completely traditional) way to embed
	109	expressions in commands (namely the <code>:=</code> assignment operator,)
	110	there ought to be a complementary way to embed commands in expressions.</p>
	111
	112	<p><code>valueof</code> blocks are evaluated in a completely new
	113	store; no other stores or let bindings are visible within the block.
	114	There is no need to declare the name with a <code>var</code> inside
	115	the block; the <code>valueof</code> counts as a <code>var</code>,
	116	declaring the name in the new store.</p>
	117
	118	<h4><code>loop</code> ... <code>repeat</code></h4>
	119
	120	<p>The <code>loop</code> construct is modelled after Scheme's "named <code>let</code>"
	121	form. When <code>repeat</code> executed, the innermost enclosing <code>loop</code>
	122	expression is re-evaluated in the current environment. Since <code>loop</code> expressions
	123	do not take arguments like a "named <code>let</code>", the values of bindings are
	124	instead altered on subsequent iterations by enclosing the <code>repeat</code> in a
	125	<code>let</code> expression, which gives new bindings to the names.</p>
	126
	127	<p>A <code>repeat</code> with an unmatched <code>loop</code> is a runtime error that aborts the
	128	program. Also, the influence of a <code>loop</code> does not extend down through a
	129	<code>valueof</code> expression. That is, the following <code>repeat</code> is not
	130	matched: <code>loop valueof x in x := repeat</code>.</p>
	131
	132	<h4><code>input</code> name <code>in</code> expr</h4>
	133
	134	<p>Works like <code>let</code>, except that the program waits for
	135	a character from the standard input channel, and associates the ASCII
	136	value of this character to the name when evaluating expr.</p>
	137
	138	<h3>Commands</h3>
	139
	140	<h4><code>begin</code> ... <code>end</code></h4>
	141
	142	<p>Commands can be sequentially composed into a single compound command
	143	by the <code>begin</code>...<code>end</code> construct.</p>
	144
	145	<h4><code>var</code> name <code>in</code> cmd</h4>
	146
	147	<p>The <code>var</code> construct declares a new updatable variable.
	148	Variables must be declared before they are used or assigned.</p>
	149
	150	<h4><code>print</code> expr</h4>
	151
	152	<p>The <code>print</code> command evaluates expr and, if the result is
	153	between 0 and 255, produces a character with that ASCII value on the
	154	standard output channel. The behaviour for other integers is not
	155	defined.</p>
	156
	157	<h2>Grammar</h2>
	158
	159	<pre>Command ::= "if" BoolExpr "then" Command "else" Command
	160	\| "while" BoolExpr "do" Command
	161	\| "begin" Command {";" Command} "end"
	162	\| "var" VarName "in" Command
	163	\| "print" NumExpr
	164	\| VarName ":=" NumExpr.
	165
	166	BoolExpr ::= RelExpr {("&" \| "\|") RelExpr}
	167	\| "!" BoolExpr
	168	\| "(" BoolExpr ")".
	169
	170	RelExpr ::= NumExpr (">" \| "<" \| ">=" \| "<=" \| "=" \| "/=") NumExpr.
	171	NumExpr ::= MulExpr {("+" \| "-") MulExpr}.
	172	MulExpr ::= Primitive {("*" \| "/") Primitive}.
	173
	174	Primitive ::= "(" NumExpr ")"
	175	\| "if" BoolExpr "then" NumExpr "else" NumExpr
	176	\| "let" VarName "=" NumExpr "in" NumExpr
	177	\| "valueof" VarName "in" Command
	178	\| "loop" NumExpr
	179	\| "repeat"
	180	\| "input" VarName "in" NumExpr
	181	\| VarName
	182	\| NumConst.</pre>
	183
	184	<p>An Iphigeneia program, at the topmost level, is a command. (One idiom
	185	for giving "functional" Iphigeneia programs is <code>var r in r := <var>expr</var></code>,
	186	or even just <code>print <var>expr</var></code>.)
	187	Comments can be given anywhere in an Iphigeneia program by enclosing them in
	188	<code>(</code> and <code>)</code>. Do not expect comments to nest.</p>
	189
	190	<h2>Implementation</h2>
	191
	192	<p>There is a reference implementation of Iphigeneia written in Haskell 98.
	193	It has been tested with ghc and Hugs, against a series of test cases which are
	194	included with the distribution.</p>
	195
	196	<p>The reference implementation actually contains two interpreters.
	197	One is a monadic interpreter, which supports the I/O facilities of Iphigeneia.
	198	The other is a "pure" interpreter, which is written without the use of
	199	monadic types; it does not support I/O, but its code may be easier to
	200	follow. The pure interpreter always binds the name that occurs in a
	201	<code>input</code> construct to zero, and it does not even evaluate the expressions
	202	in <code>print</code> commands.</p>
	203
	204	<p>Compiling the reference implementation with ghc produces an executable
	205	<code>iphi</code> which takes the following command-line options:</p>
	206
	207	<ul>
	208	<li><code>-p</code> uses the pure interpreter instead of the default monadic
	209	interpreter.</li>
	210	<li><code>-q</code> suppresses the output of the final state of the program
	211	upon termination.</li>
	212	</ul>
	213
	214	<p>The reference interpreter is mostly written in a straightforward
	215	(sometimes painfully straightforward) manner (except for, arguably, <code>Main.hs</code>,
	216	which does some ugly things with continuations.) It provides its own implementation
	217	of maps (environments) in <code>Map.hs</code>, instead of using Haskell's
	218	<code>Data.Map</code>, to make the definition of the language more explicit.
	219	The code is also released under a BSD-style license.
	220	So, even though Iphigeneia is not a particularly exciting language, this interpreter
	221	might serve as a good starting point for experimenting with unusual features to add
	222	to an otherwise relatively vanilla imperative and/or functional language.</p>
	223
	224	<p>-Chris Pressey
	225	<br />November 25, 2007
	226	<br />Chicago, Illinois</p>
	227
	228	</body></html>

+70

-0

src/AST.hs less more

	0	--
	1	-- Copyright (c)2007 Chris Pressey, Cat's Eye Technologies.
	2	-- All rights reserved.
	3	--
	4	-- Redistribution and use in source and binary forms, with or without
	5	-- modification, are permitted provided that the following conditions
	6	-- are met:
	7	--
	8	-- 1. Redistributions of source code must retain the above copyright
	9	-- notices, this list of conditions and the following disclaimer.
	10	-- 2. Redistributions in binary form must reproduce the above copyright
	11	-- notices, this list of conditions, and the following disclaimer in
	12	-- the documentation and/or other materials provided with the
	13	-- distribution.
	14	-- 3. Neither the names of the copyright holders nor the names of their
	15	-- contributors may be used to endorse or promote products derived
	16	-- from this software without specific prior written permission.
	17	--
	18	-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
	19	-- ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
	20	-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
	21	-- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
	22	-- COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
	23	-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
	24	-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
	25	-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
	26	-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	27	-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
	28	-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	29	-- POSSIBILITY OF SUCH DAMAGE.
	30	--
	31
	32	-----------------------------------------------------------------------
	33	-- ============================== AST ============================== --
	34	-----------------------------------------------------------------------
	35
	36	module AST where
	37
	38	import Primitive
	39
	40	data VarName = VarName String
	41	deriving (Eq, Ord)
	42
	43	instance Show VarName where
	44	show (VarName s) = s
	45
	46	data BoolExpr = BoolOp BoolOp BoolExpr BoolExpr
	47	\| RelOp RelOp NumExpr NumExpr
	48	\| Not BoolExpr
	49	\| BoolConst Bool
	50	deriving (Eq, Ord, Show)
	51
	52	data NumExpr = NumOp NumOp NumExpr NumExpr
	53	\| NumConst Integer
	54	\| IfExpr BoolExpr NumExpr NumExpr
	55	\| VarRef VarName
	56	\| ValueOf VarName Statement
	57	\| Let VarName NumExpr NumExpr
	58	\| Loop NumExpr
	59	\| Repeat
	60	\| Input VarName NumExpr
	61	deriving (Eq, Ord, Show)
	62
	63	data Statement = Block [Statement]
	64	\| Var VarName Statement
	65	\| Assign VarName NumExpr
	66	\| IfStmt BoolExpr Statement Statement
	67	\| While BoolExpr Statement
	68	\| Print NumExpr
	69	deriving (Eq, Ord, Show)

+153

-0

src/Check.hs less more

	0	--
	1	-- Copyright (c)2007 Chris Pressey, Cat's Eye Technologies.
	2	-- All rights reserved.
	3	--
	4	-- Redistribution and use in source and binary forms, with or without
	5	-- modification, are permitted provided that the following conditions
	6	-- are met:
	7	--
	8	-- 1. Redistributions of source code must retain the above copyright
	9	-- notices, this list of conditions and the following disclaimer.
	10	-- 2. Redistributions in binary form must reproduce the above copyright
	11	-- notices, this list of conditions, and the following disclaimer in
	12	-- the documentation and/or other materials provided with the
	13	-- distribution.
	14	-- 3. Neither the names of the copyright holders nor the names of their
	15	-- contributors may be used to endorse or promote products derived
	16	-- from this software without specific prior written permission.
	17	--
	18	-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
	19	-- ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
	20	-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
	21	-- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
	22	-- COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
	23	-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
	24	-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
	25	-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
	26	-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	27	-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
	28	-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	29	-- POSSIBILITY OF SUCH DAMAGE.
	30	--
	31
	32	-----------------------------------------------------------------------
	33	-- ==================== Static Semantic Checker ==================== --
	34	-----------------------------------------------------------------------
	35
	36	--
	37	-- The static semantic checker returns a list of errors.
	38	--
	39
	40	module Check where
	41
	42	import Map
	43	import AST
	44
	45	data VarInfo = Undeclared
	46	\| Updatable
	47	\| SingleAssignment
	48	deriving (Eq, Show)
	49
	50	--
	51	-- Helper functions
	52	--
	53
	54	checkExists v env
	55	\| (get v env Undeclared) == Undeclared =
	56	["Variable " ++ (show v) ++ " not in scope"]
	57	\| otherwise =
	58	[]
	59
	60	checkAvailable v env
	61	\| (get v env Undeclared) /= Undeclared =
	62	["Variable " ++ (show v) ++ " already declared"]
	63	\| otherwise =
	64	[]
	65
	66	checkStore v env
	67	\| (get v env Undeclared) == Undeclared =
	68	["Variable " ++ (show v) ++ " not in scope"]
	69	\| (get v env Undeclared) /= Updatable =
	70	["Variable " ++ (show v) ++ " not updatable"]
	71	\| otherwise =
	72	[]
	73
	74	--
	75	-- The checker proper
	76	--
	77
	78	--
	79	-- Currently we allow shadowing in let, valueof, and input, but not in var.
	80	-- We could disallow it everywhere by adding:
	81	-- declErrs = checkAvailable v env
	82	-- in checkNumExpr (Let ...) and (ValueOf ...),
	83	--
	84
	85	checkBoolExpr (BoolOp op b1 b2) env = (checkBoolExpr b1 env) ++ (checkBoolExpr b2 env)
	86	checkBoolExpr (RelOp op e1 e2) env = (checkNumExpr e1 env) ++ (checkNumExpr e2 env)
	87	checkBoolExpr (Not b) env = checkBoolExpr b env
	88	checkBoolExpr (BoolConst b) env = []
	89
	90	checkNumExpr (NumOp op e1 e2) env = (checkNumExpr e1 env) ++ (checkNumExpr e2 env)
	91	checkNumExpr (NumConst i) env = []
	92	checkNumExpr (VarRef v) env = checkExists v env
	93	checkNumExpr (IfExpr b e1 e2) env = (checkBoolExpr b env) ++
	94	(checkNumExpr e1 env) ++ (checkNumExpr e2 env)
	95	checkNumExpr (Let v e1 e2) env =
	96	let
	97	exprErrs = checkNumExpr e1 env
	98	newEnv = set v SingleAssignment env
	99	bodyErrs = checkNumExpr e2 newEnv
	100	in
	101	exprErrs ++ bodyErrs
	102
	103	checkNumExpr (ValueOf v s) env =
	104	let
	105	newEnv = set v Updatable env
	106	bodyErrs = checkStatement s newEnv
	107	in
	108	bodyErrs
	109
	110	checkNumExpr (Input v e) env =
	111	let
	112	newEnv = set v SingleAssignment env
	113	bodyErrs = checkNumExpr e newEnv
	114	in
	115	bodyErrs
	116
	117	checkNumExpr (Loop e) env = checkNumExpr e env
	118	checkNumExpr (Repeat) env = []
	119
	120	checkStatement (Block []) env =
	121	[]
	122	checkStatement (Block (s:rest)) env =
	123	(checkStatement s env) ++ (checkStatement (Block rest) env)
	124
	125	checkStatement (Var v s) env =
	126	let
	127	declErrs = checkAvailable v env
	128	newEnv = set v Updatable env
	129	stmtErrs = checkStatement s newEnv
	130	in
	131	declErrs ++ stmtErrs
	132
	133	checkStatement (Assign v e) env =
	134	(checkNumExpr e env) ++ (checkStore v env)
	135
	136	checkStatement (IfStmt b s1 s2) env =
	137	let
	138	exprErrs = checkBoolExpr b env
	139	s1Errs = checkStatement s1 env
	140	s2Errs = checkStatement s2 env
	141	in
	142	exprErrs ++ s1Errs ++ s2Errs
	143
	144	checkStatement (While b s) env =
	145	let
	146	exprErrs = checkBoolExpr b env
	147	bodyErrs = checkStatement s env
	148	in
	149	exprErrs ++ bodyErrs
	150
	151	checkStatement (Print e) env =
	152	checkNumExpr e env

+143

-0

src/Main.hs less more

	0	--
	1	-- Copyright (c)2007 Chris Pressey, Cat's Eye Technologies.
	2	-- All rights reserved.
	3	--
	4	-- Redistribution and use in source and binary forms, with or without
	5	-- modification, are permitted provided that the following conditions
	6	-- are met:
	7	--
	8	-- 1. Redistributions of source code must retain the above copyright
	9	-- notices, this list of conditions and the following disclaimer.
	10	-- 2. Redistributions in binary form must reproduce the above copyright
	11	-- notices, this list of conditions, and the following disclaimer in
	12	-- the documentation and/or other materials provided with the
	13	-- distribution.
	14	-- 3. Neither the names of the copyright holders nor the names of their
	15	-- contributors may be used to endorse or promote products derived
	16	-- from this software without specific prior written permission.
	17	--
	18	-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
	19	-- ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
	20	-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
	21	-- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
	22	-- COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
	23	-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
	24	-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
	25	-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
	26	-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	27	-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
	28	-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	29	-- POSSIBILITY OF SUCH DAMAGE.
	30	--
	31
	32	-----------------------------------------------------------------------
	33	-- ============================== Main ============================= --
	34	-----------------------------------------------------------------------
	35
	36	import System
	37
	38	import Map
	39	import AST
	40	import qualified PureInterp
	41	import qualified MonadInterp
	42	import Parser
	43	import Check
	44
	45	--
	46	-- Utilities
	47	--
	48
	49	--
	50	-- Wrap the pure interpreter in a token monad (token in the sense of
	51	-- inconsequential :) so that it has a type compatible with the monadic
	52	-- interpreter.
	53	--
	54
	55	pureInterpret prog map = do return (PureInterp.interpret prog map)
	56
	57	--
	58	-- Parse and check the program. If it's all OK, execute the given executor
	59	-- function (continuation) on the resultant AST. If it's not, execute the
	60	-- given failure function (another continuation) on the resultant error list.
	61	--
	62
	63	parseThen programText executor failureHandler =
	64	let
	65	(_, program) = parse programText
	66	errors = checkStatement program EmptyMap
	67	in
	68	case errors of
	69	[] ->
	70	executor program
	71	_ ->
	72	failureHandler errors
	73
	74	--
	75	-- Useful functions to call from the Hugs interactive prompt.
	76	--
	77
	78	run programText =
	79	runWith programText MonadInterp.interpret False
	80
	81	parseFile fileName = do
	82	programText <- readFile fileName
	83	(_, program) <- do return (parse programText)
	84	putStr (show program)
	85
	86	--
	87	-- Program execution
	88	--
	89
	90	runWith programText interpreter quiet =
	91	parseThen programText executor failureHandler
	92	where
	93	executor program = do
	94	result <- interpreter program EmptyMap
	95	putStr (if quiet then "" else (show result))
	96	failureHandler errors = do
	97	putStr ((show errors) ++ "\n")
	98
	99	runFileWith fileName interpreter quiet = do
	100	programText <- readFile fileName
	101	runWith programText interpreter quiet
	102
	103	--
	104	-- Main entry point, so that we can build an executable using ghc.
	105	-- When running the interpreter under hugs, it's not needed, as the
	106	-- run function can be called directly from the interactive prompt.
	107	--
	108
	109	main = do
	110	args <- getArgs
	111	(interpreter, quiet, fileName)
	112	<- processArgs args (MonadInterp.interpret) False ""
	113	case fileName of
	114	"" ->
	115	usage
	116	_ ->
	117	runFileWith fileName interpreter quiet
	118
	119	processArgs ("-p":rest) _ quiet fileName =
	120	processArgs rest (pureInterpret) quiet fileName
	121
	122	processArgs ("-q":rest) interpreter _ fileName =
	123	processArgs rest interpreter True fileName
	124
	125	processArgs (('-':unknownFlag):rest) interpreter quiet _ = do
	126	putStr ("Unknown command-line option: " ++ unknownFlag ++ "\n")
	127	return (interpreter, quiet, "")
	128
	129	processArgs (fileName:rest) interpreter quiet _ = do
	130	processArgs rest interpreter quiet fileName
	131
	132	processArgs [] interpreter quiet fileName = do
	133	return (interpreter, quiet, fileName)
	134
	135	usage = do
	136	putStr "iphi 2007.1125 - reference interpreter for Iphigeneia 1.0\n"
	137	putStr "(c)2007 Cat's Eye Technologies. All rights reserved.\n\n"
	138	putStr "Usage:\n"
	139	putStr " iphi [-p] [-q] filename\n"
	140	putStr "where\n"
	141	putStr " -p: use pure interpreter (no IO)\n"
	142	putStr " -q: don't dump final state of program to output\n"

+55

-0

src/Makefile less more

	0	# Makefile for iphi.
	1	# $Id$
	2
	3	HC=ghc
	4	# -O
	5	HCFLAGS=
	6	O=.o
	7	PROG=iphi
	8
	9	OBJS= AST${O} \
	10	Check${O} \
	11	PureInterp${O} \
	12	MonadInterp${O} \
	13	Map${O} \
	14	Main${O} \
	15	Parser${O} \
	16	Primitive${O} \
	17	Scanner${O}
	18
	19	all: ${PROG}
	20
	21	AST${O}: AST.hs Primitive${O}
	22	${HC} ${HCFLAGS} -c $*.hs
	23
	24	Check${O}: Check.hs Map${O} AST${O}
	25	${HC} ${HCFLAGS} -c $*.hs
	26
	27	Map${O}: Map.hs
	28	${HC} ${HCFLAGS} -c $*.hs
	29
	30	Main${O}: Main.hs Check${O} Parser${O} PureInterp${O}
	31	${HC} ${HCFLAGS} -c $*.hs
	32
	33	PureInterp${O}: PureInterp.hs Map${O} Primitive${O} AST${O}
	34	${HC} ${HCFLAGS} -c $*.hs
	35
	36	MonadInterp${O}: MonadInterp.hs Map${O} Primitive${O} AST${O}
	37	${HC} ${HCFLAGS} -c $*.hs
	38
	39	Scanner${O}: Scanner.hs
	40	${HC} ${HCFLAGS} -c $*.hs
	41
	42	Parser${O}: Parser.hs Scanner${O}
	43	${HC} ${HCFLAGS} -c $*.hs
	44
	45	Primitive${O}: Primitive.hs
	46	${HC} ${HCFLAGS} -c $*.hs
	47
	48
	49	${PROG}: ${OBJS}
	50	${HC} -o ${PROG} -O ${OBJS}
	51	strip ${PROG}
	52
	53	clean:
	54	rm -rf .o .hi iphi

+68

-0

src/Map.hs less more

	0	--
	1	-- Copyright (c)2007 Chris Pressey, Cat's Eye Technologies.
	2	-- All rights reserved.
	3	--
	4	-- Redistribution and use in source and binary forms, with or without
	5	-- modification, are permitted provided that the following conditions
	6	-- are met:
	7	--
	8	-- 1. Redistributions of source code must retain the above copyright
	9	-- notices, this list of conditions and the following disclaimer.
	10	-- 2. Redistributions in binary form must reproduce the above copyright
	11	-- notices, this list of conditions, and the following disclaimer in
	12	-- the documentation and/or other materials provided with the
	13	-- distribution.
	14	-- 3. Neither the names of the copyright holders nor the names of their
	15	-- contributors may be used to endorse or promote products derived
	16	-- from this software without specific prior written permission.
	17	--
	18	-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
	19	-- ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
	20	-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
	21	-- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
	22	-- COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
	23	-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
	24	-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
	25	-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
	26	-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	27	-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
	28	-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	29	-- POSSIBILITY OF SUCH DAMAGE.
	30	--
	31
	32	-----------------------------------------------------------------------
	33	-- ============================== Maps ============================= --
	34	-----------------------------------------------------------------------
	35
	36	--
	37	-- These can be used as environments, stores, etc.
	38	--
	39
	40	module Map where
	41
	42	data Map k v = Binding k v (Map k v)
	43	\| EmptyMap
	44	deriving (Eq, Ord)
	45
	46	get _ EmptyMap def = def
	47	get key (Binding key' val map) def
	48	\| key == key' = val
	49	\| otherwise = get key map def
	50
	51	set key val map = Binding key val (strip key map)
	52
	53	strip key EmptyMap = EmptyMap
	54	strip key (Binding key' val map)
	55	\| key == key' = strip key map
	56	\| otherwise = Binding key' val (strip key map)
	57
	58	--
	59	-- Entries in second map override those in first map.
	60	--
	61	merge map EmptyMap = map
	62	merge map (Binding key val rest) =
	63	merge (set key val map) rest
	64
	65	instance (Show k, Show v) => Show (Map k v) where
	66	show EmptyMap = ""
	67	show (Binding k v map) = (show k) ++ "=" ++ (show v) ++ "\n" ++ show map

+153

-0

src/MonadInterp.hs less more

	0	--
	1	-- Copyright (c)2007 Chris Pressey, Cat's Eye Technologies.
	2	-- All rights reserved.
	3	--
	4	-- Redistribution and use in source and binary forms, with or without
	5	-- modification, are permitted provided that the following conditions
	6	-- are met:
	7	--
	8	-- 1. Redistributions of source code must retain the above copyright
	9	-- notices, this list of conditions and the following disclaimer.
	10	-- 2. Redistributions in binary form must reproduce the above copyright
	11	-- notices, this list of conditions, and the following disclaimer in
	12	-- the documentation and/or other materials provided with the
	13	-- distribution.
	14	-- 3. Neither the names of the copyright holders nor the names of their
	15	-- contributors may be used to endorse or promote products derived
	16	-- from this software without specific prior written permission.
	17	--
	18	-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
	19	-- ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
	20	-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
	21	-- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
	22	-- COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
	23	-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
	24	-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
	25	-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
	26	-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	27	-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
	28	-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	29	-- POSSIBILITY OF SUCH DAMAGE.
	30	--
	31
	32	-----------------------------------------------------------------------
	33	-- ======================= Monadic Interpreter ===================== --
	34	-----------------------------------------------------------------------
	35
	36	--
	37	-- This interpreter performs I/O. It is not as straightforward as
	38	-- PureInterp, as it must frame every function in terms of IO monads,
	39	-- which tends to obscure the logic of the interpreter somewhat.
	40	--
	41
	42	module MonadInterp where
	43
	44	import qualified Data.Char as Char
	45
	46	import Map
	47	import AST
	48	import Primitive
	49
	50	--
	51	-- The eval* functions are passed a store and a continuation (cc).
	52	--
	53	-- The store maps VarName objects to their values (Integers).
	54	--
	55	-- The continuation is used with the loop and repeat constructs.
	56	-- It is not a full-blown continuation in the sense of being a
	57	-- function which represents the entire rest of the computation.
	58	-- Rather, it represents only the matchings between occurrences
	59	-- of loop and occurrences of repeat.
	60	--
	61	-- The continuation is implemented as list of NumExprs, where the
	62	-- head NumExpr is the most recently encountered (innermost) loop
	63	-- expression. Each loop expression extends the continuation with
	64	-- the expression being looped around, and a repeat expression
	65	-- executes the continuation.
	66	--
	67
	68	evalBool :: BoolExpr -> Map VarName Integer -> [NumExpr] -> IO Bool
	69
	70	evalBool (BoolOp op b1 b2) store cc = do
	71	val1 <- evalBool b1 store cc
	72	val2 <- evalBool b2 store cc
	73	return (applyBoolOp op val1 val2)
	74
	75	evalBool (RelOp op e1 e2) store cc = do
	76	val1 <- evalNum e1 store cc
	77	val2 <- evalNum e2 store cc
	78	return (applyRelOp op val1 val2)
	79
	80	evalBool (Not b) store cc = do
	81	val <- evalBool b store cc
	82	return (not val)
	83
	84	evalBool (BoolConst b) store cc = do
	85	return b
	86
	87
	88	evalNum :: NumExpr -> Map VarName Integer -> [NumExpr] -> IO Integer
	89
	90	evalNum (NumOp op e1 e2) store cc = do
	91	val1 <- evalNum e1 store cc
	92	val2 <- evalNum e2 store cc
	93	return (applyNumOp op val1 val2)
	94
	95	evalNum (NumConst i) store cc = do
	96	return i
	97
	98	evalNum (IfExpr b e1 e2) store cc = do
	99	result <- evalBool b store cc
	100	evalNum (if result then e1 else e2) store cc
	101
	102	evalNum (VarRef v) store cc = do
	103	return (get v store 0)
	104
	105	evalNum (Let v e1 e2) store cc = do
	106	val <- evalNum e1 store cc
	107	evalNum e2 (set v val store) cc
	108
	109	evalNum (Loop e) store cc = evalNum e store ((Loop e):cc)
	110	evalNum (Repeat) store cc = evalNum (head cc) store (tail cc)
	111
	112	evalNum (ValueOf v s) store cc = do
	113	newStore <- interpret s store
	114	return (get v newStore 0)
	115
	116	evalNum (Input v e) store cc = do
	117	symbol <- getChar
	118	evalNum e (set v (Prelude.fromIntegral (Char.ord symbol)) store) cc
	119
	120
	121	interpret :: Statement -> Map VarName Integer -> IO (Map VarName Integer)
	122
	123	interpret (Block []) store = do
	124	return store
	125	interpret (Block (s:rest)) store = do
	126	newStore <- interpret s store
	127	interpret (Block rest) newStore
	128
	129	interpret (Var v s) store = interpret s store
	130
	131	interpret (Assign v e) store = do
	132	val <- evalNum e store []
	133	return (set v val store)
	134
	135	interpret (IfStmt b s1 s2) store = do
	136	result <- evalBool b store []
	137	interpret (if result then s1 else s2) store
	138
	139	interpret (While b s) store = do
	140	result <- evalBool b store []
	141	loop result
	142	where
	143	loop True = do
	144	newStore <- interpret s store
	145	interpret (While b s) newStore
	146	loop False = do
	147	return store
	148
	149	interpret (Print e) store = do
	150	val <- evalNum e store []
	151	putChar (Char.chr (Prelude.fromIntegral val))
	152	return store

+310

-0

src/Parser.hs less more

	0	--
	1	-- Copyright (c)2007 Chris Pressey, Cat's Eye Technologies.
	2	-- All rights reserved.
	3	--
	4	-- Redistribution and use in source and binary forms, with or without
	5	-- modification, are permitted provided that the following conditions
	6	-- are met:
	7	--
	8	-- 1. Redistributions of source code must retain the above copyright
	9	-- notices, this list of conditions and the following disclaimer.
	10	-- 2. Redistributions in binary form must reproduce the above copyright
	11	-- notices, this list of conditions, and the following disclaimer in
	12	-- the documentation and/or other materials provided with the
	13	-- distribution.
	14	-- 3. Neither the names of the copyright holders nor the names of their
	15	-- contributors may be used to endorse or promote products derived
	16	-- from this software without specific prior written permission.
	17	--
	18	-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
	19	-- ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
	20	-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
	21	-- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
	22	-- COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
	23	-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
	24	-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
	25	-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
	26	-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	27	-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
	28	-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	29	-- POSSIBILITY OF SUCH DAMAGE.
	30	--
	31
	32	-----------------------------------------------------------------------
	33	-- ============================== Parser =========================== --
	34	-----------------------------------------------------------------------
	35
	36	module Parser where
	37
	38	import Scanner
	39	import Primitive
	40	import AST
	41
	42	--
	43	-- Utility
	44	--
	45
	46	expect [] l = l
	47	expect (x:xs) (y:ys)
	48	\| x == y =
	49	expect xs ys
	50
	51	--
	52	-- Statement ::= "if" BoolExpr "then" Statement "else" Statement
	53	-- \| "while" BoolExpr "do" Statement
	54	-- \| "begin" Statement {";" Statement} "end"
	55	-- \| "var" VarName "in" Statement
	56	-- \| "print" NumExpr
	57	-- \| VarName ":=" NumExpr
	58	--
	59
	60	parseStatement (IfToken:tokens) =
	61	let
	62	(tokens2, be) = parseBoolExpr tokens
	63	tokens3 = expect [ThenToken] tokens2
	64	(tokens4, s1) = parseStatement tokens3
	65	tokens5 = expect [ElseToken] tokens4
	66	(tokens6, s2) = parseStatement tokens5
	67	in
	68	(tokens6, IfStmt be s1 s2)
	69
	70	parseStatement (VarToken:tokens) =
	71	let
	72	((Ident ident):tokens2) = tokens
	73	v = VarName ident
	74	tokens3 = expect [InToken] tokens2
	75	(tokens4, s) = parseStatement tokens3
	76	in
	77	(tokens4, Var v s)
	78
	79	parseStatement (WhileToken:tokens) =
	80	let
	81	(tokens2, be) = parseBoolExpr tokens
	82	tokens3 = expect [DoToken] tokens2
	83	(tokens4, s) = parseStatement tokens3
	84	in
	85	(tokens4, While be s)
	86
	87	parseStatement (PrintToken:tokens) =
	88	let
	89	(tokens2, ne) = parseNumExpr tokens
	90	in
	91	(tokens2, Print ne)
	92
	93	parseStatement ((Ident s):tokens) =
	94	let
	95	v = VarName s
	96	tokens2 = expect [BecomesToken] tokens
	97	(tokens3, ne) = parseNumExpr tokens2
	98	in
	99	(tokens3, Assign v ne)
	100
	101	parseStatement (BeginToken:tokens) =
	102	let
	103	(tokens2, stmtList) = parseStmtList tokens []
	104	in
	105	(tokens2, Block (reverse stmtList))
	106
	107	parseStmtList tokens acc =
	108	let
	109	(tokens2, s) = parseStatement tokens
	110	in
	111	case tokens2 of
	112	(StmtSepToken:rest) ->
	113	parseStmtList rest (s : acc)
	114	(EndToken:rest) ->
	115	(rest, (s:acc))
	116
	117	--
	118	-- NumExpr ::= AddExpr.
	119	--
	120
	121	parseNumExpr tokens = parseAddExpr tokens
	122
	123	--
	124	-- AddExpr ::= MulExpr {("+" \| "-") MulExpr}.
	125	--
	126
	127	parseAddExpr tokens =
	128	let
	129	(tokens2, lhs) = parseMulExpr tokens
	130	in
	131	parseAddExprTail tokens2 lhs
	132
	133	parseAddExprTail (AddToken:tokens) lhs =
	134	let
	135	(tokens2, rhs) = parseMulExpr tokens
	136	newLhs = NumOp Add lhs rhs
	137	in
	138	parseAddExprTail tokens2 newLhs
	139
	140	parseAddExprTail (SubtractToken:tokens) lhs =
	141	let
	142	(tokens2, rhs) = parseMulExpr tokens
	143	newLhs = NumOp Subtract lhs rhs
	144	in
	145	parseAddExprTail tokens2 newLhs
	146
	147	parseAddExprTail tokens e = (tokens, e)
	148
	149	--
	150	-- MulExpr ::= Primitive {("*" \| "/") Primitive}.
	151	--
	152
	153	parseMulExpr tokens =
	154	let
	155	(tokens2, lhs) = parsePrimitive tokens
	156	in
	157	parseMulExprTail tokens2 lhs
	158
	159	parseMulExprTail (MultiplyToken:tokens) lhs =
	160	let
	161	(tokens2, rhs) = parsePrimitive tokens
	162	newLhs = NumOp Multiply lhs rhs
	163	in
	164	parseMulExprTail tokens2 newLhs
	165
	166	parseMulExprTail (DivideToken:tokens) lhs =
	167	let
	168	(tokens2, rhs) = parsePrimitive tokens
	169	newLhs = NumOp Divide lhs rhs
	170	in
	171	parseMulExprTail tokens2 newLhs
	172
	173	parseMulExprTail tokens e = (tokens, e)
	174
	175	--
	176	-- Primitive ::= "(" NumExpr ")"
	177	-- \| "if" BoolExpr "then" NumExpr "else" NumExpr
	178	-- \| "let" VarName "=" NumExpr "in" NumExpr
	179	-- \| "valueof" VarName "in" Statement
	180	-- \| "loop" NumExpr
	181	-- \| "repeat"
	182	-- \| "input" VarName "in" NumExpr
	183	-- \| VarName
	184	-- \| NumConst.
	185	--
	186
	187	parsePrimitive (OpenParenToken:tokens) =
	188	let
	189	(tokens2, ne) = parseNumExpr tokens
	190	tokens3 = expect [CloseParenToken] tokens2
	191	in
	192	(tokens3, ne)
	193
	194	parsePrimitive (IfToken:tokens) =
	195	let
	196	(tokens2, be) = parseBoolExpr tokens
	197	tokens3 = expect [ThenToken] tokens2
	198	(tokens4, e1) = parseNumExpr tokens3
	199	tokens5 = expect [ElseToken] tokens4
	200	(tokens6, e2) = parseNumExpr tokens5
	201	in
	202	(tokens6, IfExpr be e1 e2)
	203
	204	parsePrimitive (LetToken:tokens) =
	205	let
	206	((Ident ident):tokens2) = tokens
	207	v = VarName ident
	208	tokens3 = expect [EqualToken] tokens2
	209	(tokens4, e1) = parseNumExpr tokens3
	210	tokens5 = expect [InToken] tokens4
	211	(tokens6, e2) = parseNumExpr tokens5
	212	in
	213	(tokens6, Let v e1 e2)
	214
	215	parsePrimitive (ValueOfToken:tokens) =
	216	let
	217	((Ident ident):tokens2) = tokens
	218	v = VarName ident
	219	tokens3 = expect [InToken] tokens2
	220	(tokens4, s) = parseStatement tokens3
	221	in
	222	(tokens4, ValueOf v s)
	223
	224	parsePrimitive (LoopToken:tokens) =
	225	let
	226	(tokens2, e) = parseNumExpr tokens
	227	in
	228	(tokens2, Loop e)
	229
	230	parsePrimitive (RepeatToken:tokens) = (tokens, Repeat)
	231
	232	parsePrimitive (InputToken:tokens) =
	233	let
	234	((Ident ident):tokens2) = tokens
	235	v = VarName ident
	236	tokens3 = expect [InToken] tokens2
	237	(tokens4, ne) = parseNumExpr tokens3
	238	in
	239	(tokens4, Input v ne)
	240
	241	parsePrimitive ((IntLit i):tokens) = (tokens, NumConst i)
	242
	243	parsePrimitive ((Ident s):tokens) = (tokens, (VarRef (VarName s)))
	244
	245	--
	246	-- BoolExpr ::= RelExpr {("&" \| "\|") RelExpr}
	247	-- \| "not" BoolExpr
	248	-- \| "(" BoolExpr ")".
	249	--
	250
	251	parseBoolExpr (NotToken:tokens) =
	252	let
	253	(tokens2, be) = parseBoolExpr tokens
	254	in
	255	(tokens2, Not be)
	256
	257	parseBoolExpr (OpenParenToken:tokens) =
	258	let
	259	(tokens2, be) = parseBoolExpr tokens
	260	tokens3 = expect [CloseParenToken] tokens2
	261	in
	262	(tokens3, be)
	263
	264	parseBoolExpr tokens =
	265	let
	266	(tokens2, lhs) = parseRelExpr tokens
	267	in
	268	parseBoolExprTail tokens2 lhs
	269
	270	parseBoolExprTail (AndToken:tokens) lhs =
	271	let
	272	(tokens2, rhs) = parseRelExpr tokens
	273	newLhs = BoolOp And lhs rhs
	274	in
	275	parseBoolExprTail tokens2 newLhs
	276
	277	parseBoolExprTail (OrToken:tokens) lhs =
	278	let
	279	(tokens2, rhs) = parseRelExpr tokens
	280	newLhs = BoolOp Or lhs rhs
	281	in
	282	parseBoolExprTail tokens2 newLhs
	283
	284	parseBoolExprTail tokens be = (tokens, be)
	285
	286	--
	287	-- RelExpr ::= NumExpr (">" \| "<" \| ">=" \| "<=" \| "=" \| "/=") NumExpr.
	288	--
	289
	290	parseRelExpr tokens =
	291	let
	292	(tokens2, lhs) = parseNumExpr tokens
	293	(tokens3, relOp) = relOpForSym tokens2
	294	(tokens4, rhs) = parseNumExpr tokens3
	295	in
	296	(tokens4, RelOp relOp lhs rhs)
	297
	298	relOpForSym (GreaterThanToken:tokens) = (tokens, GreaterThan)
	299	relOpForSym (GreaterThanOrEqualToken:tokens) = (tokens, GreaterThanOrEqual)
	300	relOpForSym (EqualToken:tokens) = (tokens, Equal)
	301	relOpForSym (NotEqualToken:tokens) = (tokens, NotEqual)
	302	relOpForSym (LessThanToken:tokens) = (tokens, LessThan)
	303	relOpForSym (LessThanOrEqualToken:tokens) = (tokens, LessThanOrEqual)
	304
	305	--
	306	-- Driver
	307	--
	308
	309	parse string = parseStatement (tokenize string)

+69

-0

src/Primitive.hs less more

	0	--
	1	-- Copyright (c)2007 Chris Pressey, Cat's Eye Technologies.
	2	-- All rights reserved.
	3	--
	4	-- Redistribution and use in source and binary forms, with or without
	5	-- modification, are permitted provided that the following conditions
	6	-- are met:
	7	--
	8	-- 1. Redistributions of source code must retain the above copyright
	9	-- notices, this list of conditions and the following disclaimer.
	10	-- 2. Redistributions in binary form must reproduce the above copyright
	11	-- notices, this list of conditions, and the following disclaimer in
	12	-- the documentation and/or other materials provided with the
	13	-- distribution.
	14	-- 3. Neither the names of the copyright holders nor the names of their
	15	-- contributors may be used to endorse or promote products derived
	16	-- from this software without specific prior written permission.
	17	--
	18	-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
	19	-- ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
	20	-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
	21	-- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
	22	-- COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
	23	-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
	24	-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
	25	-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
	26	-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	27	-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
	28	-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	29	-- POSSIBILITY OF SUCH DAMAGE.
	30	--
	31
	32	-----------------------------------------------------------------------
	33	-- ===================== Primitive Operations ====================== --
	34	-----------------------------------------------------------------------
	35
	36	module Primitive where
	37
	38	data NumOp = Add \| Subtract \| Multiply \| Divide
	39	deriving (Eq, Ord, Show)
	40
	41	applyNumOp Add a b = a + b
	42	applyNumOp Subtract a b = a - b
	43	applyNumOp Multiply a b = a * b
	44	applyNumOp Divide a b = a `div` b
	45
	46	data RelOp = GreaterThan \| GreaterThanOrEqual
	47	\| Equal \| NotEqual \| LessThan \| LessThanOrEqual
	48	deriving (Eq, Ord, Show)
	49
	50	applyRelOp GreaterThan a b = a > b
	51	applyRelOp GreaterThanOrEqual a b = a >= b
	52	applyRelOp Equal a b = a == b
	53	applyRelOp NotEqual a b = a /= b
	54	applyRelOp LessThan a b = a < b
	55	applyRelOp LessThanOrEqual a b = a <= b
	56
	57	dualRelOp GreaterThan = LessThanOrEqual
	58	dualRelOp GreaterThanOrEqual = LessThan
	59	dualRelOp Equal = NotEqual
	60	dualRelOp NotEqual = Equal
	61	dualRelOp LessThan = GreaterThanOrEqual
	62	dualRelOp LessThanOrEqual = GreaterThan
	63
	64	data BoolOp = And \| Or
	65	deriving (Eq, Ord, Show)
	66
	67	applyBoolOp And a b = a && b
	68	applyBoolOp Or a b = a \|\| b

+104

-0

src/PureInterp.hs less more

	0	--
	1	-- Copyright (c)2007 Chris Pressey, Cat's Eye Technologies.
	2	-- All rights reserved.
	3	--
	4	-- Redistribution and use in source and binary forms, with or without
	5	-- modification, are permitted provided that the following conditions
	6	-- are met:
	7	--
	8	-- 1. Redistributions of source code must retain the above copyright
	9	-- notices, this list of conditions and the following disclaimer.
	10	-- 2. Redistributions in binary form must reproduce the above copyright
	11	-- notices, this list of conditions, and the following disclaimer in
	12	-- the documentation and/or other materials provided with the
	13	-- distribution.
	14	-- 3. Neither the names of the copyright holders nor the names of their
	15	-- contributors may be used to endorse or promote products derived
	16	-- from this software without specific prior written permission.
	17	--
	18	-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
	19	-- ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
	20	-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
	21	-- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
	22	-- COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
	23	-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
	24	-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
	25	-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
	26	-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	27	-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
	28	-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	29	-- POSSIBILITY OF SUCH DAMAGE.
	30	--
	31
	32	-----------------------------------------------------------------------
	33	-- ======================== Pure Interpreter ======================= --
	34	-----------------------------------------------------------------------
	35
	36	--
	37	-- This interpreter does not do any input or output. Its purpose
	38	-- is to present a very straightforward functional explication of
	39	-- the language, uncluttered by monads.
	40	--
	41
	42	module PureInterp where
	43
	44	import Map
	45	import AST
	46	import Primitive
	47
	48	--
	49	-- The eval* functions are passed a store and a continuation (cc).
	50	--
	51	-- The store maps VarName objects to their values (Integers).
	52	--
	53	-- The continuation is used with the loop and repeat constructs.
	54	-- It is not a full-blown continuation in the sense of being a
	55	-- function which represents the entire rest of the computation.
	56	-- Rather, it represents only the matchings between occurrences
	57	-- of loop and occurrences of repeat.
	58	--
	59	-- The continuation is implemented as list of NumExprs, where the
	60	-- head NumExpr is the most recently encountered (innermost) loop
	61	-- expression. Each loop expression extends the continuation with
	62	-- the expression being looped around, and a repeat expression
	63	-- executes the continuation.
	64	--
	65
	66	evalBool (BoolOp op b1 b2) store cc = applyBoolOp op (evalBool b1 store cc) (evalBool b2 store cc)
	67	evalBool (RelOp op e1 e2) store cc = applyRelOp op (evalNum e1 store cc) (evalNum e2 store cc)
	68	evalBool (Not b) store cc = not (evalBool b store cc)
	69	evalBool (BoolConst b) store cc = b
	70
	71	evalNum (NumOp op e1 e2) store cc = applyNumOp op (evalNum e1 store cc) (evalNum e2 store cc)
	72	evalNum (NumConst i) store cc = i
	73	evalNum (IfExpr b e1 e2) store cc
	74	\| evalBool b store cc = evalNum e1 store cc
	75	\| otherwise = evalNum e2 store cc
	76
	77	evalNum (VarRef v) store cc = get v store 0
	78	evalNum (Let v e1 e2) store cc = evalNum e2 (set v (evalNum e1 store cc) store) cc
	79
	80	evalNum (Loop e) store cc = evalNum e store ((Loop e):cc)
	81	evalNum (Repeat) store cc = evalNum (head cc) store (tail cc)
	82
	83	evalNum (ValueOf v s) store cc = get v (interpret s store) 0
	84
	85	evalNum (Input v e) store cc = evalNum e (set v 0 store) cc
	86
	87	interpret (Block []) store = store
	88	interpret (Block (s:rest)) store =
	89	interpret (Block rest) (interpret s store)
	90
	91	interpret (Var v s) store = interpret s store
	92
	93	interpret (Assign v e) store = set v (evalNum e store []) store
	94
	95	interpret (IfStmt b s1 s2) store
	96	\| evalBool b store [] = interpret s1 store
	97	\| otherwise = interpret s2 store
	98
	99	interpret (While b s) store
	100	\| evalBool b store [] = interpret (While b s) (interpret s store)
	101	\| otherwise = store
	102
	103	interpret (Print e) store = store

+181

-0

src/Scanner.hs less more

	0	--
	1	-- Copyright (c)2007 Chris Pressey, Cat's Eye Technologies.
	2	-- All rights reserved.
	3	--
	4	-- Redistribution and use in source and binary forms, with or without
	5	-- modification, are permitted provided that the following conditions
	6	-- are met:
	7	--
	8	-- 1. Redistributions of source code must retain the above copyright
	9	-- notices, this list of conditions and the following disclaimer.
	10	-- 2. Redistributions in binary form must reproduce the above copyright
	11	-- notices, this list of conditions, and the following disclaimer in
	12	-- the documentation and/or other materials provided with the
	13	-- distribution.
	14	-- 3. Neither the names of the copyright holders nor the names of their
	15	-- contributors may be used to endorse or promote products derived
	16	-- from this software without specific prior written permission.
	17	--
	18	-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
	19	-- ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT
	20	-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
	21	-- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
	22	-- COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
	23	-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
	24	-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
	25	-- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
	26	-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	27	-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
	28	-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	29	-- POSSIBILITY OF SUCH DAMAGE.
	30	--
	31
	32	-----------------------------------------------------------------------
	33	-- ============================= Scanner =========================== --
	34	-----------------------------------------------------------------------
	35
	36	module Scanner where
	37
	38	import Char
	39
	40	data Token = Ident String
	41	\| IntLit Integer
	42	\| OpenCommentToken
	43	\| CloseCommentToken
	44	\| BecomesToken
	45	\| GreaterThanToken
	46	\| GreaterThanOrEqualToken
	47	\| EqualToken
	48	\| NotEqualToken
	49	\| LessThanOrEqualToken
	50	\| LessThanToken
	51	\| StmtSepToken
	52	\| AndToken
	53	\| OrToken
	54	\| NotToken
	55	\| AddToken
	56	\| SubtractToken
	57	\| MultiplyToken
	58	\| DivideToken
	59	\| OpenParenToken
	60	\| CloseParenToken
	61	\| IfToken
	62	\| ThenToken
	63	\| ElseToken
	64	\| WhileToken
	65	\| DoToken
	66	\| BeginToken
	67	\| EndToken
	68	\| InputToken
	69	\| PrintToken
	70	\| LetToken
	71	\| InToken
	72	\| VarToken
	73	\| LoopToken
	74	\| RepeatToken
	75	\| ValueOfToken
	76	\| TokenizerError
	77	deriving (Show, Read, Eq)
	78
	79	digitVal '0' = 0
	80	digitVal '1' = 1
	81	digitVal '2' = 2
	82	digitVal '3' = 3
	83	digitVal '4' = 4
	84	digitVal '5' = 5
	85	digitVal '6' = 6
	86	digitVal '7' = 7
	87	digitVal '8' = 8
	88	digitVal '9' = 9
	89
	90	tokens = [("(*", OpenCommentToken),
	91	("*)", CloseCommentToken),
	92	(":=", BecomesToken),
	93	(">=", GreaterThanOrEqualToken),
	94	("<=", LessThanOrEqualToken),
	95	(">", GreaterThanToken),
	96	("<", LessThanToken),
	97	("=", EqualToken),
	98	("/=", NotEqualToken),
	99	(";", StmtSepToken),
	100	("&", AndToken),
	101	("\|", OrToken),
	102	("!", NotToken),
	103	("+", AddToken),
	104	("-", SubtractToken),
	105	("*", MultiplyToken),
	106	("/", DivideToken),
	107	("(", OpenParenToken),
	108	(")", CloseParenToken),
	109	("if", IfToken),
	110	("then", ThenToken),
	111	("else", ElseToken),
	112	("while", WhileToken),
	113	("do", DoToken),
	114	("begin", BeginToken),
	115	("end", EndToken),
	116	("input", InputToken),
	117	("print", PrintToken),
	118	("let", LetToken),
	119	("in", InToken),
	120	("var", VarToken),
	121	("loop", LoopToken),
	122	("repeat", RepeatToken),
	123	("valueof", ValueOfToken)]
	124
	125	findToken string [] =
	126	(Nothing, string)
	127	findToken string ((tokenString, token):rest)
	128	\| (take len string) == tokenString =
	129	(Just token, (drop len string))
	130	\| otherwise =
	131	findToken string rest
	132	where
	133	len = length tokenString
	134
	135	tokenize [] = []
	136	tokenize string@(char:chars)
	137	\| isSpace char =
	138	tokenize chars
	139	\| isDigit char =
	140	tokenizeIntLit string 0
	141	\| foundToken == Just OpenCommentToken =
	142	let
	143	newRestOfString = gobble CloseCommentToken restOfString
	144	in
	145	tokenize newRestOfString
	146	\| foundToken /= Nothing =
	147	let
	148	(Just token) = foundToken
	149	in
	150	token:(tokenize restOfString)
	151	\| isAlpha char =
	152	tokenizeIdent string ""
	153	\| otherwise =
	154	[TokenizerError]
	155	where
	156	(foundToken, restOfString) = findToken string tokens
	157
	158	gobble token [] = []
	159	gobble token string@(char:chars)
	160	\| foundToken == Just token =
	161	restOfString
	162	\| otherwise =
	163	gobble token chars
	164	where
	165	(foundToken, restOfString) = findToken string tokens
	166
	167	tokenizeIntLit [] num = [IntLit num]
	168	tokenizeIntLit string@(char:chars) num
	169	\| isDigit char =
	170	tokenizeIntLit chars (num * 10 + digitVal char)
	171	\| otherwise =
	172	IntLit num:(tokenize string)
	173
	174	tokenizeIdent [] id = [Ident (reverse id)]
	175	tokenizeIdent string@(char:chars) id
	176	\| isAlpha char =
	177	tokenizeIdent chars (char:id)
	178	\| otherwise =
	179	Ident (reverse id):(tokenize string)
	180

+3

-0

test/01.iphi less more

	0	(* Test 'var ... in ...' and assignment *)
	1
	2	var k in k := 5

+1

-0

test/01.out less more

0

k=5

+6

-0

test/02.iphi less more

	0	(* Test 'begin ... end' *)
	1
	2	var k in begin
	3	k := 5;
	4	k := k + 1
	5	end

+1

-0

test/02.out less more

0

k=6

+10

-0

test/03.iphi less more

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

+3

-0

test/03.out less more

	0	j=6
	1	i=15
	2	k=5

+9

-0

test/04.iphi less more

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

+2

-0

test/04.out less more

	0	j=3
	1	i=2

+10

-0

test/05.iphi less more

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

+2

-0

test/05.out less more

	0	j=12
	1	i=2

+10

-0

test/06.iphi less more

	0	(* Test 'while ... do ...' *)
	1
	2	var i in var j in begin
	3	i := 100;
	4	j := 0;
	5	while i > 0 do begin
	6	j := j + i;
	7	i := i - 1
	8	end
	9	end

+2

-0

test/06.out less more

	0	i=0
	1	j=5050

+14

-0

test/07.iphi less more

	0	(* Test 'while ... do ...' *)
	1
	2	var a in var b in var c in
	3	begin
	4	a := 10;
	5	b := 1;
	6	c := 2;
	7	while a > 0 do
	8	begin
	9	b := b * c;
	10	c := c + b;
	11	a := a - 1
	12	end
	13	end

+3

-0

test/07.out less more

	0	a=0
	1	c=140982598893793678070294688422804665931354981644880911847733136248186424030732278900819020480668973702640170212905160639132296847654374706155245147715674612235227680384069415566749494180212370357849936526549755341591854042821940420766722160615645816921368300
	2	b=140982598893793678070294688422804665931354981644880911847733136248186424030732278900819020480668973702640170212905160639132296847278898210361175931159590631877400396153764977561991761037132722898953457959352992281368361865140291306311370294857131871923863552

+8

-0

test/08.iphi less more

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

+3

-0

test/08.out less more

	0	c=5
	1	b=2
	2	a=10

+8

-0

test/09.iphi less more

	0	(* Test 'if ... then ... else' expression with positive result *)
	1
	2	var a in var b in var c in
	3	begin
	4	a := 10;
	5	b := 2;
	6	c := if a < 20 then a - b else a / b
	7	end

+3

-0

test/09.out less more

	0	c=8
	1	b=2
	2	a=10

+3

-0

test/10.iphi less more

	0	(* Test 'let ... in ...' *)
	1
	2	var a in a := let b = 7 in 10 - b;

+1

-0

test/10.out less more

0

a=3

+8

-0

test/11.iphi less more

	0	(* Test 'valueof ... in ...' *)
	1
	2	var a in var b in begin
	3	a := 10;
	4	b := valueof c in begin
	5	c := a * 2
	6	end + 7
	7	end

+2

-0

test/11.out less more

	0	b=27
	1	a=10

+9

-0

test/12.iphi less more

	0	(* Test that 'var ... in ...' does not shadow *)
	1
	2	var a in var b in
	3	begin
	4	a := 1;
	5	b := 2;
	6	var a in
	7	a := 3
	8	end

+1

-0

test/12.out less more

0

["Variable a already declared"]

+8

-0

test/13.iphi less more

	0	(* Test that 'let ... in ...' does shadow *)
	1
	2	var a in var b in
	3	begin
	4	a := 2;
	5	b := 3;
	6	a := let b = 7 in a * b
	7	end

+2

-0

test/13.out less more

	0	a=14
	1	b=3

+11

-0

test/14.iphi less more

	0	(* Test 'loop ...' and 'repeat' *)
	1
	2	var a in a :=
	3	let c = 5 in let d = 1 in
	4	loop
	5	if c = 0 then
	6	d
	7	else
	8	let d = d * c in
	9	let c = c - 1 in
	10	repeat

+1

-0

test/14.out less more

0

a=120

+25

-0

test/Makefile less more

	0	# Makefile for Iphigeneia regression test suite.
	1	# $Id$
	2
	3	# This Makefile currently assumes GNU make.
	4
	5	# The suffixes are:
	6	# .iphi Iphigeneia source code
	7	# .out Program run output - used with 'diff' to check 'run'
	8
	9	IPHI?=../src/iphi
	10	DIFF?=diff -u
	11
	12	TESTS=01.run 02.run 03.run 04.run 05.run 06.run 07.run 08.run 09.run 10.run \
	13	11.run 12.run 13.run 14.run
	14
	15	all: ${TESTS}
	16
	17	.PHONY: %.run
	18
	19	%.run: %.iphi %.out
	20	${IPHI} $< >OUTPUT
	21	${DIFF} OUTPUT $*.out
	22
	23	clean:
	24	rm -rf OUTPUT

+7

-0

test/cat.iphi less more

	0	(* Echo input to output until the first space *)
	1	var x in
	2	while x /= 32 do
	3	begin
	4	x := input c in c;
	5	print x
	6	end

+8

-0

test/hello.iphi less more

	0	(* "Hello, world!" (or actually just "Hello") in Iphigeneia *)
	1	begin
	2	print 72;
	3	print 101;
	4	print 108;
	5	print 108;
	6	print 111
	7	end