Smallfuck/smf.rhk

← Back to Smallfuck

smallfuck interpreter in Rhokell, by User:Pro465. the repo is more frequently updated so if you want the latest version, go there.

# smallfuck interpreter
# if you are using it directly:
# just input your smallfuck pprogram using standard input.
#
# or if you are using the REPL:
# give it an expression of the syntax (smf prog mem)
# where prog is the program mem is the initial memory
# both are cons lists consisting of (Cons a l) and (Nil).
# (memory is unbounded on the right).
#
# prog encoding   | smallfuck instructions
#      (Left)     | `<`
#      (Right)    | `>`
#      (Flip)     | `*`
#      (LBrace)   | `[`
#      (RBrace)   | `]`
#
# memory encoding:
#      (F) means 0
#      (T) means 1
#
# example for the program `>*>*>*[*<]` on zero-init memory:
#      (smf 
#          (Cons (Right) 
#          (Cons (Flip) 
#          (Cons (Right) 
#          (Cons (Flip) 
#          (Cons (Right) 
#          (Cons (Flip) 
#          (Cons (LBrace) 
#          (Cons (Flip) 
#          (Cons (Left) 
#          (Cons (RBrace) 
#                (Nil)
#          ))))))))))
#          (Nil)
#     )
# 

(main) = (encode (smf (decode (input) (Nil)) (Nil)));

(decode (Eof) res) = res;
(decode (2 (A)) res) = (decode (input) (append res (Cons (Flip) (Nil))));
(decode (3 (C)) res) = (decode (input) (append res (Cons (Left) (Nil))));
(decode (3 (E)) res) = (decode (input) (append res (Cons (Right) (Nil))));
(decode (5 (B)) res) = (decode (input) (append res (Cons (LBrace) (Nil))));
(decode (5 (D)) res) = (decode (input) (append res (Cons (RBrace) (Nil))));
(decode x res) = (decode (input) res);

(encode (Nil)) = (Nil);
(encode (Cons (F) res)) = (then (output (3 (0))) (encode res));
(encode (Cons (T) res)) = (then (output (3 (1))) (encode res));

(then a b) = b;

(smf prog mem) = (serialize_pair (eval (prep prog (Nil)) mem (Nil)));

# change .. [<code>] .. to .. (While <code>) ..
(prep (Nil) x) = x;
(prep (Cons (LBrace) rem) before) = (expand before (prep rem (Nil)));
(prep (Cons (RBrace) rem) before) = (Pair before (prep rem (Nil)));
(prep (Cons x rem) before) = (prep rem (append before (Cons x (Nil))));

# before [inside_loop] after
(expand before (Pair inside_loop after)) = (append before (Cons (While inside_loop) after));


# evaluate the instructions
(eval (Nil) rmem lmem) = (Pair lmem rmem);
(eval prog (Nil) lmem) = (eval prog (Cons (F) (Nil)) lmem);
(eval (Cons (Flip) rem) (Cons (T) x) lmem) = (eval rem (Cons (F) x) lmem);
(eval (Cons (Flip) rem) (Cons (F) x) lmem) = (eval rem (Cons (T) x) lmem);
(eval (Cons (Right) rem) (Cons b x) lmem) = (eval rem x (Cons b lmem));
(eval (Cons (Left) rem) rmem (Cons b x)) = (eval rem (Cons b rmem) x);
(eval (Cons (Left) rem) rmem (Nil)) = (eval rem (Cons (F) rmem) (Nil));
(eval (Cons (While body) rem) rmem lmem) = (loop body rmem lmem rem);

## helpers

# looping behaviours
(loop b (Cons (F) mem) lmem rem) = (eval rem (Cons (F) mem) lmem);
(loop b (Cons (T) mem) lmem rem) = (destruct b (eval b (Cons (T) mem) lmem) rem);

(destruct b (Pair lmem rmem) rem) = (loop b rmem lmem rem);

(serialize_pair (Pair l r)) = (append (reverse l) r);

# adds one list to the end of the other list
(append (Nil) x) = x;
(append (Cons x y) z) = (Cons x (append y z));

# reverses a list
(reverse (Nil)) =  (Nil);
(reverse (Cons x y)) = (append (reverse y) (Cons x (Nil)));