Mercurial > hg > Members > Moririn

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/doc/Interface.mm	Fri Oct 06 15:10:36 2017 +0900
@@ -0,0 +1,77 @@
+Interfaceのtypedef はコールフレームを定義する
+Interfaceの呼び出しの時に使える引数はtypedefに定義されている必要がある
+... は呼び出し側のコールフレームを保存するのに使う
+
+
+typedef struct Stack<Type, Impl>{
+        Type* stack;
+        Type* data;
+        Type* data1;
+        __code whenEmpty(...);
+        __code clear(Impl* stack,__code next(...));
+        __code push(Impl* stack,Type* data, __code next(...));
+        __code pop(Impl* stack, __code next(Type* data, ...));
+        __code pop2(Impl* stack, __code next(Type* data, Type* data1, ...));
+        __code isEmpty(Impl* stack, __code next(...), __code whenEmpty(...));
+        __code get(Impl* stack, __code next(Type* data, ...));
+        __code get2(Impl* stack, __code next(Type* data, Type* data1, ...));
+        __code next(...);
+} Stack;
+
+呼び出し方の例
+    goto nodeStack->push(newNode, replaceNode1);
+newNode はdataに対応する replaceNode1はnextに対応する。
+replaceNode1のコールフレームは...に格納される。
+つまり、replaceNode1はCodeGearのクロージャに相当する。
+
+Interfaceから値を返す場合は継続経由で値を返す
+__code get2(Impl* stack, __code next(Type* data, Type* data1, ...));
+継続の型はInterfaceで定義されていて、この型に合うCodeGearを引数として渡す
+    goto nodeStack->get2(insertCase1,tree) //意味的にはtreeの後ろに...
+
+
+__code insertCase1(struct Node *parent, struct Node *grandparent, struct RedBlackTree* tree) { //こっちも後ろに...があるはず
+
+goto next(data, data1, ...);
+
+createはinterfaceの実装を定義する
+interfaceのメソッドの番号をここで指定する
+
+implimentation側のDataGearは格納される実装依存の状態を持つ
+
+
+    struct SingleLinkedStack {
+        struct Element* top;
+    } SingleLinkedStack;
+
+Stack* createSingleLinkedStack(struct Context* context) {
+    struct Stack* stack = new Stack();
+    struct SingleLinkedStack* singleLinkedStack = new SingleLinkedStack();
+    stack->stack = (union Data*)singleLinkedStack;
+    singleLinkedStack->top = NULL;
+    stack->push = C_pushSingleLinkedStack;
+    stack->pop  = C_popSingleLinkedStack;
+    stack->pop2  = C_pop2SingleLinkedStack;
+    stack->get  = C_getSingleLinkedStack;
+    stack->get2  = C_get2SingleLinkedStack;
+    stack->isEmpty = C_isEmptySingleLinkedStack;
+    stack->clear = C_clearSingleLinkedStack;
+    return stack;
+}
+
+
+実装内部で使うCodeGearの引数はコールフレームで決まる
+コールフレームに含まれない中間変数を使っても良いが、辻褄は合ってる必要はある
+一般的にはコールフレームに含まれている引数しか書けない
+実装側の引数を書いても良い（ようにするか？）
+
+実装の状態にアクセスする時にはコールフレーム内の実装を表すDataGearから取り出してくる
+
+
+__code replaceNode1(struct RedBlackTree* tree, struct Node* node, __code next(...)) {
+
+呼び出しの例
+    goto insertNode(tree, tree->nodeStack, node);
+
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/parallel_execution/RedBlackTree.agda	Fri Oct 06 15:10:36 2017 +0900
@@ -0,0 +1,30 @@
+module RedBlackTree where
+
+open import stack
+
+record Tree {a t : Set} (treeImpl : Set) : Set  where
+  field
+    tree : treeImpl
+    put : treeImpl -> a -> (treeImpl -> t) -> t
+    get  : treeImpl -> (treeImpl -> Maybe a -> t) -> t
+
+record RedBlackTree (a : Set) : Set where
+  field
+    top : Maybe (Element a)
+    stack : Stack
+open RedBlackTree
+
+putRedBlackTree : {Data t : Set} -> RedBlackTree Data -> Data -> (Code : RedBlackTree Data -> t) -> t
+putRedBlackTree stack datum next = next newtree
+  where
+    element = cons datum (top stack)
+    newtree  = record {top = Just element}
+
+getRedBlackTree : {a t : Set} -> RedBlackTree a -> (Code : RedBlackTree a -> (Maybe a) -> t) -> t
+getRedBlackTree tree cs with (top tree)
+...                                | Nothing = cs tree  Nothing
+...                                | Just d  = cs stack1 (Just data1)
+  where
+    data1  = datum d
+    stack1 = record { top = (next d) }
+
--- a/src/parallel_execution/RedBlackTree.cbc	Fri Oct 06 15:10:07 2017 +0900
+++ b/src/parallel_execution/RedBlackTree.cbc	Fri Oct 06 15:10:36 2017 +0900
@@ -9,7 +9,7 @@
     struct RedBlackTree* redBlackTree = new RedBlackTree();
     tree->tree = (union Data*)redBlackTree;
     redBlackTree->root = NULL;
-    redBlackTree->nodeStack = createSingleLinkedStack(context);
+    redBlackTree->nodeStack = (union Data*)createSingleLinkedStack(context);
     tree->put = C_putRedBlackTree;
     tree->get = C_getRedBlackTree;
     // tree->remove = C_removeRedBlackTree;
@@ -45,9 +45,9 @@
     if (root) {
         tree->current = root;
         tree->result = compare(tree->current, node);
-        goto meta(context, C_replaceNode);
+        goto replaceNode(tree, tree->nodeStack);
     }
-    goto meta(context, C_insertNode);
+    goto insertNode(tree, tree->nodeStack, node);
 }

 __code replaceNode(struct RedBlackTree* tree, struct Stack* nodeStack) {
@@ -55,10 +55,11 @@
     struct Node* newNode = tree->newNode;
     tree->previous = newNode;
     *newNode = *oldNode;
-    nodeStack->stack = (union Data*)tree->nodeStack;
-    nodeStack->data = (union Data*)(newNode);
-    nodeStack->next = C_replaceNode1;
-    goto meta(context, tree->nodeStack->push);
+    // nodeStack->stack = (union Data*)tree->nodeStack;
+    // nodeStack->data = (union Data*)(newNode);
+    // nodeStack->next = C_replaceNode1;
+    // goto meta(context, tree->nodeStack->push);
+    goto nodeStack->push(newNode, replaceNode1);
 }

 __code replaceNode1(struct RedBlackTree* tree, struct Node* node, __code next(...)) {
@@ -94,6 +95,7 @@
     nodeStack->stack = (union Data*)tree->nodeStack;
     nodeStack->next = C_insertCase1;
     goto meta(context, tree->nodeStack->get2);
+    // goto nodeStack->get2(insertCase1)
 }

 __code insertCase1(struct RedBlackTree* tree, struct Node *parent, struct Node *grandparent) {
--- a/src/parallel_execution/Tree.cbc	Fri Oct 06 15:10:07 2017 +0900
+++ b/src/parallel_execution/Tree.cbc	Fri Oct 06 15:10:36 2017 +0900
@@ -1,8 +1,8 @@
-typedef struct Tree<Impl{
-    union Data* tree;
-    struct Node* node;
-    __code putRedBlackTree(Impl* traverse, struct Node* node, struct Node* root, struct Node* newNode);
-    __code getRedBlackTree(Impl* traverse, __code next(...));
+typedef struct Tree<Type, Impl>{
+    Type* tree;
+    Type* node;
+    __code put(Impl* tree, Type* node, Type* root, Type* newNode);
+    __code get(Impl* tree, __code next(...));
     // __code removeRedBlackTree();
     // __code clearRedBlackTree();
     __code next(...);
--- a/src/parallel_execution/generate_stub.pl	Fri Oct 06 15:10:07 2017 +0900
+++ b/src/parallel_execution/generate_stub.pl	Fri Oct 06 15:10:36 2017 +0900
@@ -278,13 +278,16 @@
     my $inTypedef = 0;
     my $inStub = 0;
     my $inParGoto = 0;
+    my $inMain = 0 ;
     my %stub;
     my $codeGearName;

     while (<$in>) {
-        if (! $inTypedef && ! $inStub) {
+        if (! $inTypedef && ! $inStub && ! $inMain) {
             if (/^typedef struct (\w+) {/) {
                 $inTypedef = 1;
+            } elsif (/^int main\((.*)\) {/) {
+                $inMain = 1;
             } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) {
                 $codeGearName = $1;
                 my $args = $2;
@@ -382,22 +385,26 @@
                 my @args = split(/,/,$4);
                 my @types = @{$dataGearVarType{$codeGearName}};
                 my $ntype;
+                my $ftype;
                 for my $v (@{$dataGearVar{$codeGearName}}) {
                     my $t = shift @types;
                     if ($v eq $next) {
                         $ntype = $t;
+                        $ftype = lcfirst($ntype);
                     }
                 }
-                print $fd "\tGearef(context, $ntype)->$next = $next->$next;\n";
-                # Put interface argument
+                print $fd "\tGearef(context, $ntype)->$ftype = $next->$ftype;\n";
+                # Put interface argument
                 my $prot = $code{$ntype}->{$method};
                 my $i = 1;
                 for my $arg (@args) {
+                    my $pType;
+                    my $pName;
                     my $p = @$prot[$i];
                     next if ( $p eq $arg);
                     $p =~ s/^(.*)\s(\w+)//;
-                    my $pType = $1;
-                    my $pName = $2;
+                    $pType = $1;
+                    $pName = $2;
                     $arg =~ s/^(\s)*(\w+)/$2/;
                     if ($pType =~ s/\_\_code$//) {
                         print $fd "\tGearef(context, $ntype)->$pName = C_$arg;\n";
@@ -408,7 +415,7 @@
                     }
                     $i++;
                 }
-                print $fd "${prev}goto meta(context, $next->$next->$ntype.$method);\n";
+                print $fd "${prev}goto meta(context, $next->$ftype->$ntype.$method);\n";
                 next;
             } elsif(/^(.*)par goto (\w+)\((.*)\);/) {
                 # handling par goto statement
@@ -509,9 +516,23 @@
                 s/new\s+(\w+)\(\)/\&ALLOCATE(context, \1)->\1/g;   # replacing new
             }
             # gather type name and type
-        } elsif (/^}/) {
+        } elsif ($inMain) {
+            if (/^(.*)goto start_code\(main_context\);/) {
+                next;
+            } elsif (/^(.*)goto (\w+)\((.*)\);/) {
+                my $prev = $1;
+                my $next = $2;
+                print $fd "${prev}struct Context* main_context = NEW(struct Context);\n";
+                print $fd "${prev}initContext(main_context);\n";
+                print $fd "${prev}main_context->next = C_$next;\n";
+                print $fd "${prev}goto start_code(main_context);\n";
+                next;
+            }
+        }
+        if (/^}/) {
             $inStub = 0;
             $inTypedef = 0;
+            $inMain = 0;
         }
         print $fd $_;
     }