Data commit

Task/Universal-Turing-machine/Mercury/universal-turing-machine-1.mercury

@@ -0,0 +1,58 @@
+:- module turing.
+
+:- interface.
+
+:- import_module list.
+:- import_module set.
+
+:- type config(State, Symbol)
+    ---> config(initial_state  :: State,
+                halting_states :: set(State),
+                blank          :: Symbol ).
+
+:- type action ---> left ; stay ; right.
+
+:- func turing(config(State, Symbol),
+               pred(State, Symbol, Symbol, action, State),
+               list(Symbol)) = list(Symbol).
+:- mode turing(in,
+               pred(in, in, out, out, out) is semidet,
+               in) = out is det.
+
+:- implementation.
+
+:- import_module pair.
+:- import_module require.
+
+turing(Config@config(Start, _, _), Rules, Input) = Output :-
+    (Left-Right) = perform(Config, Rules, Start, ([]-Input)),
+    Output = append(reverse(Left), Right).
+
+:- func perform(config(State, Symbol),
+                pred(State, Symbol, Symbol, action, State),
+                State, pair(list(Symbol))) = pair(list(Symbol)).
+:- mode perform(in, pred(in, in, out, out, out) is semidet,
+                in, in) = out is det.
+perform(Config@config(_, Halts, Blank), Rules, State,
+        Input@(LeftInput-RightInput)) = Output :-
+    symbol(RightInput, Blank, RightNew, Symbol),
+    ( set.member(State, Halts) ->
+        Output = Input
+    ; Rules(State, Symbol, NewSymbol, Action, NewState) ->
+        NewLeft  = pair(LeftInput, [NewSymbol|RightNew]),
+        NewRight = action(Action, Blank, NewLeft),
+        Output   = perform(Config, Rules, NewState, NewRight)
+    ;
+        error("an impossible state has apparently become possible") ).
+
+:- pred symbol(list(Symbol), Symbol, list(Symbol), Symbol).
+:- mode symbol(in, in, out, out) is det.
+symbol([],        Blank, [],  Blank).
+symbol([Sym|Rem], _,     Rem, Sym).
+
+:- func action(action, State, pair(list(State))) = pair(list(State)).
+action(left,  Blank, ([]-Right))            = ([]-[Blank|Right]).
+action(left,  _,     ([Left|Lefts]-Rights)) = (Lefts-[Left|Rights]).
+action(stay,  _,     Tape)                  = Tape.
+action(right, Blank, (Left-[]))             = ([Blank|Left]-[]).
+action(right, _,     (Left-[Right|Rights])) = ([Right|Left]-Rights).

Task/Universal-Turing-machine/Mercury/universal-turing-machine-2.mercury

@@ -0,0 +1,17 @@
+:- type incrementer_states  ---> a ; halt.
+:- type incrementer_symbols ---> b ; '1'.
+
+:- func incrementer_config = config(incrementer_states, incrementer_symbols).
+incrementer_config = config(a,           % the initial state
+                            set([halt]), % the set of halting states
+                            b).          % the blank symbol
+
+:- pred incrementer(incrementer_states::in,
+                    incrementer_symbols::in,
+                    incrementer_symbols::out,
+                    action::out,
+                    incrementer_states::out) is semidet.
+incrementer(a, '1', '1', right, a).
+incrementer(a, b,   '1', stay,  halt).
+
+TapeOut = turing(incrementer_config, incrementer, [1, 1, 1]).

Task/Universal-Turing-machine/Mercury/universal-turing-machine-3.mercury

@@ -0,0 +1,21 @@
+:- type busy_beaver_states  ---> a ; b ; c ; halt.
+:- type busy_beaver_symbols ---> '0' ; '1'.
+
+:- func busy_beaver_config = config(busy_beaver_states, busy_beaver_symbols).
+busy_beaver_config = config(a,           % initial state
+                            set([halt]), % set of terminating states
+                            '0').        % blank symbol
+
+:- pred busy_beaver(busy_beaver_states::in,
+                    busy_beaver_symbols::in,
+                    busy_beaver_symbols::out,
+                    action::out,
+                    busy_beaver_states::out) is semidet.
+busy_beaver(a, '0', '1', right, b).
+busy_beaver(a, '1', '1', left,  c).
+busy_beaver(b, '0', '1', left,  a).
+busy_beaver(b, '1', '1', right, b).
+busy_beaver(c, '0', '1', left,  b).
+busy_beaver(c, '1', '1', stay,  halt).
+
+TapeOut = turing(busy_beaver_config, busy_beaver, []).