diff --git a/Control/Monad/BrainFuck.hs b/Control/Monad/BrainFuck.hs
--- a/Control/Monad/BrainFuck.hs
+++ b/Control/Monad/BrainFuck.hs
@@ -2,6 +2,7 @@
 
 import qualified Control.Monad as M
 import qualified Data.Char as Char
+import Data.Word (Word8)
 
 newtype BrainFuck a = BrainFuck (DataPointer -> ([Char], DataPointer, a))
 
@@ -40,6 +41,9 @@
 -- | if byte at data pointer is nonzero, jump to optoce after matching open
 close = opcode ']'
 
+-- | ignored if brainfuck machine does not support debugging
+debug = opcode '#'
+
 -- | Adds an arbitrary character to the program.
 -- Should not be used directly.
 opcode :: Char -> BrainFuck ()
@@ -53,12 +57,19 @@
 
 -- | The loop is only run if the data pointer doesn't point to 0.
 --
--- On entry, the loop body is run, and then it loops, until the data
--- pointer points to 0.
+-- On entry, the loop body is run, and then it loops, until the address
+-- the data pointer originally pointed at has a value of 0.
+--
+-- Any change that the loop body makes to the address of the data pointer
+-- is reset each time through the loop (and at the end). This is necessary
+-- to keep the BrainFuck monad's DataPointer consistent no matter what
+-- happens when running the loop.
 loopUnless0 :: BrainFuck a -> BrainFuck a
 loopUnless0 a = do
+	start <- addr
 	open
 	r <- a
+	setAddr start
 	close
 	return r
 
@@ -76,17 +87,27 @@
 			then next >> setAddr n
 			else return ()
 
+-- | Runs an action with the data pointer temporarily set to an address,
+-- then restores the data pointer.
+withAddr :: Integer -> BrainFuck a -> BrainFuck a
+withAddr n a = do
+	old <- addr
+	setAddr n
+	r <- a
+	setAddr old
+	return r
+
 -- | Run an action multiple times.
 multi :: BrainFuck () -> Int -> BrainFuck ()
 multi c n = do
 	_ <- sequence (replicate n c)
 	return ()
 
-add, sub :: Int -> BrainFuck ()
--- adds an Int to the byte at the data pointer
-add = multi incr
--- subtracts an Int from the byte at the data pointer
-sub = multi decr
+add, sub :: Word8 -> BrainFuck ()
+-- adds an byte to the byte at the data pointer (wraps on overflow)
+add = multi incr . fromIntegral
+-- subtracts an byte from the byte at the data pointer (wraps on underflow)
+sub = multi decr . fromIntegral
 
 -- | Zeros the current data cell.
 zero :: BrainFuck ()
@@ -94,10 +115,10 @@
 
 -- | Changes the current data cell to contain a specific value.
 -- (It can start at any value).
-set :: Int -> BrainFuck ()
+set :: Word8 -> BrainFuck ()
 set n = do
 	zero
-	add n	
+	add n
 
 -- | For higher-level programming in brainfuck, it's useful to have a way
 -- to run a function, while allocating a memory cell, which is initialized
@@ -118,45 +139,98 @@
 	prev
 	return r
 
+alloc' :: (DataPointer -> BrainFuck a) -> BrainFuck a
+alloc' a = alloc $ addr >>= a
+
 -- | Allocates a new memory cell, populates it with a Char, and runs
 -- the action.
 withChar :: Char.Char -> BrainFuck a -> BrainFuck a
 withChar c a = alloc $ do
-	set (Char.ord c)
+	set $ fromIntegral $ Char.ord c
 	a
 
 -- | Allocates a cell and uses it as the loop counter, starting from 
 -- the provided value. The action will continue running in a loop until
 -- it decrements the counter to 0.
-loopFrom :: Int -> (DataPointer -> BrainFuck ()) -> BrainFuck ()
-loopFrom n a = alloc $ do
-	i <- addr
-	add n
-	loopUnless0 $ do
-		a i
-		setAddr i
+loopFrom :: Word8 -> (DataPointer -> BrainFuck ()) -> BrainFuck ()
+loopFrom n a =
+	alloc' $ \i -> do
+		add n
+		loopUnless0 $
+			a i
 
--- | Runs an action in an infinite loop. The action should avoid
--- touching the current memory cell.
+-- | Runs an action in an infinite loop. The action can modify its
+-- current memory cell, or allocate and use new ones, and will not
+-- exit the loop.
 forever :: BrainFuck a -> BrainFuck ()
-forever a = loopFrom 1 $ \_ -> do
-	_ <- a
-	return ()
+forever a = loopFrom 1 $ \i ->
+	alloc' $ \scratch -> do
+		a
+		return ()
 
+-- | Copies the value of a cell.
+copy :: DataPointer -> DataPointer -> BrainFuck ()
+copy src dest = do
+	withAddr dest zero
+	alloc' $ \tmp -> do
+		-- copy src to new and tmp, but this clobbers src
+		setAddr src
+		loopUnless0 $ do
+			decr
+			setAddr dest
+			incr
+			setAddr tmp
+			incr
+		-- put src back how it was
+		setAddr tmp
+		loopUnless0 $ do
+			decr
+			setAddr src
+			incr
+
+-- | Runs the action with a new cell that is logically NOT
+-- the value of the passed pointer.
+withNot :: DataPointer -> BrainFuck () -> BrainFuck ()
+withNot p a = alloc' $ \tmp1 -> do
+	copy p tmp1
+	alloc' $ \tmp2 -> do
+		incr
+		setAddr tmp1
+		loopUnless0 $ do
+			zero
+			setAddr tmp2
+			decr
+		setAddr tmp2
+		a
+
 -- | Runs the action unless the data pointer points to 0.
-unless0 :: BrainFuck () -> BrainFuck ()
-unless0 a = do
+unless0 :: DataPointer -> BrainFuck () -> BrainFuck ()
+unless0 p a = do
 	start <- addr
-	loopUnless0 $ do
-		a
-		next
-		zero
-	prev
+	alloc' $ \tmp -> do
+		copy p tmp
+		loopUnless0 $ do
+			setAddr start
+			a
+			setAddr tmp
+			zero -- don't loop
 
+-- | Runs the action when the data pointer points to 0.
+when0 :: DataPointer -> BrainFuck () -> BrainFuck ()
+when0 p a = withNot p $
+	addr >>= flip unless0 a
+
+-- | Monadic if; the first action is run if the data pointer points to 0,
+-- else the second action is run.
+if0 :: DataPointer -> (BrainFuck (),  BrainFuck ()) -> BrainFuck ()
+if0 p (y, n) = do
+	when0 p y
+	unless0 p n
+
 -- | Adds the current and next data cells. The next cell is zeroed
 -- and the sum is left in the current cell.
-sum :: BrainFuck ()
-sum = do
+sumNext :: BrainFuck ()
+sumNext = do
 	next
 	loopUnless0 $ do
 		prev
@@ -167,28 +241,24 @@
 
 -- | Multiplies the current data cell by some value. Uses and zeros some
 -- of the following cells.
-mult :: Int -> BrainFuck ()
+mult :: Word8 -> BrainFuck ()
 mult y = do
 	x <- addr
-	alloc $ do
-		c1 <- addr
-
+	alloc' $ \c1 -> do
 		-- Copy x to c1, and zero x.
 		setAddr x
 		loopUnless0 $ do
+			decr
 			setAddr c1
 			incr
-			setAddr x
-			decr
 	
 		setAddr c1
 		loopUnless0 $ do
+			decr
 			loopFrom y $ \c2 -> do
 				decr
 				setAddr x
 				incr
-			setAddr c1
-			decr
 
 -- | Displays a string. Tries to generate a fairly small brainfuck program,
 -- using a few encoding tricks. The current cell is modified, and not
@@ -210,33 +280,55 @@
 		| otherwise = do
 			if abs delta < c
 				then multi (if delta > 0 then incr else decr) (abs delta)
-				else set c
+				else set (fromIntegral c)
 			output
 			go False cs c
 	  where
 		delta = c - n
 
--- | Prints out the alphabet, repeatedly.
+-- | Prints out the alphabet, repeatedly, with some whitespace fun
+-- to make it more interesting.
 demo :: String
-demo = brainfuck $ forever $ do
-	alloc $ do
-		c <- addr
-		set start
+demo = brainfuck $ alloc' $ \tilt -> do
+	settilt
+	alloc' $ \tc -> do
+		decr -- set to 255
+		alloc' $ \wc -> do
+			copy tilt wc
+			forever $ alloc' $ \c -> do
+				set (fromIntegral start)
+				loopFrom (fromIntegral numchars) $ \i -> do
+					decr
 		
-		loopFrom numchars $ \i -> do
-			decr
-			setAddr c
-			output
-			incr
-		withChar ' ' output
+					withAddr wc decr
+					when0 wc $ do
+						loopFrom 3 $ \_ -> do
+							decr
+							withChar ' ' output
+						copy tilt wc
+						withAddr tc decr
+						when0 tc $ do
+							withAddr tc decr
+							withAddr tilt decr
+							when0 tilt $ do
+								withAddr tilt
+									settilt
+				
+					setAddr c
+					output
+					incr
   where
 	start = Char.ord 'a'
 	end = Char.ord 'z'
 	numchars = end - start + 1
 
+	settilt = do
+		set 4
+		mult 5
+
 -- | Copy input to output.
 cat :: String
-cat = brainfuck $ forever $ input >> output
+cat = brainfuck $ forever $ alloc $ input >> output
 
 -- | Simple hello world.
 helloworld :: String
@@ -248,9 +340,36 @@
 helloworld' :: String
 helloworld' = optimize $ brainfuck $ display "hello, world!"
 
+{-
+euler1 :: BrainFuck
+euler1 = alloc' $ \result -> alloc' $ \scratch -> do
+	let accum i = do
+		setAddr scratch
+		dup i
+		setAddr result
+		sumNext
+		
+	let checkmod i n = alloc $ do
+		dup i
+		mod n
+		when0 $
+			accum i
+
+	loopFrom 1000 $ \i -> do
+		decr
+		alloc $ do
+			checkmod i 5
+			print0	
+			unless0 $
+				checkmod 1 3
+
+	setAddr result
+	decimalOutput
+-}
+
 -- | Simple optimiser for brainfuck code.
 optimize :: String -> String
-optimize s = go s [] s
+optimize s = trimend $ go s [] s
   where
 	go orig r [] =
 		let new = reverse r in
@@ -262,6 +381,19 @@
 	go orig r ('+':'-':l) = go orig r l -- +- is a noop
 	go orig r ('-':'+':l) = go orig r l -- -+ is a noop
 	go orig r ('[':']':l) = go orig r l -- [] is a noop
-	go orig [] ('[':'-':']':l) = go orig [] l -- [-] at start is noop
-	go orig [] ('>':'[':'-':']':l) = go orig [] l -- >[-] at start is noop
+	-- [-] before , is a noop, because the read overwrites the value
+	go orig r ('[':'-':']':',':l) = go orig r (',':l)
+	-- so is + or - before ,
+	go orig r ('+':',':l) = go orig r (',':l)
+	go orig r ('-':',':l) = go orig r (',':l)
+	-- [-][-] is the same as [-]
+	go orig r ('[':'-':']':'[':'-':']':l) = go orig r ('[':'-':']':l)
+	-- [-] at start is noop, because memory starts empty
+	go orig [] ('[':'-':']':l) = go orig [] l
+	-- >[-] at start is generally a noop (for programs using alloc)
+	go orig [] ('>':'[':'-':']':l) = go orig [] l
 	go orig r (c:l) = go orig (c:r) l
+
+	-- Any sequence of > and < at the end of a program is a noop.
+	trimend = reverse . dropWhile (`elem` "><") . reverse
+
diff --git a/brainfuck-monad.cabal b/brainfuck-monad.cabal
--- a/brainfuck-monad.cabal
+++ b/brainfuck-monad.cabal
@@ -1,5 +1,5 @@
 Name: brainfuck-monad
-Version: 0.2.0
+Version: 0.4.0
 Cabal-Version: >= 1.8
 License: BSD3
 Maintainer: Joey Hess <id@joeyh.name>