ed75a3e440d5 — Leonard Ritter 3 months ago
* more work on type schema
3 files changed, 250 insertions(+), 4 deletions(-)

A => lib/tukan/kernel.sc
M testing/test_compute_process.sc
M testing/test_typeschema2.sc
A => lib/tukan/kernel.sc +24 -0
@@ 0,0 1,24 @@ 
+
+
+fn boot-image ()
+
+    #
+        we need to call to execute the root program, which is a shader
+
+
+
+    raise false
+
+fn boot-failsafe ()
+    # start console thread
+    # how do threads signal they're done?
+
+fn boot ()
+    try
+        boot-image;
+    else
+        boot-failsafe;
+
+do
+    let boot
+    locals;

          
M testing/test_compute_process.sc +33 -1
@@ 8,7 8,39 @@ using import glm
 using import testing
 
 #
-    how would a shader indicate what
+    design goals for the programming language model of tukan:
+    * pure functional
+    * sandboxed
+    * no recursions, no loops
+    * bulk data processing through map/filter/reduce abstractions (transducers)
+    * transparent & cohesive code generation for CPU/GPU
+    * structural type system
+    * no JIT, GC free
+    * fused if/select
+    * immutable data structures
+    * first order closures
+    * multiple return values
+    * pseudoquoting
+    * polymorphic at compile time
+    * modules are databases
+    * deduplication through content-addressing
+
+    its closest cousin is probably http://futhark-lang.org
+
+
+
+    types:
+
+    bool
+    i32
+    f32
+    tuple T ...
+    vector T size
+    function <tuple-type> <- <tuple-type>
+
+
+
+
 
 shared tmp : vec3
 

          
M testing/test_typeschema2.sc +193 -3
@@ 12,6 12,7 @@ 
     2. a mutable entry point into the root data structure
 
 using import struct
+using import enum
 using import Map
 using import Array
 

          
@@ 21,7 22,7 @@ let llvm.memcpy.p0i8.p0i8.i64 =
     extern 'llvm.memcpy.p0i8.p0i8.i64
         function void (mutable rawstring) rawstring i64 bool
 
-import ..tukan.use
+import ..lib.tukan.use
 using import tukan.SHA256
 
 fn hex64 (value)

          
@@ 73,7 74,7 @@ struct UBlob plain
             dec self.offset
             ">"
 
-struct UModule # content addressable store abstraction
+struct UStore # content addressable store abstraction
     # memory blob
     memory : (Array u64)
     # address to offset into memory

          
@@ 108,15 109,204 @@ struct UModule # content addressable sto
                     offset = offset
             'set self.map addr blob
             _ addr blob
+    case (self, str : string)
+        this-function self (str as rawstring) (countof str)
     case (self, data)
+        static-assert (not ((storageof data) < pointer))
         let data =
             static-if (&? data) data
             else
                 local data = data
         this-function self &data (sizeof data)
 
+global module : UStore
+
+inline intern-string (s)
+    let addr = ('insert module s)
+    global interned-string = addr
+    interned-string
+
+let ref-type-name = (intern-string "ref256")
+let integer-type-name = (intern-string "integer")
+let real-type-name = (intern-string "real")
+
+type UPointerType <: ('packed tuple UPointer i32)
+
+type NumberType <: ('packed tuple UPointer i32)
+
+static-assert ((sizeof NumberType) == 36)
+
+fn... number-type (name : UPointer, bitcount : i32,)
+    let value =
+        NumberType name bitcount
+    _ ('insert module value) ()
+
+inline integer-type (bitcount)
+    number-type integer-type-name bitcount
+
+inline real-type (bitcount)
+    number-type real-type-name bitcount
+
+inline bitcountof (T)
+    try
+        let ptr = ('@ module ('get module T) NumberType)
+        deref (ptr @ 1)
+    else 0
+
+global i32-type = (integer-type 32)
+global f32-type = (real-type 32)
+
+
+
+print
+    bitcountof
+        integer-type 32
+print
+    real-type 32
+
+#
+    untyped
+    type.typename <module-uri:StringId> <name:StringId> <super-type:TypeId> <storage-type:TypeId> <memoized-value:Any> ...
+    OK type.storage.integer <bitcount:i32> (negative bitcount: signed integer)
+    OK type.storage.real <bitcount:u32>
+    type.storage.pointer <flags:u32> <storage-class:StringId>
+    type.storage.array <element-type:TypeId> <size:u64>
+    type.storage.vector <element-type:TypeId> <size:u64>
+    type.storage.tuple [<element-type:TypeId> ...]
+    type.function <return-tuple-type:TypeId> <arguments-tuple-type:TypeId>
+    type.qualify <type:TypeId> <sorted-qualifier:TypeId> ...
+
+    subsequently, following builtin typenames are defined:
+
+    type.typename "builtin" "Nothing" untyped (type.storage.tuple)
+    type.typename "builtin" "Id" untyped (type.storage.integer 32)
+    type.typename "builtin" "Type" untyped (type.storage.integer 32)
+    type.typename "builtin" "Any" untyped (type.storage.tuple Type Id)
+    type.typename "builtin" "String" untyped (type.storage.integer 32)
+    type.typename "builtin" "Symbol" untyped (type.storage.integer 32)
+
+    when a type is defined
+
+
+#
+    types:
+
+    bool
+    i32
+    f32
+    tuple T ...
+    vector T size
+    function <tuple-type> <- <tuple-type>
+
+
+
+
+#fn decode-schemastr (s ofs)
+    returning type i32
+    if (ofs > (countof s))
+        error "schemastr is empty"
+    c := s @ ofs
+    nextofs := ofs + 1
+    switch c
+    case (char "b") (_ bool nextofs)
+    case (char "c") (_ i8 nextofs)
+    case (char "h") (_ i16 nextofs)
+    case (char "i") (_ i32 nextofs)
+    case (char "l") (_ i64 nextofs)
+    case (char "C") (_ u8 nextofs)
+    case (char "H") (_ u16 nextofs)
+    case (char "I") (_ u32 nextofs)
+    case (char "L") (_ u64 nextofs)
+    case (char "f") (_ f32 nextofs)
+    case (char "d") (_ f64 nextofs)
+    case (char "p")
+        let T nextofs = (this-function s nextofs)
+        _ (pointer.type T) nextofs
+    case (char "(")
+        local types : (Array type)
+        loop (ofs = nextofs)
+            c := s @ ofs
+            switch c
+            case (char ")")
+                let firstval = (reftoptr (types @ 0))
+                break (sc_tuple_type ((countof types) as i32) firstval) (ofs + 1)
+            default
+                let T nextofs = (this-function s ofs)
+                assert (nextofs != ofs)
+                'append types T
+                repeat nextofs
+    default
+        error
+            .. "can't parse schemastr: " (repr s)
+
+#fn... from-schemastr (s)
+    let T c = (decode-schemastr s 0)
+    assert (c == (countof s))
+    T
+
+
+#fn encode-schemastr (stack T)
+    returning string
+    T := ('storageof T)
+    for i elem in (enumerate ('reverse stack))
+        if (elem == T)
+            if (i > 9)
+                error
+                    .. "recursion limit reached (" (repr i) ")"
+            return
+                hex i
+    kind := ('kind T)
+    let parent = this-function
+    inline array-like-type (open-token close-token)
+        let size = ('element-count T)
+        .. open-token
+            parent stack ('element@ T 0)
+            hex size
+            close-token
+    switch kind
+    case type-kind-tuple
+        'append stack T
+        let size = ('element-count T)
+        ..
+            fold (s = "(") for i in (range size)
+                elem := ('element@ T i)
+                .. s (this-function stack elem)
+            ")"
+    case type-kind-array
+        array-like-type "[" "]"
+    case type-kind-vector
+        array-like-type "<" ">"
+    case type-kind-integer
+        width := ('bitcount T)
+        signed := ('signed? T)
+        switch width
+        case 1 "b"
+        case 8 (? signed "c" "C")
+        case 16 (? signed "h" "H")
+        case 32 (? signed "i" "I")
+        case 64 (? signed "l" "L")
+        default
+            error
+                .. "can't handle integer bitcount: " (repr width)
+    case type-kind-real
+        width := ('bitcount T)
+        switch width
+        case 32 "f"
+        case 64 "d"
+        default
+            error
+                .. "can't handle real bitcount: " (repr width)
+    case type-kind-pointer
+        .. "p" (this-function stack ('element@ T 0))
+    default
+        error
+            .. "can't handle kind: " (repr kind)
+
+#fn schemastr (T)
+    local stack : (Array type)
+    encode-schemastr stack T
+
 do
-    local module : UModule
     let s = "Rosetta code"
     local k = (tupleof 1 2 3)
     let addr =