vintage-basic (empty) → 1.0

raw patch · 40 files changed

+4498/−0 lines, 40 filesdep +HUnitdep +arraydep +basesetup-changed

Dependencies added: HUnit, array, base, directory, filepath, mtl, parsec, process, random, regex-base, regex-posix, time

Files

• LICENSE.txt +30/−0
• README.txt +45/−0
• Setup.hs +16/−0
• doc/Vintage_BASIC_Developer_Notes.html +40/−0
• doc/Vintage_BASIC_Users_Guide.html +752/−0
• examples/diamond.bas +12/−0
• examples/math.bas +10/−0
• examples/name.bas +5/−0
• examples/stars.bas +14/−0
• examples/strings.bas +12/−0
• run_tests.hs +81/−0
• src/Basic.hs +14/−0
• src/Control/Monad/CPST.hs +74/−0
• src/Control/Monad/CPST/DurableTraps.hs +139/−0
• src/Control/Monad/CPST/ExceptionHandlers.hs +75/−0
• src/IO/IOStream.hs +61/−0
• src/Language/VintageBasic/BasicMonad.hs +289/−0
• src/Language/VintageBasic/Builtins.hs +36/−0
• src/Language/VintageBasic/Executer.hs +73/−0
• src/Language/VintageBasic/FloatParser.hs +64/−0
• src/Language/VintageBasic/Interpreter.hs +528/−0
• src/Language/VintageBasic/LexCommon.hs +36/−0
• src/Language/VintageBasic/LineScanner.hs +38/−0
• src/Language/VintageBasic/Parser.hs +360/−0
• src/Language/VintageBasic/Printer.hs +146/−0
• src/Language/VintageBasic/Result.hs +85/−0
• src/Language/VintageBasic/RuntimeParser.hs +38/−0
• src/Language/VintageBasic/Syntax.hs +96/−0
• src/Language/VintageBasic/Tokenizer.hs +173/−0
• test/Language/VintageBasic/Asserts.hs +56/−0
• test/Language/VintageBasic/BasicMonad_test.hs +28/−0
• test/Language/VintageBasic/Executer_test.hs +14/−0
• test/Language/VintageBasic/FloatParser_test.hs +45/−0
• test/Language/VintageBasic/Interpreter_test.hs +588/−0
• test/Language/VintageBasic/LineScanner_test.hs +33/−0
• test/Language/VintageBasic/Parser_test.hs +215/−0
• test/Language/VintageBasic/Printer_test.hs +27/−0
• test/Language/VintageBasic/RuntimeParser_test.hs +33/−0
• test/Language/VintageBasic/Tokenizer_test.hs +77/−0
• vintage-basic.cabal +40/−0

@@ -0,0 +1,30 @@+Copyright (c) 2009, Lyle Kopnicky
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+* Redistributions of source code must retain the above copyright
+  notice this list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright
+  notice, this list of conditions and the following disclaimer in the
+  documentation and/or other materials provided with the
+  distribution.
+
+* Neither the name of Lyle Kopnicky nor the names of his 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
+OWNER 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.

@@ -0,0 +1,45 @@+To compile:
+
+runhaskell Setup.hs configure
+runhaskell Setup.hs build
+
+To run unit tests:
+
+runhaskell Setup.hs test
+
+To install:
+
+runhaskell Setup.hs install
+
+You can then run the resulting program as
+
+  vintbas [<.bas source file> ...]
+
+The monad transformer I created is CPST.  Monad
+transformers are basically monad building-blocks.  You
+start with the identity monad and stack monad
+transformers on top of it to build a combined monad.
+The ordering is very important.  There are monad
+transformers in the Control.Monad.Trans library,
+so I used them.  Unfortunately you can't stack any
+more monad transformers on top of CPST.  It has to be on
+top, because of the type of the shift morphism.  The
+standard ContT transformer is similar to my CPST, but
+defines callCC, not shift.  Take a look at the type
+of callCC in my code.  Notice every time you see a
+CPST, it is followed by an o.  Notice that every
+other morphism in CPST has the same property, except
+shift.  That is the key to why it's no longer stackable -
+monad transformers can take only two type parameters, not
+three.  But I like shift and think it's neat that I
+can define callCC in terms of it and reset, but not
+vice-versa.  So there.  Plus, my shift and callCC are
+rank-3 polymorphic!  Nobody else achieves that flexibility.
+
+Other things we could do:
+* Pre-check types
+* Pre-check labels, generate code in place of labels
+* Convert variable references to IORefs
+  Is it easiest to do these with staging?
+* Consider sending errors to stderr.
+* On syntax error, consider printing line with marked error.

@@ -0,0 +1,16 @@+#!/usr/local/bin/runhaskell
+
+import Distribution.Simple
+import Distribution.PackageDescription (PackageDescription)
+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo)
+import System.Cmd (system)
+import Distribution.Simple.LocalBuildInfo
+import System.Directory (removeFile)
+
+main = defaultMainWithHooks (simpleUserHooks {runTests = runAllTests})
+
+runAllTests :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
+runAllTests a b pd lb = do
+    system "runhaskell run_tests.hs"
+    removeFile "test_driver.hs"
+    return ()

@@ -0,0 +1,40 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">+<html><head><meta content="text/html; charset=ISO-8859-1" http-equiv="content-type"><title>Vintage BASIC Developer Notes</title></head>
+<body><h1>Vintage BASIC Developer Notes 1.0</h1><p>© 2009, <a href="mailto://lyle@vintage-basic.net">Lyle Kopnicky</a></p><p>I began Vintage BASIC as a class project at the <a href="http://www.ogi.edu">Oregon Graduate
+Institute</a>. My aim was to demonstrate advanced knowledge of monads in
+<a href="http://www.haskell.org">Haskell</a>.
+It occurred to me that BASIC's dynamic control structures would be
+interesting to interpret using a custom monad. Soon, using a
+continuation-passing style monad as a basic, I was able to construct an
+advanced form of exception handler that was ideal for implementing the
+BASIC control structures in a new way.</p><p>What follows are notes on a few of the more notable aspects of the design.</p><h2>Durable Traps</h2><p>Most languages, like C,
+have lexical control structures. It can be determined statically where
+the boundaries of a loop lie. But BASIC's control flow statements are
+read and interpreted one by one at runtime. Traditionally, a <code>GOSUB</code> pushes a pointer to the next statement onto the stack, and <code>RETURN</code> pops that pointer off the stack to return to that position. Any <code>RETURN</code> in the program could be associated with any <code>GOSUB</code>, if the right <code>GOTO</code>s are sprinkled about.</p><p>Instead of using the traditional stack-based method of implementing <code>GOSUB-RETURN</code>, I implemented <code>GOSUB</code> as an exception handler, and <code>RETURN</code> raises an exception to be caught by the <code>GOSUB</code>. Similarly, <code>FOR</code> is an exception handler, and <code>NEXT</code> raises a special exception to be caught by the <code>FOR</code>.
+This is not too different from the stack-based approach, because a
+pointer stack has been replaced by a handler stack. However, the code
+is higher-level and more generalizable. It flows well in Haskell's
+monadic <code>do</code> notation.</p><p>Simple Java-like exceptions
+will not suffice. For one thing, they require a nested block of code
+from which exceptions will be caught. But BASIC has no lexical nesting.
+In principle, we want to catch exceptions that occur later in
+execution. In other words, we want to catch exceptions from the
+continuation of the handler. My new exception handlers can be used in
+either way: to <span style="font-style: italic;">catch</span> exceptions from within an expression, or to <span style="font-style: italic;">trap</span> exceptions from the handler's continuation. I refer to it as trapping because it works much like a <code>trap</code> statement in Bourne shell.</p><p>There
+are three actions an exception handler may take. In case an exception
+does not apply to the exception handler, it needs to <span style="font-style: italic;">pass on</span> the exception to the next outer handler. When a <code>NEXT</code> exception occurs, the loop termination condition may or may not be met. If it is not met, control flow will <span style="font-style: italic;">continue</span> following the handler (the interior of the loop). If it is met, control&nbsp;should <span style="font-style: italic;">resume</span> with the statement following the <code>NEXT</code>.</p><p>There is one more behavior of a handler to consider: whether or not it remains in force. When a <code>NEXT</code> leads to another loop iteration, the handler should remain in force. When the <code>FOR</code> loop is complete, the handler should not remain in force. I refer to this feature as <span style="font-style: italic;">durability</span> and say that in the first case, the handler <span style="font-style: italic;">endures</span>, while in the second case it does not endure.</p><p>The exception handlers provided in Control.Monad.CPST.DurableTraps, <code>catchC</code> and <code>trap</code>, are used to catch or trap exceptions, respectively. Each one is passed, along with the exception, three functions called <code>passOn</code>, <code>resume</code>, and <code>continue</code>, corresponding to the three desired courses of action. Each of those functions takes a boolean parameter <code>endure</code>, which can be set to <code>True</code> to keep the handler in force or <code>False</code> to remove it from the handler stack.</p><h2>Parsing</h2><p>Although I originally hand-rolled a parser, I eventually moved to <a href="http://legacy.cs.uu.nl/daan/download/parsec/parsec.html">Parsec</a> for better performance and error handling. I chose to implement the parsing in three layers. The <span style="font-style: italic;">line scanner</span> layer recognizes BASIC line numbers and allows the lines to be sorted by line number without parsing the rest of the line. The <span style="font-style: italic;">tokenizer</span>
+locates and tokenizes keywords in each line, without tokenizing
+variable names. I did this so that BASIC code could be written without
+spaces between the keywords and variables, as the Commodore 64 allowed.
+Finally, the <span style="font-style: italic;">parser</span> does the rest of the work, building up statements and expressions.</p><p>I
+took care to make the syntax errors look reasonably old-fashioned.
+However, they do provide a bit more information than the old BASICs
+would have. Because Parsec provides it, they detail the error position
+and the found/expected tokens.</p><h2>Unit Testing</h2><p>Vintage
+BASIC is extensively covered with unit tests. These tests are written
+on top of the HUnit framework. Most of the tests are on parsing code or
+the interpreter. The interpreter tests are at more or less integration
+tests rather than unit tests. They test the interpretation of the BASIC
+language straight from the textual source. However they are still unit
+tests in the sense that they are focused on exercising the behavior of
+the interpreter proper.</p><p>The tests are arranged in a hierarchical directory structure parallel to the implementation: in the <code>test</code> directory rather than <code>src</code>. They are executed by a harness called <code>run_tests.hs</code> in the root directory. This custom-written script finds all of the modules named ending in <code>_test</code>, and the functions within those modules starting with <code>test_</code>. It builds a driver program that calls all the tests, and executes it.</p><p>The tests can be run by calling <code>runhaskell run_tests.hs</code>, or preferably via <code>runhaskell Setup.hs test</code>.</p></body></html>

@@ -0,0 +1,752 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">+<html><head>
+<meta content="text/html; charset=ISO-8859-1" http-equiv="content-type"><title>Vintage BASIC User's Guide</title>
+
+</head>
+<body>
+<h1>Vintage BASIC User's Guide 1.0</h1>
+<p>© 2009, <a href="mailto://lyle@vintage-basic.net">Lyle
+Kopnicky</a></p>
+<p>Congratulations on installing Vintage BASIC! You are now the
+proud owner of a copy of a versatile tool for BASIC development.</p>
+<p>Vintage BASIC is a language derived from the Microsoft's
+original <a href="http://en.wikipedia.org/wiki/Altair_BASIC">Altair
+BASIC</a>.
+It would feel right at home on a Commodore 64. The design tensions of
+Vintage BASIC are:</p>
+<ul>
+<li>Run the majority of programs from <a style="font-style: italic;" href="http://www.amazon.com/BASIC-Computer-Games-Microcomputer-David/dp/0894800523/ref=sr_1_1?ie=UTF8&amp;s=books&amp;qid=1230497638&amp;sr=8-1">BASIC
+Computer Games: Microcomputer Edition</a>, by David H. Ahl. This
+book was a lot of fun and inspired a generation of programmers.</li>
+<li>Stick fairly close to the behavior of Microsoft BASIC v2 as
+found on the&nbsp;Commodore 64.</li>
+<li>Be informed by (but not always stick to) the ANSI Minimal
+BASIC standard (ANSI X.360-1978).</li>
+<li>Relax constraints in the language where it is easy to do so
+without compromising compatibility.</li>
+</ul>
+Vintage BASIC is written in <a href="http://www.haskell.org">Haskell</a>.
+Haskell has a feature called monads, which aid in constructing custom
+control structures. The interpreter handles BASIC's dynamic
+control structures by using an advanced form of exception, rather than
+the traditional
+stack.<br>
+<br>
+Early BASICs used an interactive prompt for editing
+program text. Vintage BASIC allows you to use your own text editor.
+However, it still supports the line numbers of traditional BASIC, as
+targets for control flow.<br>
+<br>
+<span style="font-weight: bold;">Table of Contents</span><br>
+<ul id="mozToc">
+<!--mozToc h2 1 h3 2 h4 3 h5 4 h6 5 h6 6--><li><a href="#mozTocId731362">System Requirements and Installation</a></li>
+<li><a href="#mozTocId230604">Running Vintage BASIC</a></li>
+<li><a href="#mozTocId153285">BASIC
+Program Lines</a></li>
+<li><a href="#mozTocId839205">BASIC Syntax</a></li>
+<li><a href="#mozTocId277885">BASIC Types</a></li>
+<li><a href="#mozTocId116379">BASIC
+Expressions</a>
+<ul>
+<li><a href="#mozTocId235686">Operator
+Precedence and Associativity</a></li>
+<li><a href="#mozTocId251348">Builtin Functions</a></li>
+</ul>
+</li>
+<li><a href="#mozTocId829004">BASIC
+Statements</a></li>
+<li><a href="#mozTocId193848">Error Messages</a></li>
+</ul>
+<h2><a class="mozTocH2" name="mozTocId731362"></a>System
+Requirements and Installation</h2>
+<p>Vintage BASIC requires minimal resources, and will run on any
+platform with available Haskell compiler. The recommended compiler is <a href="http://www.haskell.org/ghc">GHC</a>. You can
+also download some pre-compiled binaries on the web site, <a href="http://www.vintage-basic.net">vintage-basic.net</a>.</p>
+<h3>Installation of&nbsp;binary version</h3>
+For Windows, you can simply download <code>vintbas.exe</code>,
+and put it it somewhere in your path. For other systems, consult the <a href="http://www.vintage-basic.net/download.html">download page</a>.<br>
+<h3>Installation from source</h3>
+<p>You can download the source code tarball,&nbsp; <code>vintage-basic-1.0.tar.gz</code>,&nbsp;from
+either <a href="http://www.vintage-basic.net/downloads.html">vintage-basic.net</a>
+or <a href="http://hackage.haskell.org/cgi-bin/hackage-scripts/package/vintage-basic">Hackage</a>.</p>
+<p>You should first unpack the tarball&nbsp;<code></code>using
+a tool such as tar, 7-Zip or WinZip. Then open a
+shell/console&nbsp;in
+the vintage-basic-1.0 directory, and type:
+http://hackage.haskell.org/packages/archive/armada/0.1/armada-0.1.tar.gz<br>
+<br>
+<code>&nbsp;&nbsp;runhaskell Setup.hs configure<br>
+&nbsp; runhaskell Setup.hs build</code></p>
+<p>The executable will be generated in <code>dist/build/vintbas/vintbas</code>
+on Mac/Linux, or <code>dist\build\vintbas\vintbas.exe</code>
+on Windows. You can then move this executable anywhere in your path to
+run it. Or, use</p>
+<p><code>&nbsp;&nbsp;runhaskell Setup.hs install</code></p>
+<p>See the <a href="http://haskell.org/haskellwiki/Cabal/How_to_install_a_Cabal_package">Cabal
+package installation instructions</a> for more details.<br>
+</p>
+<h2><a class="mozTocH2" name="mozTocId230604"></a>Running
+Vintage BASIC</h2>
+<p>The interpreter consists of one command-line tool, <code><span class="">vintbas</span></code> (<code>vintbas.exe</code>
+on Windows). It can take any number of filename parameters, each one
+the name of a BASIC source file. By convention (but not fiat), those
+should end in <code>.bas</code>. So, if you've written
+BASIC code and saved it in <code>miracle.bas</code>, you'd
+run it by typing <code>vintbas miracle.bas</code>.</p>
+<h2><a class="mozTocH2" name="mozTocId153285"></a>BASIC
+Program Lines</h2>
+<p>Each line in your BASIC source file should start with a BASIC
+line number (also called a <span style="font-style: italic;">label</span>).
+These numbers are part of the text at the start of the
+line, and not just a count of lines from the start of the file. They
+are used as labels for <code>GOTO</code>,&nbsp;<code>GOSUB</code>,
+and&nbsp;<code>THEN</code> targets, as well as in <code>RESTORE</code>
+statements. Here is a sample BASIC program:</p>
+<p style="margin-left: 40px;"><code>10 INPUT"YES OR
+NO";A$<br>
+20 IF A$ = "YES" THEN 50<br>
+30 IF A$ = "NO" THEN 60<br>
+40 PRINT"YOU MUST ENTER YES OR NO.":GOTO 10<br>
+50 PRINT"GREAT!":END<br>
+60 PRINT"WHY NOT?":END</code></p>
+<p>Barring any flow control changes, the lines are executed in
+order by line number, regardless of the sorting of the input file. If
+two lines in the input file have the same line number, the later one
+will take precedence (you will get a warning when lines are
+superseded). A space is not required following the line number, but it
+aids in readability.</p>
+<p>Control flow will end when your program reaches the end of the
+lines, when an <code>END</code> or <code>STOP</code>
+statement is encountered, or when an error occurs. Errors may occur
+during parsing or execution, and always being with an exclamation point
+(<code>!</code>).</p>
+<h2><a class="mozTocH2" name="mozTocId839205"></a>BASIC
+Syntax</h2>
+Each line of BASIC consists of a series of statements, separated by
+semicolons. Statements are executed in order, unless an error or
+control flow statement is encountered.
+<p>BASIC keywords are not case sensitive. You may
+freely use
+lowercase, uppercase, or mix both. Examples will be shown in caps since
+that is traditional for the language. Literal strings in quotes are
+case sensitive. They will be printed in the case used in the source.</p>
+<p>Spaces are not required between keywords. This is a violation
+of the ANSI standard, but was implemented on some early microcomputers
+in order to save memory. It will aid in compatibility with running
+programs written for such computers. Spaces are encouraged because the
+code can be harder to read without them. For example, <code>FORK=1TON</code>
+appears to set the value of a variable <code>FORK</code>
+to a weight of 1 ton. In reality it begins a <code>FOR</code>
+loop with control variable <code>K</code>, ranging in
+value from <code>1</code> to <code>N</code>.
+Ignoring spaces means that keywords must be tokenized by the parser
+before the parsing phase. It also makes it difficult to use long
+variable names, which might accidentally contain keywords. For example,
+<code>FACTOR</code> contains the keyword <code>TO</code>.
+Experience shows that people can get used to reading code without
+spaces.</p>
+<h2><a class="mozTocH2" name="mozTocId277885"></a>BASIC
+Types</h2>
+Vintage BASIC has a simple type system. In expressions, all values are
+either floating-point or string. Variables can additionally hold
+integers, which are converted to/from floating-point to be used in
+expressions. Floating-point values are also used for boolean logic. The
+canonial true value is <code>-1</code>, and the canonical
+false value is <code>0</code>. These are the values that
+will be generated by comparison operators. However, any nonzero value
+will be treated as true by the boolean operations.
+<h2><a class="mozTocH2" name="mozTocId116379"></a>BASIC
+Expressions</h2>
+<p>Expressions in BASIC, like in most languages, are used to
+compute a value. They can be used in many statements, such as <code>LET</code>,
+<code>DIM</code>, <code>ON-GOTO</code>, <code>ON-GOSUB</code>,
+<code>IF-THEN</code>, <code>FOR</code>, <code>PRINT</code>,
+and <code>DEF FN</code>. They consist of literal values
+and variable references, composed by operators and function calls.
+Let's look at each of these in turn.</p>
+<dl>
+<dt style="font-style: italic;">literal</dt>
+<dd>Literals include floating-point numbers and strings.
+Floating-point literals are of the form [+|-]999[.999][E[+|-]99]: a
+sign, a mantissa, and an exponent indicated by the letter E. The signs
+and exponent are optional. The decimal point is optional if you don't
+need to put any digits after it. Examples: <code>0</code>,
+<code>2</code>, <code>5.</code>, <code>5.6</code>,
+<code>90000000</code>, <code>-.01</code>, <code>1E-20</code>.
+Precision depends upon your platform, but is generally IEEE bin32
+(single precision). There are no special IEEE values, like +Inf or NaN.
+String literals are enclosed in quotes, e.g. <code>"HELLO"</code>.
+There are no escape sequences. To generate a quote character, append a <code>CHR$(34)</code>.</dd>
+<dt><span style="font-style: italic;">varname</span></dt>
+<dd>Variable names can include any number of letters followed
+by any number
+of digits, and a type indicator. However, only the first two letters
+and first digit are considered significant to distinguish variable
+names. Since computers historically did not have enough
+memory to handle long variable names, variable names were kept short.
+The ANSI Minimal BASIC standard, and some early BASICs, allowed only
+one letter and one digit in the variable name. In some later BASICs,
+the first two letters and the first digit of the variable name are
+considered significant. That is the choice made in Vintage BASIC. So,
+the variables <code>MILK123</code> and <code>MINT145</code>
+are considered the same.</dd>
+<dd></dd>
+<dd>Variables&nbsp;can store integers, floating-point
+numbers or strings. Integer variables are mainly there to save storage
+memory; in calculations they are converted to floats. String variable
+names are ended with a <code>$</code>, and integer
+variables with a <code>%</code>, while floating-point
+variables have no type indicator. Variable names with the same
+significant letters and digits but different type indicators are
+distinct. Thus, you can store a string in <code>A$</code>,
+a floating-point value in <code>A</code>, and an integer
+value in <code>A%</code> without a conflict.</dd>
+<dt style="font-style: italic;">var</dt>
+<dd>Variables can also be scalar or array. Scalar variables are
+indicated by an variable name alone. Array variables are accessed by
+following the variable name with parentheses enclosing a
+comma-separated list of expressions whose values are indices into the
+array. For example, <code>A(3)</code> is the value from
+index <code>3</code> in the floating-point array named <code>A</code>,
+and <code>FR$(2,3)</code> is a string value from index 2
+(in the first dimension) and 3 (in the second dimension) in an array
+named <code>FR$</code>. Scalar and array variables are
+also distinct from each other, so it is possible to have a scalar
+variable <code>A</code> with value <code>3</code>,
+so that <code>A(A)</code> would be <code>A(3)</code>
+and might contain some other value.<span style="font-style: italic;"></span></dd>
+<dt><code>FN</code> <span style="font-style: italic;">varname</span><code>(</code><span style="font-style: italic;">expr1</span><code>,</code>
+<span style="font-style: italic;">expr2</span><code>,</code>
+...<code>)</code></dt>
+<dd>Another sort of variable is a user-defined function.
+Defined using <code>DEF FN</code> statements, they are
+accessed in expressions by preceding the function name with the <code>FN</code>
+keyword. Example: <code>FN A(4)</code> calls the
+floating-point user-defined function <code>A</code> with
+argument value <code>4</code>.</dd>
+<dt><span style="font-style: italic;">builtin</span><code>(</code><span style="font-style: italic;">expr1</span><code>,</code>
+<span style="font-style: italic;">expr2</span><code>,</code>
+...<code>)</code></dt>
+<dd>Calls a builtin function. The names of the builtins are
+keywords, so they cannot be used in variable names. See the list of
+builtin functions below.</dd>
+<dt><code>(</code><span style="font-style: italic;">expr</span><code>)</code></dt>
+<dd>A parenthesized expression has the same value of
+expression. Parentheses can be used to override operator precedence.<code><span style="font-weight: bold;"></span></code></dd>
+<dt><code><span style="font-weight: bold;"></span>-</code>
+<span style="font-style: italic;">expr</span></dt>
+<dd>Negates a floating-point expression.</dd>
+<dt><code>+</code> <span style="font-style: italic;">expr</span></dt>
+<dd>No effect. This is included for parity with the negation
+operator.</dd>
+<dt><span style="font-style: italic;">expr1</span>
+<code>^</code> <span style="font-style: italic;">expr2</span></dt>
+<dd>Exponentiation. Raises the value of the first expression to
+the power of the value of the second expression.</dd>
+<dt><span style="font-style: italic;">expr1</span>
+<code>*</code> <span style="font-style: italic;">expr2</span></dt>
+<dd>Multiplication. Multiplies the value of the first
+expression by the value of the second expression.</dd>
+<dt><span style="font-style: italic;">expr1</span>
+<code>/</code> <span style="font-style: italic;">expr2</span></dt>
+<dd>Division. Divides the value of the first expression by the
+value of the second expression. Division by zero is an error.</dd>
+<dt><span style="font-style: italic;">expr1</span>
+<code>+</code> <span style="font-style: italic;">expr2</span></dt>
+<dd>Addition. Adds the value of the first expression to the
+value of the second expression.<br>
+</dd>
+<dt><span style="font-style: italic;">expr1</span>
+<code>-</code> <span style="font-style: italic;">expr2</span></dt>
+<dd>Subtraction. Subtracts the value of the second expression
+from the value of the first expression.</dd>
+<dt><span style="font-style: italic;">expr1</span>
+<code>=</code> <span style="font-style: italic;">expr2</span></dt>
+<dd>Equality test. Evaluates to&nbsp;<code>0</code>
+if the two strings or numbers are equal, <code>-1</code>
+if they differ.</dd>
+<dt><span style="font-style: italic;">expr1</span>
+<code>&lt;&gt;</code> <span style="font-style: italic;">expr2</span></dt>
+<dd>Inequality test. Evaluates to <code>-1</code>
+if the two strings or numbers are equal, <code>0</code> if
+they differ.</dd>
+<dt><span style="font-style: italic;">expr1</span>
+<code>&lt;</code> <span style="font-style: italic;">expr2</span></dt>
+<dd>Less than. Evaluates to <code>-1</code> if the
+first string or number is less than the second, <code>0</code>
+otherwise. (Strings are compared alphabetically.)</dd>
+<dt><span style="font-style: italic;">expr1</span>
+<code>&lt;=</code> <span style="font-style: italic;">expr2</span></dt>
+<dd>Less than or equal. Evaluates to <code>-1</code>&nbsp;if
+the first string or number is less than or equal to the second, <code>0</code>
+otherwise. (Strings are compared alphabetically.)</dd>
+<dt><span style="font-style: italic;">expr1</span>
+<code>&gt;</code> <span style="font-style: italic;">expr2</span></dt>
+<dd>Greater than. Evaluates to <code>-1</code> if
+the first string or number is less than the second, <code>0</code>
+otherwise. (Strings are compared alphabetically.)</dd>
+<dt><span style="font-style: italic;">expr1</span>&nbsp;<code>&gt;=</code>
+<span style="font-style: italic;">expr2</span></dt>
+<dd>Greater than or equal. Evaluates to <code>-1</code>
+if the first string or number is less than or equal to the second, <code>0</code>
+otherwise. (Strings are compared alphabetically.)</dd>
+<dt><code>NOT</code> <span style="font-style: italic;">expr</span></dt>
+<dd>Negates a boolean expression. Specifically, nonzero values
+become <code>0</code> and <code>0</code>
+becomes <code>-1</code>.</dd>
+<dt><span style="font-style: italic;">expr1</span>
+<code>AND</code> <span style="font-style: italic;">expr2</span></dt>
+<dd>Logical conjunction. If neither expression evaluates to <code>0</code>,
+then the result is the value of <span style="font-style: italic;">expr1</span>.
+Otherwise, the result is <code>0</code>.</dd>
+<dt><span style="font-style: italic;">expr1</span>
+<code>OR</code> <span style="font-style: italic;">expr2</span></dt>
+<dd>Logical disjunction. If <span style="font-style: italic;">expr1</span> evaluates to
+a nonzero value, that value is the result. Otherwise, the value of <span style="font-style: italic;">expr2</span> is the result.</dd>
+</dl>
+<h3><a class="mozTocH3" name="mozTocId235686"></a>Operator
+Precedence and Associativity</h3>
+Operators are listed in precedence groups, from highest to lowest.<br>
+<table style="text-align: left; width: 100%;" border="1" cellpadding="2" cellspacing="2">
+<tbody>
+<tr>
+<td><span style="font-weight: bold;">Operators</span></td>
+<td><span style="font-weight: bold;">Associativity</span></td>
+</tr>
+<tr>
+<td>unary <code>-</code>, unary <code>+</code></td>
+<td>N/A</td>
+</tr>
+<tr>
+<td><code>^</code></td>
+<td>right</td>
+</tr>
+<tr>
+<td><code>*</code>, <code>/</code></td>
+<td>left</td>
+</tr>
+<tr>
+<td><code>+</code>, <code>-</code></td>
+<td>left</td>
+</tr>
+<tr>
+<td><code>=</code>, <code>&lt;&gt;</code>,
+<code>&lt;</code>, <code>&lt;=</code>,
+<code>&gt;</code>, <code>&gt;=</code></td>
+<td>left</td>
+</tr>
+<tr>
+<td><code>NOT</code></td>
+<td>N/A</td>
+</tr>
+<tr>
+<td><code>AND</code></td>
+<td>left</td>
+</tr>
+<tr>
+<td><code>OR</code></td>
+<td>left</td>
+</tr>
+</tbody>
+</table>
+<span style="font-weight: bold;"></span>
+<h3><a class="mozTocH3" name="mozTocId251348"></a>Builtin
+Functions</h3>
+The builtin functions each take a particular number of arguments of
+particular types. Passing the wrong number of arguments or types will
+result in a runtime error. Each argument can be an expression. The
+expressions are evaluated before being passed to the builtin function.<br>
+<dl>
+<dt><code>ABS(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Returns the absolute value of an expression. (I.e., its
+negation if it is negative.)</dd>
+<dt><code>ASC(</code><span style="font-style: italic;">string</span><code>)</code></dt>
+<dd>Returns the ASCII value of the first character of the
+string.</dd>
+<dt><code>ATN</code><code>(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Returns the arctangent of the value. The range is from -<span style="font-style: italic;">pi</span>/2 to <span style="font-style: italic;">pi</span>/2.</dd>
+<dt><code>CHR$(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Returns a single-character string with the specified ASCII
+value.</dd>
+<dt><code>COS(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Returns the cosine of the value.</dd>
+<dt><code>EXP(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Returns the transcendental number <span style="font-style: italic;">e</span> raised to the
+power of the value.</dd>
+<dt><code>INT(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Rounds the number down to the next lower integer.</dd>
+<dt><code>LEFT$(</code><span style="font-style: italic;">string</span><code>,
+</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Returns a prefix of the string, with the number of
+characters specified by the second argument. Negative numbers are an
+error, while numbers too large will result in the whole string being
+returned.</dd>
+<dt><code>LEN(</code><span style="font-style: italic;">string</span><code>)</code></dt>
+<dd>Returns the length of the string.</dd>
+<dt><code>LOG(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Returns the logarithm, to base <span style="font-style: italic;">e</span>, of the number.
+Argument must be positive.</dd>
+<dt><code>MID$(</code><span style="font-style: italic;">string</span><code>,
+</code><span style="font-style: italic;">float</span><code></code><span style="font-style: italic;"></span><code>)</code></dt>
+<dt><code>MID$(</code><span style="font-style: italic;">string</span><code>,
+</code><span style="font-style: italic;">float</span><code>,
+</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>In its first form, returns a substring starting from the
+specified index (1-based), through the end of the string. In the second
+form, returns a substring starting an index specified by the second
+argument, with the number of characters specified by the third
+argument. Indexes less than one or string lengths less than zero will
+result in a runtime error. Any attempt to extract characters beyond the
+length of the string will be cut off at the end of the string with no
+error.</dd>
+<dt><code>RIGHT$(</code><span style="font-style: italic;">string</span><code>,
+</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Returns a suffix of the string, with the number of
+characters specified by the second argument. Negative numbers are an
+error, while numbers too large will result in the whole string being
+returned.</dd>
+<dt><code>RND(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Psuedorandom number generator. The behavior is different
+depending on the value passed. If the value is positive, the result
+will be a new random value between 0 and 1 (including 0 but not 1). If
+the value is zero, the result will be a repeat of the last random
+number generated. If the value is negative, it will be rounded down to
+the nearest integer and used to reseed the random number generator.
+Pseudorandom sequences can be repeated by reseeding with the same
+number.</dd>
+<dt><code>SGN(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Sign. Returns -1 if the value is negative, 0 if it is zero,
+or 1 if it is positive.</dd>
+<dt><code>SIN(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Returns the sine of the specified value.</dd>
+<dt><code>SPC(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Returns a string containing the specified number of spaces.
+This is useful for formatting text.</dd>
+<dt><code>SQR(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Returns the square root of the value. Argument must be
+non-negative.</dd>
+<dt><code>STR(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Returns a string representation of the floating-point
+value, as it would be printed by <code>PRINT</code>, but
+without the trailing space.</dd>
+<dt><code>TAB(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>In most BASICs this is a special command available only in <code>PRINT</code>
+statements, but in Vintage BASIC, it is just another builtin function.
+Vintage BASIC keeps track of the output column as text is printed. The <code>TAB</code>
+function&nbsp;generates a string with the number of spaces required
+to advance the cursor to the column number&nbsp;specified by the
+argument. Column numbers start with zero, which is consistent with
+Microsoft BASIC but not the ANSI standard, which starts with one
+instead. If the cursor is already past the desired column, the result
+string will be empty. This behavior is consistent with
+Microsoft BASIC but not the ANSI standard, which specifies that the
+cursor should move to a new line before tabbing to the specified column.</dd>
+<dt><code>TAN(</code><span style="font-style: italic;">float</span><code>)</code></dt>
+<dd>Returns the tangent of the value.</dd>
+<dt><code>VAL(</code><span style="font-style: italic;">string</span><code>)</code></dt>
+<dd>Attempts to read the string as a floating-point number. If
+it fails, the result is zero.</dd>
+</dl>
+<h2><a class="mozTocH2" name="mozTocId829004"></a>BASIC
+Statements</h2>
+<dl>
+<dt><code>DATA</code> <span style="font-style: italic;">literal1</span><code>,</code>
+<span style="font-style: italic;">literal2</span><code>,</code>
+...</dt>
+<dd>Has no effect when executed, but supplies data for the <code>READ</code>
+statement. Each value can be a string or floating-point literal (not an
+expression). Whitespace is ignored around values. Double quotes can be
+placed around a string to escape whitespace and commas between the
+quotes.&nbsp;<code>DATA</code> statements can occur on
+the same line as other statements, but, due to its special parsing
+rules, it must be the last statement on the line. The line on which the
+<code>DATA</code> statement occurs can be used as the
+target of a <code>RESTORE </code>statement. Example: <code>DATA
+January, 31, "Martian History Month"</code>.</dd>
+<dt><code>DEF FN</code> <span style="font-style: italic;">varname</span><code>(</code><span style="font-style: italic;">arg1</span><code>,</code>
+<span style="font-style: italic;">arg2</span><code>,</code>
+...<code>)</code> <code>=</code> <span style="font-style: italic;">expr</span></dt>
+<dd>Defines a user-defined function. The arguments are
+variable names that may be used in the expression.
+While the standard allows only for numeric functions of a single
+floating-point variable, Vintage BASIC permits string, integer or
+floating-point functions ofany number and type of arguments. Example: <code>DEF
+FN F(X) = X^2 + 3*X - 4</code>. The argument variables shadow
+the original variables; that is, the value of the original variable
+with the same name will be restored after the function is evaluated.
+Like scalar variables but unlike arrays, user-defined functions may be
+repeatedly redefined. Warning: Recursive functions are definable, but
+will always result in an infinite loop.</dd>
+<dt><code>DIM</code><span style="font-style: italic;"> varname</span><code>(</code><span style="font-style: italic;">bound1</span><code>,</code><span style="font-style: italic;"> bound2</span><code>,</code><span style="font-style: italic;"> ...<span style="font-family: monospace;"></span></span><code>)</code></dt>
+<dd>Dimensions an array. That is, specifies the number of
+dimensions and upper index bounds for an array. The lower bound is
+always zero. Unlike most BASICs, the boundaries are not limited to
+literal values; they can be any expression. Attempting to re-dimension
+an array will produce an error. Arrays can be referenced without
+dimensioning; in that case they are automatically created as
+one-dimenional arrays with an upper bound of 10. Example: <code>DIM
+RX$(20, 5)</code> creates a two-dimensional, 20x5 array of
+strings.</dd>
+<dt><code>END</code></dt>
+<dd>Terminates execution with no error condition. This
+statement is not required at the end of a program because control flow
+will end automatically there.</dd>
+<dt><code>FOR</code> <span style="font-style: italic;">varname</span> = <span style="font-style: italic;">start</span> <code>TO</code>
+<span style="font-style: italic;">end</span> [<code>STEP</code>
+<span style="font-style: italic;">increment</span>]</dt>
+<dd>Marks the start of a <code>FOR-NEXT</code>
+loop, and its termination conditions. The control variable must be a
+floating-point variable. It is initialized to the value of the <span style="font-style: italic;">start</span> expression.
+Each time a <code>NEXT</code> is encountered, the control
+variable is incremented by one, or by <span style="font-style: italic;">increment</span> if the
+optional <code>STEP</code> clause is specified. If the
+value of the control variable has not exceeded the value
+of&nbsp;the <span style="font-style: italic;">end</span>
+expression, control will continue with the statement following the <code>FOR</code>.
+But if the value of the control value exceeds <span style="font-style: italic;">end</span> (greater than
+end if <span style="font-style: italic;">increment</span>
+is positive, less than end if <span style="font-style: italic;">increment</span>
+is negative), control will pass to the statement following the <code>NEXT</code>.
+The expressions <span style="font-style: italic;">start</span>,
+<span style="font-style: italic;">end</span>,
+and <span style="font-style: italic;">increment</span>
+are evaluated only once at the start of the loop. The termination
+condition is not evaluated before entering the loop, as it is not
+always possible to determine&nbsp;where the corresponding <code>NEXT</code>
+might be, should the loop meet the termination condition. (This
+contradicts the ANSI standard, but the ANSI standard is unenforceable.)
+Example: <code>FOR I = 1 TO 20 STEP 2: PRINT I, I*2: NEXT I</code>.</dd>
+<dt><code>GOSUB</code> <span style="font-style: italic;">label</span></dt>
+<dd>Transfers control to the line numbered <span style="font-style: italic;">label</span>. Upon
+encountering a <code>RETURN</code> statement, control will
+return to the statement following the <code>GOSUB</code>.
+This is the cornerstone of structured programming in BASIC. Note: <code>GO</code>
+and <code>SUB</code> are separate keywords and may be
+separated by space.</dd>
+<dt><code>GOTO</code> <span style="font-style: italic;">label</span></dt>
+<dd>Transfers control to the line numbered <span style="font-style: italic;">label</span>. Note: <code>GO</code>
+and <code>TO</code> are separate keywords and may be
+separated by space.</dd>
+<dt><code></code><code>IF</code> <span style="font-style: italic;">expr</span> <code>THEN</code>
+<span style="font-style: italic;">statement1</span><code>:</code>
+<span style="font-style: italic;">statement2</span><code>:</code>
+...<br>
+<code>IF</code> <span style="font-style: italic;">expr</span>
+<code>THEN</code> <span style="font-style: italic;">label</span><code></code></dt>
+<dd>Evaluates the truth of the supplied expression. If it is
+true, it executes the statements following it on the line. If it is
+false, control skips to the following line. The form with a label is a
+shorthand for <code>IF</code> <span style="font-style: italic;">expr</span> <code>THEN
+GOTO</code> <span style="font-style: italic;">label</span>.
+Expressions are expected to have floating-point values. They are
+considered false if zero and true otherwise. Note: if statements follow
+the <span style="font-style: italic;">label</span>
+form on the same line, they are ignored. Example: <code>IF
+A&gt;0 THEN Y=Y+3:GOTO 80</code>.</dd>
+<dt><code>INPUT</code> [<span style="font-style: italic;">prompt</span><code>;</code>]
+<span style="font-style: italic;">var1</span><code>,</code>
+<span style="font-style: italic;">var2</span><code>,</code>
+...</dt>
+<dd>Reads input from an interactive user prompt. The optional
+prompt string&nbsp;is followed by a question mark and a space. The
+user may then enter a series of values separated by commas. The format
+is the same as in the <code>DATA</code> statement, so
+quotes can be used to escape spaces or commas. Value types entered must
+match the variable types, or an error will be generated and the user
+will be re-prompted. The user will also be re-prompted (with a double
+question mark) if the user enters insufficient values to fill the
+variables. The variables may be scalar or (indexed) array variables.
+Examples: <code>INPUT "NAME AND AGE";NA$(I), AG(I)</code>.</dd>
+<dt><code>LET</code> <span style="font-style: italic;">var</span> = <span style="font-style: italic;">expr</span></dt>
+<dd>Evaluates the expression and assigns the value to the
+variable. The <code>LET</code> keyword is optional.</dd>
+<dt><code>NEXT</code> [<span style="font-style: italic;">var</span>]</dt>
+<dd>Returns control to a <code>FOR</code>
+statement to determine whether the loop should be repeated. If the
+termination condition has not been met, control will proceed with the
+line following the <code>FOR</code> statement. If the
+termination condition has been met, control will proceed with the
+statement following the <code>NEXT</code>. How does the
+interpreter determine which <code>FOR</code> goes with the
+<code>NEXT</code>? It is determined dynamically. If the
+<code>NEXT</code> has no variable, then it is the most
+recently encountered non-terminated <code>FOR</code>. If
+the <code>NEXT</code> indicates a variable, then it is the
+most recently encountered non-terminated <code>FOR</code>
+with that control variable. Usually, it is simple to glance at code and
+see which pairs of <code>FOR</code> and <code>NEXT</code>
+statements go together. But due to the dynamic nature of the connection
+between them, it is possible to write <code>NEXT</code>
+statements that are sometimes connected with one <code>FOR</code>,
+sometimes another. For an example, see <code>FOR</code>.</dd>
+<dt><code>ON</code> <span style="font-style: italic;">expr</span> <code>GOSUB</code>
+<span style="font-style: italic;">label1</span><code>,</code><span style="font-style: italic;"> label2</span><code>,</code>
+...</dt>
+<dd>Like <code>GOSUB</code>, but makes a decision
+about the target line based on the result of evaluating an expression.
+The value of <span style="font-style: italic;">expr</span>
+is rounded down to the nearest integer, and is used as an index into
+the list of labels, starting with 1. If the index is less than 1 or
+greater than the number of labels, control falls through to the next
+statement (as in Microsoft BASIC but in violation of the ANSI standard,
+which prescribes a runtime error).</dd>
+<dt><code>ON</code> <span style="font-style: italic;">expr</span> <code>GOTO</code>
+<span style="font-style: italic;">label1</span><code>,</code><span style="font-style: italic;"> label2</span><code>,</code>
+...</dt>
+<dd>Like <code>GOTO</code>, but makes a decision
+about the target line based on the result of evaluating an expression.
+The value of <span style="font-style: italic;">expr</span>
+is rounded down to the nearest integer, and is used as an index into
+the list of labels, starting with 1. If the index is less than 1 or
+greater than the number of labels, control falls through to the next
+statement (as in Microsoft BASIC but in violation of the ANSI standard,
+which prescribes a runtime error).</dd>
+<dt><code>PRINT</code> <span style="font-style: italic;">expr1</span><code>&nbsp;</code>[<code>;</code>|<code>,</code>]
+<span style="font-style: italic;">expr2</span> [<code>;</code>|<code>,</code>]<code></code>
+...<code></code></dt>
+<dd>Outputs text to the user. Multiple expressions can be
+separated by semicolons or commas. Semicolons leave no space between
+printed expressions. A comma is used to align text neatly in columns;
+it forces the next output column to be the start of the next print
+zone. Print zones are always 14 characters wide. A newline will be
+automatically printed at the end of the line, unless the <code>PRINT</code>
+statement ends in a semicolon or comma. Floating-point values are
+automatically
+padded with one trailing space, and positive values are also padded
+with a leading space, so that they take up the same amount of space as
+negative numbers. Example: <code>PRINT "TURN";TU, "YOU
+HAVE";LI;"LIVES LEFT"</code>.</dd>
+<dt><code>RANDOMIZE</code></dt>
+<dd>Re-seeds the random number generator used for the <code>RND</code>
+function, based on the number of seconds that have elapsed since
+midnight, local time.</dd>
+<dt><code>READ</code> <span style="font-style: italic;">var1</span><code>,</code>
+<span style="font-style: italic;">var2</span><code>,</code>
+...</dt>
+<dd>Reads data from <code>DATA</code> statements
+into variables. A pointer is maintained into the <code>DATA</code>
+values, which could be anywhere within the program. Values are read in
+order into the variables, and the pointer is advanced. A runtime error
+occurs if there are not enough <code>DATA</code> values to
+fill the variables. The <code>DATA</code> pointer can be
+reset using a <code>RESTORE</code> statement. Example: <code>READ
+A$, B</code>.</dd>
+<dt><code>REM</code> <span style="font-style: italic;">text</span></dt>
+<dd>A comment (remark). All characters through the end of the
+line are considered to be part of the comment. Example: <code>REM
+BRIDGE BY J. Q. PROGRAMMER</code>.</dd>
+<dt><code>RESTORE</code> [<span style="font-style: italic;">label</span>]</dt>
+<dd>Adjusts the <code>DATA</code> value pointer.
+Without a line number, the pointer is reset to the first <code>DATA
+</code>statement of the program. With a line number, the
+pointer is moved to the first <code>DATA</code> statement
+on or following that line.</dd>
+<dt><code>RETURN</code></dt>
+<dd>Returns control to the statement following the most
+recently executed <code>GOSUB</code> to which control has
+not already been <code>RETURN</code>ed. <code>GOSUB-RETURN</code>
+pairs can be nested to any depth. If there is no such <code>GOSUB</code>,
+a runtime error occurs. As with FOR-NEXT, association of a <code>RETURN</code>
+with a <code>GOSUB</code> is dynamic; it cannot be
+statically determined in all cases.</dd>
+<dt><code>STOP</code></dt>
+<dd><code></code>In early BASICs, the <code>END</code>
+statement could only appear at the end of the program. The <code>STOP</code>
+statement was designed to send control to that solitary <code>END</code>
+statement. Vintage BASIC imitates this behavior by treating the <code>STOP</code>
+statement as an <code>END</code>. This is unlike Microsoft
+version of BASIC, in which <code>STOP</code> is used to
+terminate the program without clearing variables, so that they can be
+inspected for debugging purpose, and the <code>CONT</code>
+statement can resume control where it left off. That wouldn't be very
+useful in Vintage BASIC, since it does not have a read-eval-print loop.</dd>
+</dl>
+<h2><a class="mozTocH2" name="mozTocId193848"></a>Error
+Messages</h2>
+<dl>
+<dt><code>!BAD GOSUB TARGET </code><span style="font-style: italic;">label1</span><code>
+in line </code><span style="font-style: italic;">label2</span></dt>
+<dd>There is no line number corresponding to the target
+specified for the <code>GOSUB</code>.</dd>
+<dt><code>!BAD GOTO TARGET </code><span style="font-style: italic;">label1</span><code>
+in line </code><span style="font-style: italic;">label2</span></dt>
+<dd>There is no line number corresponding to the target
+specified for the <code>GOTO</code>.</dd>
+<dt><code>!BAD RESTORE TARGET </code><span style="font-style: italic;">label1</span><code>
+in line </code><span style="font-style: italic;">label2</span></dt>
+<dd>There is no line number corresponding to the target
+specified for the <code>RESTORE</code>.</dd>
+<dt><code>!BREAK IN LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>A <code>STOP</code> statement was encountered.</dd>
+<dt><code>!DIVISION BY ZERO IN LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>An attempt was made to divide by zero.</dd>
+<dt><code>!END OF INPUT IN LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>An attempt to <code>INPUT</code> characters
+failed because the end of the standard input stream was reached.</dd>
+<dt><code>!INVALID ARGUMENT IN LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>The argument supplied to a builtin function was outside of
+the allowed range.</dd>
+<dt><code>!LINE NUMBERING ERROR IN RAW LINE&nbsp;</code><span style="font-style: italic;">nn</span></dt>
+<dd>The line scanner could not properly read line numbers, or
+the file did not end in a newline.</dd>
+<dt><code>!MISMATCHED ARRAY DIMENSIONS IN LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>The
+number of indices used in an array reference does not match the number
+of bounds supplied in the DIM statement (1 if it was not dimensioned).</dd>
+<dt><code>!NEGATIVE ARRAY DIM IN LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>A negative value was supplied as an array index, or bound
+in a <code>DIM</code> statement.</dd>
+<dt><code>!NEXT WITHOUT FOR ERROR IN LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>A <code>NEXT</code> statement was encountered,
+but a matching <code>FOR</code> statement could not be
+found. Either a <code>FOR</code> statement was never
+encountered, or all <code>FOR</code> statements have
+reached their termination conditions.</dd>
+<dt><code>!NEXT WITHOUT FOR ERROR (VAR </code><span style="font-style: italic;">X</span><code>) IN
+LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>A <code>NEXT</code> statement was encountered,
+but a matching <code>FOR</code> statement could not be
+found. Either a <code>FOR</code> statement with that
+control variable was never encountered, or all <code>FOR</code>
+statements with that control variable have reached their termination
+conditions.</dd>
+<dt></dt>
+<dt><code>!OUT OF ARRAY BOUNDS IN LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>A supplied array index exceeded the bound for that
+dimension.</dd>
+<dt><code>!OUT OF&nbsp;DATA IN LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>A <code>READ</code> statement in this line
+tried to read data, but the <code>DATA</code> pointer has
+already reached the end of data strings in the program. You may have
+too few <code>DATA</code> statements, or a bad loop
+termination condition that causes too many <code>READ</code>s.</dd>
+<dt><code>!REDIM'D ARRAY IN LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>A <code>DIM</code> statement was encountered,
+but the array has already been dimensioned, either explicitly (through
+anorther <code>DIM</code> statement), or automatically
+(through reference to the array).</dd>
+<dt><code>!RETURN WITHOUT GOSUB ERROR IN LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>A <code>RETURN</code> statement was
+encountered, but a matching <code>GOSUB</code> statement
+could not be found. Either a <code>GOSUB</code> statement
+was never encountered, or all <code>GOSUB</code>
+statements have already been <code>RETURN</code>ed to.</dd>
+<dt><code>!SYNTAX ERROR IN LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>The program did not meet valid <a href="#Basic_Syntax">syntax
+requirements</a>. The error may contain more details as to what
+symbols were found or expected.</dd>
+<dt><code>!TYPE MISMATCH IN LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>The
+type of an expression was not the type expected by the surrounding
+context, whether it be an operator, builtin function, user-defined
+function, array, or statement that requires an expression. In a <code>READ</code>
+statement, the type of the variable did not match the value read.</dd>
+<dt><code>!UNDEFINED FUNCTION </code><span style="font-style: italic;">X</span><code> IN
+LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>The user-defined function was called via <code>FN</code>
+but has never been defined by <code>DEF FN</code>.</dd>
+<dt><code>!WRONG NUMBER OF ARGUMENTS IN LINE </code><span style="font-style: italic;">label</span></dt>
+<dd>The wrong number of arguments were passed to the builtin or
+user-defined function.</dd>
+</dl>
+</body></html>

@@ -0,0 +1,12 @@+10 LINES=17+20 FORI=1TOLINES/2+1+30 FORJ=1TO(LINES+1)/2-I+1:PRINT" ";:NEXT+40 FORJ=1TOI*2-1:PRINT"*";:NEXT+50 PRINT+60 NEXTI+70 FORI=1TOLIVES/2:REM note misspelled variable is the same+75 REM because variables are unique to only two characters+80 FORJ=1TOI+1:PRINT" ";:NEXT+90 FORJ=1TO((LINES+1)/2-I)*2-1:PRINT"*";:NEXT+100 PRINT+110 NEXTI

@@ -0,0 +1,10 @@+10 INPUT"ENTER A NUMBER";N
+20 ?"ABS(N)=";ABS(N)
+25 ?"ATN(N)=";ATN(N)
+30 ?"COS(N)=";COS(N)
+40 ?"EXP(N)=";EXP(N)
+50 ?"INT(N)=";INT(N)
+60 ?"LOG(N)=";LOG(N)
+70 ?"SGN(N)=";SGN(N)
+80 ?"SQR(N)=";SQR(N)
+90 ?"TAN(N)=";TAN(N)

@@ -0,0 +1,5 @@+10 INPUT"WHAT IS YOUR NAME";NAME$+20 INPUT"ENTER A NUMBER";N+30 FORI=1TON+40 ?"HELLO, ";NAME$;"!"+50 NEXT

@@ -0,0 +1,14 @@+10 INPUT "What is your name"; U$
+20 PRINT "Hello "; U$
+30 INPUT "How many stars do you want"; N
+40 S$ = ""
+50 FOR I = 1 TO N
+60 S$ = S$ + "*"
+70 NEXT I
+80 PRINT S$
+90 INPUT "Do you want more stars"; A$
+100 IF LEN(A$) = 0 THEN 90
+110 A$ = LEFT$(A$, 1)
+120 IF A$ = "Y" OR A$ = "y" THEN 30
+130 PRINT "Goodbye ";U$
+140 END

@@ -0,0 +1,12 @@+10 INPUT"ENTER A STRING";A$
+20 INPUT"ENTER A NUMBER";N
+30 ?"ASC(A$)=";ASC(A$)
+40 ?"CHR$(N)=";CHR$(N)
+50 ?"LEFT$(A$,N)=";LEFT$(A$,N)
+60 ?"MID$(A$,N)=";MID$(A$,N)
+70 ?"MID$(A$,N,3)=";MID$(A$,N,3)
+80 ?"RIGHT$(A$,N)=";RIGHT$(A$,N)
+90 ?"LEN(A$)=";LEN(A$)
+100 ?"VAL(A$)=";VAL(A$)
+110 ?"STR$(N)=";STR$(N)
+120 ?"SPC(N)='";SPC(N);"'"

@@ -0,0 +1,81 @@+#!/usr/local/bin/runhaskell++import Data.Array ((!))+import Data.List (intersperse)+import Data.Maybe (catMaybes)+import System.Cmd (system)+import System.Directory (doesDirectoryExist,getCurrentDirectory,getDirectoryContents)+import System.FilePath ((</>))+import System.Environment (getArgs)+import Text.Regex.Base+import Text.Regex.Posix++testFilePat = makeRegex "^.*_test.hs$" :: Regex+testFuncPat = makeRegex "^ *(test_[A-Za-z0-9_']*) *=" :: Regex+testModuleNamePat = makeRegex "^ *module *([A-Za-z0-9_'.]*)" :: Regex++main = do+   args <- getArgs+   testModulePaths <- if null args then findModulePaths else return args+   putStrLn "Running tests in files:"+   sequence_ [putStrLn ("  " ++ testModulePath) | testModulePath <- testModulePaths]+   putStrLn ""+   putStrLn "Tests found:"+   modulesWithTests <-+       sequence [do moduleCode <- readFile testModulePath+                    let testModule = findModuleName moduleCode+                    putStrLn ("  " ++ testModule)+                    let tests = findTests moduleCode+                    sequence_ [putStrLn ("    " ++ test) | test <- tests]+                    return (testModule, findTests moduleCode)+                 | testModulePath <- testModulePaths]+   let testCode = genTestDriver modulesWithTests+   writeFile "test_driver.hs" testCode+   system ("runhaskell -itest -isrc test_driver.hs")++findFilesInSubdirs :: FilePath -> IO [String]+findFilesInSubdirs dir = do+    files <- getDirectoryContents dir+    let paths = [dir </> file | file <- filter (`notElem` [".", ".."]) files]+    paths' <- sequence [do { t <- doesDirectoryExist path; if t then findFilesInSubdirs path else return [] } | path <- paths]+    return $ concat (paths : paths')++findModulePaths :: IO [String]+findModulePaths = do+    files <- findFilesInSubdirs "test"+    return $ map head $ concat [match testFilePat file | file <- files]++matchTextToSubstring :: MatchText String -> String+matchTextToSubstring mt = fst (mt ! 1)++findModuleName :: String -> String+findModuleName str =+    case matchOnceText testModuleNamePat str of+        Nothing -> error "Unable to find module name in file"+        (Just (_, mt, _)) -> matchTextToSubstring mt++findTests :: String -> [String]+findTests str = [matchTextToSubstring mt | mt <- matchAllText testFuncPat str]++genTestDriver modulesWithTests =+    "import System.Exit\n"+    ++ "import Test.HUnit\n"+    ++ concat [genImport testModule | (testModule,_) <- modulesWithTests]+    ++ "\n"+    ++ "main = do\n"+    ++ "   (Counts cases tried errors failures) <- runTestTT $\n"+    ++ "      TestList [\n"+    ++ concat (intersperse ",\n"+                 [genTest testModule testFunc+                  | (testModule,testFuncs) <- modulesWithTests, testFunc <- testFuncs])+    ++ "\n"+    ++ "               ]\n"+    ++ "   exitWith $ if errors > 0 || failures > 0\n"+    ++ "                then ExitFailure (errors+failures)\n"+    ++ "                else ExitSuccess\n"++genImport testModule = "import qualified " ++ testModule ++ "\n"++genTest testModule testFunc =+    let qualifiedTest = testModule ++ "." ++ testFunc+       in "                TestLabel \"" ++ qualifiedTest ++ "\" " ++ qualifiedTest

@@ -0,0 +1,14 @@+import System.Environment(getArgs)+import System.IO+import Language.VintageBasic.Executer(executeFile)+import Language.VintageBasic.BasicMonad(runProgram)+import Control.Monad.CPST.DurableTraps(done)+import IO.IOStream++-- | Runs a list of BASIC programs specified on the command line.+main :: IO ()+main = do+    args <- getArgs+    runProgram (IOStream stdin) (IOStream stdout) $ do+        sequence_ [executeFile fileName | fileName <- args]+        done

@@ -0,0 +1,74 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, RankNTypes, UndecidableInstances #-}++-- | A continuation-passing style monad transformer, providing partial continuations.+-- Advantages of CPST over ContT include the definition of shift and reset in the+-- monad, and the rank-3 polymorphism for flexible contexts. The disadvantage is that+-- no other monad transformers can be composed on top of it, because it has too many+-- parameters.++module Control.Monad.CPST where++import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Trans++-- | Definition of the CPST (continuation-passing style) monad.+newtype Monad m => CPST o m i =+      CPST { unCPST :: (i -> m o) -> m o }++instance (Monad m) => Functor (CPST o m) where+    fmap f (CPST m') = CPST (\k -> m' (k . f))++instance Monad m => Monad (CPST o m) where+      return x = CPST (\k -> k x)+      (CPST m') >>= f = CPST (\k -> m' (\x -> unCPST (f x) k))++-- The basic monad utilities: runCPST, lift, liftIO++-- | Runs code in the CPST monad.+runCPST :: Monad m => CPST o m o -> m o+runCPST (CPST m') = m' return++instance MonadTrans (CPST o) where+    lift m = CPST (\k -> do x <- m; k x)++instance (MonadIO m) => MonadIO (CPST o m) where+    liftIO = lift . liftIO++-- The core morphisms of CPST: shift, reset --++shift :: Monad m => ((forall a. i -> CPST a m o) -> CPST o m o) -> CPST o m i+-- ^ Captures a partial continuation out to the nearest enclosing 'reset'.+-- The rank-3 polymorphism permits the partial continuation to be used+-- in multiple differing type contexts.+shift f = CPST (\k -> runCPST (f (\x -> CPST (\k' -> k x >>= k'))))++reset :: Monad m => CPST i m i -> CPST o m i+reset m = CPST (\k -> do x <- runCPST m; k x)+-- ALTERNATELY: reset m = CPST (runCPST m >>=)++-- Other morphisms written in terms of shift & reset, without unwrapping+-- the monad.++abort :: Monad m => o -> CPST o m a+abort x = shift (\_ -> return x)+-- ALTERNATELY: abort x = CPST (\_ -> return x)++callCC :: Monad m => ((forall a. i -> CPST o m a) -> CPST o m i) -> CPST o m i+-- ^ Transforms a real continuation into a CPS-level continuation,+-- passes it into f.  The type is rank-3 polymorphic,+-- which permits the same continuation to be used in different+-- type contexts.  This is OK since invoking the continuation+-- disposes of the context.+callCC f = shift (\k -> (f (\x -> k x >>= abort)) >>= k)+-- ALTERNATELY: callCC f = CPST (\k -> unCPST (f (\x -> CPST (\_ -> k x))) k)++instance MonadReader r m => MonadReader r (CPST o m) where+    ask = lift ask+    local f (CPST m') =+        CPST (\k -> do r <- ask+                       local f (m' (\x -> local (const r) (k x))))++instance MonadState s m => MonadState s (CPST o m) where+    get = lift get+    put s = lift $ put s

@@ -0,0 +1,139 @@+{-# LANGUAGE FlexibleContexts, RankNTypes #-}++-- | Support for advanced exception handling within the CPST monad.++module Control.Monad.CPST.DurableTraps where++import Control.Monad+import Control.Monad.CPST+import Control.Monad.CPST.ExceptionHandlers(capture,install,raise)++class ResultType o where+    okValue :: o++-- | A continuation in the CPST monad, for code that may+-- throw exceptions.+type Cont o m i = i -> CPST (Excep o m i) m (Excep o m i)++-- | The full-blown exception including not only an exception value,+-- but a handler stack and continuation. Having all this allows+-- an exception handler to manipulate the handler stack or resume+-- using the exception's continuation.+--+-- [@o@] is the result type (e.g., OK, or an exception value)+--+-- [@i@] is the type to pass to the continuation (bound to the raise)+--+-- Both types must remain the same throughout your CPS computation.+data Excep o m i =+    Excep { exceptionValue        :: o+          , exceptionHandlerStack :: (Excep o m i -> CPST (Excep o m i) m (Excep o m i))+          , exceptionContinuation :: (Cont o m i)+          }++-- | Packages the current continuation with the exception value,+-- and an empty handler stack.+raiseCC :: (Monad m, ResultType o) => o -> CPST (Excep o m i) m i+raiseCC x = callCC (\k -> raise (Excep x return k))++type ExceptionResumer o m = forall a. Bool -> CPST (Excep o m ()) m a++type ExceptionHandler o m = Monad m => o -> ExceptionResumer o m -> ExceptionResumer o m+    -> ExceptionResumer o m -> CPST (Excep o m ()) m (Excep o m ())++-- | A flexible exception handling mechanism.  It takes a function 'f' as a+-- parameter, to which it passes three continuations: @passOn@, @resume@,+-- and @continue@.+--+-- [@passOn@] pass control of the exception on up the handler chain (re-raise)+--+-- [@resume@] return to where the exception was raised (the exception's continuation)+--+-- [@continue@] continue with the code following the 'trap' statement+--     (the handler's continuation)+--+-- Each of these continuations is parametrized by a boolean value:+--+-- [@endure = True@] keep this handler in force+--+-- [@endure = False@] disable this handler (remove it from the chain)++trap :: Monad m+    => ExceptionHandler o m     -- ^ exception handler+    -> CPST (Excep o m ()) m ()++-- Local variables:+--+-- [@h hk@] the full handler with all logic+--+-- [@xv  @] exception value+--+-- [@hk  @] handler's continuation+--+-- [@hc  @] handler chain+--+-- [@xk  @] exception's continuation++trap f = callCC (\hk -> install (h hk))+    where h hk (Excep xv hc xk) =+              let hc' exc' = capture (h hk) (hc exc')+                  xk' v  = capture (h hk) (xk v) >>= raise+                  passOn endure =+                      if endure+                         then raise (Excep xv hc' xk')+                         else raise (Excep xv hc  xk')+                  resume endure =+                      if endure+                         then xk' ()           -- might want other than (),+                         else xk  () >>= raise -- say, for implementing state+                  continue endure =+                      if endure+                         then install hc' >>= hk >>= raise+                         else install hc  >>= hk >>= raise+                  in f xv passOn resume continue++-- | The catching version of trap.  It catches exceptions from+-- an expression, instead of from its continuation.++catchC :: Monad m+    => ExceptionHandler o m                 -- ^ exception handler+    -> CPST (Excep o m ()) m (Excep o m ()) -- ^ computation in which to catch exceptions+    -> CPST (Excep o m ()) m (Excep o m ())++catchC f m = callCC (\hk -> capture (h hk) m)+    where h hk (Excep xv hc xk) =+              let hc' exc' = capture (h hk) (hc exc')+                  xk' v  = capture (h hk) (xk v) >>= hk >>= raise+                  passOn endure =+                      if endure+                         then raise (Excep xv hc' xk')+                         else raise (Excep xv hc  xk')+                  resume endure =+                      if endure+                         then xk' ()           -- might want other than (),+                         else xk  () >>= raise -- say, for implementing state+                  continue endure =+                      if endure+                         then install hc' >> hk (Excep xv hc' xk') >>= raise+                         else install hc  >> hk (Excep xv hc xk') >>= raise+                  in f xv passOn resume continue++-- | Like abort, ends in the middle of a program.  Can be resumed.+end :: (Monad m, ResultType o) => CPST (Excep o m i) m i+end = raiseCC okValue++-- | Can be added at the end of a @do@-sequence to make the return type+-- match the ultimate return type. It returns OK with a continuation that+-- regenerates itself.+done :: (Monad m, ResultType o) => CPST (Excep o m i) m (Excep o m i)+done = return (Excep okValue return (\_ -> done))++-- | Raises an exception that can't be resumed, and can be used in any context.+die :: (Monad m, ResultType o) => o -> CPST (Excep o m i) m a+die x = raise (Excep x return (error "cannot resume from a die"))++-- Note: getCC might seem like a nice idea, but it's untypable, since the continuation+-- has to take itself as an argument. An incorrect attempt:+--+-- getcc :: CPST o m (Cont m o i)+-- getcc = callCC (\k -> return k)

@@ -0,0 +1,75 @@+-- | Exception handlers for the CPST monad, both \'catching\' (within an expression)+-- and \'trapping\' (from the handler's continuation).++module Control.Monad.CPST.ExceptionHandlers where++import Control.Monad+import Control.Monad.CPST++-- The inward (catching) exception handlers --++-- | Captures an exception that occurs within the specified computation.+-- Like @try-catch@ in Java, but without the filtering of exceptions.+capture :: Monad m+    => (o1 -> CPST o m i) -- ^ the exception handler+    -> CPST o1 m o1       -- ^ the computation within which to capture exceptions+    -> CPST o m i+capture f m = reset m >>= f++-- | Forces a computation to occur after another one, even if the first one is+-- aborted. Like @try-finally@ in Java.+tack :: Monad m+    => CPST o m i   -- ^ the computation to tack on (@finally@ clause)+    -> CPST o1 m o1 -- ^ the computation to wrap (@try@ clause)+    -> CPST o m i+tack m = capture (\_ -> m)++-- | Catches exceptions in a computation that satisfy a predicate, and applies+-- a function to them. If the exception does not match the predicate, it+-- rethrows the exception. This is like @try-catch@ in Java.+handle :: Monad m+    => (o -> Bool)       -- ^ the condition for matching the exception+    -> (o -> CPST o m o) -- ^ the exception handler+    -> CPST o m o        -- ^ the computation within which to catch exceptions+    -> CPST o m o+handle t f = capture (\x -> if t x then f x else abort x)++-- The outward (trapping) exception handlers --++-- | Captures an exception that occurs in the continuation of this statement.+-- Like a @trap@ statement in Bourne shell or Windows PowerShell, but without+-- discriminating over the exception type.+captureAtEnd :: Monad m+    => (o -> CPST o m o) -- ^ the exception handler+    -> CPST o m ()+captureAtEnd f = shift (\k -> reset (k ()) >>= f)+-- ALTERNATELY: captureAtEnd f = CPST (\k -> do x <- k (); runCPST (f x))+-- ALTERNATELY: captureAtEnd f = callCC (\k -> reset (k ()) >>= f >>= abort)++-- | Forces a computation to occur at the end of execution. Like an @END@+-- block in Perl or @atexit()@ in C.+tackAtEnd :: Monad m+    => CPST o m o  -- ^ the computation to tack at the end of execution+    -> CPST o m ()+tackAtEnd m = captureAtEnd (\_ -> m)+-- ALTERNATELY: tackAtEnd m = CPST (\k -> do k (); runCPST m)++-- | Handles an exception that occurs in the continuation of this statement.+-- Like a @trap@ statement in Bourne shell or Windows PowerShell.+-- The exception is only caught if it matches a predicate. Otherwise, it is+-- passed on to the next outer handler.+handleAtEnd :: Monad m+    => (o -> Bool)       -- ^ the condition for matching the exception+    -> (o -> CPST o m o) -- ^ the exception handler+    -> CPST o m ()+handleAtEnd t f = captureAtEnd (\x -> if t x then f x else return x)++-- Some convenient aliases++-- | An alias for 'abort'.+raise :: Monad m => o -> CPST o m a+raise = abort++-- | An alias for 'captureAtEnd'.+install :: Monad m => (o -> CPST o m o) -> CPST o m ()+install = captureAtEnd

@@ -0,0 +1,61 @@+{-# LANGUAGE ExistentialQuantification, FlexibleInstances #-}
+
+-- | A class describing IO operations with instances for IO and strings.
+-- This is primarily for the purpose of unit testing.
+module IO.IOStream (IOStream(..),IOStream'(..)) where
+
+import Data.IORef
+import System.IO
+
+-- | The abstract base class describing methods for IOStreams.
+-- The purpose of each function is identical to the ones in
+-- System.IO.Handle starting with an 'h' instead of a 'v'.
+class IOStream' h where
+    vGetContents :: h -> IO String
+    vSetContents :: h -> String -> IO ()
+    vPutStr :: h -> String -> IO ()
+    vFlush :: h -> IO ()
+    vGetLine :: h -> IO String
+    vIsEOF :: h -> IO Bool
+
+-- | An instance of IOStream' for IO Handles.
+instance IOStream' Handle where
+    vGetContents = hGetContents
+    vSetContents h s = hSetFileSize h 0 >> hPutStr h s
+    vPutStr  = hPutStr
+    vFlush   = hFlush
+    vGetLine = hGetLine
+    vIsEOF   = hIsEOF
+
+-- | An instance for IOStream' for references to Strings.
+instance IOStream' (IORef String) where
+    vGetContents h = readIORef h
+    vSetContents h s = writeIORef h s
+    vPutStr h s = modifyIORef h (\text -> text ++ s)
+    vFlush _ = return ()
+    vGetLine h = do
+        text <- readIORef h
+        let (s, text') = span (/= '\n') text
+        if not (null text') && head text' == '\n'
+            then do
+                writeIORef h (tail text')
+                return s
+            else do
+                writeIORef h ""
+                return text'
+    vIsEOF h = do
+        text <- readIORef h
+        return $ null text
+
+-- | A datatype wrapper for IOStream'.
+data IOStream = forall h. IOStream' h => IOStream h
+
+-- | IOStream is itself an instance of IOStream', which reduces the
+-- overhead of unwrapping them from the IOStream constructor.
+instance IOStream' IOStream where
+    vGetContents (IOStream h) = vGetContents h
+    vSetContents (IOStream h) = vSetContents h
+    vPutStr (IOStream h) = vPutStr h
+    vFlush (IOStream h) = vFlush h
+    vGetLine (IOStream h) = vGetLine h
+    vIsEOF (IOStream h) = vIsEOF h

@@ -0,0 +1,289 @@+{-# LANGUAGE FlexibleContexts, Rank2Types #-}++-- | This monad provides runtime support for variable assignment,+-- user-defined functions, I/O, and a jump table.++module Language.VintageBasic.BasicMonad where++import Prelude hiding (lookup)+import Control.Monad.CPST+import Control.Monad.CPST.DurableTraps+import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Trans+import Data.HashTable+import Data.IORef+import Data.Array.IO+import Data.Maybe+import Data.Time+import IO.IOStream+import Language.VintageBasic.Printer(printVarName)+import Language.VintageBasic.Result+import Language.VintageBasic.Syntax+import System.Random++-- | Values in BASIC programs.+data Val = FloatVal Float | IntVal Int | StringVal String+    deriving (Eq,Show,Ord)++instance Typeable Val where+    typeOf (FloatVal  _) = FloatType+    typeOf (IntVal    _) = IntType+    typeOf (StringVal _) = StringType++-- | The default variable value (before assignment) for each BASIC type.+defVal :: ValType -> Val+defVal FloatType  = FloatVal 0+defVal IntType    = IntVal 0+defVal StringType = StringVal ""++-- | The store of BASIC variables.+data BasicStore = BasicStore {+    scalarTable :: HashTable VarName (IORef Val),+      -- ^ scalar variable assignments+    arrayTable :: HashTable VarName ([Int], IOArray Int Val),+      -- ^ array variable values (@[Int]@ lists the bound of each dimension)+    fnTable :: HashTable VarName (IORef ([Val] -> Code Val))+      -- ^ user-defined function (@DEF FN@) definitions+}++-- | The default array bounds.+defBounds :: [Int]+defBounds = [11] -- one dimension, 0-10++-- | The common way to convert Float to Int values in BASIC is to round down.+floatToInt :: Float -> Int+floatToInt = floor++data BasicState = BasicState {+    inputStream :: IOStream,  -- ^ where @INPUT@ comes from+    outputStream :: IOStream, -- ^ where @PRINT@ output goes+    lineNumber :: Int,        -- ^ for error reporting+    outputColumn :: Int,      -- ^ for the @TAB()@ function+    prevRandomVal :: Float,   -- ^ the previously generated random value+    randomGen :: StdGen,      -- ^ random number generator+    dataStrings :: [String]   -- ^ the strings extracted from all @DATA@ statements+}++type BasicRT = ReaderT BasicStore (StateT BasicState IO)+type Basic o = CPST o BasicRT+type BasicCont o i = Cont o BasicRT i+type BasicExcep o i = Excep o BasicRT i+type Code a = Basic (BasicExcep Result ()) a+type Program = Code (BasicExcep Result ())+type BasicExceptionHandler = ExceptionHandler Result BasicRT++-- | An exception handler used to print error messages at the outermost+-- level of execution.+errorDumper :: BasicExceptionHandler+errorDumper x _ _ continue = do+    case x of+        Pass -> return ()+        _    -> printString $ (show x ++ "\n")+    continue False++-- | Runs an interpreted BASIC program using the supplied input and output streams.+runProgram+    :: IOStream -- ^ input stream+    -> IOStream -- ^ output stream+    -> Program  -- ^ the BASIC program, in lazy interpreted form+    -> IO ()+runProgram inputHandle outputHandle prog = do+    vFlush outputHandle+    st <- new (==) (hashString . printVarName)+    at <- new (==) (hashString . printVarName)+    ft <- new (==) (hashString . printVarName)+    let store = BasicStore st at ft+    let state = (BasicState inputHandle outputHandle 0 0 0 (mkStdGen 0) [])+    runStateT (runReaderT (runCPST (catchC errorDumper prog)) store) state+    return ()++-- | Raises a runtime error if the assertion is False.+assert :: Bool -> RuntimeError -> Code ()+assert cond err = if cond then return () else raiseRuntimeError err++raiseRuntimeException :: RuntimeException -> Code ()+raiseRuntimeException rte = do+    state <- get+    raiseCC (LabeledRuntimeException (lineNumber state) rte)+    return ()++raiseRuntimeError :: RuntimeError -> Code ()+raiseRuntimeError err = raiseRuntimeException (RuntimeError err)++extractFloatOrFail :: RuntimeError -> Val -> Code Float+extractFloatOrFail _   (FloatVal fv) = return fv+extractFloatOrFail err _             = raiseRuntimeError err >> return 0++-- | Get the value of a scalar variable.+getScalarVar :: VarName -> Basic o Val+getScalarVar vn = do+    store <- ask+    liftIO $ do+        maybeVarRef <- lookup (scalarTable store) vn+        case maybeVarRef of+            Nothing -> return (defVal (typeOf vn))+            (Just varRef) -> readIORef varRef++-- | Set the value of a scalar variable.+setScalarVar :: VarName -> Val -> Basic o ()+setScalarVar vn val = do+    store <- ask+    liftIO $ do+        maybeVarRef <- lookup (scalarTable store) vn+        case maybeVarRef of+            Nothing -> do+                ref <- newIORef val+                insert (scalarTable store) vn ref+            (Just varRef) -> writeIORef varRef val++-- | BASIC indices range from zero to an upper bound.+-- We're storing 1+ that bound, to make computations easier.+indicesAreWithinBounds :: [Int] -> [Int] -> Bool+indicesAreWithinBounds bounds indices =+    and $ (zipWith (>) bounds indices) ++ (map (>=0) indices)++-- | Given the array's bounds and indices, compute the linear index+-- into the storage array.+arrIndex :: [Int] -> [Int] -> Int+arrIndex bounds indices =+    let scales = tail $ scanr (*) 1 bounds+        in sum $ zipWith (*) scales indices++-- | Create a new array in the store, with the specified name and bounds.+dimArray :: VarName -> [Int] -> Code ([Int], (IOArray Int Val))+dimArray vn bounds = do+    store <- ask+    maybeArray <- liftIO $ lookup (arrayTable store) vn+    assert (isNothing maybeArray) ReDimensionedArrayError+    arr <- liftIO $ newArray (0, product bounds - 1) (defVal (typeOf vn))+    liftIO $ insert (arrayTable store) vn (bounds, arr)+    return (bounds, arr)++-- | Look up an array from the store. Indices are provided just to check+-- validity.+lookupArray :: VarName -> [Int] -> Code ([Int], (IOArray Int Val))+lookupArray vn indices = do+    store <- ask+    maybeArray <- liftIO $ lookup (arrayTable store) vn+    (bounds, arr) <- case maybeArray of+        Nothing -> dimArray vn defBounds+        (Just (bounds, arr)) -> return (bounds, arr)+    assert (length bounds == length indices) MismatchedArrayDimensionsError+    assert (indicesAreWithinBounds bounds indices) OutOfArrayBoundsError+    return (bounds, arr)++-- | Get a value from an array variable.+getArrVar :: VarName -> [Int] -> Code Val+getArrVar vn indices = do+    (bounds, arr) <- lookupArray vn indices+    liftIO $ readArray arr (arrIndex bounds indices)++-- | Set a value in an array variable.+setArrVar :: VarName -> [Int] -> Val -> Code ()+setArrVar vn indices val = do+    (bounds, arr) <- lookupArray vn indices+    liftIO $ writeArray arr (arrIndex bounds indices) val++-- | Retrieve the code for a user-defined function from the store.+getFn :: VarName -> Code ([Val] -> Code Val)+getFn vn = do+    store <- ask+    maybeVarRef <- liftIO $ lookup (fnTable store) vn+    assert (isJust maybeVarRef) (UndefinedFunctionError vn)+    liftIO $ readIORef (fromJust maybeVarRef)++-- | Define a user-defined function in the store.+setFn :: VarName -> ([Val] -> Code Val) -> Code ()+setFn vn fn = do+    store <- ask+    liftIO $ do+        maybeVarRef <- lookup (fnTable store) vn+        case maybeVarRef of+            Nothing -> do+                ref <- newIORef fn+                insert (fnTable store) vn ref+            (Just varRef) -> writeIORef varRef fn++-- | Set the current line number in the BASIC state.+setLineNumber :: Int -> Basic o ()+setLineNumber lineNum = modify (\state -> state { lineNumber = lineNum })++-- | The width of print zones, used for commas in a @PRINT@ statement.+zoneWidth :: Int+zoneWidth = 14++-- | Output a string, updating the current output column in the state.+printString :: String -> Basic o ()+printString s = do+    state <- get+    let startCol = outputColumn state+    liftIO $ vPutStr (outputStream state) s >> vFlush (outputStream state)+    put (state { outputColumn = endCol startCol s })++-- | Given a starting column and a string, returns the ending column,+-- were that string to be output.+endCol :: Int -> String -> Int    +endCol startCol "" = startCol+endCol _ ('\n' : s) = endCol 0 s+endCol _ ('\r' : s) = endCol 0 s+endCol startCol (_ : s) = endCol (startCol + 1) s++-- | Retrieves the current output column from the state.+getOutputColumn :: Code Int+getOutputColumn = do+    state <- get+    return $ outputColumn state++-- | Gets an input line, raising an exception if we are at EOF.+getString :: Code String+getString = do+    state <- get+    liftIO $ vFlush (outputStream state)+    eof <- liftIO $ vIsEOF (inputStream state)+    assert (not eof) EndOfInputError+    liftIO $ vGetLine (inputStream state)++-- | The number of seconds that have elapsed since midnight (local time).+secondsSinceMidnight :: Code Int+secondsSinceMidnight = do+    zonedTime <- liftIO getZonedTime+    return (floor $ toRational $ timeOfDayToTime $ localTimeOfDay $+      zonedTimeToLocalTime zonedTime)++-- | Seeds the BASIC random number generator using an integer.+seedRandom :: Int -> Code ()+seedRandom i = modify (\state -> state { randomGen = (mkStdGen i) })++-- | Seeds the BAISC random number generator based on the number of+-- seconds since midnight.+seedRandomFromTime :: Code ()+seedRandomFromTime = secondsSinceMidnight >>= seedRandom++-- | Get the previously generated random number from the state.+-- Used for @RND(0)@.+getPrevRandom :: Code Float+getPrevRandom = do+    state <- get+    return (prevRandomVal state)++-- | Generate a new random number.+getRandom :: Code Float+getRandom = do+    state <- get+    let (rVal, rGen) = random (randomGen state)+    put (state { prevRandomVal = rVal, randomGen = rGen })+    return rVal++-- | Set the list of @DATA@ statement strings in the store.+setDataStrings :: [String] -> Code ()+setDataStrings ds = modify (\store -> store { dataStrings = ds })++-- | @READ@ the next @DATA@ value from the data strings.+readData :: Code String+readData = do+    state <- get+    let ds = dataStrings state+    assert (not (null ds)) OutOfDataError+    put (state { dataStrings = tail ds })+    return (head ds)

@@ -0,0 +1,36 @@+-- | A representation of BASIC's builtin functions.
+
+module Language.VintageBasic.Builtins where
+
+-- | An enumeration of BASIC's builtin functions.
+data Builtin =
+    AbsBI | AscBI | AtnBI | ChrBI | CosBI | ExpBI | IntBI | LeftBI | LenBI | LogBI | MidBI
+    | RightBI | RndBI | SgnBI | SinBI | SpcBI | StrBI | SqrBI | TabBI | TanBI | ValBI
+    deriving (Show,Eq)
+
+-- | An association list mapping BASIC builtins to their string representation.
+-- It is used forwards to print BASIC code, and backwards to parse BASIC code.
+builtinToStrAssoc :: [(Builtin, String)]
+builtinToStrAssoc = [
+    (AbsBI,   "ABS"   ),
+    (AscBI,   "ASC"   ),
+    (AtnBI,   "ATN"   ),
+    (ChrBI,   "CHR$"  ),
+    (CosBI,   "COS"   ),
+    (ExpBI,   "EXP"   ),
+    (IntBI,   "INT"   ),
+    (LeftBI,  "LEFT$" ),
+    (LenBI,   "LEN"   ),
+    (LogBI,   "LOG"   ),
+    (MidBI,   "MID$"  ),
+    (RightBI, "RIGHT$"),
+    (RndBI,   "RND"   ),
+    (SgnBI,   "SGN"   ),
+    (SinBI,   "SIN"   ),
+    (SpcBI,   "SPC"   ),
+    (StrBI,   "STR$"  ),
+    (SqrBI,   "SQR"   ),
+    (TabBI,   "TAB"   ),
+    (TanBI,   "TAN"   ),
+    (ValBI,   "VAL"   )
+  ]

@@ -0,0 +1,73 @@+-- | The shell of the interpreter.  It processes command-line parameters,
+-- and calls the line scanner, tokenizer, parser, and interpreter.
+
+module Language.VintageBasic.Executer where
+
+import Control.Monad.CPST.DurableTraps(die)
+import Control.Monad.State(get)
+import Control.Monad.Trans(liftIO)
+import Data.List(deleteFirstsBy,nubBy,sortBy)
+import Language.VintageBasic.Interpreter(interpLines)
+import Language.VintageBasic.LexCommon(Tagged(..))
+import Language.VintageBasic.LineScanner(RawLine,rawLinesP)
+import Language.VintageBasic.BasicMonad(BasicState(..),Code,printString,runProgram)
+import Language.VintageBasic.Parser(statementListP)
+import Language.VintageBasic.Result(Result(..))
+import Language.VintageBasic.Syntax(Line(..))
+import Language.VintageBasic.Tokenizer(TokenizedLine,taggedTokensP)
+import Text.ParserCombinators.Parsec(parse,setPosition,sourceLine)
+
+-- | Given a file path, loads and executes the BASIC code.
+executeFile :: FilePath -> Code ()
+executeFile fileName = do
+    text <- liftIO $ readFile fileName
+    execute fileName text
+
+-- | Executes BASIC code from a string. The file path is provided only for error reporting.
+execute :: FilePath -> String -> Code ()
+execute fileName text = do
+    rawLines <- scanLines fileName text
+    tokenizedLines <- sequence [tokenizeLine rawLine | rawLine <- rawLines]
+    parsedLines <- sequence [parseLine tokenizedLine | tokenizedLine <- tokenizedLines]
+    state <- get
+    liftIO $ runProgram (inputStream state) (outputStream state) $ interpLines parsedLines
+
+-- | Transforms the BASIC source into a series of 'RawLine's using the 'rawLinesP' LineScanner.
+scanLines :: String -> String -> Code [RawLine]
+scanLines fileName text =
+    case parse rawLinesP fileName text of
+        (Left parseError) -> die (ScanError parseError)
+        (Right rawLines)  -> sortNubLines rawLines
+
+-- | Tokenizes a 'RawLine' into a 'TokenizedLine' using the 'taggedTokensP' Tokenizer.
+tokenizeLine :: RawLine -> Code TokenizedLine
+tokenizeLine (Tagged pos text) =
+    case parse (setPosition pos >> taggedTokensP) "" text of
+        (Left parseError)    -> die (SyntaxError parseError)
+        (Right taggedTokens) -> return (Tagged pos taggedTokens)
+
+-- | Parses a 'TokenizedLine' to yield a 'Line', using the 'statementListP' Parser.
+parseLine :: TokenizedLine -> Code Line
+parseLine (Tagged pos taggedTokens) = do
+    case parse (setPosition pos >> statementListP) "" taggedTokens of
+        (Left parseError)     -> die (SyntaxError parseError)
+        (Right statementList) -> return (Line (sourceLine pos) statementList)
+
+-- | Specifies an ordering for 'RawLine's so they can be sorted.
+rawLineOrdering :: RawLine -> RawLine -> Ordering
+rawLineOrdering (Tagged pos1 _) (Tagged pos2 _) = compare (sourceLine pos1) (sourceLine pos2)
+
+rawLinesEq :: RawLine -> RawLine -> Bool
+rawLinesEq l1 l2 = rawLineOrdering l1 l2 == EQ
+
+-- | This function reverses before nubbing so that later lines take precedence.
+sortNubLines :: [RawLine] -> Code [RawLine]
+sortNubLines lineList = do
+    let sortedLines = sortBy rawLineOrdering lineList
+        reversedSortedLines = reverse sortedLines
+        reversedNubbedLines = nubBy rawLinesEq reversedSortedLines
+        nubbedLines = reverse reversedNubbedLines
+        duplicateLines = deleteFirstsBy rawLinesEq lineList nubbedLines
+    sequence_ [printString ("!SUPERSEDING PREVIOUS LINE " ++ show (sourceLine pos) ++ "\n")
+        | (Tagged pos _) <- duplicateLines]
+    return nubbedLines

@@ -0,0 +1,64 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-- | Code for parsing floats. Used both in parsing static code and at runtime+-- (@INPUT@ and @DATA@ statements).++module Language.VintageBasic.FloatParser(FloatParser(..)) where++import Data.Char(isDigit)+import Text.ParserCombinators.Parsec+import Language.VintageBasic.LexCommon(Tagged,getTaggedVal)+import Language.VintageBasic.Tokenizer(Token(..),tokenP,charTokTest)++-- | Generic class for float parsers. Can be used to parse floats from raw+-- characters (useful at runtime) or from tokenized text (for parsing source).+class FloatParser tok st where+    digitP :: GenParser tok st Char+    dotP   :: GenParser tok st Char+    plusP  :: GenParser tok st Char+    minusP :: GenParser tok st Char+    charEP :: GenParser tok st Char++    floatP :: GenParser tok st Float+    floatP = do+        sgn <- option "" sgnP+        mant <- try float2P <|> float1P+        expt <- option "" expP+        return (read (sgn++mant++expt))++    float1P :: GenParser tok st String+    float1P = many1 digitP++    float2P :: GenParser tok st String+    float2P = do+        i <- many digitP+        dotP+        f <- many digitP+        return ("0"++i++"."++f++"0")++    sgnP :: GenParser tok st String+    sgnP = do+        sgn <- plusP <|> minusP+        return (if sgn == '+' then "" else "-")++    expP :: GenParser tok st String+    expP = do+        charEP+        esgn <- option "" sgnP+        i <- many1 digitP+        return ("E"++esgn++i)++instance FloatParser Char st where+    digitP = digit+    dotP   = char '.'+    plusP  = char '+'+    minusP = char '-'+    charEP = char 'E' <|> char 'e'++instance FloatParser (Tagged Token) () where+    digitP = do tok <- tokenP (charTokTest isDigit)+                return (getCharTokChar $ getTaggedVal tok)+    dotP   = tokenP (==DotTok)            >> return '.'+    plusP  = tokenP (==PlusTok)           >> return '+'+    minusP = tokenP (==MinusTok)          >> return '-'+    charEP = tokenP (charTokTest (=='E')) >> return 'E'

@@ -0,0 +1,528 @@+{-# LANGUAGE FlexibleContexts, ParallelListComp, Rank2Types #-}++-- | The heart of the BASIC interpreter. It is implemented on top+-- of the BASIC monad.++module Language.VintageBasic.Interpreter(interpLines) where++import Control.Monad.CPST.DurableTraps+import Data.List+import Data.Maybe+import Language.VintageBasic.Builtins(Builtin(..))+import Language.VintageBasic.LexCommon(Tagged(..))+import Language.VintageBasic.BasicMonad+import Language.VintageBasic.Result+import Language.VintageBasic.Printer(printFloat)+import Language.VintageBasic.RuntimeParser(dataValsP,readFloat,trim)+import Language.VintageBasic.Syntax+import Text.ParserCombinators.Parsec(parse)+import Text.ParserCombinators.Parsec.Pos(sourceLine)++-- | Entry in the jump table, a lookup table that holds both+-- program code and @DATA@ statements, indexed by 'Label'.+data JumpTableEntry = JumpTableEntry {+    jtLabel :: Label,     -- ^ the starting line number+    jtProgram :: Program, -- ^ program source starting at that line+    jtData :: [String]    -- ^ @DATA@ strings starting at that line+}++type JumpTable = [JumpTableEntry]++programLookup :: JumpTable -> Label -> (Maybe Program)+programLookup jt lab = lookup lab [(jtLabel jte, jtProgram jte) | jte <- jt]++dataLookup :: JumpTable -> Label -> (Maybe [String])+dataLookup jt lab = lookup lab [(jtLabel jte, jtData jte) | jte <- jt]++-- | Lazily interprets a list of BASIC lines of code.++interpLines :: [Line] -> Program++-- Note that jumpTable and interpLine are mutually recursive.+-- The jumpTable contains interpreted code, which in turn calls+-- the jumpTable to look up code.  Since the jumpTable is a single+-- data structure, it memoizes interpreted code, making 'interpLines'+-- a just-in-time compiler.  (The only time code is reinterpreted+-- is following an @IF@ statement.)++interpLines progLines =+    let interpLine line@(Line lab stmts) =+            (lab, mapM_ (interpTS jumpTable) stmts, dataFromLine line)+        makeTableEntry (accumCode, accumData) (lab, codeSeg, lineData) =+            let accumCode' = codeSeg >> accumCode+                accumData' = lineData ++ accumData+                in ((accumCode', accumData'), JumpTableEntry lab accumCode' accumData')+        jumpTable = snd $ mapAccumR makeTableEntry (done, []) $ map interpLine progLines+    in do+        case jumpTable of+            ((JumpTableEntry _ prog dat) : _) -> do+                seedRandomFromTime+                setDataStrings dat+                prog+            [] -> done++-- Expression evaluation++boolToVal :: Bool -> Val+boolToVal t = if t then FloatVal (-1) else FloatVal 0++isNext :: Result -> Bool+isNext (LabeledRuntimeException _ (Next Nothing)) = True+isNext _ = False++isNextVar :: VarName -> Result -> Bool+isNextVar (VarName FloatType v1) (LabeledRuntimeException _ (Next (Just v2))) = v1==v2+isNextVar _ _ = False++isReturn :: Result -> Bool+isReturn (LabeledRuntimeException _ Return) = True+isReturn _ = False++liftFVOp1 :: (Float -> Float) -> Val -> Code Val+liftFVOp1 f (FloatVal v1) = return $ FloatVal $ f v1+liftFVOp1 _ _             = typeMismatch++liftFVBuiltin1 :: (Float -> Float) -> [Val] -> Code Val+liftFVBuiltin1 f [FloatVal v1] = return $ FloatVal $ f v1+liftFVBuiltin1 _ [_] = typeMismatch+liftFVBuiltin1 _ _ = wrongNumArgs++liftFVOp2 :: (Float -> Float -> Float) -> Val -> Val -> Code Val+liftFVOp2 f (FloatVal v1) (FloatVal v2) = return $ FloatVal $ f v1 v2+liftFVOp2 _ _             _             = typeMismatch++liftSVOp2 :: (String -> String -> String) -> Val -> Val -> Code Val+liftSVOp2 f (StringVal v1) (StringVal v2) = return $ StringVal $ f v1 v2+liftSVOp2 _ _              _              = typeMismatch++liftFSCmpOp2 :: (forall a. Ord a => a -> a -> Bool) -> Val -> Val -> Code Val+liftFSCmpOp2 f v1 v2 = do+    assert (typeOf v1 == typeOf v2) TypeMismatchError+    return $ boolToVal $ f v1 v2++valError :: RuntimeError -> Code Val+-- The return (FloatVal 0) will never be executed, but is needed to make the types work out.+valError err = raiseRuntimeError err >> return (FloatVal 0)++wrongNumArgs, typeMismatch, invalidArgument, divisionByZero :: Code Val+wrongNumArgs    = valError WrongNumberOfArgumentsError+typeMismatch    = valError TypeMismatchError+invalidArgument = valError InvalidArgumentError+divisionByZero  = valError DivisionByZeroError++-- | Evaluate a BASIC expression.+eval :: Expr -> Code Val+eval (LitX (FloatLit v)) = return (FloatVal v)+eval (LitX (StringLit v)) = return (StringVal v)+eval (VarX var) = getVar var+eval (FnX var xs) = do+    fn <- getFn var+    vals <- mapM eval xs+    fn vals+eval (MinusX x) = do+    val <- eval x+    liftFVOp1 negate val+eval (NotX x) = do+    val <- eval x+    liftFVOp1 (\v -> if v==0 then -1 else 0) val+eval (BinX op x1 x2) = do+    v1 <- eval x1+    v2 <- eval x2+    evalBinOp op v1 v2+eval (BuiltinX b xs) = do+    vs <- mapM eval xs+    evalBuiltin b vs+eval NextZoneX = do+    curCol <- getOutputColumn+    let numSpaces = zoneWidth - (curCol `mod` zoneWidth)+    return $ StringVal $ replicate numSpaces ' '+eval EmptySeparatorX = return $ StringVal ""+eval (ParenX x) = eval x++-- | Evaluate an expression with a binary operator.+evalBinOp :: BinOp -> Val -> Val -> Code Val+evalBinOp op =+    case op of+        AddOp -> \v1 v2 ->+            case (v1,v2) of+                (FloatVal _,  FloatVal _ ) -> liftFVOp2 (+) v1 v2+                (StringVal _, StringVal _) -> liftSVOp2 (++) v1 v2+                (_,           _          ) -> typeMismatch+        SubOp -> liftFVOp2 (-)+        MulOp -> liftFVOp2 (*)+        DivOp -> \v1 v2 ->+            case (v1,v2) of+                (FloatVal fv1, FloatVal fv2) ->+                    if fv2==0+                        then divisionByZero+                        else return $ FloatVal $ fv1/fv2+                (_,_) -> typeMismatch+        PowOp -> liftFVOp2 (**)+        EqOp -> liftFSCmpOp2 (==)+        NEOp -> liftFSCmpOp2 (/=)+        LTOp -> liftFSCmpOp2 (<)+        LEOp -> liftFSCmpOp2 (<=)+        GTOp -> liftFSCmpOp2 (>)+        GEOp -> liftFSCmpOp2 (>=)+        AndOp -> liftFVOp2 $ \v1 v2 -> if v1/=0 && v2/=0 then v1 else 0+        OrOp -> liftFVOp2 $ \v1 v2 -> if v1/=0 then v1 else v2++checkArgTypes :: [ValType] -> [Val] -> Code ()+checkArgTypes types vals = do+    if length types == length vals+        then+            if and [t == typeOf v | t <- types | v <- vals]+                then return ()+                else typeMismatch >> return ()+        else+            wrongNumArgs >> return ()++-- | Evaluate an expression with a builtin function.+evalBuiltin :: Builtin -> [Val] -> Code Val+evalBuiltin builtin args = case builtin of+    AbsBI -> liftFVBuiltin1 abs args+    AscBI -> do+        checkArgTypes [StringType] args+        let [StringVal v] = args+        if length v == 0+            then invalidArgument+            else return $ FloatVal (fromIntegral (fromEnum (head v)))+    AtnBI -> liftFVBuiltin1 atan args+    ChrBI -> do+        checkArgTypes [FloatType] args+        let [FloatVal v] = args+        let iv = floatToInt v+        if iv < 0 || iv > 255+            then invalidArgument+            else return $ StringVal [toEnum iv]+    CosBI -> liftFVBuiltin1 cos args+    ExpBI -> liftFVBuiltin1 exp args+    IntBI -> liftFVBuiltin1 (fromIntegral . floatToInt) args+    LeftBI -> do+        checkArgTypes [StringType, FloatType] args+        let [StringVal sv, FloatVal fv] = args+        let iv = floatToInt fv+        if iv < 0+            then invalidArgument+            else return (StringVal (take iv sv))+    LenBI -> do+        checkArgTypes [StringType] args+        let [StringVal sv] = args in return (FloatVal (fromIntegral (length sv)))+    LogBI -> do+        checkArgTypes [FloatType] args+        let [FloatVal fv] = args in if fv <= 0 then invalidArgument else return (FloatVal (log fv))+    MidBI -> case args of+        [StringVal sv, FloatVal fv] ->+            let iv = floatToInt fv in+                if iv < 1+                    then invalidArgument+                    else return (StringVal (drop (iv-1) sv))+        [_, _] -> typeMismatch+        [StringVal sv, FloatVal fv1, FloatVal fv2] ->+            let iv1 = floatToInt fv1+                iv2 = floatToInt fv2+            in+                if iv1 < 1 || iv2 < 0+                    then invalidArgument+                    else return (StringVal (take iv2 (drop (iv1-1) sv)))+        [_, _, _] -> typeMismatch+        _ -> wrongNumArgs+    RightBI -> do+        checkArgTypes [StringType, FloatType] args+        let [StringVal sv, FloatVal fv] = args+        let iv = floatToInt fv+        if iv < 0+            then invalidArgument+            else return (StringVal (drop (length sv - iv) sv))+    RndBI -> do+        checkArgTypes [FloatType] args+        let [FloatVal fv] = args+        let iv = floatToInt fv+        if iv < 0+            then seedRandom iv+            else return ()+        rv <- if (iv == 0) then getPrevRandom else getRandom+        return (FloatVal rv)+    SgnBI -> liftFVBuiltin1 (\v -> if v < 0 then -1 else if v > 0 then 1 else 0) args+    SinBI -> liftFVBuiltin1 sin args+    SpcBI -> do+        checkArgTypes [FloatType] args+        let [FloatVal fv] = args+        let iv = floatToInt fv+        if iv < 0+           then invalidArgument+           else return (StringVal (replicate iv ' '))+    SqrBI -> do+        checkArgTypes [FloatType] args+        let [FloatVal fv] = args+        if fv < 0+            then invalidArgument+            else return (FloatVal (sqrt fv))+    StrBI -> do+        checkArgTypes [FloatType] args+        let [FloatVal fv] = args in return (StringVal (showVal (FloatVal fv)))+    TabBI -> do+        checkArgTypes [FloatType] args+        let [FloatVal fv] = args+        let destCol = floatToInt fv+        if (destCol < 0)+          then invalidArgument+          else do+            curCol <- getOutputColumn+            return $ StringVal $+                if curCol > destCol+                  then ""+                  else replicate (destCol - curCol) ' '+    TanBI -> liftFVBuiltin1 tan args+    ValBI -> do+        checkArgTypes [StringType] args+        let [StringVal sv] = args in return (FloatVal (maybe 0 id (readFloat (trim sv))))++-- | Interpret a tagged statement.+-- Sets the line number in the state, then passes the statement on to interpS.+interpTS :: JumpTable -> Tagged Statement -> Code ()+interpTS jumpTable (Tagged pos statement) = do+    setLineNumber (sourceLine pos)+    interpS jumpTable statement++-- | Interpret a single statement.+-- In the type of interpS, the first () signifies what is passed to a+-- resumed trap.  The second one represents what is returned by interpS.+interpS :: JumpTable -> Statement -> Code ()++interpS _ (RemS _) = return ()++interpS _ EndS = end++interpS _ StopS = end++interpS _ (DimS arrs) = mapM_ interpDim arrs++interpS _ (LetS var x) = do+    val <- eval x+    setVar var val++interpS _ (PrintS xs) = do+    mapM (\x -> eval x >>= printVal) xs+    if null xs || not (isPrintSeparator (last xs))+        then printString "\n"+        else return ()++interpS _ (InputS mPrompt vars) = do+    case mPrompt of+        Nothing -> return ()+        (Just ps) -> printString ps+    inputVars vars++interpS jumpTable (GotoS lab) = do+    let maybeCode = programLookup jumpTable lab+    assert (isJust maybeCode) (BadGotoTargetError lab)+    fromJust maybeCode >> end++interpS jumpTable (OnGotoS x labs) = interpComputed jumpTable GotoS x labs++interpS jumpTable (OnGosubS x labs) = interpComputed jumpTable GosubS x labs++interpS jumpTable (IfS x sts) = do+    v <- eval x+    fv <- extractFloatOrFail TypeMismatchError v+    if fv == 0+        then return ()+        else mapM_ (interpTS jumpTable) sts++-- Note that the loop condition isn't tested until a NEXT is reached.+-- This is an intentionally authentic feature.  In fact, were we to try to+-- test at the initial FOR, we wouldn't know which NEXT to jump to to skip+-- the loop - it is undecidable.+interpS _ (ForS control x1 x2 x3) = do+    assert (typeOf control == FloatType) TypeMismatchError+    v1 <- eval x1+    _ <- extractFloatOrFail TypeMismatchError v1+    setScalarVar control v1+    v2 <- eval x2+    lim <- extractFloatOrFail TypeMismatchError v2+    v3 <- eval x3+    step <- extractFloatOrFail TypeMismatchError v3+    trap $ \ x passOn resume continue ->+        if isNext x || isNextVar control x+            then do+                (FloatVal index) <- getScalarVar control+                let index' = index+step+                setScalarVar control (FloatVal index')+                if (step>=0 && index'<=lim)+                    || (step<0 && index'>=lim)+                    then continue True+                    else resume False+            else passOn True++interpS _ (NextS Nothing) = raiseRuntimeException (Next Nothing)+interpS _ (NextS (Just vars)) = mapM_ interpNextVar vars++interpS jumpTable (GosubS lab) =+    do let maybeCode = programLookup jumpTable lab+       assert (isJust maybeCode) (BadGosubTargetError lab)+       catchC gosubHandler (fromJust maybeCode)+       return ()+interpS _ ReturnS = raiseRuntimeException Return++interpS _ RandomizeS = seedRandomFromTime++interpS jumpTable (RestoreS maybeLab) = do+   case maybeLab of+       (Just lab) -> case dataLookup jumpTable lab of+           (Just ds) -> setDataStrings ds+           Nothing -> raiseRuntimeError (BadRestoreTargetError lab)+       Nothing -> if null jumpTable+           then return ()+           else setDataStrings (jtData (head jumpTable))++interpS _ (ReadS vars) = mapM_ interpRead vars++interpS _ (DataS _) = return ()++interpS _ (DefFnS vn params expr) = setFn vn $ \vals -> do+    assert (length params == length vals) WrongNumberOfArgumentsError+    assert+        (and [typeOf p == typeOf v | p <- params | v <- vals])+        TypeMismatchError+    stashedVals <- mapM getScalarVar params+    sequence_ $ zipWith setScalarVar params vals+    result <- eval expr+    sequence_ $ zipWith setScalarVar params stashedVals+    return result++gosubHandler :: BasicExceptionHandler+gosubHandler x passOn _ continue = if isReturn x then continue False else passOn True++-- | Interpret a computed @GOTO@ or @GOSUB@.+interpComputed :: JumpTable -> (Label -> Statement) -> Expr -> [Label] -> Code ()+interpComputed jumpTable cons x labs = do+    v <- eval x+    fv <- extractFloatOrFail TypeMismatchError v+    let i = floatToInt fv+    if i > 0 && i <= length labs+        then do+            let lab = labs !! (i-1)+            interpS jumpTable (cons lab)+        else+            return ()++-- | Interpret a @NEXT@ with a supplied variable.+interpNextVar :: VarName -> Code ()+interpNextVar (VarName FloatType v) = raiseRuntimeException (Next (Just v))+interpNextVar _ = raiseRuntimeError TypeMismatchError++-- | Execute an @INPUT@ statement with a list of input variables.+inputVars :: [Var] -> Code ()+inputVars vars = do+    printString "? "+    inText <- getString+    case parse dataValsP "" inText of+        (Right ivs) -> do+            let maybeVals = zipWith checkInput vars ivs+            if or (map isNothing maybeVals)+                then do+                    printString "!NUMBER EXPECTED - RETRY INPUT LINE\n"+                    inputVars vars+                else do+                    let vals = map fromJust maybeVals+                    sequence_ (zipWith setVar vars vals)+                    case compare (length vars) (length ivs) of+                        LT -> printString "!EXTRA INPUT IGNORED\n"+                        GT -> do+                            printString "?"+                            inputVars (drop (length vals) vars)+                        EQ -> return ()+        (Left _) -> error "Mismatched inputbuf in inputVars"++checkInput :: Var -> String -> Maybe Val+checkInput var s = case typeOf var of+    StringType -> Just (StringVal s)+    FloatType  -> case readFloat s of+        (Just v) -> Just (FloatVal v)+        _ -> Nothing+    IntType -> case readFloat s of+        (Just v) -> Just (IntVal (floatToInt v))+        _ -> Nothing++interpRead :: Var -> Code ()+interpRead var = do+    s <- readData+    case checkInput var s of+        Nothing -> raiseRuntimeError TypeMismatchError+        (Just val) -> setVar var val++getVar :: Var -> Code Val+getVar (ScalarVar vn) = do+    val <- getScalarVar vn+    coerceToExpression val+getVar (ArrVar vn xs) = do+    inds <- mapM eval xs+    is <- checkArrInds inds+    val <- getArrVar vn is+    coerceToExpression val++setVar :: Var -> Val -> Code ()+setVar (ScalarVar vn) val = do+    val' <- coerce vn val+    setScalarVar vn val'+setVar (ArrVar vn xs) val = do+    inds <- mapM eval xs+    is <- checkArrInds inds+    val' <- coerce vn val+    setArrVar vn is val'++-- | Coerce a value to the type it would have in an expression.+-- Specifically coerces ints to floats.+coerceToExpression :: Val -> Code Val+coerceToExpression val = case typeOf val of+    IntType -> coerce FloatType val+    _       -> return val++coerce :: Typeable a => a -> Val -> Code Val+coerce var val = case (typeOf var, val) of+    (IntType,    (FloatVal fv)) -> return $ IntVal (floatToInt fv)+    (FloatType,  (FloatVal _))  -> return val+    (FloatType,  (IntVal iv))   -> return $ FloatVal (fromIntegral iv)+    (IntType,    (IntVal _))    -> return val+    (StringType, (StringVal _)) -> return val+    (_,          _)             -> typeMismatch++interpDim :: (VarName, [Expr]) -> Code ()+interpDim (vn, xs) = do+    inds <- mapM eval xs+    is <- checkArrInds inds+    -- add 1, so that range is from 0 to user-specified bound+    let bounds = map (1+) is+    dimArray vn bounds+    return ()++checkArrInds :: [Val] -> Basic (BasicExcep Result ()) [Int]+checkArrInds indVals = do+    indFs <- mapM (extractFloatOrFail TypeMismatchError) indVals+    assert (and (map (>=0) indFs)) NegativeArrayDimError+    let inds = map floatToInt indFs+    return inds++showVal :: Val -> String+showVal (FloatVal fv) = printFloat fv+showVal (IntVal iv) = if iv > 0 then " " else "" ++ show iv+showVal (StringVal s) = s++printVal :: Val -> Basic o ()+printVal v =+  printString (showVal v ++ case v of+      (FloatVal _)  -> " "+      (IntVal _)    -> " "+      (StringVal _) -> ""+  )++-- | Extract the @DATA@ strings from a program line.+dataFromLine :: Line -> [String]+dataFromLine (Line _ stmts) = concat (map (dataFromStatement . getTaggedVal) stmts)++dataFromStatement :: Statement -> [String]+dataFromStatement (DataS s) =+    let (Right ss) = parse dataValsP "" s+    in ss+dataFromStatement _ = []

@@ -0,0 +1,36 @@+-- | Contains a few common definitions for lexing BASIC.++module Language.VintageBasic.LexCommon where++import Text.ParserCombinators.Parsec++-- | A generic structure for tagging code with source positions.+data Tagged a =+    Tagged { getPosTag :: SourcePos, getTaggedVal :: a }+    deriving (Show)++instance (Eq a) => Eq (Tagged a) where+    (Tagged _ x) == (Tagged _ y) = x == y++-- | Parses a single whitespace character.+whiteSpaceChar :: Parser Char+whiteSpaceChar = oneOf " \v\f\t" <?> "SPACE"++-- | Parses a stretch of whitespace.+whiteSpace :: Parser ()+whiteSpace = skipMany (whiteSpaceChar <?> "")++-- | Parses a legal BASIC character.+legalChar :: Parser Char+legalChar = letter <|> digit <|> oneOf ",:;()$%=<>+-*/^?"++-- | Parses a line number.+labelP :: Parser Int+labelP = do+    s <- many1 (digit <?> "") <?> "LINE NUMBER"+    return (read s)++-- | Parser tries to apply another parser, returning Just the result+-- on a match, or Nothing in the case of failure.+optionally :: GenParser tok st a -> GenParser tok st (Maybe a)+optionally p = option Nothing (p >>= return . Just)

@@ -0,0 +1,38 @@+-- | Reads lines of a BASIC program. It does just enough parsing to find+-- the line number.++module Language.VintageBasic.LineScanner(RawLine,rawLinesP) where++import Text.ParserCombinators.Parsec+import Language.VintageBasic.LexCommon++type RawLine = Tagged String++eol :: Parser Char+eol = do+    optionally (char '\r')+    newline++blankLineP :: Parser ()+blankLineP = do+    eol <?> ""+    whiteSpace++rawLineP :: Parser RawLine+rawLineP = do+    n <- labelP+    whiteSpace+    pos <- getPosition+    s <- manyTill (anyChar <?> "CHARACTER") (eol <?> "END OF LINE")+    whiteSpace+    many blankLineP+    return (Tagged (setSourceLine pos n) s)++rawLinesP :: Parser [RawLine]+rawLinesP = do+    whiteSpace+    many blankLineP+    ls <- many rawLineP+    many blankLineP+    eof <?> "END OF FILE"+    return ls

@@ -0,0 +1,360 @@+-- | Parses BASIC source code, in tokenized form, to produce abstract syntax.+-- Also used at runtime to input values.++module Language.VintageBasic.Parser(exprP,statementListP) where++import Data.Char+import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Expr+import Language.VintageBasic.FloatParser+import Language.VintageBasic.LexCommon+import Language.VintageBasic.Syntax+import Language.VintageBasic.Tokenizer++-- | The number of significant letters at the start of a variable name.+varSignifLetters :: Int+varSignifLetters = 2++-- | The number of digits (following the letters) of a variable name that are significant.+varSignifDigits :: Int+varSignifDigits = 1++type TokParser = GenParser (Tagged Token) ()++skipSpace :: TokParser ()+skipSpace = skipMany $ tokenP (==SpaceTok)++lineNumP :: TokParser Int+lineNumP =+    do s <- many1 (tokenP (charTokTest isDigit) <?> "") <?> "LINE NUMBER"+       skipSpace+       return (read (map (getCharTokChar . getTaggedVal) s))++-- LITERALS++floatLitP :: TokParser Literal+floatLitP =+    do v <- floatP+       skipSpace+       return (FloatLit v)++stringLitP :: TokParser Literal+stringLitP =+    do tok <- tokenP isStringTok+       return (StringLit (getStringTokString (getTaggedVal tok)))++litP :: TokParser Literal+litP = floatLitP <|> stringLitP++-- VARIABLES++varBaseP :: TokParser String+varBaseP = do ls <- many1 (tokenP (charTokTest isAlpha))+              ds <- many (tokenP (charTokTest isDigit))+              return (taggedCharToksToString (take varSignifLetters ls+                      ++ take varSignifDigits ds))++floatVarNameP :: TokParser VarName+floatVarNameP = do+    name <- varBaseP+    return (VarName FloatType name)++intVarNameP :: TokParser VarName+intVarNameP = do+    name <- varBaseP+    tokenP (==PercentTok)+    return (VarName IntType name)++stringVarNameP :: TokParser VarName+stringVarNameP = do+    name <- varBaseP+    tokenP (==DollarTok)+    return (VarName StringType name)++-- Look for string and int vars first because of $ and % suffixes.+varNameP :: TokParser VarName+varNameP = do+    vn <- try stringVarNameP <|> try intVarNameP <|> floatVarNameP+    skipSpace+    return vn++scalarVarP :: GenParser (Tagged Token) () Var+scalarVarP = do+    vn <- varNameP+    return (ScalarVar vn)++arrVarP :: GenParser (Tagged Token) () Var+arrVarP = do+    vn <- varNameP+    xs <- argsP+    return (ArrVar vn xs)++varP :: GenParser (Tagged Token) () Var+varP = try arrVarP <|> scalarVarP++-- BUILTINS++builtinXP :: TokParser Expr+builtinXP = do+    (Tagged _ (BuiltinTok b)) <- tokenP isBuiltinTok+    xs <- argsP+    return (BuiltinX b xs)++-- EXPRESSIONS++litXP :: TokParser Expr+litXP =+    do v <- litP+       return (LitX v)++varXP :: TokParser Expr+varXP =+    do v <- varP+       return (VarX v)++argsP :: TokParser [Expr]+argsP =+    do tokenP (==LParenTok)+       xs <- sepBy exprP (tokenP (==CommaTok))+       tokenP (==RParenTok)+       return xs++fnXP :: TokParser Expr+fnXP = do+    tokenP (==FnTok)+    vn <- varNameP+    args <- argsP+    return (FnX vn args)++parenXP :: TokParser Expr+parenXP =+    do tokenP (==LParenTok)+       x <- exprP+       tokenP (==RParenTok)+       return (ParenX x)++primXP :: TokParser Expr+primXP = parenXP <|> litXP <|> builtinXP <|> fnXP <|> varXP++opTable :: OperatorTable (Tagged Token) () Expr+opTable =+    [[prefix MinusTok MinusX, prefix PlusTok id],+     [binary PowTok  (BinX PowOp) AssocRight],+     [binary MulTok  (BinX MulOp) AssocLeft, binary DivTok   (BinX DivOp) AssocLeft],+     [binary PlusTok (BinX AddOp) AssocLeft, binary MinusTok (BinX SubOp) AssocLeft],+     [binary EqTok   (BinX EqOp)  AssocLeft, binary NETok    (BinX NEOp)  AssocLeft,+      binary LTTok   (BinX LTOp)  AssocLeft, binary LETok    (BinX LEOp)  AssocLeft,+      binary GTTok   (BinX GTOp)  AssocLeft, binary GETok    (BinX GEOp)  AssocLeft],+     [prefix NotTok   NotX],+     [binary AndTok  (BinX AndOp) AssocLeft],+     [binary OrTok   (BinX OrOp)  AssocLeft]]++binary :: Token -> (Expr -> Expr -> Expr) -> Assoc -> Operator (Tagged Token) () Expr+binary tok fun assoc =+    Infix (do tokenP (==tok); return fun) assoc+prefix :: Token -> (Expr -> Expr) -> Operator (Tagged Token) () Expr+prefix tok fun =+    Prefix (do tokenP (==tok); return fun)++-- | Parses a BASIC expression from tokenized source.+exprP :: TokParser Expr+exprP = buildExpressionParser opTable primXP++-- STATEMENTS++letSP :: TokParser Statement+letSP = do+    optionally (tokenP (==LetTok))+    v <- varP+    tokenP (==EqTok)+    x <- exprP+    return (LetS v x)++gotoSP :: TokParser Statement+gotoSP = do+    try (tokenP (==GoTok) >> tokenP (==ToTok))+    n <- lineNumP+    return (GotoS n)++gosubSP :: TokParser Statement+gosubSP = do+    try (tokenP (==GoTok) >> tokenP (==SubTok))+    n <- lineNumP+    return (GosubS n)++returnSP :: TokParser Statement+returnSP =+    do tokenP (==ReturnTok)+       return ReturnS++onGotoSP :: TokParser Statement+onGotoSP = try $ do+    tokenP (==OnTok)+    x <- exprP+    tokenP (==GoTok)+    tokenP (==ToTok)+    ns <- sepBy1 lineNumP (tokenP (==CommaTok))+    return (OnGotoS x ns)++onGosubSP :: TokParser Statement+onGosubSP = try $ do+    tokenP (==OnTok)+    x <- exprP+    tokenP (==GoTok)+    tokenP (==SubTok)+    ns <- sepBy1 lineNumP (tokenP (==CommaTok))+    return (OnGosubS x ns)++ifSP :: TokParser Statement+ifSP =+    do tokenP (==IfTok)+       x <- exprP+       tokenP (==ThenTok)+       target <- try ifSPGoto <|> statementListP+       return (IfS x target)++ifSPGoto :: TokParser [Tagged Statement]+ifSPGoto =+    do pos <- getPosition+       n <- lineNumP+       return [Tagged pos (GotoS n)]++forSP :: TokParser Statement+forSP = do+    tokenP (==ForTok)+    vn <- varNameP+    tokenP (==EqTok)+    x1 <- exprP+    tokenP (==ToTok)+    x2 <- exprP+    x3 <- option (LitX (FloatLit 1)) (tokenP (==StepTok) >> exprP)+    return (ForS vn x1 x2 x3)++-- | Parses a @NEXT@ and an optional variable list.+nextSP :: TokParser Statement+nextSP = do+    tokenP (==NextTok)+    vns <- sepBy varNameP (tokenP (==CommaTok))+    if length vns > 0+        then return (NextS (Just vns))+        else return (NextS Nothing)++printSP :: TokParser Statement+printSP =+    do tokenP (==PrintTok)+       xs <- many printExprP+       return (PrintS xs)++printExprP :: TokParser Expr+printExprP = emptySeparatorP <|> nextZoneP <|> exprP++emptySeparatorP :: TokParser Expr+emptySeparatorP = do+    tokenP (==SemiTok)+    return EmptySeparatorX++nextZoneP :: TokParser Expr+nextZoneP = do+    tokenP (==CommaTok)+    return NextZoneX++inputSP :: TokParser Statement+inputSP =+    do tokenP (==InputTok)+       ps <- option Nothing inputPrompt+       vs <- sepBy1 varP (tokenP (==CommaTok))+       return (InputS ps vs)++inputPrompt :: TokParser (Maybe String)+inputPrompt =+    do (StringLit p) <- stringLitP+       tokenP (==SemiTok)+       return (Just p)++endSP :: TokParser Statement+endSP =+    do tokenP (==EndTok)+       return EndS++stopSP :: TokParser Statement+stopSP =+    do tokenP (==StopTok)+       return StopS++arrDeclP :: TokParser (VarName, [Expr])+arrDeclP = do+    vn <- varNameP+    xs <- argsP+    skipSpace+    return (vn, xs)++dimSP :: TokParser Statement+dimSP = do+   tokenP (==DimTok)+   arrDecls <- sepBy1 arrDeclP (tokenP (==CommaTok))+   return (DimS arrDecls)++randomizeSP :: TokParser Statement+randomizeSP = do+    _ <- tokenP (==RandomizeTok)+    return RandomizeS++readSP :: TokParser Statement+readSP = do+    tokenP (==ReadTok)+    vs <- sepBy1 varP (tokenP (==CommaTok))+    return (ReadS vs)++restoreSP :: TokParser Statement+restoreSP = do+    tokenP (==RestoreTok)+    maybeLineNum <- optionally lineNumP+    return (RestoreS maybeLineNum)++dataSP :: TokParser Statement+dataSP = do+    (Tagged _ (DataTok s)) <- tokenP isDataTok+    return (DataS s)++defFnSP :: TokParser Statement+defFnSP = do+    tokenP (==DefTok)+    tokenP (==FnTok)+    name <- varNameP+    tokenP (==LParenTok)+    params <- sepBy1 varNameP (tokenP (==CommaTok))+    tokenP (==RParenTok)+    tokenP (==EqTok)+    expr <- exprP+    return (DefFnS name params expr)++remSP :: TokParser Statement+remSP =+    do tok <- tokenP isRemTok+       return (RemS (getRemTokString (getTaggedVal tok)))++statementP :: TokParser (Tagged Statement)+statementP = do+    input <- getInput+    let pos = getPosTag (head input)+    st <- choice [printSP, inputSP, gotoSP, gosubSP, returnSP, onGotoSP, onGosubSP,+        ifSP, forSP, nextSP, endSP, stopSP, randomizeSP, dimSP, readSP, restoreSP, dataSP,+        remSP, defFnSP, letSP]+    return (Tagged pos st)++-- | Parses a list of statements from a tokenized BASIC source line.+statementListP :: TokParser [Tagged Statement]+statementListP = do+    many (tokenP (==ColonTok))+    sl <- sepEndBy1 statementP (many1 (tokenP (==ColonTok)))+    eol <?> ": OR END OF LINE"+    return sl++anyTokenP :: TokParser (Tagged Token)+anyTokenP = tokenP (const True)++eol :: TokParser ()+eol = try (do {+    tok <- anyTokenP;+    unexpected (printToken (getTaggedVal tok));+  } <|> return ()) <?> "END OF LINE"

@@ -0,0 +1,146 @@+-- | Prettyprinter for BASIC syntax and values.++module Language.VintageBasic.Printer where++import Numeric+import Data.List+import Language.VintageBasic.LexCommon+import Language.VintageBasic.Syntax+import Language.VintageBasic.Builtins(Builtin,builtinToStrAssoc)+import Data.Maybe(fromJust)++-- | Prettyprint a BASIC literal.+printLit :: Literal -> String+printLit (FloatLit v) = let i = floor v :: Integer+                in if fromInteger i == v+                   then show i+                   else show v+printLit (StringLit s) = show s++-- | Prettyprint a floating point value, BASIC style.+printFloat :: Float -> String+printFloat x | x == 0 = " 0"+printFloat x | x < 0  = "-" ++ printPosFloat (-x)+printFloat x | x > 0  = " " ++ printPosFloat x+printFloat _ = error "illegal number for printFloat"++-- | The maximum number of decimal digits needed to display the mantissa of a+-- Float. For IEEE 754-2008 binary32 format, this is 8 decimal digits.+maxFloatDigits :: Int+maxFloatDigits = ceiling (log 2 / log 10 * fromIntegral(floatDigits (0::Float)) :: Float)++printPosFloat :: Float -> String+printPosFloat x =+    let (digits, ex) = floatToDigits 10 x+    in+        if ex <= maxFloatDigits && length digits - ex <= maxFloatDigits+           then+               if ex >= length digits+                   then concatMap show (padDigitsRight digits ex)+                   else+                       if ex > 0+                           then concatMap show (take ex digits) ++ "."+                               ++ concatMap show (drop ex digits)+                           else "." ++ concatMap show (padDigitsLeft digits ex)+           else+               concatMap show (take 1 digits) ++ "."+                   ++ concatMap show (drop 1 digits) ++ "E"+                   ++ (if ex >= 1 then "+" else "") ++ show (ex - 1)++padDigitsRight :: [Int] -> Int -> [Int]+padDigitsRight digits ex = digits ++ replicate (ex - length digits) 0++padDigitsLeft :: [Int] -> Int -> [Int]+padDigitsLeft digits ex = replicate (-ex) 0 ++ digits++-- | Prettyprint a variable name.+printVarName :: VarName -> String+printVarName (VarName varType name) = name ++ case varType of+    FloatType  -> ""+    IntType    -> "%"+    StringType -> "$"++printVar :: Var -> String+printVar (ScalarVar vn) = printVarName vn+printVar (ArrVar vn xs) = printVarName vn ++ printArgs xs++printArgs :: [Expr] -> String+printArgs xs = "(" ++ concat (intersperse "," (map printExpr xs)) ++ ")"++printOp :: BinOp -> String+printOp AddOp = "+"+printOp SubOp = "-"+printOp MulOp = "*"+printOp DivOp = "/"+printOp PowOp = "^"+printOp EqOp = "="+printOp NEOp = "<>"+printOp LTOp = "<"+printOp LEOp = "<="+printOp GTOp = ">"+printOp GEOp = ">="+printOp AndOp = " AND "+printOp OrOp = " OR "++printBuiltin :: Builtin -> String+printBuiltin b = fromJust $ lookup b builtinToStrAssoc++printExpr :: Expr -> String+printExpr (LitX lit) = printLit lit+printExpr (VarX var) = printVar var+printExpr (FnX vn xs) = printVarName vn ++ printArgs xs+printExpr (MinusX x) = "-" ++ printExpr x+printExpr NextZoneX = ","+printExpr EmptySeparatorX = ";"+printExpr (NotX x) = "NOT " ++ printExpr x+printExpr (ParenX x) = "(" ++ printExpr x ++ ")"+printExpr (BinX op x1 x2) = printExpr x1 ++ printOp op ++ printExpr x2+printExpr (BuiltinX b xs) = printBuiltin b ++ printArgs xs++printTaggedStatement :: Tagged Statement -> String+printTaggedStatement (Tagged _ statement) = printStatement statement++printStatement :: Statement -> String+printStatement (LetS v x) = "LET " ++ printVar v ++ "=" ++ printExpr x+printStatement (DimS arrs) =+    "DIM " ++ concat (intersperse "," [printVarName vn ++ printArgs xs | (vn, xs) <- arrs])+printStatement (GotoS label) = "GOTO " ++ show label+printStatement (GosubS label) = "GOSUB " ++ show label+printStatement (OnGotoS x labels) = "ON " ++ printExpr x ++ " GOTO " ++ (concat (intersperse ", " (map show labels)))+printStatement (OnGosubS x labels) = "ON " ++ printExpr x ++ " GOSUB " ++ (concat (intersperse ", " (map show labels)))+printStatement ReturnS = "RETURN"+printStatement (IfS x ss) =+    "IF " ++ printExpr x ++ " THEN " ++ printStatementList ss+printStatement (ForS vn x1 x2 x3) =+    "FOR " ++ printVarName vn ++ "=" ++ printExpr x1 ++ " TO " ++ printExpr x2+       ++ (case x3+           of (LitX (FloatLit 1)) -> ""+              _ -> " STEP " ++ printExpr x3)+printStatement (NextS Nothing) = "NEXT"+printStatement (NextS (Just vns)) =+    "NEXT " ++ (concat $ intersperse "," (map printVarName vns))+printStatement (PrintS xs) =+    "PRINT " ++ (concat $ intersperse " " (map printExpr xs))+printStatement (InputS prompt vs) =+    "INPUT " ++ (case prompt of Nothing -> ""; Just ps -> show ps ++ ";")+         ++ (concat $ intersperse "," (map printVar vs))+printStatement EndS = "END"+printStatement StopS = "STOP"+printStatement RandomizeS = "RANDOMIZE"+printStatement (ReadS vars) = "READ " ++ (concat (intersperse ", " (map printVar vars)))+printStatement (RestoreS Nothing) = "RESTORE"+printStatement (RestoreS (Just n)) = "RESTORE " ++ show n+printStatement (DataS s) = "DATA " ++ s+printStatement (DefFnS vn vns x) =+    "DEF FN" ++ printVarName vn ++ "(" ++ (concat (intersperse ", " (map printVarName vns))) ++ ")"+    ++ " = " ++ printExpr x+printStatement (RemS s) = "REM" ++ s++printStatementList :: [Tagged Statement] -> String+printStatementList ss = concat $ intersperse ":" (map printTaggedStatement ss)++printLine :: Line -> String+printLine (Line n ss) = show n ++ " " ++ printStatementList ss ++ "\n"++printLines :: [Line] -> String+printLines progLines = concatMap printLine progLines

@@ -0,0 +1,85 @@+-- | Results of BASIC computations, including errors.++module Language.VintageBasic.Result(Result(..),RuntimeException(..),RuntimeError(..)) where++import Control.Monad.CPST.DurableTraps(ResultType(..))+import Language.VintageBasic.Printer(printVarName)+import Language.VintageBasic.Syntax(Label,VarName)+import Text.ParserCombinators.Parsec(sourceLine,sourceColumn)+import Text.ParserCombinators.Parsec.Error(ParseError,errorMessages,errorPos,showErrorMessages)++-- | The ultimate result value of a BASIC program.+data Result =+    Pass                                             -- ^ normal termination+    | ScanError ParseError                           -- ^ error in scanning line numbers+    | SyntaxError ParseError                         -- ^ tokenization or parsing error+    | LabeledRuntimeException Label RuntimeException -- ^ runtime exception (with line number)++instance ResultType Result where+    okValue = Pass++data RuntimeException =+    RuntimeError RuntimeError+    | Next (Maybe String)     -- ^ generated by @NEXT@+    | Return                  -- ^ generated by @RETURN@++instance Show Result where+    show Pass = "NORMAL TERMINATION"+    show (ScanError pe) = showParseError "LINE NUMBERING" "RAW LINE" "END OF FILE" pe+    show (SyntaxError pe) = showParseError "SYNTAX" "LINE" "END OF LINE" pe+    show (LabeledRuntimeException label x) = show x ++ " IN LINE " ++ show label++instance Show RuntimeException where+    show (RuntimeError err) = show err+    show (Next Nothing) = "!NEXT WITHOUT FOR ERROR"+    show (Next (Just s)) = "!NEXT WITHOUT FOR ERROR (VAR "++s++")"+    show Return = "!RETURN WITHOUT GOSUB ERROR"++data RuntimeError =+    TypeMismatchError+    | WrongNumberOfArgumentsError+    | InvalidArgumentError+    | DivisionByZeroError+    | BadGotoTargetError Label+    | BadGosubTargetError Label+    | BadRestoreTargetError Label+    | NegativeArrayDimError+    | ReDimensionedArrayError+    | MismatchedArrayDimensionsError+    | OutOfArrayBoundsError+    | UndefinedFunctionError VarName+    | OutOfDataError+    | EndOfInputError+  deriving Eq++instance Show RuntimeError where+    show TypeMismatchError = "!TYPE MISMATCH"+    show WrongNumberOfArgumentsError = "!WRONG NUMBER OF ARGUMENTS"+    show InvalidArgumentError = "!INVALID ARGUMENT"+    show DivisionByZeroError = "!DIVISION BY ZERO"+    show (BadGotoTargetError lab) = "!BAD GOTO TARGET " ++ show lab+    show (BadGosubTargetError lab) = "!BAD GOSUB TARGET " ++ show lab+    show (BadRestoreTargetError lab) = "!BAD RESTORE TARGET " ++ show lab+    show NegativeArrayDimError = "!NEGATIVE ARRAY DIM"+    show ReDimensionedArrayError = "!REDIM'D ARRAY"+    show MismatchedArrayDimensionsError = "!MISMATCHED ARRAY DIMENSIONS"+    show OutOfArrayBoundsError = "!OUT OF ARRAY BOUNDS"+    show (UndefinedFunctionError vn) = "!UNDEFINED FUNCTION " ++ printVarName vn+    show OutOfDataError = "!OUT OF DATA"+    show EndOfInputError = "!END OF INPUT"++showParseError+    :: String     -- ^ message describing the type of error+    -> String     -- ^ description of source line: @LINE@ or @RAW LINE@+    -> String     -- ^ what to call end of input+    -> ParseError -- ^ the parse error to show as text+    -> String+showParseError msgErrorType msgLine msgEndOfInput parseError =+    let pos = errorPos parseError+        messages = errorMessages parseError+        line = sourceLine pos+        col = sourceColumn pos+    in+        "!" ++ msgErrorType ++ " ERROR IN " ++ msgLine ++ " " ++ show line+        ++ ", COLUMN " ++ show col+        ++ showErrorMessages "OR" " UNKNOWN" " EXPECTING" " UNEXPECTED" msgEndOfInput messages

@@ -0,0 +1,38 @@+-- | Parsing for @DATA@ statements and the @INPUT@ buffer.++module Language.VintageBasic.RuntimeParser(dataValsP,readFloat,trim) where++import Language.VintageBasic.FloatParser(floatP)+import Text.ParserCombinators.Parsec++-- | Attempts to parse a floating point value from a string.+readFloat :: String -> Maybe Float+readFloat s =+    case parse floatP "" s+         of (Right fv) -> Just fv+            _ -> Nothing++nonCommaP :: Parser Char+nonCommaP = satisfy (/=',')++stringP :: Parser String+stringP =+    do char '"'+       s <- manyTill anyChar (char '"')+       spaces+       return s++-- | Trim leading and trailing space from a string.+trim :: String -> String+trim s = dropWhile (==' ') $ reverse $ dropWhile (==' ') $ reverse s++-- | Parse a single data value.+dataValP :: Parser String+dataValP = do+    spaces+    stringP <|> do { s <- many nonCommaP; return (trim s) }++-- | Parse a list of data values.+-- Works for both @INPUT@ text and @DATA@ statements.+dataValsP :: Parser [String]+dataValsP = sepBy1 dataValP (char ',')

@@ -0,0 +1,96 @@+-- | Describes the abstract syntax of BASIC.++module Language.VintageBasic.Syntax where++import Language.VintageBasic.Builtins(Builtin)+import Language.VintageBasic.LexCommon(Tagged(..))++-- | A BASIC line number.+type Label = Int++-- | BASIC value types. The IntType is used for storage or function arguments+-- but is always converted to FloatType for use in expressions.+data ValType = FloatType | IntType | StringType+    deriving (Show,Eq)++class Typeable a where+    typeOf :: a -> ValType++instance Typeable ValType where+    typeOf = id++data Literal =+    FloatLit Float+  | StringLit String+    deriving (Show,Eq)++instance Typeable Literal where+    typeOf (FloatLit  _) = FloatType+    typeOf (StringLit _) = StringType++data VarName = VarName ValType String+    deriving (Show,Eq)++instance Typeable VarName where+    typeOf (VarName valType _) = valType++data Var = ScalarVar VarName | ArrVar VarName [Expr]+    deriving (Show,Eq)++instance Typeable Var where+    typeOf (ScalarVar varName) = typeOf varName+    typeOf (ArrVar varName _)  = typeOf varName++-- | BASIC binary operators.+data BinOp =+    AddOp | SubOp | MulOp | DivOp | PowOp+    | EqOp | NEOp | LTOp | LEOp | GTOp | GEOp+    | AndOp | OrOp+    deriving (Enum,Show,Eq)++-- | BASIC expressions.+data Expr =+    LitX Literal+  | VarX Var+  | FnX VarName [Expr]+  | MinusX Expr+  | NotX Expr+  | BinX BinOp Expr Expr+  | BuiltinX Builtin [Expr]+  | NextZoneX                -- ^ commas in a @PRINT@ statement+  | EmptySeparatorX          -- ^ semicolons in a @PRINT@ statement+  | ParenX Expr+    deriving (Show,Eq)++isPrintSeparator :: Expr -> Bool+isPrintSeparator NextZoneX = True+isPrintSeparator EmptySeparatorX = True+isPrintSeparator _ = False++-- | BASIC statements.+data Statement =+    LetS Var Expr+  | DimS [(VarName, [Expr])]+  | GotoS Label+  | GosubS Label+  | OnGotoS Expr [Label]+  | OnGosubS Expr [Label]+  | ReturnS+  | IfS Expr [Tagged Statement] -- ^ includes all statements on the line following the @IF@+  | ForS VarName Expr Expr Expr+  | NextS (Maybe [VarName])+  | PrintS [Expr]+  | InputS (Maybe String) [Var]+  | EndS+  | StopS+  | RandomizeS+  | ReadS [Var]+  | RestoreS (Maybe Label)+  | DataS String+  | DefFnS VarName [VarName] Expr+  | RemS String+    deriving (Show,Eq)++-- | A line of BASIC, in fully parsed form, ready for interpretation.+data Line = Line Label [Tagged Statement]+    deriving (Show)

@@ -0,0 +1,173 @@+-- | Finds and tokenizes BASIC keywords, in preparation for parsing. This allows+-- keywords to be read even if there are no spaces around them. Even though+-- the standard disallows it, many BASIC implementations allowed this to save+-- memory or screen real estate. The down side is that longer variable names+-- are not practical, since they might contain keywords.++module Language.VintageBasic.Tokenizer+    (Token(..),TokenizedLine,isDataTok,isRemTok,charTokTest,taggedCharToksToString,isStringTok,+     isBuiltinTok,taggedTokensP,tokenP,printToken) where++import Data.Char(toUpper)+import Language.VintageBasic.Builtins(Builtin,builtinToStrAssoc)+import Language.VintageBasic.LexCommon+import Text.ParserCombinators.Parsec++type TokenizedLine = Tagged [Tagged Token]++-- | Parses one or more whitespace characters, producing a space token.+spaceTokP :: Parser Token+spaceTokP = whiteSpaceChar >> whiteSpace >> return SpaceTok++data Token = StringTok { getStringTokString :: String } | RemTok { getRemTokString :: String }+           | DataTok { getDataTokString :: String }+           | CommaTok | ColonTok | SemiTok | LParenTok | RParenTok+           | DollarTok | PercentTok+           | EqTok | NETok | LETok | LTTok | GETok | GTTok+           | PlusTok | MinusTok | MulTok | DivTok | PowTok+           | AndTok | OrTok | NotTok+           | BuiltinTok Builtin+           | LetTok | DimTok | OnTok | GoTok | SubTok | ReturnTok+           | IfTok | ThenTok | ForTok | ToTok | StepTok | NextTok+           | PrintTok | InputTok | RandomizeTok | ReadTok | RestoreTok+           | DefTok | FnTok | EndTok | StopTok+           | SpaceTok | DotTok | CharTok { getCharTokChar :: Char }+             deriving (Eq,Show)++keyword :: String -> Parser String+keyword s = try (string s) <?> ("keyword " ++ s)++stringTokP :: Parser Token+-- no special escape chars allowed+stringTokP =+    do char '"'+       s <- manyTill anyChar (char '"')+       whiteSpace+       return (StringTok s)++isStringTok :: Token -> Bool+isStringTok (StringTok _) = True+isStringTok _ = False++remTokP :: Parser Token+remTokP = do keyword "REM"+             s <- many anyChar+             return (RemTok s)++isRemTok :: Token -> Bool+isRemTok (RemTok _) = True+isRemTok _ = False++dataTokP :: Parser Token+dataTokP =+    do keyword "DATA"+       s <- many anyChar+       return (DataTok s)++isDataTok :: Token -> Bool+isDataTok (DataTok _) = True+isDataTok _ = False++charTokP :: Parser Token+charTokP = do c <- legalChar; return (CharTok (toUpper c))++charTokTest :: (Char -> Bool) -> Token -> Bool+charTokTest f (CharTok c) = f c+charTokTest _ _ = False++taggedCharToksToString :: [Tagged Token] -> String+taggedCharToksToString = map (getCharTokChar . getTaggedVal)++strToTokAssoc :: [(String, Token)]+strToTokAssoc =+    [+     (",",         CommaTok),+     (":",         ColonTok),+     (";",         SemiTok),+     ("(",         LParenTok),+     (")",         RParenTok),+     ("$",         DollarTok),+     ("%",         PercentTok),+     ("=",         EqTok),+     ("<>",        NETok),+     ("<=",        LETok),+     ("<",         LTTok),+     (">=",        GETok),+     (">",         GTTok),+     ("+",         PlusTok),+     ("-",         MinusTok),+     ("*",         MulTok),+     ("/",         DivTok),+     ("^",         PowTok),+     (".",         DotTok),+     ("AND",       AndTok),+     ("OR",        OrTok),+     ("NOT",       NotTok),+     ("LET",       LetTok),+     ("DIM",       DimTok),+     ("ON",        OnTok),+     ("GO",        GoTok),+     ("SUB",       SubTok),+     ("RETURN",    ReturnTok),+     ("IF",        IfTok),+     ("THEN",      ThenTok),+     ("FOR",       ForTok),+     ("TO",        ToTok),+     ("STEP",      StepTok),+     ("NEXT",      NextTok),+     ("PRINT",     PrintTok),+     ("?",         PrintTok),+     ("INPUT",     InputTok),+     ("RANDOMIZE", RandomizeTok),+     ("READ",      ReadTok),+     ("RESTORE",   RestoreTok),+     ("DEF",       DefTok),+     ("FN",        FnTok),+     ("END",       EndTok),+     ("STOP",      StopTok)+  ] ++ [(s, BuiltinTok b) | (b,s) <- builtinToStrAssoc]++tokToStrAssoc :: [(Token, String)]+tokToStrAssoc = [(t,s) | (s,t) <- strToTokAssoc]++anyTokP :: Parser Token+anyTokP = choice ([spaceTokP, stringTokP, remTokP, dataTokP]+                  ++ [do keyword s; whiteSpace; return t | (s,t) <- strToTokAssoc]+                  ++ [charTokP]) <?> "LEGAL BASIC CHARACTER"++isBuiltinTok :: Token -> Bool+isBuiltinTok (BuiltinTok _) = True+isBuiltinTok _              = False++taggedTokenP :: Parser (Tagged Token)+taggedTokenP =+    do pos <- getPosition+       tok <- anyTokP+       return (Tagged pos tok)++-- | The main parser used to read a series of tokens from a string.+taggedTokensP :: Parser [Tagged Token]+taggedTokensP =+    do toks <- many taggedTokenP+       eof <?> ""+       return toks++-- | The single-token parser used at the parser level+tokenP :: (Token -> Bool) -> GenParser (Tagged Token) () (Tagged Token)+tokenP test = token (printToken . getTaggedVal) getPosTag testTaggedToken+    where testTaggedToken (Tagged pos tok) =+            if test tok then Just (Tagged pos tok) else Nothing++-- | Prettyprint a token for error reporting or debugging.+printToken :: Token -> String+printToken tok =+    case (lookup tok tokToStrAssoc) of+        (Just s) -> s+        Nothing ->+            case tok of+                (CharTok c) -> [c]+                (DataTok s) -> "DATA" ++ s+                (RemTok s) -> "REM" ++ s+                SpaceTok -> " "+                (StringTok s) -> "\"" ++ s ++ "\""+                _ -> error "printToken: unrecognized token."

@@ -0,0 +1,56 @@+module Language.VintageBasic.Asserts where
+
+import Data.IORef
+import Data.List(isInfixOf)
+import Test.HUnit
+import Text.ParserCombinators.Parsec(eof,parse,sourceLine,sourceColumn,(<?>))
+import Language.VintageBasic.LexCommon
+import IO.IOStream
+
+-- | Make an input stream for testing.
+mkInput :: String -> IO IOStream
+mkInput s = do
+    input <- newIORef s
+    return $ IOStream input
+
+-- | Make an empty input stream for testing.
+noInput :: IO IOStream
+noInput = mkInput ""
+
+-- | Make an empty output stream for testing.
+mkOutput :: IO IOStream
+mkOutput = do
+    output <- newIORef ""
+    return $ IOStream output
+
+-- | Assert the output of a program, with empty input.
+assertOutputEq output expected = do
+    got <- vGetContents output
+    assertEqual "Output not as expected" expected got
+
+-- | Extracts line number and token from tagged tokens. Useful for asserting these when you don't care about column number.
+withCol taggedToks = [(sourceColumn pos, tok) | (Tagged pos tok) <- taggedToks]
+
+-- | Extracts line number, column number, and token from tagged tokens. Useful for assertion position and token value.
+withLineAndCol taggedToks = [(sourceLine pos, sourceColumn pos, tok) | (Tagged pos tok) <- taggedToks]
+
+-- | A parser that wraps a check for end of input around another parser.
+-- Useful when checking isolated expressions that don't normally reach end of input.
+parserWithEof parser = do
+    result <- parser
+    eof <?> "END OF INPUT"
+    return result
+
+-- | Assert a parse result, expecting success.
+assertParseResult normalizeResult normalizeError parser input expected = do
+    case parse (parserWithEof parser) "" input of
+        (Left err) -> assertFailure ("Parse error: " ++ show (normalizeError err))
+        (Right rls) -> assertEqual "Parse result not as expected" expected (normalizeResult rls)
+
+-- | Assert an expected parse error.
+assertParseError normalizeResult normalizeError parser input expected = do
+    case parse (parserWithEof parser) "" input of
+        (Left err) -> assertBool
+            ("Parser reported wrong error.\n\nGot:\n" ++ show (normalizeError err) ++ "\n\nExpected error to contain:\n" ++ expected)
+            (isInfixOf expected (show (normalizeError err)))
+        (Right rls) -> assertFailure ("Parser didn't report error, instead got result: " ++ show (normalizeResult rls))

@@ -0,0 +1,28 @@+module Language.VintageBasic.BasicMonad_test where
+
+import Data.List(intercalate)
+import Test.HUnit
+import Language.VintageBasic.Asserts
+import Language.VintageBasic.BasicMonad
+import Control.Monad.CPST.DurableTraps
+import IO.IOStream
+
+expectOutput expected code = TestCase $ do
+    input <- noInput
+    output <- mkOutput
+    runProgram input output (code >> done)
+    assertOutputEq output expected
+
+test_printString =
+    expectOutput "first\nsecondthird" $ do
+        printString "first\nsecond"
+        printString "third"
+
+test_output_column =
+    expectOutput "hello\n0;5;0" $ do
+        col1 <- getOutputColumn
+        printString "hello"
+        col2 <- getOutputColumn
+        printString "\n"
+        col3 <- getOutputColumn
+        printString (intercalate ";" [show c | c <- [col1, col2, col3]])

@@ -0,0 +1,14 @@+module Language.VintageBasic.Executer_test where
+
+import Data.List(isInfixOf)
+import Test.HUnit
+import Text.ParserCombinators.Parsec.Pos(newPos)
+import Language.VintageBasic.Asserts
+import Language.VintageBasic.Executer
+
+--test_tokenization_errors_reported_at_correct_location = TestCase $ do
+--    let source = (Tagged (newPos "bobble.bas" 10 4) "!")
+--    let expectedError = "(line 10, column 4)"
+--    case tokenizeRawLine source of
+--        (Left err) -> assertBool ("Parser reported wrong error. Got:\n" ++ show err ++ "\nExpected error to contain:\n" ++ expectedError) (isInfixOf expectedError (show err))
+--        (Right rls) -> assertFailure "Parser didn't report error"

@@ -0,0 +1,45 @@+module Language.VintageBasic.FloatParser_test where
+
+import Test.HUnit
+import Language.VintageBasic.Asserts
+import Language.VintageBasic.FloatParser
+import Language.VintageBasic.Result
+
+assertFloatPSuccess source expected = assertParseResult id ScanError floatP source expected
+assertFloatPFailure source expected = assertParseError  id ScanError floatP source expected
+
+test_successes = TestCase $ do
+    mapM_ (uncurry assertFloatPSuccess) success_cases
+
+success_cases =
+  [
+    ( "0",           0     ),
+    ( ".",           0     ),
+    ( ".25",         0.25  ),
+    ( "123",       123     ),
+    ( "12.",        12     ),
+    ( "-1",         -1     ),
+    ( "+12",        12     ),
+    ( ".5",          0.5   ),
+    ( "2.5",         2.5   ),
+    ( "1e2",       100     ),
+    ( "1E2",       100     ),
+    ( "2.5E-1",      0.25  ),
+    ( "+12.5e-2",    0.125 ),
+    ( "+12.5e+2", 1250     )
+  ]
+
+test_failures = TestCase $ do
+    mapM_ (`assertFloatPFailure` "") failure_cases
+
+failure_cases =
+  [
+    "/",
+    "+",
+    "-",
+    "E",
+    "E10",
+    "A",
+    "1E",
+    "1A"
+  ]

@@ -0,0 +1,588 @@+module Language.VintageBasic.Interpreter_test where
+
+import Test.HUnit
+import Language.VintageBasic.Asserts
+import Language.VintageBasic.Executer
+import Language.VintageBasic.BasicMonad
+import Control.Monad.CPST.DurableTraps
+
+testProgramOutput source expected = TestCase $ do
+    i <- noInput
+    o <- mkOutput
+    runProgram i o (execute "" source >> done)
+    assertOutputEq o expected
+
+testProgramOutputWithInput source input expected = TestCase $ do
+    i <- mkInput input
+    o <- mkOutput
+    runProgram i o (execute "" source >> done)
+    assertOutputEq o expected
+
+testExpression source expected = testProgramOutput ("1?" ++ source ++ "\n") (expected ++ "\n")
+
+testExpressions ts = TestList $ map (uncurry testExpression) ts
+
+test_does_nothing = testProgramOutput "" ""
+
+test_executes_lines_in_sequence = testProgramOutput "10 ?\"A\"\n20 ?\"B\"\n" "A\nB\n"
+
+test_var_defaults = testProgramOutput "10 ?A:?A%:?A$\n" " 0 \n 0 \n\n"
+
+test_float_assignment = testProgramOutput "10 A=5:PRINTA\n" " 5 \n"
+
+test_int_assignment_pos = testProgramOutput "10 A%=5.9:?A%\n" " 5 \n"
+
+test_int_assignment_neg = testProgramOutput "10 A%=-5.1:?A%\n" "-6 \n"
+
+test_string_assignment = testProgramOutput "10 A$=\"WOW\":?A$\n" "WOW\n"
+
+test_variables_of_different_types_with_the_same_name_are_different = testProgramOutput
+    "10 A=4.5:A%=3:A$=\"HI\"\n20 ?A:?A%:?A$\n"
+    " 4.5 \n 3 \nHI\n"
+
+test_var_names_are_only_significant_to_two_characters = testProgramOutput
+    "10 SOMETHING=4:SAMETHING=2:?SOWHAT:?SALLY\n"
+    " 4 \n 2 \n"
+
+test_first_digit_of_var_name_is_significant_too = testProgramOutput
+    "10 SOMETHING12=4:SOMETHING22=2:?SOMETHING13:?SOMETHING24\n"
+    " 4 \n 2 \n"
+
+test_dim = testProgramOutput "10 DIMA(20):A(0)=5:A(20)=6:PRINTA(20);A(0)\n" " 6  5 \n"
+
+test_dim_default_size_is_at_least_10 = testProgramOutput "10 A(10)=6:PRINTA(10)\n" " 6 \n"
+
+test_dim_default_size_is_at_most_10 = testProgramOutput
+    "10 A(11)=6:PRINTA(11)\n" "!OUT OF ARRAY BOUNDS IN LINE 10\n"
+
+test_dim_with_negative_dimension = testProgramOutput
+    "10 DIMA(-1)\n"
+    "!NEGATIVE ARRAY DIM IN LINE 10\n"
+
+test_multiple_dimensions = testProgramOutput "10 DIMA(1,3):A(1,3)=12:PRINTA(1,3)\n" " 12 \n"
+
+test_array_dim_rounding = testProgramOutput
+    "10 DIMA(11.9):A(11.9)=5:?A(11.1):A(12)=6:?A(6)\n"
+    " 5 \n!OUT OF ARRAY BOUNDS IN LINE 10\n"
+
+test_for_loop_with_array = testProgramOutput "10 FORI=1TO10:A(I)=10-I:NEXT:PRINTA(3)\n" " 7 \n"
+
+test_int_array = testProgramOutput "10 A%(5)=2.8:?A%(1);A%(5)\n" " 0  2 \n"
+
+test_string_array = testProgramOutput "10 A$(5)=\"HI\":?A$(1);A$(5)\n" "HI\n"
+
+test_arithmetic_expression = testProgramOutput "10 A=5:?A^2+3*A-1/2\n" " 39.5 \n"
+
+test_parentheses = testProgramOutput "10 A=5:?A^(2+3)*(A-1)/2\n" " 6250 \n"
+
+test_relational_operators_on_numbers = TestList $ [
+    "eq" ~: testProgramOutput "10 ?1= 1:?1= 2:?2= 1\n" "-1 \n 0 \n 0 \n",
+    "ne" ~: testProgramOutput "10 ?1<>1:?1<>2:?2<>1\n" " 0 \n-1 \n-1 \n",
+    "lt" ~: testProgramOutput "10 ?1< 1:?1< 2:?2< 1\n" " 0 \n-1 \n 0 \n",
+    "le" ~: testProgramOutput "10 ?1<=1:?1<=2:?2<=1\n" "-1 \n-1 \n 0 \n",
+    "gt" ~: testProgramOutput "10 ?1> 1:?1> 2:?2> 1\n" " 0 \n 0 \n-1 \n",
+    "ge" ~: testProgramOutput "10 ?1>=1:?1>=2:?2>=1\n" "-1 \n 0 \n-1 \n"
+  ]
+
+test_relational_operators_on_strings = TestList $ [
+    "eq" ~: testProgramOutput "10 ?\"A\"= \"A\":?\"A\"= \"B\":?\"B\"= \"A\"\n" "-1 \n 0 \n 0 \n",
+    "ne" ~: testProgramOutput "10 ?\"A\"<>\"A\":?\"A\"<>\"B\":?\"B\"<>\"A\"\n" " 0 \n-1 \n-1 \n",
+    "lt" ~: testProgramOutput "10 ?\"A\"< \"A\":?\"A\"< \"B\":?\"B\"< \"A\"\n" " 0 \n-1 \n 0 \n",
+    "le" ~: testProgramOutput "10 ?\"A\"<=\"A\":?\"A\"<=\"B\":?\"B\"<=\"A\"\n" "-1 \n-1 \n 0 \n",
+    "gt" ~: testProgramOutput "10 ?\"A\"> \"A\":?\"A\"> \"B\":?\"B\"> \"A\"\n" " 0 \n 0 \n-1 \n",
+    "ge" ~: testProgramOutput "10 ?\"A\">=\"A\":?\"A\">=\"B\":?\"B\">=\"A\"\n" "-1 \n 0 \n-1 \n"
+  ]
+
+test_boolean_logic = TestList $ [
+    "and" ~: testProgramOutput "10 ?0AND0:?0AND-1:?-1AND0:?-1AND-1\n" " 0 \n 0 \n 0 \n-1 \n",
+    "or"  ~: testProgramOutput "10 ?0OR 0:?0OR -1:?-1OR 0:?-1OR -1\n" " 0 \n-1 \n-1 \n-1 \n",
+    "not" ~: testProgramOutput "10 ?NOT0:?NOT-1:?NOT2\n" "-1 \n 0 \n 0 \n"
+  ]
+
+test_boolean_logic_with_nonintegers = TestList $ [
+    "and" ~: testProgramOutput "10 ?0.1AND-0.1:?0.1AND0:?0AND0.1\n" " .1 \n 0 \n 0 \n",
+    "or"  ~: testProgramOutput "10 ?0OR-0.1:?0.1OR0:?0OR0\n" "-.1 \n .1 \n 0 \n",
+    "not" ~: testProgramOutput "10 ?NOT-0.9:?NOT-0.1:?NOT0.1:?NOT0.9:?NOT1.1\n" " 0 \n 0 \n 0 \n 0 \n 0 \n"
+  ]
+
+test_negation = testProgramOutput "10 A=5:?-A:?-(-A)\n" "-5 \n 5 \n"
+
+test_abs = testExpressions [
+    ("ABS()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("ABS(\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("ABS( 5.7)", " 5.7 "),
+    ("ABS( 0  )", " 0 "),
+    ("ABS(-5.7)", " 5.7 "),
+    ("ABS(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_asc = testExpressions [
+    ("ASC()",            "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("ASC(65)",          "!TYPE MISMATCH IN LINE 1"),
+    ("ASC(\"\")",        "!INVALID ARGUMENT IN LINE 1"),
+    ("ASC(\"A\")",       " 65 "),
+    ("ASC(\"ABC\")",     " 65 "),
+    ("ASC(\"0\")",       " 48 "),
+    ("ASC(\"0\",\"0\")", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_atn = testExpressions [
+    ("ATN()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("ATN(\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("ATN(0)",   " 0 "       ),
+    ("ATN(1)",   " .7853982 "),
+    ("ATN(10)",  " 1.4711276 "),
+    ("ATN(-1)",  "-.7853982 "),
+    ("ATN(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_chr = testExpressions [
+    ("CHR$()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("CHR$(\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("CHR$(-1)", "!INVALID ARGUMENT IN LINE 1"),
+    ("CHR$(10)", "\n"),
+    ("CHR$(13)", "\r"),
+    ("CHR$(32)", " "),
+    ("CHR$(48)", "0"),
+    ("CHR$(65)", "A"),
+    ("CHR$(256)", "!INVALID ARGUMENT IN LINE 1"),
+    ("CHR$(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_cos = testExpressions [
+    ("COS()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("COS(\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("COS(0)", " 1 "),
+    ("COS(1)", " .5403023 "),
+    ("COS(1.5707964)", "-4.371139E-8 "),
+    ("COS(3.1415927)", "-1 "),
+    ("COS(4.712389)",  " 1.1924881E-8 "),
+    ("COS(6.2831855)", " 1 "),
+    ("COS(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_exp = testExpressions [
+    ("EXP()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("EXP(\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("EXP(-1)", " .36787945 "),
+    ("EXP(0)",  " 1 "),
+    ("EXP(1)",  " 2.7182817 "),
+    ("EXP(2)",  " 7.389056 "),
+    ("EXP(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_int = testExpressions [
+    ("INT()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("INT(\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("INT(-23.1)", "-24 "),
+    ("INT(23)",    " 23 "),
+    ("INT(23.1)",  " 23 "),
+    ("INT(23.9)",  " 23 "),
+    ("INT(24)",    " 24 "),
+    ("INT(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_left = testExpressions [
+    ("LEFT$()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("LEFT$(\"A\")", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("LEFT$(\"ABC\",\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("LEFT$(1,1)", "!TYPE MISMATCH IN LINE 1"),
+    ("LEFT$(\"ABC\",-1)", "!INVALID ARGUMENT IN LINE 1"),
+    ("LEFT$(\"ABC\",-.1)", "!INVALID ARGUMENT IN LINE 1"),
+    ("LEFT$(\"ABC\", 0)", ""),
+    ("LEFT$(\"ABC\", 1)", "A"),
+    ("LEFT$(\"ABC\", 2)", "AB"),
+    ("LEFT$(\"ABC\", 2.9)", "AB"),
+    ("LEFT$(\"ABC\", 3)", "ABC"),
+    ("LEFT$(\"ABC\", 4)", "ABC"),
+    ("LEFT$(\"A\",1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_len = testExpressions [
+    ("LEN()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("LEN(1)", "!TYPE MISMATCH IN LINE 1"),
+    ("LEN(\"\")",  " 0 "),
+    ("LEN(\"A\")", " 1 "),
+    ("LEN(\" \" + CHR$(0) + \"23$!\")", " 6 "),
+    ("LEN(\"A\", \"B\")", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_log = testExpressions [
+    ("LOG()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("LOG(\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("LOG(-1)",        "!INVALID ARGUMENT IN LINE 1"),
+    ("LOG( 0)",        "!INVALID ARGUMENT IN LINE 1"),
+    ("LOG( 0.1)",      "-2.3025851 "),
+    ("LOG( 1)",        " 0 "),
+    ("LOG(2.7182817)", " .99999994 "),
+    ("LOG(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_mid = testExpressions [
+    ("MID$()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("MID$(\"ABC\")", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("MID$(1,1)", "!TYPE MISMATCH IN LINE 1"),
+    ("MID$(\"ABC\",\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("MID$(\"ABC\",-1)", "!INVALID ARGUMENT IN LINE 1"),
+    ("MID$(\"ABC\", 0)", "!INVALID ARGUMENT IN LINE 1"),
+    ("MID$(\"ABC\", 1)", "ABC"),
+    ("MID$(\"ABC\", 2)", "BC"),
+    ("MID$(\"ABC\", 3)", "C"),
+    ("MID$(\"ABC\", 4)", ""),
+    ("MID$(1,1)", "!TYPE MISMATCH IN LINE 1"),
+    ("MID$(\"ABC\",\"A\",1)", "!TYPE MISMATCH IN LINE 1"),
+    ("MID$(\"ABC\",1,\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("MID$(\"ABC\",-1, 1)", "!INVALID ARGUMENT IN LINE 1"),
+    ("MID$(\"ABC\", 0, 1)", "!INVALID ARGUMENT IN LINE 1"),
+    ("MID$(\"ABC\", 0,-1)", "!INVALID ARGUMENT IN LINE 1"),
+    ("MID$(\"ABC\", 1,0)", ""),
+    ("MID$(\"ABC\", 1,1)", "A"),
+    ("MID$(\"ABC\", 1,2)", "AB"),
+    ("MID$(\"ABC\", 1,3)", "ABC"),
+    ("MID$(\"ABC\", 1,4)", "ABC"),
+    ("MID$(\"ABC\", 2,0)", ""),
+    ("MID$(\"ABC\", 2,1)", "B"),
+    ("MID$(\"ABC\", 2,2)", "BC"),
+    ("MID$(\"ABC\", 2.9, 2.9)", "BC"),
+    ("MID$(\"ABC\", 2,3)", "BC"),
+    ("MID$(\"ABC\", 3,0)", ""),
+    ("MID$(\"ABC\", 3,1)", "C"),
+    ("MID$(\"ABC\", 3,2)", "C"),
+    ("MID$(\"ABC\", 4,0)", ""),
+    ("MID$(\"ABC\", 4,1)", ""),
+    ("MID$(\"ABC\", 1, 1, 1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_right = testExpressions [
+    ("RIGHT$()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("RIGHT$(\"A\")", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("RIGHT$(\"ABC\",\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("RIGHT$(1,1)", "!TYPE MISMATCH IN LINE 1"),
+    ("RIGHT$(\"ABC\",-1)", "!INVALID ARGUMENT IN LINE 1"),
+    ("RIGHT$(\"ABC\", 0)", ""),
+    ("RIGHT$(\"ABC\", 1)", "C"),
+    ("RIGHT$(\"ABC\", 2)", "BC"),
+    ("RIGHT$(\"ABC\", 2.9)", "BC"),
+    ("RIGHT$(\"ABC\", 3)", "ABC"),
+    ("RIGHT$(\"ABC\", 4)", "ABC"),
+    ("RIGHT$(\"A\",1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_rnd = testProgramOutput
+    "1 ?RND(-1):?RND(1):?RND(1):?RND(0):?RND(10):?RND(-2.5)\n"
+    " .35925463 \n .3306234 \n .13648525 \n .13648525 \n .53864 \n .10321328 \n"
+
+test_rnd_errors = testExpressions [
+    ("RND()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("RND(\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("RND(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+-- RANDOMIZE is difficult to test because it depends on system time
+
+test_sgn = testExpressions [
+    ("SGN()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("SGN(\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("SGN( 5.7)", " 1 "),
+    ("SGN( 0  )", " 0 "),
+    ("SGN(-5.7)", "-1 "),
+    ("SGN(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_sin = testExpressions [
+    ("SIN()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("SIN(\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("SIN(0)", " 0 "),
+    ("SIN(1)", " .84147096 "),
+    ("SIN(1.5707964)", " 1 "),
+    ("SIN(3.1415927)", "-8.742278E-8 "),
+    ("SIN(4.712389)",  "-1 "),
+    ("SIN(6.2831855)", " 1.7484555E-7 "),
+    ("SIN(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_spc = testExpressions [
+    ("SPC()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("SPC(\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("SPC(-1)", "!INVALID ARGUMENT IN LINE 1"),
+    ("SPC(0)", ""),
+    ("SPC(1)", " "),
+    ("SPC(2.9)", "  "),
+    ("SPC(10)", "          "),
+    ("SPC(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_sqr = testExpressions [
+    ("SQR()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("SQR(\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("SQR(-1)", "!INVALID ARGUMENT IN LINE 1"),
+    ("SQR(0)", " 0 "),
+    ("SQR(2)", " 1.4142135 "),
+    ("SQR(4)", " 2 "),
+    ("SQR(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_str = testExpressions [
+    ("STR$()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("STR$(\"ABC\")", "!TYPE MISMATCH IN LINE 1"),
+    ("STR$(1E2)", " 100"),
+    ("STR$(.000000001)", " 1.E-9"),
+    ("STR$(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_tan = testExpressions [
+    ("TAN()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("TAN(\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("TAN(0)", " 0 "),
+    ("TAN(.7853982)", " 1 "),
+    ("TAN(1)", " 1.5574077 "),
+    ("TAN(1.5707964)", "-22877332 "),
+    ("TAN(3.1415927)", " 8.742278E-8 "),
+    ("TAN(4.712389)",  "-83858280 "),
+    ("TAN(6.2831855)", " 1.7484555E-7 "),
+    ("TAN(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_val = testExpressions [
+    ("VAL()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("VAL(1)", "!TYPE MISMATCH IN LINE 1"),
+    ("VAL(\"\")", " 0 "),
+    ("VAL(\"123\")", " 123 "),
+    ("VAL(\" 123 \")", " 123 "),
+    ("VAL(\" 1 2\")", " 1 "),
+    ("VAL(\"1A\")", " 1 "),
+    ("VAL(\"A\")", " 0 "),
+    ("VAL(\"1\",\"1\")", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_goto_forwards = testProgramOutput "10GOTO30\n20?20\n30?30\n" " 30 \n"
+
+test_goto_backwards = testProgramOutput "10GOTO50\n20?20\n30?30\n40END\n50GOTO30\n" " 30 \n"
+
+test_gosub = testProgramOutput "1?1\n2GOSUB5\n3?3\n4END\n5?5\n6RETURN\n" " 1 \n 5 \n 3 \n"
+
+test_nested_gosub = testProgramOutput (unlines [
+    "  1 ?1     ",
+    "  2 GOSUB5 ",
+    "  3 ?3     ",
+    "  4 END    ",
+    "  5 ?5     ",
+    "  6 GOSUB9 ",
+    "  7 ?7     ",
+    "  8 RETURN ",
+    "  9 ?9     ",
+    " 10 RETURN "
+  ])
+  " 1 \n 5 \n 9 \n 7 \n 3 \n"
+
+test_return_does_double_duty = testProgramOutput (unlines [
+    "10 ?10:GOSUB30",
+    "20 ?20:END",
+    "30 ?30:GOSUB40",
+    "40 ?40:RETURN"
+  ])
+  " 10 \n 30 \n 40 \n 40 \n 20 \n"
+
+test_on_goto = TestList [
+    testProgramOutput "1 ON\"A\"GOTO2\n" "!TYPE MISMATCH IN LINE 1\n",
+    testProgramOutput "1 A=-1  :ONAGOTO3,4,5\n2 ?2\n3 ?3\n4 ?4\n5 ?5\n6 ?6\n" " 2 \n 3 \n 4 \n 5 \n 6 \n",
+    testProgramOutput "1 A=-0.1:ONAGOTO3,4,5\n2 ?2\n3 ?3\n4 ?4\n5 ?5\n6 ?6\n" " 2 \n 3 \n 4 \n 5 \n 6 \n",
+    testProgramOutput "1 A= 0  :ONAGOTO3,4,5\n2 ?2\n3 ?3\n4 ?4\n5 ?5\n6 ?6\n" " 2 \n 3 \n 4 \n 5 \n 6 \n",
+    testProgramOutput "1 A= 1  :ONAGOTO3,4,5\n2 ?2\n3 ?3\n4 ?4\n5 ?5\n6 ?6\n" " 3 \n 4 \n 5 \n 6 \n",
+    testProgramOutput "1 A= 2  :ONAGOTO3,4,5\n2 ?2\n3 ?3\n4 ?4\n5 ?5\n6 ?6\n" " 4 \n 5 \n 6 \n",
+    testProgramOutput "1 A= 2.9:ONAGOTO3,4,5\n2 ?2\n3 ?3\n4 ?4\n5 ?5\n6 ?6\n" " 4 \n 5 \n 6 \n",
+    testProgramOutput "1 A= 3  :ONAGOTO3,4,5\n2 ?2\n3 ?3\n4 ?4\n5 ?5\n6 ?6\n" " 5 \n 6 \n",
+    testProgramOutput "1 A= 4  :ONAGOTO3,4,5\n2 ?2\n3 ?3\n4 ?4\n5 ?5\n6 ?6\n" " 2 \n 3 \n 4 \n 5 \n 6 \n",
+    testProgramOutput "1 A= 2  :ONAGOTO3,5,4\n2 ?2\n3 ?3\n4 ?4\n5 ?5\n6 ?6\n" " 5 \n 6 \n"
+  ]
+
+test_on_gosub = TestList [
+    testProgramOutput "1 ON\"A\"GOSUB2\n" "!TYPE MISMATCH IN LINE 1\n",
+    testProgramOutput "1 A=-1  :ONAGOSUB3,4,5:END\n2 ?2:RETURN\n3 ?3:RETURN\n4 ?4:RETURN\n5 ?5:RETURN\n6 ?6:RETURN\n" "",
+    testProgramOutput "1 A=-0.1:ONAGOSUB3,4,5:END\n2 ?2:RETURN\n3 ?3:RETURN\n4 ?4:RETURN\n5 ?5:RETURN\n6 ?6:RETURN\n" "",
+    testProgramOutput "1 A= 0  :ONAGOSUB3,4,5:END\n2 ?2:RETURN\n3 ?3:RETURN\n4 ?4:RETURN\n5 ?5:RETURN\n6 ?6:RETURN\n" "",
+    testProgramOutput "1 A= 1  :ONAGOSUB3,4,5:END\n2 ?2:RETURN\n3 ?3:RETURN\n4 ?4:RETURN\n5 ?5:RETURN\n6 ?6:RETURN\n" " 3 \n",
+    testProgramOutput "1 A= 2  :ONAGOSUB3,4,5:END\n2 ?2:RETURN\n3 ?3:RETURN\n4 ?4:RETURN\n5 ?5:RETURN\n6 ?6:RETURN\n" " 4 \n",
+    testProgramOutput "1 A= 2.9:ONAGOSUB3,4,5:END\n2 ?2:RETURN\n3 ?3:RETURN\n4 ?4:RETURN\n5 ?5:RETURN\n6 ?6:RETURN\n" " 4 \n",
+    testProgramOutput "1 A= 3  :ONAGOSUB3,4,5:END\n2 ?2:RETURN\n3 ?3:RETURN\n4 ?4:RETURN\n5 ?5:RETURN\n6 ?6:RETURN\n" " 5 \n",
+    testProgramOutput "1 A= 4  :ONAGOSUB3,4,5:END\n2 ?2:RETURN\n3 ?3:RETURN\n4 ?4:RETURN\n5 ?5:RETURN\n6 ?6:RETURN\n" "",
+    testProgramOutput "1 A= 2  :ONAGOSUB3,5,4:END\n2 ?2:RETURN\n3 ?3:RETURN\n4 ?4:RETURN\n5 ?5:RETURN\n6 ?6:RETURN\n" " 5 \n"
+  ]
+
+test_if = TestList [
+    testProgramOutput "1 IF\"A\"THEN?1\n" "!TYPE MISMATCH IN LINE 1\n",
+    testProgramOutput "1 IF-11THEN?1:?2\n2 ?3\n" " 1 \n 2 \n 3 \n",
+    testProgramOutput "1 IF 0THEN?1:?2\n2 ?3\n" " 3 \n",
+    testProgramOutput "1 IF 1THEN?1:?2\n2 ?3\n" " 1 \n 2 \n 3 \n",
+    testProgramOutput "1 IF .1THEN?1:?2\n2 ?3\n" " 1 \n 2 \n 3 \n",
+    testProgramOutput "1 IF -.1THEN?1:?2\n2 ?3\n" " 1 \n 2 \n 3 \n",
+    testProgramOutput "1 IF 2.1THEN?1:?2\n2 ?3\n" " 1 \n 2 \n 3 \n"
+  ]
+
+test_for = TestList [
+    testProgramOutput "1 FORA$=1TO10\n" "!TYPE MISMATCH IN LINE 1\n",
+    testProgramOutput "1 FORA%=1TO10\n" "!TYPE MISMATCH IN LINE 1\n",
+    testProgramOutput "1 FORA=\"A\"TO3\n" "!TYPE MISMATCH IN LINE 1\n",
+    testProgramOutput "1 FORA=1TO\"A\"\n" "!TYPE MISMATCH IN LINE 1\n",
+    testProgramOutput "1 FORA=1TO3:?A:NEXT:?99:?A\n" " 1 \n 2 \n 3 \n 99 \n 4 \n",
+    testProgramOutput "1 FORA=2TO8STEP2:?A:NEXT:?99:?A\n" " 2 \n 4 \n 6 \n 8 \n 99 \n 10 \n",
+    testProgramOutput "1 FORA=8TO2STEP-2:?A:NEXT:?99:?A\n" " 8 \n 6 \n 4 \n 2 \n 99 \n 0 \n",
+    testProgramOutput "1 FORA=1TO0:?A:NEXT:?99:?A\n" " 1 \n 99 \n 2 \n",
+    testProgramOutput "1 FORA=1TO3\n2 ?A\n3 NEXT\n" " 1 \n 2 \n 3 \n",
+    testProgramOutput "1 FORA=1TO3\n2 ?A\n3 NEXTA\n" " 1 \n 2 \n 3 \n",
+    testProgramOutput "1 FORA=1TO3\n2 ?A\n3 NEXTB\n" " 1 \n!NEXT WITHOUT FOR ERROR (VAR B) IN LINE 3\n"
+  ]
+
+test_nested_for = testProgramOutput (unlines [
+    "1 FORA=10TO20STEP10",
+    "2 FORB=1TO3",
+    "3 ?A+B",
+    "4 NEXT",
+    "5 NEXT"
+  ])
+  " 11 \n 12 \n 13 \n 21 \n 22 \n 23 \n"
+
+test_improperly_nested_for = testProgramOutput (unlines [
+    "1 FORA=10TO20STEP10",
+    "2 FORB=1TO3",
+    "3 ?A+B",
+    "4 NEXTA",
+    "5 NEXTB"
+  ])
+  " 11 \n 21 \n 32 \n!NEXT WITHOUT FOR ERROR (VAR A) IN LINE 4\n"
+
+test_return_in_for = testProgramOutput (unlines [
+    "10 GOSUB40",
+    "20 NEXT",
+    "30 END",
+    "40 FORI=1TO3",
+    "50 PRINT\"HELLO\"",
+    "60 RETURN"
+  ])
+  "HELLO\nHELLO\n!RETURN WITHOUT GOSUB ERROR IN LINE 60\n"
+
+test_print_literals = testProgramOutput "10 PRINT\"NUMBER\";5;\"AND\";-2\n" "NUMBER 5 AND-2 \n"
+
+test_float_representation = testProgramOutput "10 ?1E17:?5.55555\n" " 1.E+17 \n 5.55555 \n"
+
+test_tab = testProgramOutput
+    "10 ?TAB(4);\"A\";TAB(10);\"B\";TAB(11);\"C\";TAB(4);\"D\"\n"
+    "    A     BCD\n"
+
+test_tab_with_nonintegers = testProgramOutput "10 ?TAB(2.9);\"A\"\n" "  A\n"
+
+test_tab_with_newlines_and_linefeeds = testProgramOutput
+    "10 ?\"HI\";CHR$(13);\"TO\";TAB(5);\"YOU\";CHR$(10);\"AND\";TAB(10);\"ME\"\n"
+    "HI\rTO   YOU\nAND       ME\n"
+
+test_tab_wrongargs = testExpressions [
+    ("TAB()", "!WRONG NUMBER OF ARGUMENTS IN LINE 1"),
+    ("TAB(\"A\")", "!TYPE MISMATCH IN LINE 1"),
+    ("TAB(-1)", "!INVALID ARGUMENT IN LINE 1"),
+    ("TAB(1,1)", "!WRONG NUMBER OF ARGUMENTS IN LINE 1")
+  ]
+
+test_print_zones = testProgramOutput
+    "1 ?\"A\",\"B\",,\"C\":?\"123456789012345\",\"X\":?1,;:?2,:?,3\n"
+    "A             B                           C\n123456789012345             X\n 1             2                           3 \n"
+
+test_input = TestList [
+    "multiple values and types" ~: testProgramOutputWithInput
+        "1 INPUT\"WHAT\";A$,B,CD$(9),M%\n2 ?:?A$:?B:?CD$(9):?M%\n"
+        "  Bob 4 , 3  ,2  1, 5.2\n"
+        "WHAT? \nBob 4\n 3 \n2  1\n 5 \n",
+    "trims whitespace" ~: testProgramOutputWithInput
+        "1 INPUTA$:?:?A$\n"
+        "  \t   Bob 4 \n"
+        "? \nBob 4\n",
+    "quoted strings" ~: testProgramOutputWithInput
+        "1 INPUTA$\n2 ?:?A$\n"
+        "  \t\"   Bob 4 \"         \t   \n"
+        "? \n   Bob 4 \n",
+    "re-prompts for invalid number" ~: testProgramOutputWithInput
+        "1 INPUTA:?:?A\n"
+        "X\n4\n"
+        "? !NUMBER EXPECTED - RETRY INPUT LINE\n? \n 4 \n",
+    "re-prompts if not enough data on line" ~: testProgramOutputWithInput
+        "1 INPUT\"NUM\";A,B:?:?A:?B\n"
+        "3\n4\n"
+        "NUM? ?? \n 3 \n 4 \n",
+    "extra input ignored" ~: testProgramOutputWithInput
+        "1 INPUTA\n"
+        "1,2\n"
+        "? !EXTRA INPUT IGNORED\n",
+    "error if we reach eof without enough data" ~: testProgramOutputWithInput
+        "1 INPUTA,B:?:?A:?B\n"
+        "4\n"
+        "? ?? !END OF INPUT IN LINE 1\n",
+    "error if we reach eof without enough data (no newline)" ~: testProgramOutputWithInput
+        "1 INPUTA:?:?A\n"
+        ""
+        "? !END OF INPUT IN LINE 1\n"
+  ]
+
+test_read_data = TestList [
+    "multiple values and types" ~: testProgramOutput
+        "1 READ A$,B,CD$(9),M%\n2 ?A$:?B:?CD$(9):?M%\n3 DATA  Bob 4 , 3  ,2  1, 5.2\n"
+        "Bob 4\n 3 \n2  1\n 5 \n",
+    "trims whitespace" ~: testProgramOutput
+        "1 READA$:?A$\n2 DATA  \t   Bob 4 \n"
+        "Bob 4\n",
+    "quoted strings" ~: testProgramOutput
+        "1 READA$\n2 ?A$\n3 DATA  \t\"   Bob 4 \"         \t   \n"
+        "   Bob 4 \n",
+    "type mismatch for invalid number" ~: testProgramOutput
+        "1 READA:?:?A\n2 DATAX\n"
+        "!TYPE MISMATCH IN LINE 1\n",
+    "data on multiple lines" ~: testProgramOutput
+        "1 READA,B:?A:?B\n2 DATA3\n3 DATA4\n"
+        " 3 \n 4 \n",
+    "extra data ignored" ~: testProgramOutput
+        "1 READA:?A\n2 DATA1,2\n"
+        " 1 \n",
+    "error if we reach eof without enough data" ~: testProgramOutput
+        "1 READA,B:?A:?B\n2 DATA4\n"
+        "!OUT OF DATA IN LINE 1\n",
+    "don't care where data appears" ~: testProgramOutput
+        (unlines [
+            "1 DATA A:?7",
+            "2 READA$,B$,C:DATAmore",
+            "3 DATA 5",
+            "4 ?A$:?B$:?C"
+        ])
+        "A:?7\nmore\n 5 \n"
+  ]
+
+test_restore = testProgramOutput
+    (unlines [
+        "1 READ A,B,C:RESTORE 3:READ D,E:RESTORE:READ F,G,H:?A:?B:?C:?D:?E:?F:?G:?H\n",
+        "2 DATA1",
+        "3 DATA2",
+        "4 DATA3"
+    ])
+    " 1 \n 2 \n 3 \n 2 \n 3 \n 1 \n 2 \n 3 \n"
+
+test_def_fn = TestList [
+    "simple float" ~: testProgramOutput
+        "1 DEFFNA(X)=X^2+1:?FNA(4)\n"
+        " 17 \n",
+    "multi-arg float" ~: testProgramOutput
+        "1 DEFFNA(X,Y,Z$)=LEN(Z$)^2+2*X+Y:?FNA(2,3,\"HELLO\")\n"
+        " 32 \n",
+    "multi-arg string" ~: testProgramOutput
+        "1 DEFFNA$(X$,Y,Z)=MID$(X$,Y-1,Z+1):?FNA$(\"MAGILLICUDDY\",3,4)\n"
+        "AGILL\n",
+    "wrong num args" ~: testProgramOutput
+        "1 DEFFNA(X)=X*2:?FNA()\n"
+        "!WRONG NUMBER OF ARGUMENTS IN LINE 1\n",
+    "type mismatch" ~: testProgramOutput
+        "1 DEFFNA(X)=X*2:?A(\"X\")\n"
+        "!TYPE MISMATCH IN LINE 1\n",
+    "undefined" ~: testProgramOutput
+        "1 ?FNA(5):DEFFNA(X)=X*2\n"
+        "!UNDEFINED FUNCTION A IN LINE 1\n"
+  ]
+
+test_stop = testProgramOutput "1 ?1:STOP:?2\n" " 1 \n"
+
+test_rem = testProgramOutput "1 ?1:REM COMMENT:?2\n2 ?3\n" " 1 \n 3 \n"

@@ -0,0 +1,33 @@+module Language.VintageBasic.LineScanner_test where++import Test.HUnit+import Language.VintageBasic.Asserts+import Language.VintageBasic.LineScanner+import Language.VintageBasic.Result++assertRawParseResult = assertParseResult withLineAndCol ScanError rawLinesP+assertRawParseError  = assertParseError  withLineAndCol ScanError rawLinesP++test_LineScanner = TestCase $ do+  let text = unlines ["10SKDJF@#"," 5   ASJDKFdf "]+  assertRawParseResult text [(10, 3, "SKDJF@#"), (5, 6, "ASJDKFdf ")]+ +test_reports_error_if_line_doesn't_start_with_number = TestCase $ do+  let text = unlines ["10SKDJF@#","ASJD4KFdf "]+  assertRawParseError text "EXPECTING LINE NUMBER OR END OF FILE"+ +test_skips_blank_lines = TestCase $ do+  let text = unlines ["","10?","","20?",""]+  assertRawParseResult text [(10, 3, "?"), (20, 3, "?")]+ +test_reports_error_if_file_doesn't_end_in_newline = TestCase $ do+  let text = "10SKDJF@#"+  assertRawParseError text "UNEXPECTED END OF FILE\n EXPECTING END OF LINE OR CHARACTER"+ +test_accepts_blank_line = TestCase $ do+  let text = unlines ["10"]+  assertRawParseResult text [(10, 3, "")]++test_strips_carriage_return_preceding_newline = TestCase $ do+  let text = "10 BLAH\r\n20 BLORT\r\n"+  assertRawParseResult text [(10, 4, "BLAH"), (20, 4, "BLORT")]

@@ -0,0 +1,215 @@+module Language.VintageBasic.Parser_test where++import Test.HUnit+import Text.ParserCombinators.Parsec(parse)+import Text.ParserCombinators.Parsec.Pos+import Language.VintageBasic.Asserts+import Language.VintageBasic.Builtins+import Language.VintageBasic.LexCommon(Tagged(..))+import Language.VintageBasic.Parser+import Language.VintageBasic.Result+import Language.VintageBasic.Syntax+import Language.VintageBasic.Tokenizer(taggedTokensP)++tokenize source = let (Right taggedToks) = parse taggedTokensP "" source in taggedToks++goodStatements source expectedColAndStatements = TestCase $+  assertParseResult withCol SyntaxError statementListP (tokenize source) expectedColAndStatements++badStatements parser source expectedError = TestCase $+  assertParseError withCol SyntaxError statementListP (tokenize source) expectedError++goodExpr source expectedExpr = TestCase $+  assertParseResult id SyntaxError exprP (tokenize source) expectedExpr++badExpr source expectedError = TestCase $+  assertParseError id SyntaxError exprP (tokenize source) expectedError++test_parses_multiple_statements = goodStatements+    ":?::?: "+    [(2,PrintS []), (5,PrintS [])]+ +test_parse_bare_print = goodStatements+    "PRINT"+    [(1,PrintS [])]+ +test_parse_print_string = goodStatements+    "PRINT\"hello\""+    [(1,PrintS [LitX (StringLit "hello")])]+ +test_parse_print_string_ending_in_semicolon = goodStatements+    "PRINT\"hello\";"+    [(1,PrintS [LitX (StringLit "hello"), EmptySeparatorX])]+ +test_parse_print_string_ending_in_comma = goodStatements+    "PRINT\"hello\","+    [(1,PrintS [LitX (StringLit "hello"), NextZoneX])]+ +test_parse_print_with_semicolon_separated_parts = goodStatements+    "PRINT\"hello\";\"there\""+    [(1,PrintS [LitX (StringLit "hello"), EmptySeparatorX, LitX (StringLit "there")])]+ +test_parse_print_with_juxtaposed_parts = goodStatements+    "PRINT\"hello\"\"there\""+    [(1,PrintS [LitX (StringLit "hello"), LitX (StringLit "there")])]++test_parse_print_with_comma_separated_parts = goodStatements+    "PRINT\"hello\",\"there\""+    [(1,PrintS [LitX (StringLit "hello"), NextZoneX, LitX (StringLit "there")])]+ +test_parse_print_with_a_comma_at_the_start = goodStatements+    "PRINT,\"hello\""+    [(1,PrintS [NextZoneX, LitX (StringLit "hello")])]++test_parse_let = goodStatements+    "LETA=1"+    [(1,LetS (ScalarVar (VarName FloatType "A")) (LitX (FloatLit 1.0)))]+ +test_parse_let_wo_keyword = goodStatements+    "A=1"+    [(1,LetS (ScalarVar (VarName FloatType "A")) (LitX (FloatLit 1.0)))]++test_parse_multiple_dims = goodStatements+    "DIMA$(5),G(14,20)"+    [(1,DimS [(VarName StringType "A", [(LitX (FloatLit 5))]), (VarName FloatType "G", [(LitX (FloatLit 14)), (LitX (FloatLit 20))])])]++test_parse_goto = goodStatements+    "GOTO20"+    [(1,GotoS 20)]++test_ignores_space_after_target = goodStatements+    "GOTO20 "+    [(1,GotoS 20)]+ +test_parse_gosub = goodStatements+    "GOSUB20"+    [(1,GosubS 20)]++test_parse_on_goto = goodStatements+    "ON3GOTO10,20,40"+    [(1,OnGotoS (LitX (FloatLit 3)) [10,20,40])]++test_parse_on_gosub = goodStatements+    "ON3GOSUB10,20,40"+    [(1,OnGosubS (LitX (FloatLit 3)) [10,20,40])]++test_parse_data = goodStatements+    "DATA4,5,\"THIS,WORKS\""+    [(1,DataS "4,5,\"THIS,WORKS\"")]++test_parse_read = goodStatements+    "READA$(5),B"+    [(1,ReadS [ArrVar (VarName StringType "A") [(LitX (FloatLit 5))], ScalarVar (VarName FloatType "B")])]++test_parse_restore = goodStatements+    "RESTORE"+    [(1,RestoreS Nothing)]++test_parse_restore_with_line_number = goodStatements+    "RESTORE20"+    [(1,RestoreS (Just 20))]++test_parse_def_fn = goodStatements+    "DEFFNAN1$(B,CD$)=4+B"+    [(1,DefFnS (VarName StringType "AN1") [(VarName FloatType "B"), (VarName StringType "CD")] (BinX AddOp (LitX (FloatLit 4)) (VarX (ScalarVar (VarName FloatType "B")))))]++test_parse_fn = goodStatements+    "?FNAN2$(1,\"X\")"+    [(1,PrintS [FnX (VarName StringType "AN2") [(LitX (FloatLit 1)), (LitX (StringLit "X"))]])]++test_parse_end = goodStatements+    "END"+    [(1,EndS)]++test_parse_stop = goodStatements+    "STOP"+    [(1,StopS)]++fl v = LitX (FloatLit v)+sl s = LitX (StringLit s)+fv s = VarX (ScalarVar (VarName FloatType s))+iv s = VarX (ScalarVar (VarName IntType s))+sv s = VarX (ScalarVar (VarName StringType s))++test_primitive_expressions = TestList [+    "round number"  ~: goodExpr "234" (fl 234),+    "float"         ~: goodExpr "2.3" (fl 2.3),+    "string"        ~: goodExpr "\"Work\"" (sl "Work"),+    "builtin"       ~: goodExpr "SIN(1)" (BuiltinX SinBI [(fl 1)]),+    "builtin2"      ~: goodExpr "LEFT$(A$,1)" (BuiltinX LeftBI [sv "A", fl 1]),+    "fn"            ~: goodExpr "FNAB(1,2,3)" (FnX (VarName FloatType "AB") [fl 1, fl 2, fl 3]),+    "float var"     ~: goodExpr "BR" (fv "BR"),+    "int var"       ~: goodExpr "BR%" (iv "BR"),+    "string var"    ~: goodExpr "BR$" (sv "BR"),+    "array var"     ~: goodExpr "AB(20, 5)" (VarX (ArrVar (VarName FloatType "AB") [fl 20, fl 5]))+  ]++test_operators = TestList [+    "unary +"       ~: goodExpr "+A"   (fv "A"),+    "unary -"       ~: goodExpr "-A"   (MinusX (fv "A")),+    "num add"       ~: goodExpr "1+2"  (BinX AddOp (fl 1) (fl 2)),+    "num sub"       ~: goodExpr "1-2"  (BinX SubOp (fl 1) (fl 2)),+    "num mul"       ~: goodExpr "1*2"  (BinX MulOp (fl 1) (fl 2)),+    "num div"       ~: goodExpr "1/2"  (BinX DivOp (fl 1) (fl 2)),+    "num pow"       ~: goodExpr "1^2"  (BinX PowOp (fl 1) (fl 2)),+    "num eq"        ~: goodExpr "1=2"  (BinX EqOp  (fl 1) (fl 2)),+    "num ne"        ~: goodExpr "1<>2" (BinX NEOp  (fl 1) (fl 2)),+    "num lt"        ~: goodExpr "1<2"  (BinX LTOp  (fl 1) (fl 2)),+    "num gt"        ~: goodExpr "1>2"  (BinX GTOp  (fl 1) (fl 2)),+    "string concat" ~: goodExpr "\"A\"+\"B\"" (BinX AddOp (sl "A") (sl "B")),+    "string lt"     ~: goodExpr "\"A\"<\"B\"" (BinX LTOp  (sl "A") (sl "B")),+    "string gt"     ~: goodExpr "\"A\">\"B\"" (BinX GTOp  (sl "A") (sl "B")),+    "string eq"     ~: goodExpr "\"A\"=\"B\"" (BinX EqOp  (sl "A") (sl "B")),+    "and"           ~: goodExpr "1=2AND3=4" (BinX AndOp (BinX EqOp (fl 1) (fl 2)) (BinX EqOp (fl 3) (fl 4))),+    "or"            ~: goodExpr "1=2OR3=4"  (BinX OrOp (BinX EqOp (fl 1) (fl 2)) (BinX EqOp (fl 3) (fl 4))),+    "not"           ~: goodExpr "NOT1" (NotX (fl 1))+  ]++test_associativity = TestList [+    "or assoc"      ~: goodExpr "1OR2OR3" (BinX OrOp (BinX OrOp (fl 1) (fl 2)) (fl 3)),+    "and assoc"     ~: goodExpr "1AND2AND3" (BinX AndOp (BinX AndOp (fl 1) (fl 2)) (fl 3)),+    "eq assoc"      ~: goodExpr "1=2=3" (BinX EqOp (BinX EqOp (fl 1) (fl 2)) (fl 3)),+    "ne assoc"      ~: goodExpr "1<>2<>3" (BinX NEOp (BinX NEOp (fl 1) (fl 2)) (fl 3)),+    "lt assoc"      ~: goodExpr "1<2<3" (BinX LTOp (BinX LTOp (fl 1) (fl 2)) (fl 3)),+    "le assoc"      ~: goodExpr "1<=2<=3" (BinX LEOp (BinX LEOp (fl 1) (fl 2)) (fl 3)),+    "gt assoc"      ~: goodExpr "1>2>3" (BinX GTOp (BinX GTOp (fl 1) (fl 2)) (fl 3)),+    "ge assoc"      ~: goodExpr "1>=2>=3" (BinX GEOp (BinX GEOp (fl 1) (fl 2)) (fl 3)),+    "add assoc"     ~: goodExpr "1+2+3" (BinX AddOp (BinX AddOp (fl 1) (fl 2)) (fl 3)),+    "sub assoc"     ~: goodExpr "1-2-3" (BinX SubOp (BinX SubOp (fl 1) (fl 2)) (fl 3)),+    "mul assoc"     ~: goodExpr "1*2*3" (BinX MulOp (BinX MulOp (fl 1) (fl 2)) (fl 3)),+    "div assoc"     ~: goodExpr "1/2/3" (BinX DivOp (BinX DivOp (fl 1) (fl 2)) (fl 3)),+    "pow assoc"     ~: goodExpr "1^2^3" (BinX PowOp (fl 1) (BinX PowOp (fl 2) (fl 3)))+  ]++test_precedence = TestList [+    "and beats or"      ~: goodExpr "1OR2AND3" (BinX OrOp (fl 1) (BinX AndOp (fl 2) (fl 3))),+    "not beats and"     ~: goodExpr "NOT1AND2" (BinX AndOp (NotX (fl 1)) (fl 2)),+    "eq beats not"      ~: goodExpr "NOT1=2"   (NotX (BinX EqOp (fl 1) (fl 2))),+    "eq class"          ~: goodExpr "1=2<>3<4<=5>6>=7" (BinX GEOp (BinX GTOp (BinX LEOp (BinX LTOp (BinX NEOp (BinX EqOp (fl 1) (fl 2)) (fl 3)) (fl 4)) (fl 5)) (fl 6)) (fl 7)),+    "eq class rev"      ~: goodExpr "1>=2>3<=4<5<>6=7" (BinX EqOp (BinX NEOp (BinX LTOp (BinX LEOp (BinX GTOp (BinX GEOp (fl 1) (fl 2)) (fl 3)) (fl 4)) (fl 5)) (fl 6)) (fl 7)),+    "add beats eq"      ~: goodExpr "1=2+3" (BinX EqOp (fl 1) (BinX AddOp (fl 2) (fl 3))),+    "add class"         ~: goodExpr "1+2-3" (BinX SubOp (BinX AddOp (fl 1) (fl 2)) (fl 3)),+    "add class rev"     ~: goodExpr "1-2+3" (BinX AddOp (BinX SubOp (fl 1) (fl 2)) (fl 3)),+    "mul beats add"     ~: goodExpr "1+2*3" (BinX AddOp (fl 1) (BinX MulOp (fl 2) (fl 3))),+    "mul class"         ~: goodExpr "1*2/3" (BinX DivOp (BinX MulOp (fl 1) (fl 2)) (fl 3)),+    "mul class rev"     ~: goodExpr "1/2*3" (BinX MulOp (BinX DivOp (fl 1) (fl 2)) (fl 3)),+    "pow beats mul"     ~: goodExpr "1*2^3" (BinX MulOp (fl 1) (BinX PowOp (fl 2) (fl 3))),+    "unary - beats pow" ~: goodExpr "-A^B" (BinX PowOp (MinusX (fv "A")) (fv "B"))+  ]++test_parentheses = TestList [+    goodExpr "(1+2)*3" (BinX MulOp (ParenX (BinX AddOp (fl 1) (fl 2))) (fl 3)),+    goodExpr "-(1+2)*3" (BinX MulOp (MinusX (ParenX (BinX AddOp (fl 1) (fl 2)))) (fl 3)),+    goodExpr "(1+(2-3))*4" (BinX MulOp (ParenX (BinX AddOp (fl 1) (ParenX (BinX SubOp (fl 2) (fl 3))))) (fl 4))+  ]++test_embedded_spaces_are_ignored = TestList [+    goodExpr "1 * 2  +3-  4" (BinX SubOp (BinX AddOp (BinX MulOp (fl 1) (fl 2)) (fl 3)) (fl 4)),+    goodExpr "CHR$ ( A ) " (BuiltinX ChrBI [fv "A"])+  ]++test_bad_expressions = TestList [+    "starting with operator" ~: badExpr "/4" "UNEXPECTED /",+    "ending with operator"   ~: badExpr "4/" "UNEXPECTED END OF LINE",+    "double operator"        ~: badExpr "4/*4" "UNEXPECTED *"+  ]

@@ -0,0 +1,27 @@+module Language.VintageBasic.Printer_test where
+
+import Test.HUnit
+import Language.VintageBasic.Printer
+
+floatTest (x, s) = TestCase $ assertEqual "" s (printFloat x)
+
+test_printFloat = TestList $ map floatTest [
+    (       -1.337e-20,   "-1.337E-20"   ),
+    (       -1,           "-1"           ),
+    (        0,           " 0"           ),
+    (        0.00000001,  " .00000001"   ),
+    (        0.000000001, " 1.E-9"       ),
+    (        0.011111111, " 1.1111111E-2"),
+    (        1,           " 1"           ),
+    (        1.1,         " 1.1"         ),
+    (        1.1111111,   " 1.111111"    ),
+    (       pi,           " 3.1415927"   ),
+    (        9,           " 9"           ),
+    (        1e2,         " 100"         ),
+    (     1111.1111,      " 1111.1111"   ),
+    ( 16777215,           " 16777215"    ),
+    ( 55555555,           " 55555556"    ),
+    (100000000,           " 1.E+8"       ),
+    (444444444,           " 4.4444445E+8"),
+    (555555555,           " 5.555556E+8" )
+  ]

@@ -0,0 +1,33 @@+module Language.VintageBasic.RuntimeParser_test where++import Test.HUnit+import Text.ParserCombinators.Parsec+import Language.VintageBasic.RuntimeParser(dataValsP,readFloat)++floatTest string expected = assertEqual "" expected (readFloat string)++test_readFloat = TestCase $+    mapM_ (uncurry floatTest) [+        ("A",     Nothing  ),+        (".",     Just   0.0 ),+        ("0",     Just   0.0 ),+        ("1",     Just   1.0 ),+        (" 1",    Nothing    ),+        ("-1",    Just (-1.0)),+        ("+1",    Just   1.0 ),+        ("1.",    Just   1.0 ),+        ("-1.",   Just (-1.0)),+        (".1",    Just   0.1 ),+        ("-.1",   Just (-0.1)),+        ("1.0",   Just   1.0 ),+        ("1E",    Nothing    ),+        ("1E.2",  Nothing    ),+        ("1A",    Just   1.0 ),+        ("1 E2",  Just   1.0 ),+        ("1 2",   Just   1.0 ),+        ("1E2",   Just   1.0E+2 ),+        ("1E+2",  Just   1.0E+2 ),+        ("1E-2",  Just   1.0E-2 ),+        ("-1E-2", Just (-1.0E-2)),+        ("123456789", Just 123456789.0)+    ]

@@ -0,0 +1,77 @@+module Language.VintageBasic.Tokenizer_test where++import Test.HUnit+import Language.VintageBasic.Asserts+import Language.VintageBasic.Builtins(Builtin(..))+import Language.VintageBasic.Result+import Language.VintageBasic.LineScanner+import Language.VintageBasic.Tokenizer(Token(..),taggedTokensP,printToken)++assertTokenizerResult = assertParseResult withCol SyntaxError taggedTokensP+assertTokenizerError  = assertParseError  withCol SyntaxError taggedTokensP++test_taggedTokensP = TestCase $ do+  let source = [+                ",:;()$%=<><=>=><+-*/^.?",+                "ABSASCCHR$COSEXPINTLEFT$LENLOGMID$RIGHT$RNDSGNSINSPCSQRSTR$TABTANVAL",+                "ANDORNOTLETDIMONGOSUBRETURNIFTHENFORTOSTEPNEXTPRINTINPUT",+                "RANDOMIZEREADRESTOREDEFFNENDSTOP",+                "\"hello\"REMGOFORTH\"ANDREAD\"",+                "XDATATODATA"+               ]+  let expectedLenAndTokss = [+                        [(1,CommaTok), (1,ColonTok), (1,SemiTok), (1,LParenTok), (1,RParenTok),+                         (1,DollarTok), (1,PercentTok), (1,EqTok), (2,NETok), (2,LETok), (2,GETok),+                         (1,GTTok), (1,LTTok), (1,PlusTok), (1,MinusTok), (1,MulTok), (1,DivTok),+                         (1,PowTok), (1,DotTok), (1,PrintTok)],+                        [(3,BuiltinTok AbsBI), (3,BuiltinTok AscBI), (4,BuiltinTok ChrBI),+                         (3,BuiltinTok CosBI), (3,BuiltinTok ExpBI), (3,BuiltinTok IntBI),+                         (5,BuiltinTok LeftBI), (3,BuiltinTok LenBI), (3,BuiltinTok LogBI),+                         (4,BuiltinTok MidBI), (6,BuiltinTok RightBI), (3,BuiltinTok RndBI),+                         (3,BuiltinTok SgnBI), (3,BuiltinTok SinBI), (3,BuiltinTok SpcBI),+                         (3,BuiltinTok SqrBI), (4,BuiltinTok StrBI), (3,BuiltinTok TabBI),+                         (3,BuiltinTok TanBI), (3,BuiltinTok ValBI)],+                        [(3,AndTok), (2,OrTok), (3,NotTok), (3,LetTok), (3,DimTok), (2,OnTok),+                         (2,GoTok), (3,SubTok), (6,ReturnTok), (2,IfTok), (4,ThenTok), (3,ForTok),+                         (2,ToTok), (4,StepTok), (4,NextTok), (5,PrintTok), (5,InputTok)],+                        [(9,RandomizeTok), (4,ReadTok), (7,RestoreTok), (3,DefTok), (2,FnTok),+                         (3,EndTok), (4,StopTok)],+                        [(7,StringTok "hello"), (19,RemTok "GOFORTH\"ANDREAD\"")],+                        [(1,CharTok 'X'), (10,DataTok "TODATA")]+                       ]+  let accumLensWToks lenAndToks =+          let (lens, toks) = unzip lenAndToks+              cols = scanl (+) 1 lens+              in zip cols toks+  let expectedColAndTokss = map accumLensWToks expectedLenAndTokss+  sequence_ $ zipWith assertTokenizerResult source expectedColAndTokss++test_capitalizes_lowercase_chars = TestCase $ do+   let source = "azAZ"+   let expected = [(1,CharTok 'A'), (2,CharTok 'Z'), (3,CharTok 'A'), (4, CharTok 'Z')]+   assertTokenizerResult source expected++test_eats_spaces_after_most_tokens_but_not_chars = TestCase $ do+   let source = "   ,   +  AND  ORX   YZ  "+   let expectedColAndToks = [(1,SpaceTok), (4,CommaTok), (8,PlusTok), (11,AndTok), (16,OrTok),+                             (18,CharTok 'X'), (19,SpaceTok), (22,CharTok 'Y'), (23,CharTok 'Z'),+                             (24,SpaceTok)]+   assertTokenizerResult source expectedColAndToks++test_reports_error_for_an_illegal_char = TestCase $ do+   sequence_ [ assertTokenizerError [illegalChar] "EXPECTING LEGAL BASIC CHARACTER"+               | illegalChar <- "~`!@#&_[]{}\\'\n\a" ]++test_printToken = TestCase $ do+   let tokens = [CommaTok, ColonTok, SemiTok, LParenTok, RParenTok, DollarTok, PercentTok, EqTok,+                 NETok, GETok, GTTok, LTTok, PlusTok, MinusTok, MulTok, DivTok, PowTok, AndTok,+                 OrTok, NotTok, LetTok, DimTok, OnTok, GoTok, SubTok, ReturnTok, IfTok, ThenTok,+                 ForTok, ToTok, StepTok, NextTok, PrintTok, InputTok, RandomizeTok, ReadTok,+                 RestoreTok, FnTok, EndTok, StringTok "hello", SpaceTok, RemTok "comment \"here",+                 CharTok 'X', DataTok "DATA,More Data   ,5"]+   let expectedStrings = [",", ":", ";", "(", ")", "$", "%", "=", "<>", ">=", ">", "<", "+", "-",+                          "*", "/", "^", "AND", "OR", "NOT", "LET", "DIM", "ON", "GO", "SUB",+                          "RETURN", "IF", "THEN", "FOR", "TO", "STEP", "NEXT", "PRINT", "INPUT",+                          "RANDOMIZE", "READ", "RESTORE", "FN", "END", "\"hello\"", " ",+                          "REMcomment \"here", "X", "DATADATA,More Data   ,5"]+   assertEqual "" expectedStrings (map printToken tokens)

@@ -0,0 +1,40 @@+Name:          vintage-basic
+Version:       1.0
+Cabal-Version: >= 1.6
+Stability:     experimental
+Synopsis:      Interpreter for 1970s-era BASIC
+Description:
+    An interpreter for what is essentially Microsoft BASIC v2,
+    what you might find on a computer in the late 70s or early
+    80s, such as the Commodore 64.
+    .
+    Rather than making use of traditional stack-based primitives,
+    the implementation uses monad transformers, including one
+    with resumable exceptions that can caught by a program's
+    continuation rather than its context.
+Category:           Compilers/Interpreters
+License:            BSD3
+License-File:       LICENSE.txt
+Author:             Lyle Kopnicky
+Maintainer:         lyle@vintage-basic.net
+Homepage:           http://www.vintage-basic.net
+Build-Type:         Simple
+Tested-With:        GHC==6.10.1
+Extra-Source-Files: test/Language/VintageBasic/*.hs run_tests.hs examples/*.bas README.txt doc/*.html
+
+Executable vintbas
+  Main-is:        Basic.hs
+  Build-Depends:  base >=3,
+                  array >=0.1,
+                  mtl >=1.1,
+                  parsec >=2.1,
+                  random >=1,
+                  time >=1.1,
+                  HUnit >=1.2,
+                  directory >=1,
+                  process >=1,
+                  regex-base >=0.72,
+                  regex-posix >=0.72,
+                  filepath >=1.1
+  HS-Source-Dirs: src
+  GHC-Options:    -Wall