cleanbf.icl

   1 module cleanbf
   2
   3 import Data.Either
   4 import Data.Error
   5 import Data.Tuple
   6 import StdEnv
   7 import System.CommandLine
   8 import System.File
   9 import _SystemArray
  10
  11 from Data.Func import $
  12
  13 TAPESIZE :== 1024
  14 :: *BFState = {pc :: Int, tc :: Int, io :: *File, cs :: [Int], tape :: *{Int},
  15         prog :: String}
  16
  17 bf :: *BFState -> Either *BFState *BFState
  18 bf st=:{prog,pc,tc,tape,cs}
  19 | st.pc == size st.prog = Left st
  20 = let (b, tape`) = uselect tape tc in Right $ case select prog pc of
  21         '<' = {st & pc=pc+1, tc=tc-1}
  22         '>' = {st & pc=pc+1, tc=tc+1}
  23         '+' = {st & pc=pc+1, tape=update tape` tc (b+1)}
  24         '-' = {st & pc=pc+1, tape=update tape` tc (b-1)}
  25         '.' = {st & pc=pc+1, tape=tape`, io=st.io <<< toChar b}
  26         ',' = let (_, c, io) = freadc st.io
  27                 in {st & pc=pc+1, tape=update tape` tc (toInt c), io=io}
  28         '[' = let st` = {st & cs=[pc:cs], tape=tape`, pc=pc+1} in if (b == 0)
  29                         {st` & pc=1+(while (\pc`->select prog pc` <> ']') ((+) 1) pc)} st`
  30         ']' = {st & pc=hd cs, cs=tl cs}
  31         _ = {st & pc=pc+1}
  32
  33 Start w
  34 # ([_:p], (io, w)) = appSnd stdio $ getCommandLine w
  35 | isEmpty p = snd $ fclose (io <<< "Pleasy supply a filename\n") w
  36 # (io, w) = case readFile (hd p) w of
  37         (Error e, w) = (io <<< "File error: " <<< toString e <<< "\n", w)
  38         (Ok s, w) = let st` = run bf $ mkState io s in (st`.io, w)
  39         with
  40                 run g = (either id (run g)) o g
  41                 mkState f s = {pc=0,tc=0,io=f,cs=[],tape={0\\_<-[0..TAPESIZE]},prog=s}
  42 = snd $ fclose io w