bf13.hoon

::  Brainfuck interpreter in Hoon with Nock 13 virtual operator
::  (https://gist.github.com/Quodss/2608695c50ed2d25b9107fa45f316828)
::
::  ++bink-mem  is assumed as a virtual Nock interpreter for this code
::
::  .%  (dotcen) is compiled:
::  (compile .%(p))  ->  [%13 (compile p)]
::
::  .>  (dotgar) desugars:
::  .>(p q)  ->
::  =+  .%(p)
::  =>  +
::  q
::
=<
  (run code "21+21=")
|%
++  add
  |=  [a=@ b=@]
  ^-  @
  ?:  =(a 0)  b
  ?:  =(b 0)  a
  =+  c=0
  |-  ^-  @
  ?:  =(c b)  a
  $(c +(c), a +(a))
::
++  mem-read  %1
++  mem-write  %2
++  parse
  |=  source=tape
  ^-  @
  =/  edge=@  0
  |-  ^-  @
  ?~  source  edge
  ?:  ?|  =(i.source ',')
          =(i.source '.')
          =(i.source '<')
          =(i.source '>')
          =(i.source '+')
          =(i.source '-')
      ==
    .>  [mem-write edge 1 i.source]
    $(source t.source, edge +(edge))
  ?:  |(=('[' i.source) =(']' i.source))
    .>  [mem-write edge 1 i.source]
    $(source t.source, edge (add edge 5))  ::  allocate 4 bytes for jump pointer
  $(source t.source)
::
++  fill-jumps
  |=  edge=@
  ^-  ~
  =/  ptr=@  0
  |-  ^-  ~
  =*  outer  $
  ?:  =(ptr edge)  ~
  =+  rid=.%([mem-read ptr 1])
  ?:  =(']' rid)
    ~|(%ser-not-open !!)
  ?.  =('[' rid)
    outer(ptr +(ptr))
  =/  depf  1
  =.  ptr  (add 5 ptr)
  =/  start=@  ptr
  |-  ^-  ~
  =*  search-end  $
  ?:  =(ptr edge)  ~|(%sel-not-closed !!)
  =.  rid  .%([mem-read ptr 1])
  ?:  =('[' rid)
    search-end(ptr (add 5 ptr), depf +(depf))
  ?.  =(']' rid)
    search-end(ptr +(ptr))
  =.  depf  (dec depf)
  ?.  =(0 depf)
    search-end(ptr (add 5 ptr))
  =.  ptr  (add 5 ptr)
  =/  end=@  ptr
  .>  [mem-write (sub start 4) 4 end]  ::  4 byte jump pointer after closing ]
  .>  [mem-write (sub end 4) 4 start]  ::  4 byte jump pointer after opening [
  =+  outer(ptr start, edge (sub end 5))  ::  fill nested []
  outer
::
++  run
  |=  [source=tape input=tape]
  ^-  tape
  =|  output=tape
  =/  tape-start=@  (parse source)
  =+  (fill-jumps tape-start)  =>  +
  =/  tape-ptr=@  tape-start
  =/  prog-ptr=@  0
  |-  ^-  tape
  ?:  =(prog-ptr tape-start)  (flop output)
  =+  instr=.%([mem-read prog-ptr 1])
  ?+    instr  ~|(%weird-instr !!)
      %'+'
    =+  char=.%([mem-read tape-ptr 1])
    ?^  char  ~|(%weird-result !!)
    =+  ?:  =(char 255)
          .>  [mem-write tape-ptr 1 0]
          ~
        .>  [mem-write tape-ptr 1 +(char)]
        ~
    $(prog-ptr +(prog-ptr))
  ::
      %'-'
    =+  char=.%([mem-read tape-ptr 1])
    ?^  char  ~|(%weird-result !!)
    =+  ?:  =(char 0)
          .>  [mem-write tape-ptr 1 255]
          ~
        .>  [mem-write tape-ptr 1 (dec char)]
        ~
    $(prog-ptr +(prog-ptr))
  ::
      %'<'
    ?:  =(tape-ptr tape-start)  ~|(%out-of-bounds !!)
    $(prog-ptr +(prog-ptr), tape-ptr (dec tape-ptr))
  ::
      %'>'
    $(prog-ptr +(prog-ptr), tape-ptr +(tape-ptr))
  ::
      %','
    ?~  input  ~|(%input-block !!)
    .>  [mem-write tape-ptr 1 i.input]
    $(prog-ptr +(prog-ptr), input t.input)
  ::
      %'.'
    =+  char=.%([mem-read tape-ptr 1])
    $(prog-ptr +(prog-ptr), output [;;(@ char) output])
  ::
      %'['
    ?:  =(0 .%([mem-read tape-ptr 1]))
      $(prog-ptr ;;(@ .%([mem-read +(prog-ptr) 4])))
    $(prog-ptr (add 5 prog-ptr))
  ::
      %']'
    ?:  =(0 .%([mem-read tape-ptr 1]))
      $(prog-ptr (add 5 prog-ptr))
    $(prog-ptr ;;(@ .%([mem-read +(prog-ptr) 4])))
  ::
  ==
::
++  code
  """
  >> +
    [- >,>+< 
    ----- ----- ----- -----    ; checking with ascii 43 ie plus symbol
    ----- ----- ----- -----
    ---
    [
    +++++ +++++ +++++ +++++
    +++++ +++++ +++++ +++++
    +++
    < ] >>
    ]
    ; first input is over and terminated by a 'plus' symbol
    <->>>>>+
    [- >,>+<
    ----- ----- ----- -----   ; checking with ascii 61 ie = symbol
    ----- ----- ----- -----
    ----- ----- ----- ------
    [
    +++++ +++++ +++++ +++++
    +++++ +++++ +++++ +++++
    +++++ +++++ +++++ ++++++
    < ] >>
    ]
        ; second input is over and terminated by an = symbol
        ; now the array looks like 0 0 0 49 0 50 0 0 0 0 0 0 0 0 49 0 53 0 0 1 0
        ; for an input 12'plus'15=
    <<<<
    [<+<]
                ; filled with 1's in between
    + [<+>-<<[>-]>] ; This is a special loop to traverse LEFT through indefinite no of 0s
                ; Lets call it left traverse
    <<
    [<+<]
    >[>]<
                ; now the array looks like
                ; 0 0 1 49 1 50 0 0 0 0 0 0 0 1 49 1 53 0 0 1 for eg:12plus15
    [
    [->+>   + [>+<->>[<-]<]  ; Right traverse
        >>[>]<+ [<]
        + [<+>-<<[>-]>]  ; Left traverse
        <<-<
    ] 
    + [>+<->>[<-]<] 
    >> [>] <<-<[<]
    + [<+>-<<[>-]>]
    <<-<
    ]
              ; now actual addition took place
              ; ie array is 00000000000000 98 0 103 0 0 1
    + [>+<->>[<-]<]
    >>
    [ 
    ----- ----- ----- -----
    ----- ----- ----- -----
    ----- ---
    >>]
                ; minus 48 to get the addition correct as we add 2 ascii numbers
    >-<         ; well an undesired 1 was there 2 place after 103 right ? just to kill it
            ; now the array is 00000 00000 0000 50 0 55
            ; now comes the biggest task Carry shifting
    <<
    [<<]
    +++++ +++++ +++++ +++++
    +++++ +++++ +++++ +++++
    +++++ +++
    [>>]
        ; we added a 48 before all the digits in case there is an overall carry
        ; to make the size n plus 1
        ; array : 00000 00000 00 48 0 50 0 55
    <<
    <<
    [
    [>>->[>]>+>>>> >>>+<<<< <<<<<[<]><<]
    >+[>]>-
    [-<<[<]>+[>]>]
    >>>>>+>>>
    +++++ +++++ +++++ +++++ +++++
    +++++ +++++ +++++ +++++ +++++
    +++++ +++
    <
                ; comparison loop:  0   1   0   a      b  0
                ;                  (q) (p)    (num)  (58)
    [->-[>]<<]  ; comparison loop to check each digit with 58: greater means 
                ; we need to minus 10 and add 1 to next significant digit
    <[-
            ; n greater than or equal to 58 (at p)
            <<<< <<<
            [<]+
            >
            ----- ----- ; minus 10 to that digit
            <<+         ; plus 1 to next digit
            >
            [>]
            >>>>>>
    ]
    < [-<
            ; n less than 58 (at q)
            <<<<<<
            [<]+
            [>]
            >>>>>
      ]
        ; at (q)
        >>>[-]>[-]
        <<<<< <<<<<
        [<]>
        <<
    ]
        ; Its all over now : something like 0 48 0 52 0 66 ( ie 0 4 18 )
        ; will turn into 0 48 0 53 0 56 (ie 0 5 8)
    >>
    ----- ----- ----- -----
    ----- ----- ----- -----
    ----- ---
            ; here we are just checking first digit is 48 or not
            ; its weird to print 0 ahead but it is defenitely needed
            ; if it is 49 ie 1
    [
    +++++ +++++ +++++ +++++
    +++++ +++++ +++++ +++++
    +++++ +++
    .
    [-]
    ]
    >>
    [.>>]
    +++++ +++++
    .           ; to print nextline : ascii 10
  """
--