58d895b38a60 — Leonard Ritter 25 days ago
* nodelang test
1 files changed, 284 insertions(+), 0 deletions(-)

A => testing/test_nodelang.sc
A => testing/test_nodelang.sc +284 -0
@@ 0,0 1,284 @@ 
+
+
+using import struct
+using import Map
+using import Set
+using import Array
+using import UTF-8
+
+#sugar node (name args...)
+
+    local inargs : (Array Value)
+
+    let outargs body =
+        loop (args = args...)
+            sugar-match args
+            case ('=> (params...) body...)
+                break params... body...
+            case ((name as Symbol) args...)
+                'append inargs name
+                repeat args...
+            default
+                error@ ('first-anchor args) "while expanding syntax"
+                    "syntax error: symbol or `=> (...)` expected"
+
+    loop (body = body)
+        if (empty? body)
+            break;
+        let expr rest... = (decons body)
+        local sources : (Array Value)
+        let isdef? sinks =
+            loop (args = expr)
+                sugar-match args
+                case (':=> params...)
+                    break true params...
+                case ('=> params...)
+                    break false params...
+                case ((name as Symbol) args...)
+                    'append sources name
+                    repeat args...
+                default
+                    error@ ('first-anchor args) "while expanding syntax"
+                        "syntax error: symbol or `=> (...)` expected"
+        print sources sinks
+        rest...
+
+    print inargs
+    print outargs
+    print body
+
+
+
+    '()
+
+type Node : voidstar
+
+type NodeAccessor
+
+type NodeIndex < NodeAccessor : (storageof Closure)
+    spice __repr (self)
+        let args = (sc_prove `([(bitcast (self as this-type) Closure)]))
+        let node index = ('getarg args 0) ('getarg args 1)
+        spice-quote
+            .. (repr node) "." (repr index)
+
+type NodeKey < NodeAccessor : (storageof Closure)
+    spice __repr (self)
+        let args = (sc_prove `([(bitcast (self as this-type) Closure)]))
+        let node key = ('getarg args 0) ('getarg args 1)
+        spice-quote
+            .. (repr node) "." (key as string)
+
+type+ Node
+    struct _Node
+        name : Symbol = unnamed
+        args : (Array Value)
+        keys : (Map Symbol Value)
+        cached : Value = `none
+
+        inline __drop (self)
+            print "Node dropped"
+            ;
+
+    inline __drop (self)
+        print "Node dropped"
+        ;
+
+    spice __getattr (self name)
+        name as:= Symbol
+        namestr := name as string
+        if ((countof namestr) == 1)
+            let index = (((namestr as rawstring) @ 0) as i32 - (char "0"))
+            if (index < 10)
+                return `(bitcast (inline "Node.index" () (_ self index)) NodeIndex)
+        return `(bitcast (inline "Node.key" () (_ self name)) NodeKey)
+
+    spice __repr (self)
+        let uself = (bitcast (self as Node) (mutable @_Node))
+        let self = (view uself)
+        defer (inline () (lose uself))
+        .. "<Node "
+            self.name as string
+            ">"
+
+    spice __typecall (cls name)
+        let self = (malloc _Node)
+        store (_Node) self
+        self.name = (name as Symbol)
+        'append self.args _
+        bitcast self Node
+
+    spice refresh (self)
+        if (not ('constant? self))
+            error@ ('anchor self) "while calling node" "constant expected"
+        # build expression
+        let uself = (bitcast (self as Node) (mutable @_Node))
+        let self = (view uself)
+        defer (inline () (lose uself))
+        self.cached = none
+        `()
+
+    spice __call (self)
+        if (not ('constant? self))
+            error@ ('anchor self) "while calling node" "constant expected"
+        # build expression
+        define func
+            let uself = (bitcast (self as Node) (mutable @_Node))
+            let self = (view uself)
+            defer (inline () (lose uself))
+            if (('typeof self.cached) == Nothing)
+                local finalargs : (Array Value)
+                'append finalargs (self.args @ 0)
+                for k v in self.keys
+                    'append finalargs (sc_keyed_new k v)
+                for i arg in (enumerate self.args)
+                    if (i == 0)
+                        continue;
+                    let arg = (copy arg)
+                    'append finalargs
+                        if (('typeof arg) == Node) `(arg)
+                        else arg
+                let args =
+                    sc_argument_list_map_new ((countof finalargs) as i32)
+                        inline (i)
+                            finalargs @ i
+                self.cached =
+                    spice-quote
+                        inline (self) (args)
+            copy self.cached
+        `(func)
+
+    spice connect (self arg)
+        if (not ('constant? self))
+            hide-traceback;
+            error@ ('anchor self) "while connecting edges" "constant expected"
+        let selfT = ('typeof self)
+        if (selfT == NodeKey)
+            let self = (bitcast (self as NodeKey) Closure)
+            let args = (sc_prove `(self))
+            let node = (bitcast (('getarg args 0) as Node) (mutable @_Node))
+            let key = (('getarg args 1) as Symbol)
+            if (key == unnamed)
+                'append node.args arg
+                return;
+            else
+                'set node.keys key arg
+        else
+            let node slot =
+                match selfT
+                case Node
+                    _ (bitcast (self as Node) (mutable @_Node)) 0
+                case NodeIndex
+                    let self = (bitcast (self as NodeIndex) Closure)
+                    let args = (sc_prove `(self))
+                    _ (bitcast (('getarg args 0) as Node) (mutable @_Node))
+                        ('getarg args 1) as i32
+                default
+                    hide-traceback;
+                    error@ ('anchor self) "while connecting edges" "node expected"
+            defer (inline () (lose node))
+            assert (slot >= 0)
+            while (slot >= (countof node.args))
+                'append node.args none
+            node.args @ slot = arg
+        ;
+
+inline connect (outvals invals...)
+    let outvals... = (outvals)
+    va-map
+        inline (target)
+            static-if (not (none? target))
+                va-map
+                    inline (inval...)
+                        #print "connecting" inval... "=>" target
+                        Node.connect target inval...
+                    invals...
+        outvals...
+    invals...
+
+inline newnode (name outvals...)
+    let node = (Node name)
+    connect (inline () outvals...) node
+    _ node (getattr node unnamed)
+
+sugar => (a b)
+    let a rest sugar-scope = (sc_expand a '() sugar-scope)
+    let b rest sugar-scope = (sc_expand b '() sugar-scope)
+    _ `(embed b (connect (inline () b) a)) next-expr sugar-scope
+
+sugar :=> (a b)
+    let orig = a
+    sugar join-symbols (x y)
+        let y =
+            if (('typeof y) == Symbol) y
+            else
+                let y rest scope = (sc_expand y '() sugar-scope)
+                y
+        `(_ x y)
+    let a rest =
+        if (('typeof a) == Symbol) a
+        else
+            _
+                sc_expand a '()
+                    'bind sugar-scope
+                        _ = join-symbols
+                ()
+    let b rest sugar-scope = (sc_expand b '() sugar-scope)
+    let result =
+        fold (result = '()) for name in ('args a)
+            let nameport = (Symbol (.. (name as Symbol as string) "."))
+            cons
+                list let name nameport '= (list newnode (list sugar-quote name) b)
+                result
+    return (cons embed ('reverse (cons orig result))) next-expr sugar-scope
+
+run-stage;
+
+define-infix< 40 :=>
+define-infix< 40 =>
+define-infix< 50 , _
+
+inline testfunc (x y ...)
+    print "testfunc called!" x y ...
+
+inline muladd (out)
+    + => B :=> out
+    a :=> B.
+    * => C :=> B.
+    b,c :=> C.
+    _ a. b. c.
+
+testfunc => A :=> ()
+"!" => A.1,A.2,A.3
+1,2,3 => A.
+4,5,6 => A.
+let a b c = (muladd A.)
+5 => a
+2 => b
+3 => c
+
+# prints `testfunc called! ! ! ! 1 2 3 4 5 6 11`
+print (A)
+
+
+
+#inline do_with_muladd (f a b c)
+    inline (X)
+        (_)
+
+
+
+#node do_with_muladd f a b c => (X)
+    f => X
+    Y :=> X.sum
+    + => Y
+    c => Y.3
+    Z :=> X.product Y.1
+    * => Z
+    a => Z.1
+    b => Z.2
+
+#do_with_muladd print 6 6 6 => main
+
+
+;
  No newline at end of file