M lib/tukan/SHA1.sc +9 -7
@@ 178,6 178,14 @@ struct SHA1 plain
& ((bitcast &self.wbuf (mutable rawstring)) @ pos)
& (data @ sp)
len
+ case (self : (mutable &this-type), data : rawstring, len : usize)
+ # process in 4GB chunks
+ loop (len = len)
+ if (len == 0:usize)
+ break;
+ let sz = (min len 0xffffffff:usize)
+ this-function self data (sz as u32)
+ len - sz
inline... digest
case (self : (mutable &this-type),)
@@ 213,13 221,7 @@ case (data : rawstring, len : u32)
'digest sha
case (data : rawstring, len : usize)
local sha : SHA1
- # process in 4GB chunks
- loop (len = len)
- if (len == 0:usize)
- break;
- let sz = (min len 0xffffffff:usize)
- 'hash sha data (sz as u32)
- len - sz
+ 'hash sha data len
'digest sha
case (data : string,)
this-function data ((countof data) as u32)
A => lib/tukan/ustore.sc +227 -0
@@ 0,0 1,227 @@
+""""UStore
+ ======
+
+ The UStore module provides the memory interface to Tukan. At the fundamental
+ level it can be used to store and retrieve information to/from the universe.
+
+using import struct
+using import enum
+using import Map
+using import Array
+using import .SHA1
+
+# declare void @llvm.memcpy.p0i8.p0i8.i64(i8* <dest>, i8* <src>,
+ i64 <len>, i1 <isvolatile>)
+let llvm.memcpy.p0i8.p0i8.i64 =
+ extern 'llvm.memcpy.p0i8.p0i8.i64
+ function void (mutable rawstring) rawstring i64 bool
+
+enum UError
+ SegmentationFault
+
+type UPointer #< integer
+ Hasher := SHA1
+ DigestType := Hasher.DigestType
+ Bitcount := 32 * 8
+ DigestOffset := Bitcount - (sizeof DigestType) * 8
+ NullBitOffset := DigestOffset - 1
+
+ inline... to (cls, data : voidstar, size : usize)
+ local result : (storageof cls)
+ local sha : Hasher
+ 'hash sha (data as rawstring) size
+ 'digest sha (@ (bitcast (& result) (mutable @DigestType)))
+ as
+ ((result << 1) | 1) << (DigestOffset - 1)
+ cls
+
+ @@ memo
+ inline new-type (T)
+ static-assert ((typeof T) == type)
+ type (.. "(UPointer " (tostring T) ")") < this-type : (integer Bitcount)
+ ElementType := T
+ PointerType := (pointer ElementType)
+
+ inline __typecall (cls ...)
+ static-if (cls == this-type)
+ new-type ...
+ else
+ nullof cls
+
+ unlet new-type
+
+ inline __hash (self)
+ ((storagecast self) >> DigestOffset) as u64
+
+ fn null? (self)
+ self == (nullof (typeof self))
+
+ fn __tobool (self)
+ not (null? self)
+
+ fn __repr (self)
+ if (null? self) "@null"
+ else
+ value := (storagecast self)
+ size := ((sizeof value) as i32)
+ .. "@"
+ ..
+ va-map
+ inline (i)
+ i := size - 1 - i
+ let e1 e0 =
+ ((value >> (i * 8)) as u8) & 0xf
+ ((value >> (i * 8 + 4)) as u8) & 0xf
+ ..
+ hex e0
+ hex e1
+ va-range size
+ ":"
+ repr (qualifiersof self)
+
+ @@ memo
+ inline __== (cls T)
+ static-if (cls == T)
+ inline (a b)
+ (storagecast a) == (storagecast b)
+
+ @@ memo
+ inline __ras (T cls)
+ static-if (T == (storageof cls))
+ inline (self)
+ bitcast self cls
+
+ @@ memo
+ inline __imply (cls T)
+ static-if ((T < this-type) and (imply? cls.PointerType T.PointerType))
+ inline (self)
+ bitcast self T
+
+let uvoidstar = (UPointer void)
+
+struct UMemory plain
+ ptr : voidstar
+ size : usize
+
+ @@ memo
+ inline __rimply (T cls)
+ static-if (T == string)
+ inline (self)
+ cls (self as rawstring) (countof self)
+
+ @@ memo
+ inline __as (T cls)
+ static-if (cls == string)
+ inline (self)
+ string (self.ptr as rawstring) self.size
+
+ fn __repr (self)
+ .. "<UMemory @"
+ hex (ptrtoint self.ptr usize)
+ ":u8x"
+ dec self.size
+ ">"
+
+struct UStore # content addressable store abstraction
+ WordType := u64
+ WordTypeSize := (sizeof WordType)
+
+ # address to offset into memory
+ map : (Map uvoidstar UMemory)
+
+ fn... store (self : &this-type, mem : UMemory)
+ let data size = mem.ptr mem.size
+ let addr = ('to uvoidstar data size)
+ try
+ 'get self.map addr
+ ;
+ else
+ numblocks := ((size + WordTypeSize - 1) // WordTypeSize)
+ let ptr = (malloc-array WordType numblocks)
+ #'append-slots self.memory numblocks
+ #'emplace-append-many self.memory numblocks 0xdeadbeef:u64
+ for i in (range numblocks)
+ ptr @ i = 0xdeadbeefedc0ffee:u64
+ #ptr := (& (self.memory @ offset))
+ llvm.memcpy.p0i8.p0i8.i64
+ ptr as (mutable rawstring)
+ data as rawstring
+ size as i64
+ false
+ 'set self.map addr
+ UMemory
+ ptr = ptr
+ size = size
+ addr
+
+ fn... load (self : &this-type, addr : (typematch T < UPointer))
+ try
+ 'get self.map addr
+ else
+ raise (UError.SegmentationFault)
+
+global g_ustore : UStore
+
+inline... uload (uptr : uvoidstar)
+ 'load g_ustore uptr
+
+inline... ustore (mem : UMemory)
+ 'store g_ustore mem
+
+type+ UPointer
+ fn __toref (self)
+ let T = (typeof self)
+ let mem = ('load g_ustore self)
+ @ (mem.ptr as T.PointerType)
+
+ fn __countof (self)
+ let T = (typeof self)
+ let mem = ('load g_ustore self)
+ (deref mem.size) // (sizeof T.ElementType)
+
+ @@ memo
+ inline __as (cls T)
+ static-if ((T < this-type) and (as? cls.PointerType T.PointerType))
+ inline (self)
+ bitcast self T
+ elseif ((cls.ElementType == i8) and (T == string))
+ inline (self)
+ (uload self) as string
+
+inline... u&
+case (str : string)
+ as
+ 'store g_ustore str
+ UPointer i8
+case (data)
+ let sz = (sizeof data)
+ let data =
+ static-if (&? data) data
+ else
+ local data = data
+ as
+ 'store g_ustore
+ UMemory &data sz
+ UPointer (typeof data)
+
+if main-module?
+ let ptr = (u& 36)
+ report ptr
+ try (countof ptr)
+ else (unreachable)
+ report
+ try (@ ptr)
+ else (unreachable)
+ let s = "The quick brown fox jumps over the lazy dog"
+ let ptr = (u& s)
+ report
+ try (as ptr string)
+ else (unreachable)
+ countof s
+ try (countof ptr)
+ else (unreachable)
+
+do
+ let UMemory UPointer uvoidstar UError
+ let uload ustore u&
+ locals;
No newline at end of file
M testing/test_typeschema2.sc +353 -300
@@ 16,123 16,8 @@ using import enum
using import Map
using import Array
-# declare void @llvm.memcpy.p0i8.p0i8.i64(i8* <dest>, i8* <src>,
- i64 <len>, i1 <isvolatile>)
-let llvm.memcpy.p0i8.p0i8.i64 =
- extern 'llvm.memcpy.p0i8.p0i8.i64
- function void (mutable rawstring) rawstring i64 bool
-
import ..lib.tukan.use
-using import tukan.SHA256
-
-struct UPointer plain
- digest : SHA224.DigestType
- head : i32
-
- inline... to (data : voidstar, size : usize)
- local sha : SHA224
- 'hash sha (data as rawstring) size
- local result : this-type
- result.head = -1
- 'digest sha result.digest
- result
-
- inline __hash (self)
- as
- bor
- (self.digest @ 0) as u64
- ((self.digest @ 1) as u64) << 32
- hash
-
- fn __repr (self)
- local content = self.digest
- .. "@"
- sha224-digest-string content
-
- @@ memo
- inline __== (cls T)
- static-if (cls == T)
- inline (a b)
- (storagecast a) == (storagecast b)
-
- @@ memo
- inline __imply (cls T)
- static-if (T == (storageof cls))
- storagecast
-
- @@ memo
- inline __rimply (T cls)
- static-if (T == (storageof cls))
- inline (self)
- bitcast self cls
-
-struct UBlob plain
- size : usize
- offset : usize
-
- fn __repr (self)
- .. "<UBlob["
- dec self.size
- "] @ "
- dec self.offset
- ">"
-
-struct UStore # content addressable store abstraction
- let ChunkType = u64
- let ChunkTypeSize = (sizeof ChunkType)
-
- # root address
- root : UPointer = (undef UPointer)
- # address to offset into memory
- map : (Map UPointer UBlob)
- # memory blob
- memory : (Array ChunkType)
-
- fn... insert
- case (self, data : voidstar, size : usize)
- let addr = (UPointer.to data size)
- try
- let blob = ('get self.map addr)
- _ addr (copy blob)
- else
- let offset = (countof self.memory)
- numblocks := ((size + ChunkTypeSize - 1) // ChunkTypeSize)
- #'append-slots self.memory numblocks
- #'emplace-append-many self.memory numblocks 0xdeadbeef:u64
- for i in (range numblocks)
- 'append self.memory 0xdeadbeef:u64
- ptr := (& (self.memory @ offset))
- llvm.memcpy.p0i8.p0i8.i64
- ptr as (mutable rawstring)
- data as rawstring
- size as i64
- false
- let blob =
- UBlob
- size = size
- offset = offset
- 'set self.map addr blob
- #do
- ptr := (& (self.memory @ offset))
- let revaddr = (UPointer.to ptr size)
- #assert (addr == revaddr)
- _ 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)
-
- inline... @ (self, addr : UPointer, T : type)
- blob := ('get self.map addr)
- ptr := (& (self.memory @ blob.offset))
- @ (ptr as @T)
-
-global module : UStore
+using import tukan.ustore
#
types are schemas which specify the layout of the specified memory as well as
@@ 149,114 34,401 @@ enum TypeKind : u8
Qualify = 7
Typename = 8
-inline intern-string (s)
- let addr = ('insert module s)
- global interned-string = addr
+inline... intern-string (s : string)
+ global interned-string = (u& s)
interned-string
-print
- UPointer.to ("The quick brown fox jumps over the lazy dog" as rawstring) 0
-
inline verify-sizeof (size)
inline (T)
#static-assert ((alignof T) == 8)
.. "(alignof " (tostring T) ") != 8"
static-assert ((sizeof T) == size)
- .. "(sizeof " (tostring T) ") == "
+ .. "(sizeof " (tostring T) ") == "
\ (tostring (sizeof T)) " != " (tostring size)
T
+@@ verify-sizeof 1
+struct Type plain
+ kind : TypeKind
+
+let u&Type = (UPointer Type)
+
@@ verify-sizeof 16
struct NumberType plain
kind : TypeKind
bitcount : i64
-fn... number-type (kind : TypeKind, bitcount : i32,)
- _
- 'insert module
- NumberType kind bitcount
- ;
+ @@ memo
+ inline __pointer-imply? (cls T)
+ (elementof T) == Type
inline integer-type (bitcount)
- number-type TypeKind.Integer bitcount
+ u& (NumberType TypeKind.Integer bitcount)
inline real-type (bitcount)
- number-type TypeKind.Real bitcount
+ u& (NumberType TypeKind.Real bitcount)
-inline bitcountof (T)
- try
- let ptr = ('@ module T NumberType)
- deref ptr.bitcount
- else 0:i64
+inline... bitcountof (T : (UPointer NumberType))
+ deref ((@ T) . bitcount)
global i32-type = (integer-type 32)
global u32-type = (integer-type 32)
global float-type = (real-type 32)
-@@ verify-sizeof 36
+@@ verify-sizeof 40
struct UPointerType plain
kind : TypeKind
- element : UPointer
+ element : u&Type
-fn... pointer-type (element : UPointer,)
- _
- 'insert module
- UPointerType TypeKind.Ref256 element
- ;
+fn... pointer-type (element : u&Type,)
+ u& (UPointerType TypeKind.Ref256 element)
@@ verify-sizeof 48
struct ArrayType plain
kind : TypeKind
- element : UPointer
+ element : u&Type
count : u64
-fn... array-type (element : UPointer, count : u64)
- _
- 'insert module
- ArrayType TypeKind.Array element count
- ;
+fn... array-type (element : u&Type, count : u64)
+ u& (ArrayType TypeKind.Array element count)
-let MaxNodes = 8
-struct UPTreeHeader plain
- count : u64
- root : UPointer
- tail : UPointer
+let IndexBits = 2
+let MaxNodes = (1 << IndexBits)
+let IndexMask = ((1 << IndexBits) - 1)
+fn tree-levels (count)
+ let numnodes = ((count + MaxNodes - 1) // MaxNodes)
+ ? (numnodes == 0) 0
+ (findmsb numnodes) + 1
-struct UPTreeNode plain
- nodes : (array UPointer MaxNodes)
+struct UNode plain
+ level : u32 = 0
+ nodes : (array (UPointer this-type) MaxNodes)
-fn empty-uptree ()
- _
- 'insert module
- UPTreeHeader 0 (nullof UPointer) (nullof UPointer)
- ;
-
-global empty-uptree = (empty-uptree)
-
-fn insert-uptree (header element...)
- 'insert module
- UPTreeNode
+type ULeaf < CStruct
+ @@ memo
+ inline __ras (T cls)
+ static-if ((&? T) & ((unqualified T) == UNode))
+ inline (self)
+ @ (bitcast &self @cls)
-print empty-uptree
+type UVector < CStruct
+ fn __countof (self)
+ deref self.count
+
+ #fn append (self value)
+ cls := (typeof self)
+ count := (deref self.count)
+ newcount := count + 1
+ if (newcount == 1)
+ local leaf = (cls.LeafType)
+ leaf.nodes @ 0 = value
+ cls
+ count = newcount
+ root = ((u& leaf) as cls.NodePointerType)
+ elseif (newcount <= MaxNodes)
+ local leaf = (@ (self.root as cls.LeafPointerType))
+ leaf.nodes @ count = value
+ cls
+ count = newcount
+ root = ((u& leaf) as cls.NodePointerType)
+ else self
+
+ fn... append (self, value)
+ let cls = (typeof self)
+ let index = (deref self.count)
+ let depth =
+ if (index == 0) 0:u64
+ else
+ ((findmsb index) + IndexBits - 1) // IndexBits
+ local stack : (Array (tuple u64 (UPointer UNode)))
+ let leaf slot =
+ loop (depth key shift = depth (deref self.root) (depth * IndexBits))
+ slot := (index >> shift) & IndexMask
+ if (not key)
+ break (cls.LeafType) slot
+ node := (@ key)
+ if (node.level == 0)
+ node := node as cls.LeafType
+ break (deref node) slot
+ else
+ 'append stack (tupleof slot key)
+ _
+ depth - 1
+ deref (node.nodes @ slot)
+ shift - IndexBits
+ local leaf = leaf
+ leaf.nodes @ slot = value
+ let root =
+ fold (key = ((u& leaf) as cls.NodePointerType)) for src in ('reverse stack)
+ let slot src = (unpack src)
+ dump (qualifiersof (deref src))
+ node := (@ (deref src))
+ node.nodes @ slot = key
+ u& node
+ print root
+ self
+
+ fn... indexof (self, index : u64)
+ let cls = (typeof self)
+ assert (index < self.count)
+ #local stack : (Array cls.NodePointerType)
+ loop (node index = (deref self.root) index)
+ node := (@ node)
+ slot := index & IndexMask
+ if (node.level == 0)
+ node := node as cls.LeafType
+ break
+ node.nodes @ slot
+ else
+ _
+ deref (node.nodes @ slot)
+ index >> IndexBits
-print
- integer-type 32
- bitcountof
- integer-type 32
-print
- pointer-type
- integer-type 32
+ fn print (self)
+ let cls = (typeof self)
+ fn print-node (level node maxcount count)
+ returning void
+ let node =
+ try (@ node)
+ else
+ return;
+ let delta =
+ fold (s = "") for i in (range level)
+ .. s " "
+ if (node.level == 0) # leaf
+ node := node as cls.LeafType
+ for node in node.nodes
+ print (.. delta (repr node))
+ count += 1
+ if (count == maxcount)
+ break;
+ else
+ for node in node.nodes
+ this-function (level + 1) node maxcount count
+ local count = 0
+ print-node 0 self.root (deref self.count) count
+
+@@ memo
+inline UVector (ElementType)
+ let Leaf =
+ struct (.. "<ULeaf " (tostring ElementType) ">") < ULeaf
+ PointerType := (UPointer ElementType)
+
+ level : u32 = 0
+ nodes : (array ElementType MaxNodes)
+
+ struct (.. "<UVector " (tostring ElementType) ">") < UVector
+ LeafType := Leaf
+ LeafPointerType := (UPointer Leaf)
+ NodePointerType := (UPointer UNode)
+
+ count : u64 = 0
+ root : NodePointerType
+
+do
+ let vec = ((UVector i32))
+ print (empty? vec)
+ let vec =
+ fold (vec = vec) for i in (range 10)
+ let vec =
+ try ('append vec i)
+ else
+ error "fuck"
+ 'print vec
+ print;
+ vec
+ #for i in (range (countof vec))
+ print ('indexof vec i)
+ ;
+
+#ElementType
+
+#for i in (range 65)
+ print i "->" (tree-levels i)
+
+run-stage;
+
+struct VM
+
+ # new map
+ fn empty ()
+
+ # setting a value to nothing deletes it
+ # we need a special key value to mean end-of-array / next-key
+ fn set (map kvpairs...)
+
+ fn get (map keypairs...)
+
+ fn switch (number ivpairs...)
+ fn select (value truevalue falsevalue)
-print
- i32-type
- bitcountof
+ fn add (a b)
+ fn sub (a b)
+ fn mul (a b)
+ fn div (a b)
+ fn rem (a b)
+ fn shl (a b)
+ fn shr (a b)
+ fn and (a b)
+ fn or (a b)
+ fn xor (a b)
+ fn trunc (x T)
+ fn zext (x T)
+ fn sext (x T)
+ fn icmp (a b)
+
+ fn fadd (a b)
+ fn fsub (a b)
+ fn fmul (a b)
+ fn fdiv (a b)
+ fn fneg (x)
+ fn frem (a b)
+ fn fptrunc (x T)
+ fn fpext (x T)
+ fn fcmp (a b)
+
+ fn fptoui (x T)
+ fn fptosi (x T)
+ fn uitofp (x T)
+ fn sitofp (x T)
+
+ fn bitcast (x T)
+
+ fn fold (structure function)
+ fn map (structure function)
+ fn filter (structure function)
+
+
+ #
+ iterators over maps specify search order
+ these need to be presupplied
+
+ to limit iterations, could we just specify a max iteration depth?
+ then we still have to deal with array iterations, which don't
+ necessarily have to be ordered.
+
+ we also need to be able to combine loops
+
+ as well as compose data
+
+
+ #
+ paths need a cons and decons function
+
+ decons is supposed to return two arguments
+
+
+
+
+#fn empty-uptree ()
+ u& (UPTreeHeader)
+
+#global empty-uptree = (empty-uptree)
+
+#fn insert-uptree (header element...)
+ u& (UPTreeNode
+
+#if 1
+ print empty-uptree
+
+ print
integer-type 32
-print
- real-type 32
+ bitcountof
+ integer-type 32
+ print
+ pointer-type
+ integer-type 32
+
+ print
+ i32-type
+ bitcountof
+ integer-type 32
+ print
+ real-type 32
+
+ print
+ array-type i32-type 16
+
+
+#
+ CAS heap alloc:
+
+ insertvalue <composite>
+ <index or key> <value>
+ <index or key> <value>
+ ...
+
+ extractvalue <composite> <index or key> ...
+
+ for big values, can allocate memory on the heap
+
+ abstract type
+
+ integer
+ float
+ composite
+ (unsized) array
+ arrays can not contain composites
+ tuple
+ max number of members in a tuple is 128
+ tuples can not contain composites
+
+ the current state of the system is perfectly summed up by a single
+ pointer address
-print
- array-type i32-type 16
+ however we need to think about optimal representation of data:
+ * in registers
+ * on the stack
+ * on the heap
+ * on disk
+ * on the network
+
+ conceptually each register can hold one value
+ which references other values - on the stack and on the heap
+ in principle we can use machine pointers here to save memory and
+ processing time, but once data is translated to disk or to the network,
+ we need to use content-addressing.
+
+ similarly, when network/disk data is loaded, content must be assigned to
+ directly addressable heap pointers.
+
+ on disk, we can in principle clean garbage by garbage collection, knowing
+ the currently valid state. but one has to be careful about data pruning.
+
+ in memory, we also need to handle the memory limit, keep track of what data
+ needs to be kept alive. though a LRU caching principle might be simpler here;
+ once the pool hits capacity, we first eject LRU data already serialized to
+ disk, followed by LRU data not yet serialized, which is serialized before
+ it is ejected (this is similar to swapping).
+
+ however in order to avoid swap-out, it could also be useful to collect the
+ LRU cache, or even deliberately drop pages. we could tag data with an
+ expiration date. we could also specify that data first lives in a short
+ term cache, and only moves to long term LRU when it is referenced at least
+ once.
+
+ but we could do all this precise too, refcount each chunk exactly, and
+ recursively delete memory as soon as we're decreasing the reference on an
+ object.
+
+ maybe it would be good to have both?
+
+ do we need more than one LRU cache? if we only have one, it must be
+ threadsafe.
+
+ a LRU cache needs a ringbuffer
+
+ *** Cheney on the MTA ***
+
+ as we build data, we run continuations. the data is conceptually first built
+ in registers, then moves to the stack.
+
+ each thread could also pre-allocate its own custom stack
+
+
+
+
#
untyped
@@ 295,124 467,5 @@ print
-#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
- let s = "Rosetta code"
- local k = (tupleof 1 2 3)
- let addr =
- 'insert module k
- let blob =
- try
- 'get module addr
- else
- error "invalid access"
- let ptr = ('@ module blob (tuple i32 i32 i32))
- print ptr
- ;
-
-
-;
No newline at end of file
A => testing/test_unrecurse.sc +83 -0
@@ 0,0 1,83 @@
+fn transform-value (x)
+ x := x as i32 + 1
+ `x
+
+# method 1: implicit stack
+
+fn process (values)
+ returning (typeof values)
+ if (empty? values) values
+ else
+ let value values = (decons values)
+ cons (transform-value value)
+ this-function values
+
+print
+ process '(1 2 3 4)
+
+# method 2: explicit stack + 2 loops
+
+using import Array
+
+fn process (values)
+ local stack : (Array list)
+ let values =
+ loop (values = values)
+ if (empty? values)
+ break values
+ else
+ 'append stack values
+ repeat ('next values)
+ loop (result = values)
+ if (empty? stack)
+ break result
+ else
+ let values = ('pop stack)
+ let value = ('@ values)
+ cons
+ transform-value value
+ result
+
+print
+ process '(1 2 3 4)
+
+
+# method 3: using restack abstraction
+
+using import itertools
+
+inline restack (src f init...)
+ let start valid at next = ((src as Generator))
+ let it... = (start)
+ if (valid it...)
+ let at... = (at it...)
+ local stack : (Array (tuple (va-map qualifiersof at...)))
+ 'append stack (tupleof at...)
+ loop (it... = (next it...))
+ if (valid it...)
+ 'append stack (tupleof (at it...))
+ repeat (next it...)
+ else
+ break;
+ fold (result... = init...) for value in ('reverse stack)
+ (f (unpack value)) result...
+ else
+ init...
+
+fn process (values)
+ restack
+ # generator to be unrolled to stack
+ imap values
+ transform-value
+ # currying fold function
+ inline (value)
+ inline (result)
+ cons value result
+ # init values for fold
+ '()
+
+print
+ process '(1 2 3 4)
+
+
+;