hacks

turing.sml (6790B)

 (* Editor's note: A random script I wrote for a Nature of Reason (80-150) assignment.
  * Written around spring 2024. The below introductory comment is taken from my submission:
  * 
  * I was procrastinating a bit last week and so I wrote up a little Standard ML program to 
  * simulate a Turing Machine!
  *
  * The bulk of the work is in representing the infinite tape of the Turing machine: I
  * considered having some wonky double-ended stream at first but I ended up just using a
  * function of type int -> bool to represent the state of the tape (thus to set index j to
  * true, you would redefine the existing function f to be fn i => i = j orelse f i). This
  * is pretty wasteful in terms of memory usage since it means that a Turing program that
  * just flips one cell forever would use increasing amounts of memory, but explicitly
  * tracking which cells have been flipped seem like a bunch of work.
  *
  * The actual Turing program evaluator is super simple: it just fetches the rules for the
  * current state from the program, applies them to the tape, and recurses (with the base
  * case being state 0).
  *
  * I almost wrote a parser for this too (did you know SMLNJ ships with a parser combinator
  * library?!), but some of the validation logic was icky and so I ran out of energy.
  * Final tidbit: the tape has to track some other metadata (current position, bounds of 1s
  * to read) and so I actually use a wackier feature of SML: flex records (look at the type
  * definition for tape! or try typing something like {x=2, y="whee"} into your SML
  * interpreter!).  They’re basically anonymous named tuples. Kinda cool feature which I
  * haven’t seen in any other language (to be fair they’re a bit limited: often SML will
  * complain if you try to write polymorphic functions that access fields of arbitrary flex
  * records). *)
 
 datatype direction = Left | Right
 type rule = (int * bool * direction)
 type instr = (rule * rule)
 
 signature TAPE = sig
     type tape
     val inpNum : int -> tape
     val inpPair : int*int -> tape
     val outNum : tape -> int
     val toList : tape -> bool list
     val get : tape -> bool
     val set : tape -> bool -> tape
     val move : tape -> direction -> tape
 end
                                          
 structure Tape :> TAPE = struct
 type tape = {bounds: (int * int), loc: int, f: int -> bool}
 fun inpNum x = {bounds=(0, x), loc=0, f=fn i => i >= 0 andalso i <= x}
 
 fun inpPair (x,y) =
     {bounds=(0, x+y+3), loc=0, f=(fn i => (i >= 0 andalso i <= x) orelse
                                           (i > x+1 andalso i <= x+2+y))}
 
 fun toList (t : tape) =
     let val (min,max) = #bounds t
     in List.tabulate (max-min, fn i => (#f t) (min+i)) end
                             
 fun outNum (t : tape) = let
     fun count (t : tape) i sum =
         if i > (#2 (#bounds t)) then sum
         else count t (i+1) (sum + (if ((#f t) i) then 1 else 0))
 in
     count t (#1 (#bounds t)) 0
 end
 
 fun get (t : tape) = (#f t) (#loc t)
 fun set (t : tape) new = let
     val (min, max) = #bounds t
     val min = Int.min(min, #loc t)
     val max = Int.max(max, #loc t)
 in
     {bounds=(min,max), loc=(#loc t),
      f=(fn i => if i = (#loc t) then new else (#f t) i)} 
 end
 fun move (t : tape) dir =
     let val shift = (case dir of Left => ~1 | Right => 1)
     in {bounds=(#bounds t), loc=(#loc t)+shift, f=(#f t)} end
 end 
 
 fun eval t 0 _ = t
   | eval (tape : Tape.tape) (state : int) (instrs : instr list) = let
     val ins = List.nth (instrs, state - 1)
     val (newstate, newval, dir) = if Tape.get tape then #2 ins else #1 ins
 in
     eval (Tape.move (Tape.set tape newval) dir) newstate instrs
 end
 
 (* I originally had a parser for this, but it ended up being too much of a
  * hassle (being able to leave off unreachable rules for some states and
  * other stuff made it annoying to parse). Instead programs are represented
  * as a list of instructions where the nth item represents the two rules
  * for the nth state (rule being what to do for a 0 and what to do for a 1. *)
 
 val plus3 = [((2, true, Right), (1, true, Right)),
              ((0, true, Right), (0, true, Right))]
 
 val ident = [((1, true, Right), (0, false, Right))]
 
 val three = [((2, true, Right), (2, true, Right)),
              ((3, true, Right), (3, true, Right)),
              ((4, true, Right), (4, true, Right)),
              ((0, false, Right), (4, false, Right))]
 
 val add = [((1, false, Right), (2, false, Right)),
            ((3, false, Right), (2, true, Right)),
            ((0, false, Right), (0, false, Right))]
 
 
 val mock = [((0, false, Right), (2, true, Right)),
             ((0, true, Right),  (3, false, Left)),
             ((0, false, Right), (0, false, Left))]
 
 (* Editor's note: The buried remnants of my attempt at a parser: *)
 			   
 (* structure P = ParserComb *)
 
 (* fun skipWS parser = P.skipBefore Char.isSpace parser *)
 (* (* Combines two parsers, ignoring whitespace. *) *)
 (* fun +> (a, b) = P.seq (a, skipWS(b)) *)
 (* infixr 3 +> *)
 (* (* Only keeps the right hand result. *) *)
 (* fun %> (a, b) = P.wrap(a +> b, #2) *)
 (* infixr 3 %> *)
 (* (* Only keeps the left hand result. *) *)
 (* fun @> (a, b) = P.wrap(a +> b, #1) *)
 (* infixr 3 @> *)
 
 (* (* Optionally applies a parser. On failure, parses to NONE instead of passing *)
 (*  * an actual failure up and causing the overall parse to fail. *) *)
 (* fun parseOptional parser getc = P.or (P.wrap (parser, SOME), P.result NONE) getc *)
          
 (* fun parseState getc = ((P.char #"q") %> (Int.scan StringCvt.DEC)) getc *)
 (* fun parseDir getc = P.or(P.wrap(P.char #"L", fn _ => Left), *)
 (*                          P.wrap(P.char #"R", fn _ => Right)) getc *)
 (* fun parseVal getc = P.or'([P.wrap(P.char #"B", fn _ => false), *)
 (*                            P.wrap(P.char #"0", fn _ => false), *)
 (*                            P.wrap(P.char #"1", fn _ => true)]) getc *)
          
 (* fun parseRule getc =  *)
 (*     P.wrap(parseState +> P.or'([P.wrap(P.char #"1", fn _ => true), *)
 (*                           P.wrap(P.char #"0", fn _ => false), *)
 (*                           P.wrap(P.char #"B", fn _ => false)])                            *)
 (*                       +> P.wrap(parseState +> parseVal +> parseDir, *)
 (*                                 fn (s, (v, d)) => (s,v,d)), *)
 (*           fn (s, (i, r)) => (s, i, r)) getc *)
 
 (* exception Parse *)
 (* fun strToRule str = Option.valOf (StringCvt.scanString parseRule str) *)
 (*                     handle Option => raise Parse *)
           
 (* fun parseRules rules = let *)
 (*     val rules = map strToRule rules *)
 (* in *)
     
 (* end *)
                     
 (* (* in *) *)
     
 (* (* end *) *)
                                            
 (* val prog = [ *)
 (*     "q3 1 q2 1 R", *)
 (*     "q3 0 q2 1 R", *)
 (*     "q2 1 q0 1 R" *)
 (* ] *)