Typed execution code converted - untested so far

6 files changed, 350 insertions, 18 deletions

diff --git a/compiler/elymasAsm.ey b/compiler/elymasAsm.ey
index 974f1ce..ddf541a 100644
--- a/compiler/elymasAsm.ey
+++ b/compiler/elymasAsm.ey
@@ -792,6 +792,18 @@
     reg mem modrm00
   } /movzxMem8Reg64 deff
 
+  { ==reg ==mem ==disp
+    reg bit64assert
+    mem bit64assert
+    disp 128 lt assert
+
+    1 reg /none mem rex
+    %0F
+    %B6
+    reg mem modrm01
+    disp imm8
+  } /movzxMem8Disp8Reg64 deff
+
   { ==reg
     reg bit64assert
 
diff --git a/compiler/elymasGlobal.ey b/compiler/elymasGlobal.ey
index 37160a9..e2e8c49 100644
--- a/compiler/elymasGlobal.ey
+++ b/compiler/elymasGlobal.ey
@@ -230,7 +230,7 @@
         /edx /rdi :cmplRegMem
         /inExtensionArea :jnbLbl8
 
-        # FIXME
+        "FIXME: extension area is full" ::outputError
         :ud2
 
         @inExtensionArea
@@ -367,7 +367,9 @@
       %F0 /cl :andbImmReg
       %00 /cl :cmpbImmReg
       /arrayIntArgument :jeLbl8
-      :ud2 # TODO handle the fully typed case
+
+      "FIXME: typed array application" ::outputError
+      :ud2
 
       @arrayIntArgument
       8 /rbx /rax :movqMemDisp8Reg # rax == requested index
@@ -378,7 +380,13 @@
       /rsi /rsi :xorqRegReg
       /rdx /rsi :xchgqRegReg
 
-      # TODO: think about skipping this if index fits
+      /rcx /rcx :testqRegReg
+      /nonEmpty :jnzLbl8
+
+      "access into empty array" ::outputError
+      :ud2
+
+      @nonEmpty
       /rcx :divqReg
 
       # rsi == array object on heap
@@ -447,15 +455,6 @@
       :retn
     ]] /ey* defv
 
-    # dump top stack element (actually drop it for now)
-    # FIXME: this belongs in the standard library
-    [
-      /rax :popqReg
-      /rcx :popqReg
-      /rax :pushqReg
-      :retn
-    ] /eydump defv
-
     # array construction, push begin marker on stack
     [
       /rax :popqReg
@@ -817,6 +816,8 @@
       ::internalDumpErrorString /rax :movqImmReg
       /rax :callqReg
       :ud2
+      /rbx :pushqReg
+      :retn
     ] /eydie defv
   > _ ==globalFunctions { defv }' ::allocateOffsetStruct
 
diff --git a/compiler/elymasGlobalSys.ey b/compiler/elymasGlobalSys.ey
index 3a7be17..9d20c35 100644
--- a/compiler/elymasGlobalSys.ey
+++ b/compiler/elymasGlobalSys.ey
@@ -6,6 +6,7 @@
   ] :execute
 
   "elymasGlobalSysAsm.ey" include
+  "elymasGlobalSysTyped.ey" include
 
   leaveSubScope
 > --
diff --git a/compiler/elymasGlobalSysTyped.ey b/compiler/elymasGlobalSysTyped.ey
new file mode 100644
index 0000000..bdc88d0
--- /dev/null
+++ b/compiler/elymasGlobalSysTyped.ey
@@ -0,0 +1,74 @@
+<
+  <
+    # return the array of input types of a function
+    # 0 -> the function object to analyze
+    # 0 <- the array of input types
+    [[
+      /rbx :popqReg
+
+      /rdx :popqReg
+      16 /rdx /rdx :movqMemDisp8Reg
+      /rdx /rdx :testqRegReg
+      /typed :jnzLbl8
+
+      # untyped functions, it does not officially take any arguments
+      /rdi /rdi :xorqRegReg
+      ::internalAllocateArray /rax :movqImmReg
+      /rax :callqReg
+      /rax :pushqReg
+      /rbx :pushqReg
+      :retn
+
+      @typed
+      8 /rdx /rdi :movqMemDisp8Reg
+      3 /rdi :shlqImm8Reg
+      16 /rdx /rsi :leaqMemDisp8Reg
+      /rsi :pushqReg
+      ::internalAllocateArray /rax :movqImmReg
+      /rax :callqReg
+
+      /rsi :popqReg
+      /rax :pushqReg
+
+      8 /rax /rdi :leaqMemDisp8Reg
+      /rax /ecx :movlMemReg
+      8 /rcx :subqImm8Reg
+      :reprcx :movsb
+
+      /rbx :pushqReg
+      :retn
+    ]] /eyinputs defv
+
+    # return the type of an object
+    # 0 -> the object to analyze
+    # 0 <- an integer from 0 - 15
+    [[
+      /rbx :popqReg
+
+      16 /rdi :movqImmReg
+      ::internalAllocate /rax :movqImmReg
+      /rax :callqReg
+
+      /rdx :popqReg
+      7 /rdx /rdx :movzxMem8Disp8Reg64
+      4 /rdx :shrqImm8Reg
+      /rdx 8 /rax :movqRegMemDisp8
+
+      /rax :pushqReg
+
+      /rbx :pushqReg
+      :retn
+    ]] /eytype defv
+  > _ ==globalFunctions { defv }' ::allocateOffsetStruct
+
+  "typed" enterSubScope
+
+  [
+    globalFunctions keys eydeff { | }' createScopeEntries
+    createScopeExtensionEntries
+  ] :execute
+
+  leaveSubScope
+> --
+
+# vim: syn=elymas
diff --git a/compiler/standardClient.ey b/compiler/standardClient.ey
index e48798e..f7c1bb6 100644
--- a/compiler/standardClient.ey
+++ b/compiler/standardClient.ey
@@ -92,12 +92,247 @@
   > --
 
   < # sys .typed extensions
-    <
-      {
-        "Here!!! :)" die
-      } /execute deff
-    > /typed sys .defv
+
+    # 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
+      { "unknown type in typeStack" die } ==unknown
+      { "invalid type in typeStack" die } ==invalid
+      { } ==literal
+
+      object sys .typed .type [
+        literal # integer
+        literal # string
+        literal # scope
+        invalid # name table
+        invalid # extension area
+        { object sys .typed .inputs ==in
+          in len 1 neq { "multi-input function in typeStack" die } rep
+          0 in *
+          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 * typeStackInternal } # array
+        invalid # function type
+        unknown
+        unknown
+        unknown
+        unknown
+        unknown
+        unknown
+        unknown
+      ] * *
+    } /typeStackInternal deff
+
+    { [ -01 typeStackInternal ] } /typeStack deff
+
+    { 0 } /isVariableType 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 sys .typed .inputs ==inputs
+      [ ] ==concreteArgs
+      [ ] ==viewPortOffset
+
+      # Phase 1
+      0 inputs len 1 sub 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 range { ==viewPortSize
+            [ 0 viewPortSize 1 sub 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 _ len dearray ] =viewPortOffset
+        } ? *
+
+        [ c concreteArgs _ len dearray ] =concreteArgs
+      } each
+
+      # "Viewport Offsets: @viewPortOffset\n" print
+
+      "survived" die
+
+      # Phase 2,
+      [
+        0 viewPortOffset len 1 sub range { ==i
+          i concreteArgs * typeStack ==remaining
+          [ 0 i viewPortOffset * 1 sub range { remaining * } each ] # explicit each here
+        } each
+      ] ==toBeAbstractedTypes
+
+      # "To be abstracted: " . Dumper(@toBeAbstractedTypes) print
+
+      "survived (not reached)" die
+
+      [ toBeAbstractedTypes { len } each ] any not {
+        # no types need to be abstracted, function can be called
+        concreteArgs _ 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 1 sub 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 1 sub reverse { ==j
+                j toBeAbstractedTypes * len not not {
+                  0 j toBeAbstractedTypes * * type commonSubType # -> <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
+              } ? *
+            [ stageCalls _ len dearray stageCalls2 ] =stageCalls
+          } loop
+        } each
+
+        # Dumper(\@argTypes, \@stageCalls, \@loops) print
+
+        "survived (not reached)" die
+        
+        { ==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 {
+              [ ] ==results
+              loopIndex concreteArgs * ==loopedOver
+              loopedOver getLoopStart ==i
+              { i loopedOver isLoopEnd not } {
+                i loopedOver doLoopStep =i
+
+                stage { ==j
+                  # TODO: think about a single function returning multiple values
+                  i j concreteArgs * * j concreteArgs =[]
+                } each
+
+                concreteArgs stageCalls argTypes loops unravel
+                results -01 cat =results
+                # TODO: think about a single function returning multiple values
+                # should be solved by producing two arrays side by side
+              } loop
+
+              results
+              # push @$data, [\@results, ['array', '[]', [['range', 0, $#results]], [undef]]];
+              # FIXME the undef can be determined
+            } {
+              { ==v
+                stage { ==i
+                  v i concreteArgs * * i concreteArgs =[]
+                } each
+
+                concreteArgs 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
+      } ? *
+    } /execute sys .typed .deff
   > --
 > --
 
+# global extensions
+<
+  [ /0 /1 /2 /3 /4 /5 /6 /7 /8 /9 /A /B /C /D /E /F ] ==base16singleDigits
+  [ base16singleDigits { ==first base16singleDigits { first -01 cat } each } each ] ==base16digits
+
+  {
+    [ -01 8 { _ 256 mod base16digits * -01 256 div } rep -- ]
+    reverse |cat fold
+  } /base16encode64 deff
+
+  # dump top stack element to sys .err
+  { _ ==o
+    { "unknown type in dump" die } ==unknown
+    { "invalid type in dump" die } ==invalid
+        
+    sys .typed .type [
+      { o base16encode64 sys .err .writeall } # integer
+      { "\"" o "\"" cat cat sys .err .writeall } # string
+      { "<scope>" } # scope
+      invalid # name table
+      invalid # extension area
+      { "<function>" } # function
+      invalid # function code
+      { "[\n" sys .err .writeall o |dump each "]" sys .err .writeall } # array
+      invalid # function type
+      unknown
+      unknown
+      unknown
+      unknown
+      unknown
+      unknown
+      unknown
+    ] * *
+    "\n" sys .err .writeall
+  }
+> -- /dump deff
+
 # vim: syn=elymas
diff --git a/notes b/notes
index 84c9f60..feea511 100644
--- a/notes
+++ b/notes
@@ -198,9 +198,11 @@ Small set in between
   bit 63-60: 1 0 0 0
   bit 59: reserved for GC
 * Number of input stack elements
-* Number of output stack elements
 * [ <input type pointer> ]*
+* Number of output stack elements
 * [ <output type pointer> ]*
+  ( TODO: Think about representing this directly as array pointers )
+  ( TODO: Think about moving the counts to the beginning )
 
 = Musings About The Optimizer =
 
@@ -273,3 +275,10 @@ Types are represented by concrete values of that type.
 Co-iterability is decided by type-match and
 * integers: co-iterated type is bitwise and, if zero, no co-iteration
 * strings: co-iterated type is longest common substring, if epsilon, no co-iteration
+
+== Musings about function composition operator ==
+
+Maybe ; should act differently when getting a string, or use another single char for category operations
+
+Uses: Categorical operators over Set
+Anyway: This should be handled by a library, use escape mechanism for ;