@@ 1,5 1,6 @@
using import struct
+using import enum
typedef FILE
let
@@ 32,6 33,18 @@ struct File
super-type.__typecall this-type
_handle = handle
+ inline tell (self)
+ ftell self._handle
+
+ inline seek (self set at end)
+ fseek self._handle
+ static-if (not (none? set))
+ _ set SEEK_SET
+ elseif (not (none? end))
+ _ end SEEK_END
+ else
+ _ at SEEK_CUR
+
inline error? (self)
ferror self._handle
@@ 1,6 1,7 @@
using import struct
using import enum
using import Map
+using import Set
using import Array
using import String
using import Rc
@@ 10,6 11,15 @@ using import tukan.libbf
using import tukan.thread
using import tukan.SHA256
+# features:
+ * six value types: none, bool, bigfloat, string, symbol, map
+ * a pure functional evaluator without mutation, recursion or other side effects
+ * GC free, refcount based memory management
+ * any value can be used as a key in a map
+
+ in progress:
+ * pickle/unpickle
+
let u256 = (integer 256)
###############################################################################
@@ 70,6 80,8 @@ type Number :: (storageof bf_t)
bf_set_si self value
case (self, value : real)
bf_set_float64 self value
+ case (self, value : &bf_t)
+ bf_set self &value
case (self, value : this-type)
bf_set self value
@@ 80,17 92,42 @@ type Number :: (storageof bf_t)
set self ...
self
+ @@ memo
+ inline writer (f)
+ fn write (self ...)
+ viewing self
+ let self = (bitcast self bf_t)
+ va-map
+ inline (name)
+ let member = (getattr self name)
+ f (&member as rawstring) (sizeof member) ...
+ \ 'sign 'expn 'len
+ f (self.tab as rawstring) ((sizeof (self.tab @ 0)) * self.len) ...
+
+ @@ memo
+ inline reader (f)
+ fn read (...)
+ local source : bf_t
+ va-map
+ inline (name)
+ let member = (getattr source name)
+ f (&member as rawstring) (sizeof member) ...
+ \ 'sign 'expn 'len
+ let limbT = (typeof (source.tab @ 0))
+ source.tab = (alloca-array limbT source.len)
+ f (source.tab as rawstring) ((sizeof limbT) * source.len) ...
+ this-type source
+
+ let sha-writer =
+ writer
+ inline (data size sha)
+ 'hash sha data size
+
fn uhash (self)
viewing self
local digest : SHA256.DigestType
local sha : SHA256
- let self = (bitcast self bf_t)
- va-map
- inline (name)
- let member = (getattr self name)
- 'hash sha (&member as rawstring) (sizeof member)
- \ 'sign 'expn 'len
- 'hash sha (self.tab as rawstring) ((sizeof (self.tab @ 0)) * self.len)
+ sha-writer self sha
'digest sha digest
digest
@@ 255,18 292,52 @@ struct TableLimb
cells : (array UAtom ArrayCellCount)
mask : u64 = 0 # slots used
- fn... uhash (self)
+ @@ memo
+ inline writer (f)
+ fn write (self ...)
+ viewing self
+ local celldigest : SHA256.DigestType
+ va-map
+ inline (i)
+ celldigest = ('uhash (self.cells @ i))
+ f (&celldigest as rawstring) (sizeof celldigest) ...
+ va-range ArrayCellCount
+ local mask = self.mask
+ f (&mask as rawstring) (sizeof mask) ...
+
+ @@ memo
+ inline reader (f)
+ fn read (cache ...)
+ local celldigest : SHA256.DigestType
+ local limb : this-type
+ va-map
+ inline (i)
+ #celldigest = ('uhash (self.cells @ i))
+ f (&celldigest as rawstring) (sizeof celldigest) ...
+ limb.cells @ i =
+ do
+ try
+ copy
+ 'get cache celldigest
+ else
+ report "TableLimb cell missing:"
+ sha256-digest-string celldigest
+ \ "(" (UAtom.kind-from-digest celldigest) ")"
+ UAtom;
+ va-range ArrayCellCount
+ f (&limb.mask as rawstring) (sizeof limb.mask) ...
+ limb
+
+ let sha-writer =
+ writer
+ inline (data size sha)
+ 'hash sha data size
+
+ fn uhash (self)
viewing self
local digest : SHA256.DigestType
local sha : SHA256
- local celldigest : SHA256.DigestType
- va-map
- inline (i)
- celldigest = ('uhash (self.cells @ i))
- 'hash sha (&celldigest as rawstring) (sizeof celldigest)
- va-range ArrayCellCount
- local mask = self.mask
- 'hash sha (&mask as rawstring) (sizeof mask)
+ sha-writer self sha
'digest sha digest
digest
@@ 295,18 366,53 @@ struct Table
ivalues = (copy self.ivalues)
depth = self.depth
+ @@ memo
+ inline writer (f)
+ fn write (self ...)
+ viewing self
+ local memberdigest : SHA256.DigestType
+ va-map
+ inline (name)
+ let member = (getattr self name)
+ memberdigest = ('uhash member)
+ f (&memberdigest as rawstring) (sizeof memberdigest) ...
+ \ 'meta 'keys 'values 'ivalues
+ local depth = self.depth
+ f (&depth as rawstring) (sizeof depth) ...
+
+ @@ memo
+ inline reader (f)
+ fn read (cache ...)
+ local memberdigest : SHA256.DigestType
+ local table : this-type
+ va-map
+ inline (name)
+ let member = (getattr table name)
+ f (&memberdigest as rawstring) (sizeof memberdigest) ...
+ member =
+ do
+ try
+ copy
+ 'get cache memberdigest
+ else
+ report "Table member missing"
+ sha256-digest-string memberdigest
+ \ "(" (UAtom.kind-from-digest memberdigest) ")"
+ UAtom;
+ \ 'meta 'keys 'values 'ivalues
+ f (&table.depth as rawstring) (sizeof table.depth) ...
+ table
+
+ let sha-writer =
+ writer
+ inline (data size sha)
+ 'hash sha data size
+
fn uhash (self)
viewing self
local digest : SHA256.DigestType
local sha : SHA256
- va-map
- inline (name)
- let member = (getattr self name)
- local memberdigest = ('uhash member)
- 'hash sha (&memberdigest as rawstring) (sizeof memberdigest)
- \ 'meta 'keys 'values 'ivalues
- local depth = self.depth
- 'hash sha (&depth as rawstring) (sizeof depth)
+ sha-writer self sha
'digest sha digest
digest
@@ 822,7 928,16 @@ type+ UAtom
case string
return (value as string as UAtom)
case Symbol
- return (value as Symbol as UAtom)
+ let sym = (value as Symbol)
+ switch sym
+ case 'none
+ return (UAtom)
+ case 'false
+ return (false as UAtom)
+ case 'true
+ return (true as UAtom)
+ default
+ return (sym as UAtom)
case Nothing
return (UAtom)
case bool
@@ 842,6 957,9 @@ type+ UAtom
inline __ras (T cls)
static-if (T == Value) from-value
+ fn kind-from-digest (digest)
+ (((digest @ 3) >> 60) & 0xf:u64) as i32 as Kind
+
fn uhash (self)
let ptr = (topointer self)
let kind = ('kind self)
@@ 871,11 989,20 @@ type+ UAtom
static-assert ((sizeof digest) == (sizeof u256))
@ (bitcast &digest @u256)
+ inline hash-from-digest (digest)
+ (digest @ 3) as u64 as hash
+
+ fn __hash (self)
+ hash-from-digest ('uhash self)
+
@@ memo
inline __== (cls T)
static-if (cls == T)
inline (self other)
('uhash self) == ('uhash other)
+ elseif (T == SHA256.DigestType)
+ inline (self other)
+ ('uhash self) == other
spice __dispatch (self handlers...)
let ptr = `(topointer self)
@@ 965,11 1092,16 @@ type+ UAtom
inline (index node str count)
if (count > 0)
'append str " "
+ let strval = (uatom-repr node)
if (count != index)
+ 'append str "(: "
'append str
default-styler style-number (tostring index)
- 'append str "="
- 'append str (uatom-repr node)
+ 'append str " "
+ 'append str strval
+ 'append str ")"
+ else
+ 'append str strval
count += 1
local count = 0
f table str count
@@ 978,9 1110,11 @@ type+ UAtom
inline (key value str count)
if (count > 0)
'append str " "
+ 'append str "(: "
'append str (uatom-repr key)
- 'append str "="
+ 'append str " "
'append str (uatom-repr value)
+ 'append str ")"
count += 1
f table str count
'append str ")"
@@ 1019,7 1153,11 @@ type+ UAtom
run-stage;
-###############################################################################
+sugar uquote (expr...)
+ qq [UAtom.from-value] ([sugar-quote] (unquote-splice expr...))
+
+# Evaluation
+################################################################################
let builtins global-env =
fold (scope env = (Scope) (Table)) for name in
@@ 1141,6 1279,134 @@ fn... ueval (env : UAtom, expr : UAtom)
default
return (copy expr)
+# Serialization
+################################################################################
+
+let filewriter =
+ inline (data size file)
+ let ok? = ('write file data size)
+ assert ok?
+
+let filereader =
+ inline (data size file)
+ let ok? = ('read file data size)
+ assert ok?
+
+fn... pickle1 (file, value : UAtom)
+ local digest : SHA256.DigestType = ('uhash value)
+ filewriter (&digest as rawstring) (sizeof digest) file
+
+ inline pickle-str (str)
+ let sz = (countof str)
+ local size : u64 = sz
+ filewriter (&size as rawstring) (sizeof size) file
+ filewriter (str as rawstring) sz file
+
+ dispatch value
+ case Number (num)
+ (Number.writer filewriter) num file
+ case String (str)
+ pickle-str str
+ case Symbol (str)
+ pickle-str str
+ case TableLimb (limb)
+ (TableLimb.writer filewriter) limb file
+ case Table (table)
+ (Table.writer filewriter) table file
+ default;
+
+fn unpickle1 (file cache)
+ local digest : SHA256.DigestType
+ filereader (&digest as rawstring) (sizeof digest) file
+
+ inline unpickle-str ()
+ local size : u64
+ filereader (&size as rawstring) (sizeof size) file
+ let sz = (deref size)
+ local str = (String sz)
+ 'resize str sz
+ filereader (str as rawstring) sz file
+ str
+
+ let kind = (UAtom.kind-from-digest digest)
+ let atom =
+ switch kind
+ case UAtom.Kind.None (UAtom)
+ case UAtom.Kind.False (UAtom false)
+ case UAtom.Kind.True (UAtom true)
+ case UAtom.Kind.Number
+ local num = ((Number.reader filereader) file)
+ UAtom num
+ case UAtom.Kind.String
+ UAtom (unpickle-str)
+ case UAtom.Kind.Symbol
+ UAtom.wrap (UString (unpickle-str)) kind
+ case UAtom.Kind.TableLimb
+ UAtom ((TableLimb.reader filereader) cache file)
+ case UAtom.Kind.Table
+ UAtom ((Table.reader filereader) cache file)
+ default
+ assert false "unhandled atom kind"
+ unreachable;
+ assert (atom == digest)
+ atom
+
+fn... pickle (file, root : UAtom)
+ local done : (Set UAtom)
+ va-map
+ inline (value)
+ 'insert done value
+ UAtom;
+ UAtom false
+ UAtom true
+ fn recur (value ...)
+ let file done = ...
+ let recur = this-function
+ if ('in? done value)
+ return;
+ 'insert done (copy value)
+ assert ('in? done value)
+ dispatch value
+ case TableLimb (limb)
+ for value in limb.cells
+ recur value ...
+ case Table (table)
+ recur table.meta ...
+ recur table.ivalues ...
+ recur table.keys ...
+ recur table.values ...
+ default;
+ #report "pickling" ('tostring value)
+ pickle1 file value
+ ;
+ recur root file done
+
+fn unpickle (file)
+ let cur = ('tell file)
+ 'seek file (end = 0)
+ let size = ('tell file)
+ 'seek file cur
+ local cache :
+ Set UAtom
+ inline (value)
+ static-if ((typeof value) == SHA256.DigestType)
+ UAtom.hash-from-digest value
+ else
+ hash value
+ va-map
+ inline (value)
+ 'insert cache value
+ UAtom;
+ UAtom false
+ UAtom true
+ loop (root = (unpickle1 file cache))
+ #report "unpickled" ('tostring root)
+ 'insert cache (copy root)
+ if (('tell file) >= size)
+ break root
+ let atom = (unpickle1 file cache)
+ atom
+
###############################################################################
#fn from-value (value)
@@ 1157,12 1423,8 @@ fn testfunc ()
#print ("test" as UAtom)
let expr =
- sugar-quote
- test "test" 1 2 3 (a b c) [d e] 3.5 (: (1 2 3) (4 5 6))
- print 1
- let expr =
- UAtom.from-value expr
- print 2
+ uquote
+ test "test" 1 2 3 (a b c) (: 10 true) (: d e) 3.5 (: (1 2 3) (4 5 6))
print
'tostring expr
let tab = (expr as Table)
@@ 1170,26 1432,57 @@ fn testfunc ()
'get tab (Table.new 1 2 3)
;
+ let expr =
+ uquote
+ let
+ : a 2
+ : b 2.5
+ : c 4
+ : make-seq
+ fn (f1 f2)
+ fn (x y z)
+ f2 (f1 x y) z
+ : pow2
+ fn (x)
+ * x x
+ let
+ : muladd (make-seq * +)
+ muladd (pow2 c) b a
+
+ using import tukan.File
+ let testfilepath =
+ .. module-dir "/test.uvm"
+ do
+ let testfile =
+ try (File.open testfilepath "wb")
+ else
+ error
+ .. "creating " testfilepath " failed"
+ pickle testfile expr
+ let expr2 =
+ do
+ let testfile =
+ try (File.open testfilepath "rb")
+ else
+ error
+ .. "opening " testfilepath " failed"
+ unpickle testfile
+
+ let env = (global-environment)
+ let result1 result2 =
+ ueval env expr
+ ueval env expr2
print
- 'tostring
- ueval
- global-environment;
- UAtom.from-value
- sugar-quote
- let
- : a 2
- : b 2.5
- : c 4
- : make-seq
- fn (f1 f2)
- fn (x y z)
- f2 (f1 x y) z
- : pow2
- fn (x)
- * x x
- let
- : muladd (make-seq * +)
- muladd (pow2 c) b a
+ 'tostring expr
+ print
+ 'tostring result1
+ print
+ 'tostring expr2
+ print
+ 'tostring result2
+ assert (expr == expr2)
+ assert (result1 == result2)
+
#
print