5be07992b5d4 — Leonard Ritter 4 months ago
* check-in ccvm demo
1 files changed, 147 insertions(+), 0 deletions(-)

A => testing/ccvm_fib.sc
A => testing/ccvm_fib.sc +147 -0
@@ 0,0 1,147 @@ 
+using import struct
+using import enum
+using import String
+
+import ..lib.tukan.use
+using import tukan.uvm
+
+#
+    # fibonacci, head recursive
+    fn fib-rec (f n)
+        cond (< n 2) n
+            +
+                f f (- n 1)
+                f f (- n 2)
+    fib-rec fib-rec 10
+
+enum sym plain
+    fib
+    _1
+    _2
+    _3
+    _4
+    _5
+    _6
+    _7
+    _8
+    exit
+    <
+    -
+    +
+    cond
+
+global mt_closure : Atom =
+    Cell.new
+        type = "closure"
+
+fn... closure (target : sym, ctx : Atom)
+    Atom
+        'set-meta
+            Cell.new (Atom (target as integer)) (copy ctx)
+            copy mt_closure
+case (target : sym)
+    this-function target (Atom)
+
+#struct Instruction
+    cont : Atom       # function to continue with
+    return : Atom     # return function
+    monad : Atom      # global "mutable" environment
+    args : Atom       # arguments to function
+
+loop
+    cont ret monad args =
+        closure sym.fib
+        closure sym.exit
+        Cell;
+        Cell.new 10
+    let target = (('get-index (cont as Cell) 0) as Number as i32 as sym)
+    let ctx = ('get-index (cont as Cell) 1)
+    inline unpack-ctx (c)
+        ctx := (ctx as Cell)
+        va-map
+            inline (i)
+                'get-index ctx i
+            va-range c
+    inline unpack-args (c)
+        va-map
+            inline (i)
+                'get-index args i
+            va-range c
+    switch target
+    case sym.fib
+        let n = (unpack-args 1)
+        repeat (closure sym.<)
+            closure sym._1 (Cell.new (copy n) ret)
+            monad
+            Cell.new n 2
+    case sym._1
+        let n<2 = (unpack-args 1)
+        repeat (closure sym.cond)
+            closure sym._2
+            monad
+            Cell.new n<2
+                closure sym._3 ctx
+                closure sym._4 ctx
+    case sym._2
+        let f = (unpack-args 1)
+        repeat f (Atom) monad (Cell.new)
+    case sym._3
+        let n ret = (unpack-ctx 2)
+        repeat ret (Atom) monad (Cell.new n)
+    case sym._4
+        let n ret = (unpack-ctx 2)
+        repeat (closure sym.-)
+            closure sym._5 (Cell.new (copy n) ret)
+            monad
+            Cell.new n 1
+    case sym._5
+        let n ret = (unpack-ctx 2)
+        let n-1 = (unpack-args 1)
+        repeat (closure sym.-)
+            closure sym._6 (Cell.new n-1 ret)
+            monad
+            Cell.new n 2
+    case sym._6
+        let n-1 ret = (unpack-ctx 2)
+        let n-2 = (unpack-args 2)
+        repeat (closure sym.fib)
+            closure sym._7 (Cell.new n-2 ret)
+            monad
+            Cell.new n-1
+    case sym._7
+        let n-2 ret = (unpack-ctx 2)
+        let fib_n-1 = (unpack-args 1)
+        repeat (closure sym.fib)
+            closure sym._8 (Cell.new fib_n-1 ret)
+            monad
+            Cell.new n-2
+    case sym._8
+        let fib_n-1 ret = (unpack-ctx 2)
+        let fib_n-2 = (unpack-args 1)
+        repeat (closure sym.+) ret
+            monad
+            Cell.new fib_n-1 fib_n-2
+    case sym.<
+        let a b = (unpack-args 2)
+        repeat ret (Atom) monad (Cell.new ((a as Number) < (b as Number)))
+    case sym.+
+        let a b = (unpack-args 2)
+        repeat ret (Atom) monad (Cell.new ((a as Number) + (b as Number)))
+    case sym.-
+        let a b = (unpack-args 2)
+        repeat ret (Atom) monad (Cell.new ((a as Number) - (b as Number)))
+    case sym.cond
+        let c tf ef = (unpack-args 3)
+        repeat ret (Atom) monad
+            Cell.new
+                if (('kind c) == Atom.Kind.True) tf
+                else ef
+    case sym.exit
+        # print result and break
+        let x = (unpack-args 1)
+        print ('tostring x)
+        break;
+    default
+        error (.. "illegal instruction: " (repr target))
+
+;
  No newline at end of file