RCSNUSP/Factor

⚠️ Warning: This is a draft ⚠️

This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.

If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.

{{implementation|SNUSP}}{{collection|RCSNUSP}} This is a translation of the Go entry [http://www.rosettacode.org/wiki/Execute_SNUSP/Go], and as such consists of core SNUSP, a fixed-size data store, and no bounds checking. It has been made a bit more idiomatic for Factor by splitting the implementation up into several words (functions), and uses a tuple in place of Go's lexical variables.

USING: accessors byte-arrays combinators
combinators.short-circuit fry io kernel math multiline sequences
splitting strings ;
IN: rosetta-code.snusp

STRING: sample-program
/++++!/
### =====
?\>++.>+.+++++++..+++\
\+++\ | /+>+++++++>/ /++++++++++<<.++>./
$+++/ | \+++++++++>\ \+++++.>.+++.-----\
      \==-<<<<+>+++/ /=.>.+>.--------.-/
;

: find-start ( matrix -- r c )
    [ CHAR: $ swap member? ] find [ CHAR: $ = ] find drop dup
    [ 1 + ] [ 2drop 0 0 ] if ;

! Instruction store, data store, instruction pointer row,
! instruction pointer column, data pointer, instruction
! direction
TUPLE: snusp is ds ipr ipc dp id ;

: <snusp> ( str n -- snusp )
    [ "\n" split ] [ <byte-array> ] bi* over find-start 0 0
    snusp boa ;

: step ( snusp -- )
    1 over id>> [ 2 bitand - ] [ 1 bitand zero? ] bi
    [ '[ _ + ] change-ipc ] [ '[ _ + ] change-ipr ] if drop ;

: still-running? ( snusp -- ? )
    {
        [ ipr>> 0 >= ]
        [ [ ipr>> ] [ is>> length < ] bi ]
        [ ipc>> 0 >= ]
        [ [ ipc>> ] [ ipr>> ] [ is>> nth length < ] tri ]
    } 1&& ;

: data ( snusp -- dp ds ) [ dp>> ] [ ds>> ] bi ;

CONSTANT: commands {
    { CHAR: > [ [ 1 + ] change-dp drop ] }
    { CHAR: < [ [ 1 - ] change-dp drop ] }
    { CHAR: + [ data [ 1 + ] change-nth ] }
    { CHAR: - [ data [ 1 - ] change-nth ] }
    { CHAR: . [ data nth 1string write ] }
    { CHAR: , [ read1 swap data set-nth ] }
    { CHAR: / [ [ bitnot ] change-id drop ] }
    { CHAR: \\ [ [ 1 bitxor ] change-id drop ] }
    { CHAR: ! [ step ] }
    { CHAR: ? [ dup data nth zero? [ step ] [ drop ] if ] }
    [ 2drop ]
}

: curr-instr ( snusp -- n )
    [ ipc>> ] [ ipr>> ] [ is>> ] tri nth nth ;

: execute-snusp ( snusp -- )
    [ dup still-running? ]
    [ dup dup curr-instr commands case dup step ] while drop ;

: snusp-demo ( -- ) sample-program 5 <snusp> execute-snusp ;

MAIN: snusp-demo


Hello World!