aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

76
Task/Universal-Turing-machine/PicoLisp/universal-turing-machine.l Normal file
View file

@ -0,0 +1,76 @@
# Finite state machine
(de turing (Tape Init Halt Blank Rules Verbose)
(let
(Head 1
State Init
Rule NIL
S 'start
C (length Tape))
(catch NIL
(loop
(state 'S
(start 'print
(when (=0 C)
(setq Tape (insert Head Tape Blank))
(inc 'C) ) )
(print 'lookup
(when Verbose
(for (N . I) Tape
(if (= N Head)
(print (list I))
(prin I) ) )
(prinl) )
(when (= State Halt) (throw NIL) ) )
(lookup 'do
(setq Rule
(find
'((X)
(and
(= (car X) State)
(= (cadr X) (car (nth Tape Head))) ) )
Rules ) ) )
(do 'step
(setq Tape (place Head Tape (caddr Rule))) )
(step 'print
(cond
((= (cadddr Rule) 'R) (inc 'Head))
((= (cadddr Rule) 'L) (dec 'Head)) )
(cond
((< Head 1)
(setq Tape (insert Head Tape Blank))
(inc 'C)
(one Head) )
((> Head C)
(setq Tape (insert Head Tape Blank))
(inc 'C) ) )
(setq State (last Rule)) ) ) ) ) )
Tape )
(println "Simple incrementer")
(turing '(1 1 1) 'A 'H 'B '((A 1 1 R A) (A B 1 S H)) T)
(println "Three-state busy beaver")
(turing '() 'A 'H 0
'((A 0 1 R B)
(A 1 1 L C)
(B 0 1 L A)
(B 1 1 R B)
(C 0 1 L B)
(C 1 1 S H)) T )
(println "Five-state busy beaver")
(let Tape (turing '() 'A 'H 0
'((A 0 1 R B)
(A 1 1 L C)
(B 0 1 R C)
(B 1 1 R B)
(C 0 1 R D)
(C 1 0 L E)
(D 0 1 L A)
(D 1 1 L D)
(E 0 1 S H)
(E 1 0 L A)) NIL)
(println '0s: (cnt '((X) (= 0 X)) Tape))
(println '1s: (cnt '((X) (= 1 X)) Tape)) )
(bye)