path: root/compiler/standardClient.ey

## dynamic member lookup fallback routines
{ -- 0 } "#.?" deffd
{ keys dump "undefined member in .: " dump dump "" die } "#." defmd
{ keys dump "undefined member in .|: " dump dump "" die } "#.|" defmd
{ keys dump "undefined member in =: " dump dump "" die } "#.=" defmd

{
  quoted { ==name =*f
    name "|" sys .executeIdentifier
    f
    name "=" sys .executeIdentifier
  } { ==name =*f name | f name = } ? *
} "|=" defq

## regex support
# ideas taken from http://swtch.com/~rsc/regexp/regexp3.html
<
  0 ==:MATCH 1 ==:TERM 2 ==:JUMP 3 ==:SPLIT 4 ==:SAVE 5 ==:FIRST 6 ==:LAST
  7 ==:FLOATBEGIN 8 ==:TERMBEGIN

  { ==b ==a [
    [ SPLIT 1 a len 2 add ]
    a _ len dearray
    [ JUMP b len 1 add ]
    b _ len dearray
  ] } /alternative deffd

  |cat /sequence deffd

  { ==?a [ # TODO measure separate + implementation performance impact
    [ JUMP a len 1 add ]
    a _ len dearray
    [ SPLIT a len neg 1 ]
  ] } /star deffd

  { ==?p [
    [ TERM p ]
  ] } /terminal deffd

  { -- 1 }" terminal ==:TERMANY
  { { eq }_ terminal } =*:TERMCHAR

  { ==?i ==?a [
    [ SAVE i 2 mul ]
    a _ len dearray
    [ SAVE i 2 mul 1 add ]
  ] } /capture deffd

  { [ ] } /empty deffd

  { ==?str
    str len 0 eq {
      1 neg
    } {
      0 str *
    } ? *
  } /head deffd

  { 1 -01 str .postfix } /tail deffd

  { 0 -01 * -101 head eq } "^" deffd
  { deffd }' /install deffd
  [ "(" ")" "[" "]" "-" "|" "^" "*" "+" "." "$" "\\" "?" ] { ==?c
    { _ head 0 c * eq } "^" c cat install
  } each

  { 0 -01 * }" /threadGetPC deffd
  { 1 -01 * }" /threadGetCaptures deffd

  { #==thread ==newpc
    [ -021 threadGetCaptures ]
  }" /cloneThread deffd

  { #==thread ==newpc
    0 -1201 =[]
  }" /updateThread deffd

  { #==thread ==newpc
    [ -0201 threadGetCaptures _ len dearray ] ]
  }" /fullCloneThread deffd

  |add /origadd deffd
  str .|bitTest /bitTest deffd
  str .|bitSet /bitSet deffd
  str .|zero /zero deffd

  # TODO think about implementation efficiency
  { ==maxSize
    <
    0 ==size
    [ maxSize { 0 }" rep ] =*get
    maxSize 1 sub 8 udiv 1 add 8 mul str .alloc _ zero ==pcUsed

    { # ==thread
      _ threadGetPC pcUsed bitTest { -- }" {
        _ size |get =[]
          threadGetPC pcUsed bitSet
        size 1 origadd =size
      }" ? *
    }' /add deffst

    {
      size 1 sub _ =size
                   get
    }' /pop deffst

    {
      0 =size
      pcUsed zero
    }' /clear deffst
  > } /threadList deffd

  {
    0 ==?currentCapture

    { # "(parse) re: " -101 cat dump

      seq ==?a
      ^| {
        tail parse ==?b
        a b alternative =a
      } rep
      a
    } /parse deffst

    { # "(seq) re: " -101 cat dump

      empty _ ==?a
              ==?l

      { # "(seq loop) re: " -101 cat dump
        _ head 1 neg eq -01
        ^| -01
        ^) -01
        -0321 or or not
      } {
        [ { ^* } {
          l star =l
          tail
        } { ^+ } {
          l l star sequence =l
          tail
        } { ^? } {
          l empty alternative =l
          tail
        } { 1 } {
          a l sequence =a
          atom =l
        } ] conds
      } loop
      a l sequence
    } /seq deffst

    { # "(atom) re: " -101 cat dump
      empty ==?a

      [ { ^( } {
        currentCapture ==thisCapture
        currentCapture 1 add =currentCapture
        tail parse thisCapture capture =a
        ^) not { ") expected" die } rep
        tail
      } { ^[ } {
        tail
        ^^ {
          tail chars =*nset
          { nset not }' ==?set
          ^] not { "] expected" die } rep
          tail
        }' {
          chars ==?set
          ^] not { "] expected" die } rep
          tail
        }' ? *
        set terminal =a
      } { ^. } {
        TERMANY =a
        tail
      } { ^^ } {
        [ [ FIRST ] ] =a
        tail
      } { ^$ } {
        [ [ LAST ] ] =a
        tail
      } { ^\ } {
        tail
        [ { ^d } {
          { _ 0 "0" * ge -01 0 "9" * le and }" terminal =a
          tail
        } { ^n } {
          { 0 "\n" * eq }" terminal =a
          tail
        }
        [ "." "[" "]" "?" "*" "+" "$" "^" "\\" "(" ")" ] { ==c
          { _ head 0 c * eq } {
            { 0 c * eq } terminal =a
            tail
          }
        } each
        { 1 } {
          "invalid character '" "' after \\ in regex" -120 cat cat die
        } ] conds
      } { 1 } {
        _ head TERMCHAR =a
        tail
      } ] conds

      # "(atom end) re: " -101 cat dump
      a
    } /atom deffst

    { # "(chars) re: " -101 cat dump
      ^] {
        tail chars2 =*s
        { _ s -01 0 "]" * eq or }' ==?set
      }' {
        chars2 ==?set
      }' ? *
      set
    } /chars deffst

    { # "(chars2) re: " -101 cat dump
      ^- {
        tail chars2 =*s
        { _ s -01 0 "-" * eq or }' ==?set
      }' {
        charsR ==?set
      }' ? *
      set
    } /chars2 deffst

    { # "(charsR) re: " -101 cat dump
      charsN ==?set
      { ^] not } {
        set =*s1
        charsN =*s2
        { _ s1 -01 s2 or }' =set
      } loop
      set
    } /charsR deffst

    { # "(charsN) re: " -101 cat dump
      _ head ==?start
      ^\ {
        tail
        [ { ^\ } {
          0 "\\" * =start
        } { ^n } {
          0 "\n" * =start
        } { 1 } {
          "invalid character '" "' after \\ in regex" -120 cat cat die
        } ] conds
      } rep
      tail
      ^- {
        tail
        _ head ==?end
        ^\ {
          tail
          [ { ^\ } {
            0 "\\" * =end
          } { ^n } {
            0 "\n" * =end
          } { 1 } {
            "invalid character '" "' after \\ in regex" -120 cat cat die
          } ] conds
        } rep
        tail
        { _ start ge -01 end le and }' ==?set
      }' {
        { start eq }' ==?set
      }' ? *
      set
    } /charsN deffst

    { [
      0 # pc
      [ currentCapture { 0 0 } rep ] # captures
    ] }" /newThread deff

    # TODO: reconsider clist/ilist and also reconsider optimisation potential
    { ==string
      0 ==position
      string len ==maxPosition
      0 ==matched
      [ ] ==matchedThread

      clist .clear
      nlist .clear
      ilist .clear

      newThread _ ==thread clist .add

      0 ==pc
      [ ] =*code

      ilist .|add =*iPush
      ilist .|pop =*iPop

      {
        { ilist .size }" {
          iPop _ =thread
                 threadGetPC _ =pc
                               prog * =code
          0 code codeSemantics *
        }" loop
      }" /runIList deffst

      [
        { # MATCH
          1 =matched
          thread =matchedThread
          clist .clear
        }" { # TERM
          position maxPosition lt {
            position string * 1 code * { pc 1 add thread updateThread nlist .add }" rep
          }" rep
        }" { # JUMP
          pc 1 code add thread cloneThread iPush
        }" { # SPLIT
          pc 2 code add thread cloneThread iPush
          pc 1 code add thread cloneThread iPush
        }" { # SAVE
          pc 1 add thread fullCloneThread
          position 1 code -2102 threadGetCaptures =[]
                                iPush
        }" { # FIRST
          position 0 eq { pc 1 add thread cloneThread iPush }" rep
        }" { # LAST
          position maxPosition eq { pc 1 add thread cloneThread iPush }" rep
        }" { # FLOATBEGIN
          pc 1 add thread cloneThread iPush
          thread
          runIList
          position maxPosition lt {
            nlist .add
          }" { -- }" ? *
        }" { # TERMBEGIN
          1 code =*p
          nlist .size not clist .size 1 eq and {
            { position maxPosition lt { position string * p not }" { 0 }" ? * }" {
              position 1 add =position
            }" loop
          }" rep

          position maxPosition lt {
            position string * p {
              pc 1 add thread cloneThread nlist .add
            }" rep
            thread nlist .add
          }" rep
        }"
      ] =*codeSemantics

      0 ==i
      { position maxPosition le }" {
        0 =i

        { i clist .size lt }" {
          i clist .get _ =thread
                         threadGetPC _ =pc
                                       prog * =code
          0 code codeSemantics *
          i 1 add =i

          runIList
        }" loop

        # "Next input character ========" dump
        clist nlist =clist =nlist
        nlist .clear
        ilist .clear
        position 1 add =position
      }" loop

      matched {
        currentCapture ==i
        { i } { i 1 sub =i
          i 2 mul       matchedThread threadGetCaptures *
          i 2 mul 1 add matchedThread threadGetCaptures *
          string str .infix
        } loop
      } rep
      matched
    }' /execute defvst

    parse ==prog --
    prog 0 -01 * 0 -01 * FIRST eq {
      [
        1 prog len range { prog * } each
      ] =prog
    } {
      prog 0 -01 * 0 -01 * TERM eq {
        [
          [ TERMBEGIN 1 0 prog * * ]
          1 prog len range { prog * } each
        ] =prog
      } {
        [
          [ FLOATBEGIN ]
          prog _ len dearray
        ] =prog
      } ? *
    } ? *
    [
      prog _ len dearray
      [ MATCH ]
    ] =prog

    prog len _ threadList ==clist
             _ threadList ==nlist
               threadList ==ilist

    execute
  }
> -- /enregex deffd

{
  quoted {
    _ sys .typed .type 1 eq {
      enregex
    } { |enregex "*" | } ? *
  } { enregex * } ? *
} /regex defq

{ scope keys }' /globals deffd

< # sys extensions
  # TODO: handle EINTR correctly

  0 _ ==:RDONLY
  1 _ ==:WRONLY
  2 _ ==:RDWR
      bor bor ==:RWMASK

  1 ==:PROTREAD
  2 ==:PROTWRITE
  4 ==:PROTEXEC

  2 ==:MAPPRIVATE

  [
    { sys .?linux }   { 32 }
    { sys .?freebsd } { 4096 }
  ] conds ==:MAPANONYMOUS

  [
    { sys .?linux } {
      64 ==:OCREAT
      512 ==:OTRUNC
      1024 ==:OAPPEND

      0 ==:READ
      1 ==:WRITE
      2 ==:OPEN
      3 ==:CLOSE

      9 ==:MMAP
      11 ==:MUNMAP
      60 ==:EXIT
    }'
    { sys .?freebsd } {
      512 ==:OCREAT
      1024 ==:OTRUNC
      8 ==:OAPPEND

      3 ==:READ
      4 ==:WRITE
      5 ==:OPEN
      6 ==:CLOSE

      477 ==:MMAP
      73 ==:MUNMAP
      1 ==:EXIT
    }'
  ] conds

  { ==code
    code 0 0 0 0 0 EXIT sys .asm .syscall
    "exit failed" die
  } /exit sys .deff

  { < ==mode ==flags ==fd <
      { flags RWMASK bnot band RDONLY bor =flags } /readonly deff
      { flags RWMASK bnot band WRONLY bor =flags } /writeonly deff
      { flags RWMASK bnot band RDWR bor =flags } /readwrite deff
      { flags OCREAT bor =flags } /creating deff
      { flags OAPPEND bor =flags } /appending deff
      { flags OTRUNC bor =flags } /truncating deff

      { ==path
        fd 0 ge { "file already open" die } rep
        path "\0" cat flags mode 0 0 0 OPEN sys .asm .syscall -- _ =fd
        0 lt { "cannot open " path cat die } rep
      } /open deff
      {
        fd 0 0 0 0 0 CLOSE sys .asm .syscall --
        0 lt { "bad things happened to your close call" die } rep
      } /close deff
      { ==count
        fd 0 lt { "file not open" die } rep
        count str .alloc ==buf
        fd buf count 0 0 0 READ sys .asm .syscall -- _
        0 lt { "read failed" die } rep
        buf str .inplacePrefix
      } /read deff
      { ==buf
        fd 0 lt { "file not open" die } rep
        fd buf _ len 0 0 0 WRITE sys .asm .syscall -- _
        0 lt { "write failed" die } rep
      } /write deff
      { ==buf
        fd 0 lt { "file not open" die } rep
        { buf len } {
          fd buf _ len 0 0 0 WRITE sys .asm .syscall -- _
          0 lt { "write failed" die } rep
          buf str .postfix =buf
        } loop
      } /writeall deff
      { =*f "" ==buffer
        {
          buffer 4096 read -010 cat =buffer
                                "" eq not
        } {
          buffer "\n" str .split ==lines
          0 lines len 1 sub range {
            lines * f
          } each
          lines len 1 sub lines * =buffer
        } loop

        buffer "" eq not {
          buffer "\n" str .split |f each
        } rep
      } /eachLine deff
  > > -- } /makefile deff

  {
    RDWR 511 makefile
  } /fdToFile sys .deff

  { # 0777 = 511
    1 neg RDONLY 511 makefile
  } /file sys .deff

  0 RDONLY 0 makefile /in sys .defv
  1 WRONLY 0 makefile /out sys .defv
  2 WRONLY 0 makefile /err sys .defv

  < # sys .asm extensions
    { ==reqAddr ==reqSize
      <
        reqAddr
        reqSize
        PROTEXEC PROTREAD PROTWRITE bor bor
        MAPPRIVATE MAPANONYMOUS bor
        1 neg
        0
        MMAP sys .asm .syscall -- _
        0 lt { "mmap failed" die } rep

        ==base
        reqSize ==size

        {
          base size 0 0 0 0 MUNMAP sys .asm .syscall --
          0 lt { "munmap failed" die } rep
        } =*free
      >
    } /allocAt sys .asm .deff

    {
      0 sys .asm .allocAt
    } /alloc sys .asm .deff
  > --

  < # sys .typed extensions

    # Returns an array which lists the sequence of curried arguments
    # i.e. if f: A -> B -> C -> D -> E the result will be [ A B C D ]
    { ==object
      { object dump "unknown type in typeStack" die } ==unknown
      { object dump "invalid type in typeStack" die } ==invalid
      { [ object 0 1 neg 0 ] } ==literal

      object sys .typed .type [
        literal # integer
        literal # string
        unknown
        unknown
        invalid # extension area
        { object sys .typed .inputs ==in
          in len 1 neq { "multi-input function in typeStack" die } rep
          [ 0 in * 0 1 neg 0 ]
          object sys .typed .outputs ==out
          out len 1 neq { "multi-output function in typeStack" die } rep
          0 out * typeStackInternal
        } # function
        invalid # function code
        {
          [ 1 0 object len 1 sub 1 ]
          object len {
            0 object * typeStackInternal
          } {
            [ 0 0 1 neg 0 ] # fake some integer entries
          } ? *
        } # array
        invalid # function type
        {
          [
            { object "#dom" .? } {
              object "#dom" . ==d
              object "#in" . ==in
              in len 1 neq { "multi-input scope (with #dom) in typeStack" die } rep
              [ 0 in * 0 d len 1 sub 1 ]
              object "#out" . ==out
              out len 1 neq { "multi-output scope (with #dom) in typeStack" die } rep
              0 out * typeStackInternal
            }
            { object "#*" .? } {
              object "#in" . ==in
              in len 1 neq { "multi-input scope in typeStack" die } rep
              [ 0 in * 0 1 neg 0 ]
              object "#out" . ==out
              out len 1 neq { "multi-output scope in typeStack" die } rep
              0 out * typeStackInternal
            }
            { 1 } literal
          ] conds
        } # scope
        invalid # name table
        unknown
        unknown
        unknown
        unknown
        unknown
      ] * *
    } /typeStackInternal deff

    { [ -01 typeStackInternal ] } /typeStack deff

    { -- 0 } /isVariableType deff

    { ==t
      t len 4 neq { "complex execution type non-triple" die } rep

      3 t *
    } /isIterableType deff

    { =*a =*b
      [
        { 0 a sys .typed .type 0 b sys .typed .type neq }
        { 0 }

        { 0 a sys .typed .type 0 neq }
        { "type equality only implemented for ints" die }

        { 0 b sys .typed .type 0 neq }
        { "type equality only implemented for ints" die }

        { 0 a 0 b neq } { 0 }
        { 1 } { 1 }
      ] conds
    } /typeEqual deff

    { ==earlierType ==laterType
      [
        { earlierType laterType typeEqual }
        { earlierType 1 }

        # TODO: maybe handle structs here one day (or move the whole affair into
        # a real compilation stage
        { 0 earlierType * sys .typed .type 0 neq }
        { 0 }

        # General integers co-iterate only if equal
        { 0 earlierType * 0 laterType * neq }
        { 0 }

        # Who came first determines iteration range
        { 2 earlierType * 1 neg neq }
        { earlierType 1 }

        # But if only the later one defines a range, take that one
        { 2 laterType * 1 neg neq }
        { laterType 1 }

        # If none defines a range, take the first
        { 1 }
        { earlierType 1 }
      ] conds
    } /commonIterationType deff

    { ==arr
      arr sys .typed .type 7 eq { 0 arr len range } { arr "#iclone" . } ? *
    } /cloneForLoop deff

    # Executing a function f: A->B->C (i.e. B A f) on concrete arguments b a.
    # Phase 1
    #   Foreach argument:
    #     Find the function input type from top of concrete argument type stack,
    #       increase viewport from top of concrete type stack
    #         match type from bottom to top, if type cannot be found, create constant function
    #         final match is that which creates minimal number of constant function layers
    # Phase 2
    #   Foreach argument type:
    #     Identify the type stack above the match from phase 1.
    #     Run from right (stacktop) argument to left (stacklow) argument:
    #       Take topmost type, check whether it can be found in other stacks (from top)
    #         Eliminate all matching types via function or loop creation
    { ==f
      f sys .typed .type 7 eq { _ sys .typed .type 7 eq } { 0 } ? * { ==a
        # this block is purely an optimization for common array-on-array invocation
        # the other block handles this case correctly, too (but a lot slower)
        [ a { f * }" each ]
      } {
        f sys .typed .type 7 eq { f { * }_ [ 0 ] [ 0 ] '' =f } rep

        f sys .typed .inputs ==inputs
        f sys .typed .outputs ==outputs

        outputs len 1 gt { "multi-output function in auto-loop" die } rep

        [ ] ==concreteArgs
        [ ] ==viewPortOffset

        # Phase 1
        0 inputs len range reverse {
          # print "Analyzing arg: %d"
          inputs * typeStack ==formalTypeStack
          _ ==c typeStack ==concreteTypeStack
          # "Type-Stack: %d" Dumper($concreteTypeStack) die

          0 ==bestViewPortSize
          concreteTypeStack len 1 add ==bestViewPortMatch

          # "Formal Type Stack: @$formalTypeStack\n" print
          # "       Type Stack: @$concreteTypeStack\n" print

          1 neg concreteTypeStack * isVariableType {
            1 concreteTypeStack len 1 add range { ==viewPortSize
              [ 0 viewPortSize range { concreteTypeStack * } each ] ==typeViewPort # explicit each here
              # "@$formalTypeStack vs. @$concreteTypeStack\n" print

              formalTypeStack concreteTypeStack typeMismatchCount ==viewPortMatch # FIXME this line seems fishy
              viewPortMatch bestViewPortMatch lt {
                viewPortSize =bestViewPortSize
                viewPortMatch =bestViewPortMatch
              } rep
            } each
          } {
            concreteTypeStack len =bestViewPortSize
            0 =bestViewPortMatch
          } ? *

          # convert concrete argument to exactly matching function
          # ... which calls the concrete argument using its relevant args
          bestViewPortMatch {
            # if argument is concrete, but we need are construction a function overall, then concrete
            # argument needs to be converted to a constant function in whatever domain is necessary
            "concrete argument constant functionification needs to be implemented, mismatch: $bestViewPortMatch" die
            { "magic goes here FIXME" die } =c
          } {
            # zero mismatches, can directly use concrete argument
            [ concreteTypeStack len formalTypeStack len sub ] viewPortOffset cat =viewPortOffset
          } ? *

          [ c ] concreteArgs cat =concreteArgs
        } each

        # "Viewport Offsets: @viewPortOffset\n" print

        # Phase 2,
        [
          0 viewPortOffset len range { ==i
            i concreteArgs * typeStack ==remaining
            [ 0 i viewPortOffset * range { remaining * } each ] # explicit each here
          } each
        ] ==toBeAbstractedTypes

        # "toBeAbstractedTypes: " dump
        # toBeAbstractedTypes dump

        [ toBeAbstractedTypes { len } each ] any not {
          # no types need to be abstracted, function can be called
          # "attempting to call function (w.o. abstraction)" dump
          0 ==typeMismatch
          0 ==mismatchIndex
          0 concreteArgs len range reverse { ==i
            i concreteArgs * sys .typed .type # _ dump
            i inputs       * sys .typed .type # _ dump
            neq typeMismatch not and { 1 =typeMismatch i =mismatchIndex } rep
          } each
          typeMismatch {
            mismatchIndex concreteArgs * ==arg
            arg sys .typed .type 9 eq { # this is a scope
              "" ==handlingMember
              globals { _ ==g | sys .asm .rawAddress f sys .asm .rawAddress eq {
                  mismatchIndex 9 gt { "cannot create member-fallback for argument index " dump mismatchIndex dump "" die } rep
                  arg
                    concreteArgs len 1 sub mismatchIndex sub [
                      "#" "#-01 " "#-021 " "#-0321 " "#-04321 " "#-054321 " "#-0654321 " "#-07654312 " "#-087654321 " "#-0987654321 "
                    ] *
                    g cat _ ==candidate .? { candidate =handlingMember } rep
                } rep
              } each
              "" handlingMember eq { "a handling member could not be found at argument index " dump mismatchIndex dump " of " dump arg dump "" die } rep
              0 concreteArgs len range { ==i
                i mismatchIndex neq { i concreteArgs * } rep
              } each
              arg handlingMember .
            } {
              "invalid input type at argument index " dump typeMismatch 1 sub dump "" die
            } ? *
          } {
            concreteArgs # _ dump
                       _ len dearray f *
          } ? *
        } {
          [ ] ==argTypes # the type stack of the new function
          [ ] ==stageCalls # which functions to call in each stage
          [ ] ==loops # undef for lambda abstraction, loop bound source for loops

          0 toBeAbstractedTypes len range reverse { ==i
            { i toBeAbstractedTypes * len } {
              # TODO: create a decent shift
              [ i toBeAbstractedTypes * reverse _ len dearray ==type ] reverse i toBeAbstractedTypes =[]
                [ i ] ==stageCalls2
                1 neg ==iterationSource
                type isIterableType { i =iterationSource } rep

                0 i range reverse { ==j
                  j toBeAbstractedTypes * len not not {
                    0 j toBeAbstractedTypes * * type commonIterationType # -> <type> <any exists>
                    { =type
                      iterationSource 0 lt type isIterableType and { j =iterationSource } rep
                      # TODO: create a decent shift
                      [ j toBeAbstractedTypes * reverse _ len dearray -- ] reverse j toBeAbstractedTypes =[]
                      [ j ] stageCalls2 cat =stageCalls2
                    } rep
                  } rep
                } each

                iterationSource 0 ge {
                  [ 1 neg ] argTypes cat =argTypes
                  [ iterationSource ] loops cat =loops
                } {
                  [ type ] argTypes cat =argTypes
                  [ 1 neg ] loops cat =loops
                } ? *
              [ stageCalls2 ] stageCalls cat =stageCalls
            } loop
          } each

          # "concreteArgs: " dump
          # concreteArgs dump
          # "stageCalls: " dump
          # stageCalls dump
          # "argTypes: " dump
          # argTypes dump
          # "loops: " dump
          # loops dump

          { ==loops ==argTypes ==stageCalls ==concreteArgs
            stageCalls len not {
              concreteArgs _ len dearray f
              *
            } {
              [ stageCalls _ len dearray ==stage ] =stageCalls
              [ argTypes _ len dearray ==argType ] =argTypes
              [ loops _ len dearray ==loopIndex ] =loops
              loopIndex 0 ge {
                loopIndex concreteArgs * ==loopedOver
                outputs len { loopedOver cloneForLoop } { [ ] } ? * ==results

                loopedOver sys .typed .type 7 eq {
                  0 ==i 0 ==j
                  [ concreteArgs _ len dearray ] ==concreteArgsCopy

                  loopedOver dom { =i
                    stage { =j
                      # TODO: think about a single function returning multiple values
                      i j concreteArgs * * j concreteArgsCopy =[]
                    }" each

                    concreteArgsCopy stageCalls argTypes loops unravel
                      outputs len { i results =[] }" rep
                    # results dump
                    # TODO: think about a single function returning multiple values
                    # should be solved by producing two arrays side by side
                  }" each
                } {
                  loopedOver "#istart" . ==i

                  { i loopedOver "#iend" . not } {
                    [ concreteArgs _ len dearray ] ==concreteArgsCopy
                    stage { ==j
                      # TODO: think about a single function returning multiple values
                      i loopedOver "#itrans" . j concreteArgs * * j concreteArgsCopy =[]
                    } each

                    concreteArgsCopy stageCalls argTypes loops unravel
                      outputs len { i loopedOver "#itrans" . results =[] } rep
                    # results dump
                    # TODO: think about a single function returning multiple values
                    # should be solved by producing two arrays side by side

                    i loopedOver "#istep" . =i
                  } loop
                } ? *

                outputs len { results } rep
                # push @$data, [\@results, ['array', '[]', [['range', 0, $#results]], [undef]]];
                # FIXME the undef can be determined
              } {
                { ==v
                  [ concreteArgs _ len dearray ] ==concreteArgsCopy
                  stage { ==i
                    v i concreteArgs * * i concreteArgsCopy =[]
                  } each

                  concreteArgsCopy stageCalls argTypes loops unravel
                } # leave this on the stack
                # push @$data, [$abstraction, ['func', 'autoabstraction of ' . $f->[1]->[1], [grep { $_ } @argTypeCopy], undef]];
                # FIXME the undef can be determined
              } ? *
            } ? *
          } =*?unravel

          concreteArgs stageCalls argTypes loops unravel

          # "execution complete" dump
        } ? *
      } ? *
    } /execute sys .typed .deff
  > --

  # TODO: why do we save section information, exactly?
  { ==filename # ==f (left on the stack a while and executed from sys .asm .programStart)
    sys .asm .patchProgramStart ==frozenAllocationCount ==heapSize

    # hex decoding
    { ==strNumber
      strNumber len 2 neq { "not a valid hex-string" die } rep
      1 0 { strNumber * 48 sub [ 0 1 2 3 4 5 6 7 8 9  0 0 0 0 0 0 0  10 11 12 13 14 15 ] * } -20*10* 16 mul add
    } "%" defq

    {                                               8 { _ 256 umod -01 256 udiv } rep -- } /uint64 deffd
    { _ 0 lt { 4294967296 add } rep 4294967295 band 4 { _ 256 umod -01 256 udiv } rep -- } /uint32 deffd
    { _ 0 lt { 65536 add } rep 65535 band           2 { _ 256 umod -01 256 udiv } rep -- } /uint16 deffd
    { _ 0 lt { 256 add } rep 255 band } /uint8 deffd

    { ==align ==value
      align value align umod sub align umod
    } /alignUpto deff

    sys .file ==out
    filename out _ .creating _ .writeonly .open

    [
      <
        ".null" ==?name
        0 ==?nameOffset { =nameOffset } /setNameOffset deff
        0 ==?dataOffset { =dataOffset } /setDataOffset deff
        0 ==?type # reserved first section
        0 ==?flags # none
        0 ==?addr # not loaded
        0 ==?link # no associated section
        0 ==?entsize # no entries
        [ ] ==?data
        0 ==?dataSize
      > <
        ".strtab" ==?name
        0 ==?nameOffset { =nameOffset } /setNameOffset deff
        0 ==?dataOffset { =dataOffset } /setDataOffset deff
        3 ==?type # string table
        0 ==?flags # none
        0 ==?addr # not loaded
        0 ==?link # no associated section
        0 ==?entsize # no entries
        [ ] ==?data # to be filled later
        0 ==?dataSize # to be filled later
        { _ =data len =dataSize } /setData deff
      > _ ==?stringTable
    ] ==metaSections

    [
      0 frozenAllocationCount range { ==i
        <
          ".-=#=-" ==?name
          0 ==?nameOffset { =nameOffset } /setNameOffset deff
          0 ==?dataOffset { =dataOffset } /setDataOffset deff
          1 ==?type # program data
          7 ==?flags # writable, allocated, executable
          i sys .asm .globalAllocBase ==?addr # address where this section will be loaded
          0 ==?link # no associated section
          0 ==?entsize # no entries
          i sys .asm .globalAllocBase ==?dataBase
          i sys .asm .globalAllocSize ==?dataSize
        >
      } each
    ] ==allocSections

    4096 ==:PAGESIZE

    < 1 ==?nameOffset
      [
        %00 # initial zero byte of string table
        ### section names

        [ metaSections allocSections ] { { ==?s
          s .name ==?n
          0 n len range { n * } each %00
          nameOffset s .setNameOffset
          nameOffset n len add 1 add =nameOffset
        } each } each
      ] stringTable .setData
    > -- <
      # %40 ==? section header size, %38 == program header size
      metaSections len allocSections len add %40 mul
                       allocSections len     %38 mul add
                                             %40     add ==?dataOffset
      metaSections { ==s
        dataOffset s .setDataOffset
        dataOffset s .dataSize add =dataOffset
      } each

      dataOffset _ 4096 alignUpto add =dataOffset

      allocSections { ==s
        dataOffset s .setDataOffset
        dataOffset s .dataSize add _ PAGESIZE alignUpto add =dataOffset
      } each
    > --

    [
      ### elf header
      # unsigned char e_ident[16]; /* ELF identification */
      %7F 0 1 2 "ELF" -30*20*10*  # elf identifier
      %02                         # elfclass64
      %01                         # elf version
      %01                         # little endian encoding
      [
        { sys .?linux }   { %00 %00 } # Sys-V ABI
        { sys .?freebsd } { %09 %00 } # FreeBSD ABI
      ] conds
      %00 %00 %00 %00 %00 %00 %00 # padding
      # Elf64_Half    e_type;      /* Object file type */
      %02 %00                     # executable file
      # Elf64_Half    e_machine;   /* Machine type */
      %3E %00                     # whatever, /bin/ls has this
      # Elf64_Word    e_version;   /* Object file version */
      %01 %00 %00 %00             # always 1
      # Elf64_Addr    e_entry;     /* Entry point address */
      sys .asm .|programStart sys .asm .rawCodeAddress uint64
      # Elf64_Off     e_phoff;     /* Program header offset */
      metaSections len allocSections len add %40 mul
                                             %40     add uint64
      # Elf64_Off     e_shoff;     /* Section header offset */
      %40 uint64
      # Elf64_Word    e_flags;     /* Processor-specific flags */
      %00 %00 %00 %00 # taken from from /bin/ls
      # Elf64_Half    e_ehsize;    /* ELF header size */
      %40 %00
      # Elf64_Half    e_phentsize; /* Size of program header entry */
      %38 %00
      # Elf64_Half    e_phnum;     /* Number of program header entries */
      allocSections len uint16
      # Elf64_Half    e_shentsize; /* Size of section header entry */
      %40 %00
      # Elf64_Half    e_shnum;     /* Number of section header entries */
      metaSections len allocSections len add uint16
      # Elf64_Half    e_shstrndx;  /* Section name string table index */
      %01 %00 # section header name table index in section headers table

      [ metaSections allocSections ] { { ==s
        ### section header
        # Elf64_Word  sh_name;      /* Section name */
        s .nameOffset uint32
        # Elf64_Word  sh_type;      /* Section type */
        s .type uint32
        # Elf64_Xword sh_flags;     /* Section attributes */
        s .flags uint64
        # Elf64_Addr  sh_addr;      /* Virtual address in memory */
        s .addr uint64
        # Elf64_Off   sh_offset;    /* Offset in file */
        s .dataOffset uint64
        # Elf64_Xword sh_size;      /* Size of section */
        s .dataSize uint64
        # Elf64_Word  sh_link;      /* Link to other section */
        s .link uint32
        # Elf64_Word  sh_info;      /* Miscellaneous information */
        0 uint32
        # Elf64_Xword sh_addralign; /* Address alignment boundary */
        1 uint64
        # Elf64_Xword sh_entsize;   /* Size of entries, if section has table */
        0 uint64
      } each } each

      allocSections { ==s
        ### program header
        # Elf64_Word       p_type;          /* Type of segment */
        %01 %00 %00 %00 # loadable segment
        # Elf64_Word       p_flags;         /* Segment attributes */
        %07 %00 %00 %00 # read | write | execute
        # Elf64_Off        p_offset;        /* Offset in file */
        s .dataOffset uint64
        # Elf64_Addr       p_vaddr;         /* Virtual address in memory */
        s .dataBase uint64
        # Elf64_Addr       p_paddr;         /* Reserved */
        %00 %00 %00 %00 %00 %00 %00 %00
        # Elf64_Xword      p_filesz;        /* Size of segment in file */
        s .dataSize uint64
        # Elf64_Xword      p_memsz;         /* Size of segment in memory */
        s .dataSize uint64
        # Elf64_Xword      p_align;         /* Alignment of segment */
        %01 %00 %00 %00 %00 %00 %00 %00 # alignment
      } each
    ] ==fileHeaders

    0 ==fileOffset
    [ fileHeaders metaSections { .data } each ] { ==data
      fileOffset data len add =fileOffset
      data str .fromArray out .writeall
    } each

    allocSections { ==section
      section .dataOffset fileOffset sub str .alloc out .writeall
      section .dataOffset section .dataSize add =fileOffset

      2000000000 ==:BLOCKSIZE
      0 section .dataSize BLOCKSIZE div 1 add range { ==block
        section .dataBase block BLOCKSIZE mul add ==dataBase
        block section .dataSize BLOCKSIZE div eq 
          section .dataSize block BLOCKSIZE mul sub BLOCKSIZE ? ==dataSize

        out .fd dataBase dataSize 0 0 0 WRITE sys .asm .syscall --
        dataSize neq { "write failed" die } rep
      } each
    } each

    out .close

    ==f

    sys .asm .patchProgramStart -- heapSize neq {
      "freezing allocated new memory chunks, retrying..." dump
      f filename sys .freeze
    } rep
  } /freeze sys .deff
> --

{ _ ==f _ sys .typed .inputs ==inputs
          sys .typed .outputs ==outputs
  inputs len 2 lt { f } {
    { "t from curry should never execute" die }
      [ inputs len 1 sub inputs * ] outputs '' ==t
    0 inputs len 2 sub range reverse { ==i t [ i inputs * ] [ t ] '' =t } each
    1 inputs len range reverse { ==i
      f < =*g { { g }_ } > -- [ i inputs * ] [ t ] '' =f
      0 t sys .typed .outputs * =t
    } each
    f
  } ? *
} /curry deffd

{ | curry } "||" deffd

{ ==o
  { "unknown type in **" die } ==:unknown
  { "invalid type in **" die } ==:invalid

  o sys .typed .type [
    { o } # integer
    { o } # string
    { o } # float
    unknown
    invalid # extension area
    { o * ** } # function
    invalid # function code
    { o * ** } # array
    invalid # function type
    { o "#*" .? { o * ** } { o } ? * } # scope
    invalid # name table
    unknown
    unknown
    unknown
    unknown
    unknown
  ] * *
} "**" deffd

# global extensions
<
  "0123456789" ==:base10digits
  "0123456789ABCDEF" ==:base16digits

  [ 0 11 range {
    sys .asm .intToFloat
  }' each ] =*:FLOAT

  { _ 0 lt { neg "-" }' { "" }' ? * -01
    [ -01 16 { _ 16 umod base16digits * -01 16 udiv }' rep -- ] reverse str .fromArray cat
  }' /base16encode64 deffd

  [
    { o base16encode64 sys .err .writeall }" # integer
    { "\"" o "\"" cat cat sys .err .writeall }" # string
    { o { ==f 0 ==e "+" ==s 0 ==i
      f 0 FLOAT lt { 0 FLOAT f sub =f "-" =s }' rep
      { f 1 FLOAT lt i 500 lt and }' { f 10 FLOAT mul =f e 1 sub =e i 1 add =i }' loop
      { f 10 FLOAT ge i 500 lt and }' { f 10 FLOAT div =f e 1 add =e i 1 add =i }' loop

      i 500 eq {
        s
        f 1 FLOAT lt "0.0e0" "inf" ?
        cat sys .err .writeall
      }' {
        {
          0 ==d
          1 10 range { ==i f i FLOAT gt { i =d }' rep } each
          f d sub =f
          f 10 FLOAT mul =f
          d base10digits *
        } /extractDigit deffst

        [
          0 s *
          extractDigit
          0 "." *
          10 |extractDigit rep
          0 "e" *
          e 0 lt {
            0 e sub =e
            0 "-" *
          } rep
          e 0 eq {
            0 "0" *
          } rep
          [
            { e } {
              e 10 mod base10digits *
              e 10 div =e
            } loop
          ] reverse _ len dearray
        ] str .fromArray sys .err .writeall
      }' ? *
    } * }" # float
    { "<invalid object-type code 3>" sys .err .writeall }" # not allocated
    { "<object extension area (should not be on stack)>" sys .err .writeall }"
    { "<function: " o sys .asm .rawAddress base16encode64 cat ">" cat sys .err .writeall }"
    { "<function code: " o sys .asm .rawAddress base16encode64 cat ">" cat sys .err .writeall }"
    {
      "[\n" sys .err .writeall
      o { indent 1 add dumpIndented }' each
      "" indent { "  " cat }' rep "]" cat sys .err .writeall
    }" # array
    { "<function type (should not be on stack)>" sys .err .writeall }"
    { "<scope: " o sys .asm .rawAddress base16encode64 cat ">" cat sys .err .writeall }"
    { "<name table (should not be on stack)>" sys .err .writeall }"
    { "<call stack (should not be on stack)>" sys .err .writeall }"
    { "<coroutine: " o sys .asm .rawAddress base16encode64 cat ">" cat sys .err .writeall }"
    { "<invalid object-type code 13>" sys .err .writeall }"
    { "<invalid object-type code 14>" sys .err .writeall }"
    { "<invalid object-type code 15>" sys .err .writeall }"
  ] /dumpActions deffd

  { ==indent _ ==o
    "" indent { "  " cat }' rep sys .err .writeall
    sys .typed .type dumpActions *
    "\n" sys .err .writeall
  } /dumpIndented deffd

  # dump top stack element to sys .err
  { 0 dumpIndented }
> -- /dump deffd

# no long-term stack use here as the executed program uses it as well
{ ==currentScope
  0 "0" * ==:zero
  { 0 ==result
    { zero sub result 10 mul add =result } each
    result
  } /base10decode deffd

  [ 0 11 range {
    sys .asm .intToFloat
  } each ] =*:FLOAT

  { .value currentScope sys .executeIdentifierScoped =currentScope } /TOKID defvst
  { .value base10decode } /TOKINT defvd
  { .value "^(\\d+)(\\.(\\d*))?([eE](-)?(\\d+))?$" regex
    not { "Not in fact a float" die } rep
    ==m1 -- ==m2 -- ==eS ==e

    0 FLOAT ==m1f
    m1 { zero sub m1f 10 FLOAT mul add =m1f } each
    0 FLOAT ==m2f
    [ m2 { } each ] reverse { zero sub m2f add 10 FLOAT div =m2f } each

    m1f m2f add ==result

    0 ==ei
    e { zero sub ei 10 mul add =ei } each
    eS "" eq {
      ei { result 10 FLOAT mul =result } rep
    } {
      ei { result 10 FLOAT div =result } rep
    } ? *

    result
  } /TOKFLOAT defvd

  { .value } /TOKSTR defvd

  { TOKFLOAT TOKINT TOKSTR TOKID elymas .tokenize { _ .handle } each }
} /enincludeLine deffd

{ scope enincludeLine * }" /includeLine deffd

{ scope
  { enincludeLine ==includeLine ==input
    includeLine input .eachLine
  } *
}" /includeFile deffd

{ # ==?filename
  sys .file _ _ .|open -01 |includeFile -01 .|close ; ; -120 * # can use neither stack nor scope for storage here
}" /include deffd

# vim: syn=elymas