September 2017 Update

Task/Same-Fringe/Haskell/same-fringe.hs

@@ -1,24 +1,29 @@
-data Tree a = Leaf a | Node (Tree a) (Tree a)
-    deriving (Show, Eq)
+data Tree a
+  = Leaf a
+  | Node (Tree a)
+         (Tree a)
+  deriving (Show, Eq)
 
 fringe :: Tree a -> [a]
 fringe (Leaf x) = [x]
 fringe (Node n1 n2) = fringe n1 ++ fringe n2
 
-sameFringe :: (Eq a) => Tree a -> Tree a -> Bool
+sameFringe
+  :: (Eq a)
+  => Tree a -> Tree a -> Bool
 sameFringe t1 t2 = fringe t1 == fringe t2
 
+main :: IO ()
 main = do
-    let a = Node (Leaf 1) (Node (Leaf 2) (Node (Leaf 3) (Node (Leaf 4) (Leaf 5))))
-        b = Node (Leaf 1) (Node (Node (Leaf 2) (Leaf 3)) (Node (Leaf 4) (Leaf 5)))
-        c = Node (Node (Node (Node (Leaf 1) (Leaf 2)) (Leaf 3)) (Leaf 4)) (Leaf 5)
-    print $ sameFringe a a
-    print $ sameFringe a b
-    print $ sameFringe a c
-
-    let x = Node (Leaf 1) (Node (Leaf 2) (Node (Leaf 3) (Node (Leaf 4) (Node (Leaf 5) (Leaf 6)))))
-        y = Node (Leaf 0) (Node (Node (Leaf 2) (Leaf 3)) (Node (Leaf 4) (Leaf 5)))
-        z = Node (Leaf 1) (Node (Leaf 2) (Node (Node (Leaf 4) (Leaf 3)) (Leaf 5)))
-    print $ sameFringe a x
-    print $ sameFringe a y
-    print $ sameFringe a z
+  let a = Node (Leaf 1) (Node (Leaf 2) (Node (Leaf 3) (Node (Leaf 4) (Leaf 5))))
+      b = Node (Leaf 1) (Node (Node (Leaf 2) (Leaf 3)) (Node (Leaf 4) (Leaf 5)))
+      c = Node (Node (Node (Node (Leaf 1) (Leaf 2)) (Leaf 3)) (Leaf 4)) (Leaf 5)
+      x =
+        Node
+          (Leaf 1)
+          (Node
+             (Leaf 2)
+             (Node (Leaf 3) (Node (Leaf 4) (Node (Leaf 5) (Leaf 6)))))
+      y = Node (Leaf 0) (Node (Node (Leaf 2) (Leaf 3)) (Node (Leaf 4) (Leaf 5)))
+      z = Node (Leaf 1) (Node (Leaf 2) (Node (Node (Leaf 4) (Leaf 3)) (Leaf 5)))
+  mapM_ print $ sameFringe a <$> [a, b, c, x, y, z]

Task/Same-Fringe/Phix/same-fringe.phix

@@ -0,0 +1,79 @@
+--
+-- demo\rosetta\Same_Fringe.exw
+-- ============================
+--
+--  Requires 0.7.5 or later (implementation revealed that task_yield did not
+--                           have side effects of e_all properly set.)
+--
+constant tests = {{0,1,{0,2,0}},
+                  {{0,1,0},2,0},
+                  {{0,1,0},2,{0,3,0}},
+                 }
+
+sequence tasks
+integer res = 0
+sequence sdata = repeat(0,2)
+
+integer active_tasks
+integer show_details = 1
+
+procedure scan(sequence tree, integer level, integer tidx)
+object {left,data,right} = tree
+    if res=0 then
+        if left!=0 then scan(left,level+1,tidx) end if
+        sdata[tidx] = data
+        if show_details then
+            printf(1,"task[%d] sets sdata[%d] to ",tidx)
+            ?data
+        end if
+        if res=0 then
+            task_suspend(task_self())
+            task_yield()
+        end if
+        if right!=0 then scan(right,level+1,tidx) end if
+    end if
+    if level=1 then
+        if show_details then
+            printf(1,"task[%d] ends\n",tidx)
+        end if
+        active_tasks -= 1
+        tasks[tidx] = 0
+        sdata[tidx] = -1 -- (or use a separate flag)
+    end if
+end procedure
+
+?"started"
+procedure test(integer t1, integer t2)
+    tasks = {task_create(routine_id("scan"),{tests[t1],1,1}),
+             task_create(routine_id("scan"),{tests[t2],1,2})}
+    active_tasks = 2
+    res = 0
+    while active_tasks>0 do
+        if tasks[1] then
+            task_schedule(tasks[1],1)
+            task_yield()
+        end if
+        if tasks[2] then
+            task_schedule(tasks[2],1)
+            task_yield()
+        end if
+        if res=0 then
+            res = compare(sdata[1],sdata[2])
+            if show_details then
+                ?{res,sdata[1],sdata[2],active_tasks}
+            end if
+        end if
+    end while
+    printf(1,"test(%d,%d):%d\n",{t1,t2,res})
+end procedure
+
+test(1,1)
+show_details = 0
+test(1,2)
+test(1,3)
+test(2,1)
+test(2,2)
+test(2,3)
+test(3,1)
+test(3,2)
+test(3,3)

Task/Same-Fringe/Zkl/same-fringe.zkl

@@ -0,0 +1,27 @@
+var G=Utils.Generator;
+//Tree: (node,left,right) or (leaf) or (node,left) ...
+aTree := T(1, T(2, T(4, T(7)), T(5)), T(3, T(6, T(8), T(9))));
+bTree := aTree;
+println("aTree and bTree ",sameFringe(aTree,bTree) and "have" or "don't have",
+          " the same leaves.");
+cTree := T(1, T(2, T(4, T(7)), T(5)), T(3, T(6, T(8))));
+dTree := T(1, T(2, T(4, T(7)), T(5)), T(3, T(6, T(8), T(9))));
+println("cTree and dTree ",sameFringe(cTree,dTree) and "have"or"don't have",
+          " the same leaves.");
+
+fcn sameFringe(a,b){ same(G(genLeaves,a),G(genLeaves,b)) }
+
+fcn same(g1,g2){ //(Generator,Generator)
+   foreach n1,n2 in (g1.zip(g2)){ //-->(int,int) ...
+      if(n1 != n2) return(); // == return(Void)
+   }
+   return(not (g2._next() or g2._next())); //-->False if g1 or g2 has leaves
+}
+
+fcn genLeaves(tree){
+   switch(tree.len()){ // (), (leaf), (node,left, [right])
+      case(1){ vm.yield(tree[0]) } // leaf: int
+      case(2){ genLeaves(tree[1]); }
+      else   { genLeaves(tree[1]); genLeaves(tree[2]); }
+   }
+}