Can now retype functions

5 files changed, 118 insertions, 11 deletions

diff --git a/compiler/elymasAsmLib.ey b/compiler/elymasAsmLib.ey
index 3ff6412..823208f 100644
--- a/compiler/elymasAsmLib.ey
+++ b/compiler/elymasAsmLib.ey
@@ -614,13 +614,25 @@
       :retn
 
       @markFunctionType
-      /rdi :pushqReg
-      "function type marked FIXME\n" outputError
-      /rdi :popqReg
+      # /rdi :pushqReg
+      # "function type marked FIXME\n" outputError
+      # /rdi :popqReg
 
-      :ud2 # FIXME needs to be done
+      /rcx :pushqReg
+      /rsi :pushqReg
+      /rdi /ecx :movlMemReg
+      /rdi /rsi :movqRegReg
+      8 /rcx :subqImm8Reg
+      @markFunctionTypeLoop
+      /rsi /rcx /rdi :movqMemIndexReg
+      /markObject :callqLbl32
+      8 /rcx :subqImm8Reg
+      /markFunctionTypeLoop :jnzLbl8
+      /rsi :popqReg
+      /rcx :popqReg
       :retn
 
+
       # allocate next chunk of memory from the operating system
       @allocateFromSystem
       heapSize /rax :movqImmReg
diff --git a/compiler/elymasGlobal.ey b/compiler/elymasGlobal.ey
index 8ac388e..9ba92c9 100644
--- a/compiler/elymasGlobal.ey
+++ b/compiler/elymasGlobal.ey
@@ -355,7 +355,7 @@
       %50 /cl :cmpbImmReg
       /normalFunction :jeLbl8
       %10 /cl :cmpbImmReg
-      /stringFunctionSJ :jeLbl8
+      /stringFunctionSJ :jeLbl8 # TODO replace by long jump
       %70 /cl :cmpbImmReg
       /unexecutable :jneLbl8
       /arrayFunction :jmpLbl32
@@ -1612,6 +1612,60 @@
       %C1 -101* /eydeffd defv
       --
 
+    # retype a function
+    # 0 -> function output arguments as array
+    # 1 -> function input arguments as array
+    # 2 -> function object
+    # 0 <- function object with new types
+    [[
+      24 /r15 :subqImm8Reg
+      16 /r15 :popqMemDisp8 # return address
+      8 /r15 :popqMemDisp8 # output arguments
+      /r15 :popqMem # input arguments
+
+      /r15 /rdx :movqMemReg
+      /rdx /edi :movlMemReg
+      8 /r15 /rdx :movqMemDisp8Reg
+      /rdx /edi :addlMemReg # rdi now input + output array lengths + 16
+      8 /rdi :addqImm8Reg # rdi now length of function type object
+
+      ::internalAllocate /rax :movqImmReg
+      /rax :callqReg
+      %80 7 /rax :orbImmMemDisp8 # set type
+      8 /rax /rdi :leaqMemDisp8Reg
+      /rax /rbp :movqRegReg # store type object away for later use
+
+      /r15 /rdx :movqMemReg
+      /rdx /eax :movlMemReg
+      3 /rax :shrqImm8Reg
+      /rax :decqReg
+      /rax /rcx :movqRegReg
+      :stosq # store input argument count
+      8 /rdx /rsi :leaqMemDisp8Reg
+      :reprcx :movsq # store input argument types
+
+      8 /r15 /rdx :movqMemDisp8Reg
+      /rdx /eax :movlMemReg
+      3 /rax :shrqImm8Reg
+      /rax :decqReg
+      /rax /rcx :movqRegReg
+      :stosq # store output argument count
+      8 /rdx /rsi :leaqMemDisp8Reg
+      :reprcx :movsq # store output argument types
+
+      /rax :popqReg # original function object
+      8 /rax /rsi :movqMemDisp8Reg # scope pointer as before
+      24 /rax /rdi :movqMemDisp8Reg # code pointer as before
+      /rbp /rdx :movqRegReg # type pointer to new type object
+      ::internalAllocateFunction /rax :movqImmReg
+      /rax :callqReg
+      /rax :pushqReg
+
+      16 /r15 :pushqMemDisp8
+      24 /r15 :addqImm8Reg
+      :retn
+    ]] /ey' defv
+
     # concatenate two functions
     # 0 -> function g
     # 1 -> function f
diff --git a/compiler/elymasGlobalSysTyped.ey b/compiler/elymasGlobalSysTyped.ey
index 5284c69..c604532 100644
--- a/compiler/elymasGlobalSysTyped.ey
+++ b/compiler/elymasGlobalSysTyped.ey
@@ -39,6 +39,47 @@
       :retn
     ]] /eyinputs defv
 
+    # return the array of output types of a function
+    # 0 -> the function object to analyze
+    # 0 <- the array of output types
+    [[
+      /rbx :popqReg
+
+      /rdx :popqReg
+      16 /rdx /rdx :movqMemDisp8Reg
+      /rdx /rdx :testqRegReg
+      /typed :jnzLbl8
+
+      # untyped functions, it does not officially produce any objects
+      /rdi /rdi :xorqRegReg
+      ::internalAllocateArray /rax :movqImmReg
+      /rax :callqReg
+      /rax :pushqReg
+      /rbx :pushqReg
+      :retn
+
+      @typed
+      8 /rdx /rax :movqMemDisp8Reg
+      16 8 /rax /rdx /rdx :leaqMemIndexScaleDisp8Reg
+      /rdx /rdi :movqMemReg
+      3 /rdi :shlqImm8Reg
+      8 /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
+    ]] /eyoutputs defv
+
     # return the type of an object
     # 0 -> the object to analyze
     # 0 <- an integer from 0 - 15
diff --git a/compiler/standard.ey b/compiler/standard.ey
index dd611e6..dedbe6b 100644
--- a/compiler/standard.ey
+++ b/compiler/standard.ey
@@ -17,9 +17,9 @@
 }" /via defq
 
 { -1110 ; ==f =*a len _
-  {
-    0 a
-    1 -102 range f each
+    {
+      0 a
+      1 -102 range f each
     }' { "fold on empty array" die }'
   ? *
 } /fold deffd
diff --git a/compiler/standardClient.ey b/compiler/standardClient.ey
index efe7298..8e7a3a9 100644
--- a/compiler/standardClient.ey
+++ b/compiler/standardClient.ey
@@ -502,8 +502,8 @@
     # 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
+      { object dump "unknown type in typeStack" die } ==unknown
+      { object dump "invalid type in typeStack" die } ==invalid
       { [ object 0 1 neg ] } ==literal
 
       object sys .typed .type [
@@ -576,7 +576,7 @@
         { 2 laterType * 1 neg neq }
         { laterType 1 }
 
-        # General integers go-iterate iff they binary and results in non-zero
+        # General integers co-iterate iff their binary and results in non-zero
         { 0 earlierType * 0 laterType * band 0 neq }
         { earlierType 1 }