Typed execution code converted - untested so far

1 files changed, 240 insertions, 5 deletions

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