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

September 2017 Update

Browse source
This commit is contained in:
Ingy döt Net 2017-09-23 10:01:46 +02:00
parent bba7bfd280
commit ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
Download patch file Download diff file Expand all files Collapse all files

40
Task/Execute-Brain----/Ol/execute-brain----.ol Normal file
View file

@ -0,0 +1,40 @@
(define (bf program stack-length)
(let ((program (string-append program "]"))
(program-counter 0)
(stack (make-vector stack-length 0))
(stack-pointer 0))
(letrec ((skip (lambda (PC sp)
(let loop ((pc PC) (sp sp))
(let ((ch (string-ref program pc))
(pc (+ pc 1)))
(case ch
(#\] (list pc sp))
(#\[ (apply loop (skip pc sp)))
(else
(loop pc sp)))))))
(step (lambda (PC SP)
(let loop ((pc PC) (sp SP))
(let ((ch (string-ref program pc))
(pc (+ pc 1)))
(case ch
(#\] (list (- PC 1) sp))
(#\[ (if (eq? (vector-ref stack sp) 0)
(apply loop (skip pc sp))
(apply loop (step pc sp))))
(#\+ (set-ref! stack sp (+ (vector-ref stack sp) 1))
(loop pc sp))
(#\- (set-ref! stack sp (- (vector-ref stack sp) 1))
(loop pc sp))
(#\> (loop pc (+ sp 1)))
(#\< (loop pc (- sp 1)))
(#\. (display (make-string 1 (vector-ref stack sp)))
(loop pc sp))
(else
(loop pc sp))))))))
(step 0 0))))
; testing:
; (bf ",++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>." 30000)
; ==> Hello World!
; (bf ">>++++[<++++[<++++>-]>-]<<.[-]++++++++++." 30000)
; ==> @