From 4868efbf0e080d204172c17a3feb5ee42b066c9e Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Thu, 3 Sep 2015 20:54:15 +0200
Subject: More compact & nicer toString for states; added ! for step functions;
 bugfix for tape length

The new toString takes only one line and is a better reproduction of
the notation from Sudkamp, Languages and Machines, 1997.

The IterableClass functions now have ! on input types that are
iterated, so that these arguments are computed for sure.

There was a bug (!! index too large or the like) for some machines
that 'walked off the tape' on the right side. The tape is now auto-
matically extended with Nothing (blank) cells. When the machine
walks off the tape on the *left*, the machine still terminates
abnormally.
---
 IterableClass.dcl  | 10 +++++-----
 IterableClass.icl  |  6 +++---
 TuringMachines.icl |  6 +++++-
 3 files changed, 13 insertions(+), 9 deletions(-)

diff --git a/IterableClass.dcl b/IterableClass.dcl
index 729cd68..73c9776 100644
--- a/IterableClass.dcl
+++ b/IterableClass.dcl
@@ -1,10 +1,10 @@
 definition module IterableClass
 
-class step a :: a -> a
-class rewind a :: a -> a
+class step a :: !a -> a
+class rewind a :: !a -> a
 
-stepn :: Int a -> a | step a
-rewindn :: Int a -> a | rewind a
+stepn :: Int !a -> a | step a
+rewindn :: Int !a -> a | rewind a
 
-stepOrRewindn :: Int a -> a | step, rewind a
+stepOrRewindn :: Int !a -> a | step, rewind a
 
diff --git a/IterableClass.icl b/IterableClass.icl
index 97340ba..0aa2dda 100644
--- a/IterableClass.icl
+++ b/IterableClass.icl
@@ -2,15 +2,15 @@ implementation module IterableClass
 
 import StdEnv
 
-stepn :: Int a -> a | step a
+stepn :: Int !a -> a | step a
 stepn 0 a = a
 stepn n a = stepn (n-1) (step a)
 
-rewindn :: Int a -> a | rewind a
+rewindn :: Int !a -> a | rewind a
 rewindn 0 a = a
 rewindn n a = rewindn (n-1) (rewind a)
 
-stepOrRewindn :: Int a -> a | step, rewind a
+stepOrRewindn :: Int !a -> a | step, rewind a
 stepOrRewindn 0 a = a
 stepOrRewindn n a
 | n < 0 = rewindn (0-n) a
diff --git a/TuringMachines.icl b/TuringMachines.icl
index b37233c..f13ca7d 100644
--- a/TuringMachines.icl
+++ b/TuringMachines.icl
@@ -30,7 +30,10 @@ where
 instance toString (TuringMachineState a) | toString a
 where
     toString st=:{state,tapeHead,tape,running}
-    = toString running +++ " turing machine in state " +++ toString state +++ ", tape head at " +++ toString tapeHead +++ ".\nTape: " +++ toString tape
+    = toString (take tapeHead tape) +++
+        "[q" +++ toString state +++ "]" +++
+        toString (drop tapeHead tape) +++
+        " (" +++ toString running +++ ")"
 
 instance == Direction
 where
@@ -55,6 +58,7 @@ instance step (TuringMachineState a) | == a
 where
     step st=:{machine,state,tapeHead,tape,running}
         | running <> Running    = st
+        # tape                  = if (length tape < tapeHead + 1) (tape ++ [Nothing]) tape
         # move                  = machine.transition state (tape!!tapeHead)
         | move == Halt          = {st & running = Normal}
         # (Step state write dir) = move
-- 
cgit v1.2.3