Improvements to speed, custom miniflak mode

.gitignore

@@ -18,3 +18,5 @@ cabal.sandbox.config
 .stack-work/
 cabal.project.local
 .HTF/
+BrainHack
+*.flk

BrainHack.hs

@@ -1,4 +1,5 @@
 import Interpreter
+import MiniInterpreter
 import System.Environment
 import Data.List
 import Data.Char
@@ -39,7 +40,9 @@ helpMenu = unlines ["",
   "   -a, --ascii-out\t\tOutputs as ascii character codes.",
   "   -e, --execute\t\tExecutes the first commandline argument as Brain-Flak code.",
   "   -h, --help\t\t\tPrints this menu and exits.",
-  "   -v, --version\t\tPrints the version number of the interpreter and exits."]
+  "   -m, --mini\t\t\tRun in an interpreter optimized for miniflak,",
+  "   -v, --version\t\tPrints the version number of the interpreter and exits.",
+  "   -x, --cycles\t\t\tPrints the number of cycles elapsed upon termination."]
 
 displayInteger :: Integer -> String
 displayInteger x = show x ++ " "
@@ -62,7 +65,9 @@ main = do
              )
            )
  let formatOutput = if (elem "a" flags)||(elem "ascii-out" flags) then (\x -> (chr.fromInteger) x:[]) else displayInteger
- putStr$ if exiting then
-           "" 
-         else 
-           (concat (map formatOutput (brainflak source (processInput (tail args)))))
+ let cycles = (elem "x" flags)||(elem "cycles" flags)
+ putStr$ (if exiting then
+           ""
+          else
+           (\ (a,b) -> (concat (map formatOutput a)) ++ (if cycles then ("\nCycles: " ++ show b) else "")) (if (elem "m" flags)||(elem "mini" flags) then (miniflak source (processInput (tail args)) cycles) else (brainflak source (processInput (tail args)) cycles))
+          )

Helpers.hs

@@ -0,0 +1,32 @@
+module Helpers (pop,rest,topadd,interior,exterior) where
+
+pop :: (Integral a) => [a] -> a
+pop [] = 0
+pop (x:_) = x
+
+rest :: (Integral a) => [a] -> [a]
+rest [] = []
+rest (_:x) = x
+
+topadd :: [Integer] -> Integer -> [Integer]
+topadd [] x = [x]
+topadd (a:[]) x = [a+x]
+topadd (a:b) x = (a+x):b
+
+ir :: [Char] -> Integer -> [Char]
+ir x 0 = ""
+ir ('{':x) y = "{" ++ (ir x (y+1))
+ir ('}':x) y = "}" ++ (ir x (y-1))
+ir (a:x)   y = [a] ++ (ir x   y  )
+
+interior :: [Char] -> [Char]
+interior x = init (ir x 1)
+
+ex :: [Char] -> Integer -> [Char]
+ex x 0 = x
+ex ('{':x) y = ex x (y+1)
+ex ('}':x) y = ex x (y-1)
+ex  (a:x)  y = ex x y
+
+exterior :: [Char] -> [Char]
+exterior x = ex x 1

Interpreter.hs

@@ -1,35 +1,8 @@
 module Interpreter (brainflak) where
 
-pop :: (Integral a) => [a] -> a
-pop [] = 0
-pop (x:_) = x
+import Helpers
 
-rest :: (Integral a) => [a] -> [a]
-rest [] = []
-rest (_:x) = x
-
-topadd :: [Integer] -> Integer -> [Integer]
-topadd [] x = [x]
-topadd (a:[]) x = [a+x]
-topadd (a:b) x = (a+x):b
-
-ir :: [Char] -> Integer -> [Char]
-ir x 0 = ""
-ir ('{':x) y = "{" ++ (ir x (y+1))
-ir ('}':x) y = "}" ++ (ir x (y-1))
-ir (a:x)   y = [a] ++ (ir x   y  )
-
-interior :: [Char] -> [Char]
-interior x = init (ir x 1)
-
-ex :: [Char] -> Integer -> [Char]
-ex x 0 = x
-ex ('{':x) y = ex x (y+1)
-ex ('}':x) y = ex x (y-1)
-ex  (a:x)  y = ex x y
-
-exterior :: [Char] -> [Char]
-exterior x = ex x 1
+--- bf is the main version of the interpreter ---
 
 bf :: [Char] -> ([Integer],[Integer],[Integer]) -> ([Integer],[Integer],[Integer])
 bf []          (x,y,z)= (x,y,z)
@@ -48,10 +21,32 @@ bf (_:a)        t     = bf a t
 
 run :: [Char] -> ([Integer],[Integer],[Integer]) -> ([Integer],[Integer],[Integer])
 run s ([],y,z)  = ([],y,z)
-run s ([0],y,z) = ([0],y,z)
 run s (0:x,y,z) = (0:x,y,z)
 run s x         = run s (bf s x)
 
+--- xbf is a slower cycle counting version of bf ---
+
+xbf :: [Char] -> ([Integer],[Integer],[Integer],Int) -> ([Integer],[Integer],[Integer],Int)
+xbf _ (_,_,_,c) | c `seq` False = undefined
+xbf []          (x,y,z,c)= (x,y,z,c)
+xbf ('(':')':a) (x,y,z,c)= xbf a (x,y,((pop z+1):rest z),c+1)
+xbf ('<':'>':a) (x,y,z,c)= xbf a (y,x,z,c+1)
+xbf ('{':'}':a) (x,y,z,c)= xbf a ((rest x),y,(topadd z (pop x)),c+1)
+xbf ('[':']':a) (x,y,z,c)= xbf a (x,y,(topadd z (toInteger (length x))),c+1)
+xbf ('(':a)     (x,y,z,c)= xbf a (x,y,(0:z),c+1)
+xbf ('<':a)     (x,y,z,c)= xbf a (x,y,(0:z),c+1)
+xbf ('[':a)     (x,y,z,c)= xbf a (x,y,(0:z),c+1)
+xbf (')':a) (x,y,(h:z),c)= xbf a ((h:x),y,(topadd z h),c+1)
+xbf (']':a) (x,y,(h:z),c)= xbf a (x,y,(topadd z (-h)),c+1)
+xbf ('>':a) (x,y,(_:z),c)= xbf a (x,y,z,c+1)
+xbf ('{':a)      t     = xbf (exterior a) (xrun (interior a) t)
+xbf (_:a)        t     = xbf a t
+
+xrun :: [Char] -> ([Integer],[Integer],[Integer],Int) -> ([Integer],[Integer],[Integer],Int)
+xrun s ([],y,z,c)  = ([],y,z,c)
+xrun s (0:x,y,z,c) = (0:x,y,z,c)
+xrun s x         = xrun s (xbf s x)
+
 bl :: [Char] -> [Char] -> Bool
 bl [] [] = True
 bl [] _  = False
@@ -76,7 +71,9 @@ clean (x:xs)
  | elem x "()[]<>{}" = x:(clean xs)
  | otherwise         = clean xs
 
-brainflak :: [Char] -> [Integer] -> [Integer]
-brainflak s x
- | balanced s = (\(a,_,_) -> a) (bf (clean s) (x,[],[]))
+brainflak :: [Char] -> [Integer] -> Bool -> ([Integer], Int)
+brainflak s x c
+ | balance && c       = (\(a,_,_,c) -> (a,c)) (xbf (clean s) (x,[],[],0))
+ | balance && (not c) = (\(a,_,_)   -> (a,0)) ( bf (clean s) (x,[],[]  ))
  | otherwise  = error "Unbalanced braces."
+ where balance = balanced s

MiniInterpreter.hs

@@ -0,0 +1,72 @@
+module MiniInterpreter (miniflak) where
+
+import Helpers
+
+bf :: [Char] -> ([Integer],[Integer]) -> ([Integer],[Integer])
+bf []          (x,z)= (x,z)
+bf ('(':')':a) (x,z)= bf a (x,((pop z+1):rest z))
+bf ('{':'}':a) (x,z)= bf a ((rest x),(topadd z (pop x)))
+bf ('[':']':a) (x,z)= bf a (x,(topadd z (toInteger (length x))))
+bf ('(':a)     (x,z)= bf a (x,(0:z))
+bf ('[':a)     (x,z)= bf a (x,(0:z))
+bf (')':a) (x,(h:z))= bf a ((h:x),(topadd z h))
+bf (']':a) (x,(h:z))= bf a (x,(topadd z (-h)))
+bf ('{':a)      t     = bf (exterior a) (run (interior a) t)
+bf (_:a)        t     = bf a t
+
+run :: [Char] -> ([Integer],[Integer]) -> ([Integer],[Integer])
+run s ([],z)  = ([],z)
+run s (0:x,z) = (0:x,z)
+run s x         = run s (bf s x)
+
+--- xbf is a version of bf that counts cycles ---
+
+xbf :: [Char] -> ([Integer],[Integer],Int) -> ([Integer],[Integer],Int)
+xbf _ (_,_,c) | c `seq` False = undefined
+xbf []          (x,z,c)= (x,z,c+1)
+xbf ('(':')':a) (x,z,c)= xbf a (x,((pop z+1):rest z),c+1)
+xbf ('{':'}':a) (x,z,c)= xbf a ((rest x),(topadd z (pop x)),c+1)
+xbf ('[':']':a) (x,z,c)= xbf a (x,(topadd z (toInteger (length x))),c+1)
+xbf ('(':a)     (x,z,c)= xbf a (x,(0:z),c+1)
+xbf ('[':a)     (x,z,c)= xbf a (x,(0:z),c+1)
+xbf (')':a) (x,(h:z),c)= xbf a ((h:x),(topadd z h),c+1)
+xbf (']':a) (x,(h:z),c)= xbf a (x,(topadd z (-h)),c+1)
+xbf ('{':a)      t     = xbf (exterior a) (xrun (interior a) t)
+xbf (_:a)        t     = xbf a t
+
+xrun :: [Char] -> ([Integer],[Integer],Int) -> ([Integer],[Integer],Int)
+xrun s ([],z,c)  = ([],z,c)
+xrun s (0:x,z,c) = (0:x,z,c)
+xrun s x         = xrun s (xbf s x)
+
+bl :: [Char] -> [Char] -> Bool
+bl [] [] = True
+bl [] _  = False
+bl ('(':x) y   = bl x (')':y) 
+bl ('[':x) y   = bl x (']':y) 
+bl ('<':x) y   = bl x ('>':y) 
+bl ('{':x) y   = bl x ('}':y) 
+bl  (a:x) []
+ | elem a ")]>}" = False
+ | otherwise     = bl x []
+bl (a:x) (b:y)
+ | elem a ")]>}" = (a == b) && (bl x y)
+ | otherwise     = bl x (b:y)
+
+balanced :: [Char] -> Bool
+balanced x = bl x []
+
+clean :: [Char] -> [Char]
+clean [] = []
+clean ('#':'{':xs) = clean (exterior xs)
+clean ('[':']':xs) = clean xs
+clean (x:xs)
+ | elem x "()[]{}" = x:(clean xs)
+ | otherwise         = clean xs
+
+miniflak :: [Char] -> [Integer] -> Bool -> ([Integer],Int)
+miniflak s x c
+ | balance &&      c  = (\(a,_,c) -> (a,c)) (xbf (clean s) (x,[],0))
+ | balance && (not c) = (\(a,_)   -> (a,0))  (bf (clean s) (x,[]  ))
+ | otherwise  = error "Unbalanced braces."
+ where balance = balanced s