diff options
| author | Shinya Sato <shinnya.sato@gmail.com> | 2024-03-16 20:20:09 +0900 |
|---|---|---|
| committer | Shinya Sato <shinnya.sato@gmail.com> | 2024-03-16 20:20:09 +0900 |
| commit | 8cbadb4fe54a9fc0e631ff688e423839f74e27df (patch) | |
| tree | f702efc82bac987577fd4cd4ba7da5c6e734d987 | |
| parent | cc7d7841935652c0906c2d863e9b71119167ece6 (diff) | |
| download | inpla-8cbadb4fe54a9fc0e631ff688e423839f74e27df.tar.gz inpla-8cbadb4fe54a9fc0e631ff688e423839f74e27df.zip | |
v0.12.2
| -rw-r--r-- | Changelog.md | 49 | ||||
| -rw-r--r-- | Gentle_introduction_Inpla.md | 21 | ||||
| -rw-r--r-- | README.md | 18 | ||||
| -rw-r--r-- | comparison/Inpla/main.sh | 18 | ||||
| -rw-r--r-- | comparison/Inpla/sptestInpla.sh | 3 | ||||
| -rw-r--r-- | pic/benchmark_reuse_v0.12.2.png | bin | 0 -> 39329 bytes | |||
| -rw-r--r-- | sample/unary_numbers/GCM2023/AckSZ-3_10-reuse.in | 13 | ||||
| -rw-r--r-- | sample/unary_numbers/GCM2023/AckSZ-3_10.in | 13 | ||||
| -rw-r--r-- | sample/unary_numbers/GCM2023/FibSZ_31-reuse.in | 19 | ||||
| -rw-r--r-- | sample/unary_numbers/GCM2023/FibSZ_31.in | 19 | ||||
| -rw-r--r-- | sample/unary_numbers/GCM2023/hanoi19-reuse.in | 52 | ||||
| -rw-r--r-- | sample/unary_numbers/GCM2023/hanoi19.in | 52 | ||||
| -rw-r--r-- | sample/unary_numbers/GCM2023/nqueenSZ_10-reuse.in | 225 | ||||
| -rw-r--r-- | sample/unary_numbers/GCM2023/nqueenSZ_10.in | 226 | ||||
| -rw-r--r-- | src/config.h | 4 | ||||
| -rw-r--r-- | src/inpla.y | 498 |
16 files changed, 979 insertions, 251 deletions
diff --git a/Changelog.md b/Changelog.md index e869c2f..91615f2 100644 --- a/Changelog.md +++ b/Changelog.md @@ -1,6 +1,53 @@ # Change log -### v0.12.1 (released on Mar 2024) +### v0.12.2 (released on 16 Mar 2024) + +#### New Features + +- **Tail call optimisation on/off switch**: Tail call optimisation was enabled by default. It is now enabled by invoking Inpla with `-foptimise-tail-calls`. If the last equation in a rule has the reuse annotations, this optimisation is cancelled the same as before. I hope that this will be useful if we want to have a *pure* interaction nets evaluator. + + ``` + $ ./inpla -c + Inpla 0.12.2 : Interaction nets as a programming language [built: 16 Mar 2024] + >>> add(r,y) >< S(x) => r~S(w), add(w,y)~x; + Rule: add(id:33,arity:2) >< S(id:32,arity:1). + Line:Addr. + 0001:0000: mkname reg13 + 0002:0002: mkagent id:32 reg14 + 0003:0005: loadp reg13 $0 reg14 + 0004:0009: push reg1 reg14 + 0005:0012: mkagent id:33 reg14 + 0006:0015: loadp reg13 $0 reg14 + 0007:0019: loadp reg2 $1 reg14 + 0008:0023: push reg14 reg6 + 0009:0026: ret_free_lr + >>> + ``` + The following is an example with the optimisation enabled: + ``` + $ ./inpla -c -foptimise-tail-calls + Inpla 0.12.2 : Interaction nets as a programming language [built: 16 Mar 2024] + >>> add(r,y) >< S(x) => r~S(w), add(w,y)~x; + Rule: add(id:33,arity:2) >< S(id:32,arity:1). + Line:Addr. + 0001:0000: mkname reg13 + 0002:0002: mkagent id:32 reg14 + 0003:0005: loadp reg13 $0 reg14 + 0004:0009: push reg1 reg14 + 0005:0012: jmpcnct reg6 id32 $15 ; if x is S, PC is added by 15 (=> go to 0031). + 0006:0016: mkagent id:33 reg14 + 0007:0019: loadp reg13 $0 reg14 + 0008:0023: loadp reg2 $1 reg14 + 0009:0027: push reg14 reg6 + 0010:0030: ret_free_lr + 0011:0031: load reg13 reg1 ; w is connected as add(w,_) + 0012:0034: loop_rrec1_free_r reg6 ; reload x as the RHS node and loop this rule. + >>> + ``` + + + +### v0.12.1 (released on 8 Mar 2024) #### Bug Fix diff --git a/Gentle_introduction_Inpla.md b/Gentle_introduction_Inpla.md index df82415..747f190 100644 --- a/Gentle_introduction_Inpla.md +++ b/Gentle_introduction_Inpla.md @@ -639,6 +639,23 @@ Inpla has the following macro: ``` $ ./inpla -h + Inpla version 0.12.2 + Usage: inpla [options] + + Options: + -f <filename> Set input file name (Default: STDIN) + -d <Name>=<val> Bind <val> to <Name> + -Xms <num> Set initial heap size to 2^<num> (Defalut: 12 (=4096)) + -Xmt <num> Set multiple heap increment to 2^<num> (Defalut: 3 (= 8)) + 0: the same (=2^0) size heap is inserted when it runs up. + 1: the heap size is twice (=2^1). + 2: the size is four times (=2^2). + -Xes <num> Set initial equation stack size (Default: 256) + -w Enable Weak Reduction strategy (Default: disable) + -c Enable output of compiled codes (Default: disable) + -h Print this help message + -foptimise-tail-calls Enable tail call optimisation (Default: disable) + Inpla version 0.12.0 Usage: inpla [options] @@ -650,16 +667,18 @@ Inpla has the following macro: 0: the same size heap is inserted when it runs up. 1: the twice (=2^1) size heap is inserted. -Xes <num> Set initial equation stack size (Default: 256) + -t <num> Set the number of threads (Default: 8) -w Enable Weak Reduction strategy (Default: false) -c Enable to output compiled codes (Default: disable) - -t <num> Set the number of threads (Default: 8) -h Print this help message + -foptimise-tail-calls Enable tail call optimisation (Default: disable) ``` **Note**: * The option `-w` is available for the single-thread version. * The option ```-t``` is available for the multi-thread version that is compiled by ```make thread```. The default value is setting for the number of cores, so execution will be automatically scaled without specifying this. +* The option `-foptimise-tail-calls` enables the optimisation of tail calls. If the last equation in a rule has the reuse annotations, this optimisation is cancelled. ## Advanced topics @@ -6,10 +6,10 @@ Inpla is a multi-threaded parallel interpreter of interaction nets. Once you write programs for sequential execution, it works also in multi-threaded parallel execution. Each thread is managed on each CPU-core with POSIX-thread library. -* The current version is 0.12.1, released on **8 Mar 2024**. (See [Changelog.md](Changelog.md) for details.) +* The current version is 0.12.2, released on **16 Mar 2024**. (See [Changelog.md](Changelog.md) for details.) * The below graph shows speed-up ratio to threads numbers for programs in the following benchmark table. - + - **Comparison in execution time** with other implementations: **Haskell** (GHC version 8.10.7), **OCaml** (ocamlopt, the native-code compiler, version 4.13.1), **Standard ML of New Jersey** v110.74 (interpreter mode) and **Python** 3.10.6 in execution time. @@ -17,19 +17,19 @@ Inpla is a multi-threaded parallel interpreter of interaction nets. Once you wri | | Haskell | OCaml | SML | Python | Inpla8 | Inpla8r | | -------------- | :------: | :------: | :----: | :----: | :------: | :------: | -| n-queens 12 | [**0.23**](comparison/Haskell/nqueen-12.hs) | [0.44](comparison/OCaml/nqueen12.ml) | [0.60](comparison/SML/ack3-11.sml) | [3.79](comparison/Python/nqueen-12.py) | [0.55](comparison/Inpla/src/nqueen-12.in) | [0.40](comparison/Inpla/src/nqueen-12-reuse.in) | -| ack(3,11) | [2.37](comparison/Haskell/ack3-11.hs) | [0.57](comparison/OCaml/ack3_11.ml) | [**0.42**](comparison/SML/ack3-11.sml) | [-](comparison/Python/ack3-11.py) | [0.91](comparison/Inpla/src/ack-stream_3-11.in) | [0.68](comparison/Inpla/src/ack-stream_3-11-reuse.in) | +| n-queens 12 | [**0.23**](comparison/Haskell/nqueen-12.hs) | [0.44](comparison/OCaml/nqueen12.ml) | [0.60](comparison/SML/ack3-11.sml) | [3.79](comparison/Python/nqueen-12.py) | [0.55](comparison/Inpla/src/nqueen-12.in) | [0.41](comparison/Inpla/src/nqueen-12-reuse.in) | +| ack(3,11) | [2.37](comparison/Haskell/ack3-11.hs) | [0.57](comparison/OCaml/ack3_11.ml) | [**0.42**](comparison/SML/ack3-11.sml) | [-](comparison/Python/ack3-11.py) | [0.92](comparison/Inpla/src/ack-stream_3-11.in) | [0.70](comparison/Inpla/src/ack-stream_3-11-reuse.in) | | fib 38 | [1.61](comparison/Haskell/fib-38.hs) | [**0.15**](comparison/OCaml/fib38.ml) | [0.27](comparison/SML/fib-38.sml) | [9.27](comparison/Python/fib-38.py) | [0.43](comparison/Inpla/src/fib-38.in) | [0.45](comparison/Inpla/src/fib-38-reuse.in) | -| bsort 20000 | [5.03](comparison/Haskell/bsort-20000.hs) | [6.47](comparison/OCaml/bsort20000.ml) | [2.39](comparison/SML/bsort-20000.sml) | [20.02](comparison/Python/bsort-20000.py) | [2.31](comparison/Inpla/src/bsort-20000.in) | [**1.45**](comparison/Inpla/src/bsort-20000-reuse.in) | +| bsort 20000 | [5.03](comparison/Haskell/bsort-20000.hs) | [6.47](comparison/OCaml/bsort20000.ml) | [2.39](comparison/SML/bsort-20000.sml) | [20.02](comparison/Python/bsort-20000.py) | [2.38](comparison/Inpla/src/bsort-20000.in) | [**1.46**](comparison/Inpla/src/bsort-20000-reuse.in) | | isort 20000 | [2.15](comparison/Haskell/isort-20000.hs) | [1.48](comparison/OCaml/isort20000.ml) | [0.60](comparison/SML/isort-20000.sml) | [8.83](comparison/Python/isort-20000.py) | [**0.32**](comparison/Inpla/src/isort-20000.in) | [0.33](comparison/Inpla/src/isort-20000-reuse.in) | | qsort 260000 | [0.36](comparison/Haskell/qsort-800000.hs) | [0.22](comparison/OCaml/qsort260000.ml) | [0.27](comparison/SML/qsort-260000.sml) | [10.33](comparison/Python/qsort-260000.py) | [0.15](comparison/Inpla/src/qsort-260000.in) | [**0.12**](comparison/Inpla/src/qsort-260000-reuse.in) | -| msort 260000 | [0.38](comparison/Haskell/msort-800000.hs) | [0.17](comparison/OCaml/msort260000.ml) | [0.29](comparison/SML/msort-260000.sml) | [11.09](comparison/Python/msort-260000.py) | [**0.14**](comparison/Inpla/src/msort-260000.in) | [0.17](comparison/Inpla/src/msort-260000-reuse.in) | +| msort 260000 | [0.38](comparison/Haskell/msort-800000.hs) | [0.17](comparison/OCaml/msort260000.ml) | [0.29](comparison/SML/msort-260000.sml) | [11.09](comparison/Python/msort-260000.py) | [**0.14**](comparison/Inpla/src/msort-260000.in) | [0.18](comparison/Inpla/src/msort-260000-reuse.in) | - The above table contains execution time in second on average of ten times execution by using Linux PC (Core i7-9700 (8 threads, no Hyper-threading), 16GB memory). The fastest one is shown with bold style. Scripts for the comparison table are in the `comparison` directory. These are written to have the same algorithms as much as possible, though only the Ackermann function in Inpla is a little optimised to interaction nets computing so that it can take advantage of the parallelism well. - - Inpla8 and Inpla8r mean 8 threads without/with [reuse-annotated](./Gentle_introduction_Inpla.md#reuse-annotations) execution, respectively. + - Inpla8 and Inpla8r mean 8 threads without/with [reuse-annotated](./Gentle_introduction_Inpla.md#reuse-annotations) execution, respectively. Inpla8 is called with an enable switch to optimise tail calls, as it is off by default since v0.12.2. Inpla8r is not called with this option because this optimisation will not work if the last equation in a rule has the reuse annotations. - "n-queens 12" is computation of n-Queens at 12. @@ -292,8 +292,10 @@ Electronic Communications of the EASST, Volume 73: Graph Computation Models - Se ## Related Works -* [HINet: Interaction Nets in Haskell](http://www.cas.mcmaster.ca/~kahl/Haskell/HINet/) +* [Train: Translator of a functional language to interaction nets (Inpla notation)](https://github.com/inpla/train) * [High-order Virtual Machine (HVM)](https://github.com/Kindelia/HVM) +* [Language, interpreter and compiler for interaction nets](https://github.com/szeiger/interact) +* [HINet: Interaction Nets in Haskell](http://www.cas.mcmaster.ca/~kahl/Haskell/HINet/) diff --git a/comparison/Inpla/main.sh b/comparison/Inpla/main.sh index c3ba3b3..fea221e 100644 --- a/comparison/Inpla/main.sh +++ b/comparison/Inpla/main.sh @@ -1,28 +1,28 @@ #!/bin/bash -bash ./sptestInpla.sh src/nqueen-12.in '-Xmt 6' +bash ./sptestInpla.sh src/nqueen-12.in '-Xmt 6 -foptimise-tail-calls' bash ./sptestInpla.sh src/nqueen-12-reuse.in '-Xmt 6' -bash ./sptestInpla.sh src/fib-38.in +bash ./sptestInpla.sh src/fib-38.in '-foptimise-tail-calls' bash ./sptestInpla.sh src/fib-38-reuse.in -bash ./sptestInpla.sh src/ack-stream_3-11.in +bash ./sptestInpla.sh src/ack-stream_3-11.in '-foptimise-tail-calls' bash ./sptestInpla.sh src/ack-stream_3-11-reuse.in -bash ./sptestInpla.sh src/bsort-20000.in +bash ./sptestInpla.sh src/bsort-20000.in '-foptimise-tail-calls' bash ./sptestInpla.sh src/bsort-20000-reuse.in -bash ./sptestInpla.sh src/isort-20000.in +bash ./sptestInpla.sh src/isort-20000.in '-foptimise-tail-calls' bash ./sptestInpla.sh src/isort-20000-reuse.in -bash ./sptestInpla.sh src/qsort-260000.in +bash ./sptestInpla.sh src/qsort-260000.in '-foptimise-tail-calls' bash ./sptestInpla.sh src/qsort-260000-reuse.in '-Xms 17 -Xmt 0' -bash ./sptestInpla.sh src/msort-260000.in +bash ./sptestInpla.sh src/msort-260000.in '-foptimise-tail-calls' bash ./sptestInpla.sh src/msort-260000-reuse.in '-Xms 18 -Xmt 0' -bash ./sptestInpla.sh src/qsort-800000.in +bash ./sptestInpla.sh src/qsort-800000.in '-foptimise-tail-calls' bash ./sptestInpla.sh src/qsort-800000-reuse.in '-Xms 18 -Xmt 0' -bash ./sptestInpla.sh src/msort-800000.in +bash ./sptestInpla.sh src/msort-800000.in '-foptimise-tail-calls' bash ./sptestInpla.sh src/msort-800000-reuse.in '-Xms 18 -Xmt 0' diff --git a/comparison/Inpla/sptestInpla.sh b/comparison/Inpla/sptestInpla.sh index 833606a..87797f8 100644 --- a/comparison/Inpla/sptestInpla.sh +++ b/comparison/Inpla/sptestInpla.sh @@ -11,6 +11,7 @@ waittime=5 max_threads=9 min_threads=1 + # options source=$1 inpla_seq='inplaSeq' @@ -24,6 +25,8 @@ fname=`echo $1 | sed -e s'|.*/\(.*\)|\1|'` log="log-${fname}.txt" + + # main ------------------------------------------------------ if [ -z $1 ]; then echo "Usage: ./sptestInpla.sh filename option" diff --git a/pic/benchmark_reuse_v0.12.2.png b/pic/benchmark_reuse_v0.12.2.png Binary files differnew file mode 100644 index 0000000..00fd45f --- /dev/null +++ b/pic/benchmark_reuse_v0.12.2.png diff --git a/sample/unary_numbers/GCM2023/AckSZ-3_10-reuse.in b/sample/unary_numbers/GCM2023/AckSZ-3_10-reuse.in new file mode 100644 index 0000000..6c82def --- /dev/null +++ b/sample/unary_numbers/GCM2023/AckSZ-3_10-reuse.in @@ -0,0 +1,13 @@ +// Ackermann function on unary natural numbers + +ack(r,y)>< Z => r~(*R)S(y); +ack(r,y)>< S(x) => (*L)ack_Sx(r, x)~y; +ack_Sx(r,x)>< Z => (*L)ack(r, S((*R)Z))~x; +ack_Sx(r,x)>< S(y) => (*R)Dup(x1,x2)~x, (*L)ack(r,cnt)~x1, ack_Sx(cnt,x2)~y; + +// ack 3 10 +// 1 2 3 4 5 6 7 8 9 0 +ack(result, S(S(S(S(S(S(S(S(S(S(Z)))))))))))~S(S(S(Z))); + +prnat result; +exit; diff --git a/sample/unary_numbers/GCM2023/AckSZ-3_10.in b/sample/unary_numbers/GCM2023/AckSZ-3_10.in new file mode 100644 index 0000000..6dec0ab --- /dev/null +++ b/sample/unary_numbers/GCM2023/AckSZ-3_10.in @@ -0,0 +1,13 @@ +// Ackermann function on unary natural numbers + +ack(r,y)>< Z => r~S(y); +ack(r,y)>< S(x) => ack_Sx(r, x)~y; +ack_Sx(r,x)>< Z => ack(r, S(Z))~x; +ack_Sx(r,x)>< S(y) => Dup(x1,x2)~x, ack(r,cnt)~x1, ack_Sx(cnt,x2)~y; + +// ack 3 10 +// 1 2 3 4 5 6 7 8 9 0 +ack(result, S(S(S(S(S(S(S(S(S(S(Z)))))))))))~S(S(S(Z))); + +prnat result; +exit; diff --git a/sample/unary_numbers/GCM2023/FibSZ_31-reuse.in b/sample/unary_numbers/GCM2023/FibSZ_31-reuse.in new file mode 100644 index 0000000..3163182 --- /dev/null +++ b/sample/unary_numbers/GCM2023/FibSZ_31-reuse.in @@ -0,0 +1,19 @@ +// Fibonacci number on unary natural numbers +fib(r)><Z => r~(*R)Z; +fib(r)><S(x) => (*L)fibS(r)~x; +fibS(r)><Z => r~(*L)S((*R)Z); +fibS(r)><S(x) => (*R)Dup(x1,x2)~x, (*L)add(r,r2)~r1, fib(r2)~x2, fibS(r1)~x1; + + +//------ ADD ------ +add(r,x)><Z => r~x; +add(r,x)><S(y) => r~(*R)S(w), (*L)add(w,x)~y; + + +// Execution +// Fib 31 +// 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 +fib(r)~S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(Z))))))))))))))))))))))))))))))); +prnat r; +free r; + diff --git a/sample/unary_numbers/GCM2023/FibSZ_31.in b/sample/unary_numbers/GCM2023/FibSZ_31.in new file mode 100644 index 0000000..6bb2297 --- /dev/null +++ b/sample/unary_numbers/GCM2023/FibSZ_31.in @@ -0,0 +1,19 @@ +// Fibonacci number on unary natural numbers +fib(r)><Z => r~Z; +fib(r)><S(x) => fibS(r)~x; +fibS(r)><Z => r~S(Z); +fibS(r)><S(x) => Dup(x1,x2)~x, add(r,r2)~r1, fib(r2)~x2, fibS(r1)~x1; + + +//------ ADD ------ +add(r,x)><Z => r~x; +add(r,x)><S(y) => r~S(w), add(w,x)~y; + + +// Execution +// Fib 31 +// 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 +fib(r)~S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(Z))))))))))))))))))))))))))))))); +prnat r; +free r; + diff --git a/sample/unary_numbers/GCM2023/hanoi19-reuse.in b/sample/unary_numbers/GCM2023/hanoi19-reuse.in new file mode 100644 index 0000000..af34c47 --- /dev/null +++ b/sample/unary_numbers/GCM2023/hanoi19-reuse.in @@ -0,0 +1,52 @@ +// Tower of Hanoi Puzzle + +// Rules +hanoi(return, source, target, aux) >< Z => + // Erase the source, target and aux + source ~ (*L)Eraser, + target ~ (*R)Eraser, + aux ~ Eraser, + + // result + return~[]; + +hanoi(return, source, target, aux) >< S(n) => + // Duplicate the source, target and aux + source ~ Dup(src1, Dup(src2, src3)), + target ~ Dup(tgt1, Dup(tgt2, tgt3)), + aux ~ Dup(aux1, aux2), + + + // recursive applications + n ~ Dup(nn1, Dup(nn2, nn3)), + (*L)hanoi(ret1, src1, aux1, tgt1)~nn1, + (*R)hanoi(ret2, aux2, tgt2, src2)~nn2, + + // result + append(return, ((nn3,src3,tgt3)):ret2)~ret1; + + +// --------------------------------------- +// append +// --------------------------------------- +append(r,a) >< [] => r~a; +append(r,a) >< x:xs => r~(*R)(x:w), (*L)append(w,a)~xs; + + +// --------------------------------------- +// len +// --------------------------------------- +len(ret) >< [] => ret~(*L)Z; +len(ret) >< x:xs => (*L)len_(ret, (*R)S(Z))~xs, Eraser~x; +len_(ret, n) >< [] => ret~n; +len_(ret, n) >< x:xs => (*L)len_(ret, (*R)S(n))~xs, Eraser~x; + + + +// Net +hanoi(result, A, C, B) ~ +//1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 + S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(Z))))))))))))))))))), + +len(r)~result; +prnat r; diff --git a/sample/unary_numbers/GCM2023/hanoi19.in b/sample/unary_numbers/GCM2023/hanoi19.in new file mode 100644 index 0000000..66bc4ab --- /dev/null +++ b/sample/unary_numbers/GCM2023/hanoi19.in @@ -0,0 +1,52 @@ +// Tower of Hanoi Puzzle + +// Rules +hanoi(return, source, target, aux) >< Z => + // Erase the source, target and aux + source ~ Eraser, + target ~ Eraser, + aux ~ Eraser, + + // result + return~[]; + +hanoi(return, source, target, aux) >< S(n) => + // Duplicate the source, target and aux + source ~ Dup(src1, Dup(src2, src3)), + target ~ Dup(tgt1, Dup(tgt2, tgt3)), + aux ~ Dup(aux1, aux2), + + + // recursive applications + n ~ Dup(nn1, Dup(nn2, nn3)), + hanoi(ret1, src1, aux1, tgt1)~nn1, + hanoi(ret2, aux2, tgt2, src2)~nn2, + + // result + append(return, ((nn3,src3,tgt3)):ret2)~ret1; + + +// --------------------------------------- +// append +// --------------------------------------- +append(r,a) >< [] => r~a; +append(r,a) >< x:xs => r~x:w, append(w,a)~xs; + + +// --------------------------------------- +// len +// --------------------------------------- +len(ret) >< [] => ret~Z; +len(ret) >< x:xs => len_(ret, S(Z))~xs, Eraser~x; +len_(ret, n) >< [] => ret~n; +len_(ret, n) >< x:xs => len_(ret, S(n))~xs, Eraser~x; + + + +// Net +hanoi(result, A, C, B) ~ +//1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 + S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(S(Z))))))))))))))))))), + +len(r)~result; +prnat r; diff --git a/sample/unary_numbers/GCM2023/nqueenSZ_10-reuse.in b/sample/unary_numbers/GCM2023/nqueenSZ_10-reuse.in new file mode 100644 index 0000000..c37d7dc --- /dev/null +++ b/sample/unary_numbers/GCM2023/nqueenSZ_10-reuse.in @@ -0,0 +1,225 @@ +// N-Queen on unary natural numbers +// +// The original is written as a Lisp program in the following file: +// https://www.istc.kobe-u.ac.jp/activity/mage/m27/27_Lisp.pdf + + +// --------------------------------------- +// eq +// equality between unary natural numbers numbers +// r << eq(m, n) +// --------------------------------------- +eq(r,m) >< Z => (*L)eqZ(r)~m; +eq(r,m) >< S(x) => (*L)eqS(r,x)~m; + +eqZ(r) >< Z => r~(*R)True; +eqZ(r) >< S(x) => r~(*L)False, (*R)Eraser~x; + +eqS(r,x) >< Z => r~(*L)False, (*R)Eraser~x; +eqS(r,x) >< S(y) => (*L)eq(r,y)~x; + + + +// --------------------------------------- +// r, m1, n1 << eq_stream(m,n) +// --------------------------------------- +eq_stream(r,m1,n1, m) >< Z => (*L)eqZ_stream(r,m1,n1)~m; +eq_stream(r,m1,n1, m) >< S(n) => n1~(*R)S(w), (*L)eqS_stream(r,m1,w, n)~m; + +eqZ_stream(r,m1,n1) >< Z => r~(*L)True, m1~(*R)Z, n1~Z; +eqZ_stream(r,m1,n1) >< S(m) => r~(*L)False, m1~(*R)S(m), n1~Z; + + +eqS_stream(r,m1,n1, n) >< Z => r~(*L)False, m1~(*R)Z, n1~n; +eqS_stream(r,m1,n1, n) >< S(m) => m1~(*R)S(w), (*L)eq_stream(r,w , n1, m)~n; + + + + + +// --------------------------------------- +// member +// r, m1, list1 << member(m, list) +// --------------------------------------- +// fun member x [] = false +// | member x (y::ys) = if x=y then true else (member x ys); + +member(r, m1, list1, m) >< [] => + r~(*L)False, m1~m, list1~(*R)[]; + +member(r, m1, list1, m) >< n:ys => + eq_result, m2, n2 << eq_stream(m,n), + list1~(*R)(n2:cnt), + (*L)member1(r, m1, cnt, m2, ys) ~ eq_result; + + +member1(r, m1, list1, m2, ys) >< True => + r~(*R)True, m1~m2, list1~ys; + +member1(r, m1, list1, m2, ys) >< False => + (*L)member(r, m1, list1, m2) ~ys; + + + + +// --------------------------------------- +// len_list (stream version) +// len, done << len_list(list) +// --------------------------------------- + +len_list(len, done) >< [] => + len~(*L)Z, done~(*R)[]; +len_list(len, done) >< x:xs => + done~(*R)(x:cnt), + (*L)len_list_(len, cnt, S(Z))~xs; + +len_list_(len, done, ct) >< [] => + len~ct, done~(*R)[]; +len_list_(len, done, ct) >< x:xs => + done~(*R)(x:cnt), + (*L)len_list_(len, cnt, S(ct)) ~ xs; + + +// --------------------------------------- +// len (non-stream version) +// ret << len(list) +// --------------------------------------- +len(ret) >< [] => ret~(*L)Z; +len(ret) >< x:xs => (*L)len_(ret, (*R)S(Z))~xs, Eraser~x; +len_(ret, n) >< [] => ret~n; +len_(ret, n) >< x:xs => (*L)len_(ret, (*R)S(n))~xs, Eraser~x; + + +// --------------------------------------- +// append (list1++list2) +// ret << append(list2, list1) +// --------------------------------------- +append(r,a) >< [] => r~a; +append(r,a) >< x:xs => r~(*R)(x:w), (*L)append(w,a)~xs; + + + + +/** + * threat (stream version) + * check for (0,q) and (k, qpos[col=k]) where k=1... + * http://www.nct9.ne.jp/m_hiroi/func/haskell06.html + 0 1 2 --> + +------------- + 1| . . . . . . + 2| . . . -3. . 5 - 3 = 2 + 3| . . -2. . . 5 - 2 = 3 + 4| . -1. . . . 5 - 1 = 4 + 5| Q . . . . . Q position is 5 + 6| . +1. . . . 5 + 1 = 6 + 7| . . +2. . . 5 + 2 = 7 + 8| . . . +3. . 5 + 2 = 8 + +------------- + * r, board_done << threat(k,m, board) + * return + * r: True if threat conditions are satisfied + * done: the same to `board' + */ +// fun threat k m [] = false +// | threat k m (x::xs) = +// if (k = x-m) orelse (k = x+m) then true +// else (threat (k+1) m xs); + + + +// r << diff(m,n) +diff(r,m) >< Z => r~m; +diff(r,m) >< S(n) => (*L)diff_S(r,n)~m; +diff_S(r, n) >< Z => r~(*L)S(n); +diff_S(r, n) >< S(m) => (*L)diff(r,m)~n; + + + +threat(r, done, k, q) >< [] => + r~(*L)False, done~(*R)[], Eraser~k, Eraser~q; + +threat(r, done, k, q) >< x:xs => + x1,x2 << Dup(x), + q1,q2 << Dup(q), + diff_xq << diff(x1,q1), + k1,k2 << Dup(k), + eq_ret << eq(k1, diff_xq), + (*L)threat1(r, done, k2, q2 , (*R)(x2:xs))~eq_ret; + +threat1(r, done, k, q, xxs) >< True => + r~(*R)True, done~xxs, (*L)Eraser~k, Eraser~q; + +threat1(r, done, k, q, xxs) >< False => + (*R)(x1:xs1) ~ xxs, + done~x1:cnt, (*L)threat(r, cnt, S(k), q)~xs1; + + +// fun queen1 b n 0 = [] +// | queen1 b n m = +// if (member m b) orelse (threat 1 m b) then (queen1 b n (m-1)) +// else if (length b) = (n-1) then (m::b)::(queen1 b n (m-1)) +// else (queen1 (m::b) n n) @ (queen1 b n (m-1)); +// fun queen n = queen1 n [] n; + +queen(ret, n) >< () => + n1, n2 << (*R)Dup(n), + (*L)queen_(ret, [], n1)~n2; + + +queen_(r, b, n) >< Z => + r~(*L)[], (*R)Eraser~b, Eraser~n; + +queen_(r, b, n) >< S(m) => + mem_ret, done_m, done_b << member((*R)S(m), b), + (*L)queen__chk_m_in_b(r, done_b, n, done_m)~mem_ret; + + +dec(r)><Z => r~(*R)Z; +dec(r)><S(n) => r~n; + +queen__chk_m_in_b(r, b, n, m) >< True => + m1 << (*R)dec(m), + (*L)queen_(r, b, n)~m1; + +queen__chk_m_in_b(r, b, n, m) >< False => + m1,m2 << (*R)Dup(m), + th_ret, done_b << threat(S(Z), m1, b), + (*L)queen__chk_threat(r, done_b, n, m2)~th_ret; + + + +queen__chk_threat(r, b, n, m) >< True => + m_dec << (*R)dec(m), + (*L)queen_(r, b, n)~m_dec; + +queen__chk_threat(r, b, n, m) >< False => + len_ret, done_b << (*R)len_list(b), + n1,nn << Dup(n), + n_dec << dec(nn), + eq_ret << eq(len_ret, n_dec), + (*L)queen__chk_lastelem(r, done_b, n1, m) ~ eq_ret; + + + +queen__chk_lastelem(r,b,n, m) >< True => + b1, b2 << (*R)Dup(b), + m1, mm << Dup(m), + m_dec << dec(mm), + r~(m1:b1):cnt, (*L)queen_(cnt, b2, n)~m_dec; + +queen__chk_lastelem(r,b,n, m) >< False => + b1, b2 << (*R)Dup(b), + r << (*L)append(cnt2, cnt1), + n1, Dup(n2,n3) << Dup(n), + m1, mm << Dup(m), + m_dec << dec(mm), + queen_(cnt1, m1:b1, n1)~n2, queen_(cnt2, b2, n3)~m_dec; + + + +// ---------------------------------------------------------- +// main +// ---------------------------------------------------------- +n~S(S(S(S(S(S(S(S(S(S(Z)))))))))), // 10 +queen(ret,n)~(), len(count)~ret; +prnat count;
\ No newline at end of file diff --git a/sample/unary_numbers/GCM2023/nqueenSZ_10.in b/sample/unary_numbers/GCM2023/nqueenSZ_10.in new file mode 100644 index 0000000..2038886 --- /dev/null +++ b/sample/unary_numbers/GCM2023/nqueenSZ_10.in @@ -0,0 +1,226 @@ +// N-Queen on unary natural numbers +// +// The original is written as a Lisp program in the following file: +// https://www.istc.kobe-u.ac.jp/activity/mage/m27/27_Lisp.pdf + + +// --------------------------------------- +// eq +// equality between unary natural numbers numbers +// r << eq(m, n) +// --------------------------------------- +eq(r,m) >< Z => eqZ(r)~m; +eq(r,m) >< S(x) => eqS(r,x)~m; + +eqZ(r) >< Z => r~True; +eqZ(r) >< S(x) => r~False, Eraser~x; + +eqS(r,x) >< Z => r~False, Eraser~x; +eqS(r,x) >< S(y) => eq(r,y)~x; + + + +// --------------------------------------- +// r, m1, n1 << eq_stream(m,n) +// --------------------------------------- +eq_stream(r,m1,n1, m) >< Z => eqZ_stream(r,m1,n1)~m; +eq_stream(r,m1,n1, m) >< S(n) => n1~S(w), eqS_stream(r,m1,w, n)~m; + +eqZ_stream(r,m1,n1) >< Z => r~True, m1~Z, n1~Z; +eqZ_stream(r,m1,n1) >< S(m) => r~False, m1~S(m), n1~Z; + + +eqS_stream(r,m1,n1, n) >< Z => r~False, m1~Z, n1~n; +eqS_stream(r,m1,n1, n) >< S(m) => m1~S(w), eq_stream(r,w , n1, m)~n; + + + + + +// --------------------------------------- +// member +// r, m1, list1 << member(m, list) +// --------------------------------------- +// fun member x [] = false +// | member x (y::ys) = if x=y then true else (member x ys); + +member(r, m1, list1, m) >< [] => + r~False, m1~m, list1~[]; + +member(r, m1, list1, m) >< n:ys => + eq_result, m2, n2 << eq_stream(m,n), + list1~n2:cnt, + member1(r, m1, cnt, m2, ys) ~ eq_result; + + +member1(r, m1, list1, m2, ys) >< True => + r~True, m1~m2, list1~ys; + +member1(r, m1, list1, m2, ys) >< False => + member(r, m1, list1, m2) ~ys; + + + + + +// --------------------------------------- +// len_list (stream version) +// len, done << len_list(list) +// --------------------------------------- + +len_list(len, done) >< [] => + len~Z, done~[]; +len_list(len, done) >< x:xs => + done~x:cnt, + len_list_(len, cnt, S(Z))~xs; + +len_list_(len, done, ct) >< [] => + len~ct, done~[]; +len_list_(len, done, ct) >< x:xs => + done~x:cnt, + len_list_(len, cnt, S(ct)) ~ xs; + + +// --------------------------------------- +// len (non-stream version) +// ret << len(list) +// --------------------------------------- +len(ret) >< [] => ret~Z; +len(ret) >< x:xs => len_(ret, S(Z))~xs, Eraser~x; +len_(ret, n) >< [] => ret~n; +len_(ret, n) >< x:xs => len_(ret, S(n))~xs, Eraser~x; + + +// --------------------------------------- +// append (list1++list2) +// ret << append(list2, list1) +// --------------------------------------- +append(r,a) >< [] => r~a; +append(r,a) >< x:xs => r~x:w, append(w,a)~xs; + + + + +/** + * threat (stream version) + * check for (0,q) and (k, qpos[col=k]) where k=1... + * http://www.nct9.ne.jp/m_hiroi/func/haskell06.html + 0 1 2 --> + +------------- + 1| . . . . . . + 2| . . . -3. . 5 - 3 = 2 + 3| . . -2. . . 5 - 2 = 3 + 4| . -1. . . . 5 - 1 = 4 + 5| Q . . . . . Q position is 5 + 6| . +1. . . . 5 + 1 = 6 + 7| . . +2. . . 5 + 2 = 7 + 8| . . . +3. . 5 + 2 = 8 + +------------- + * r, board_done << threat(k,m, board) + * return + * r: True if threat conditions are satisfied + * done: the same to `board' + */ +// fun threat k m [] = false +// | threat k m (x::xs) = +// if (k = x-m) orelse (k = x+m) then true +// else (threat (k+1) m xs); + + + +// r << diff(m,n) +diff(r,m) >< Z => r~m; +diff(r,m) >< S(n) => diff_S(r,n)~m; +diff_S(r, n) >< Z => r~S(n); +diff_S(r, n) >< S(m) => diff(r,m)~n; + + + +threat(r, done, k, q) >< [] => + r~False, done~[], Eraser~k, Eraser~q; + +threat(r, done, k, q) >< x:xs => + x1,x2 << Dup(x), + q1,q2 << Dup(q), + diff_xq << diff(x1,q1), + k1,k2 << Dup(k), + eq_ret << eq(k1, diff_xq), + threat1(r, done, k2, q2 , x2:xs)~eq_ret; + +threat1(r, done, k, q, xxs) >< True => + r~True, done~xxs, Eraser~k, Eraser~q; + +threat1(r, done, k, q, xxs) >< False => + x1:xs1 ~ xxs, + done~x1:cnt, threat(r, cnt, S(k), q)~xs1; + + +// fun queen1 b n 0 = [] +// | queen1 b n m = +// if (member m b) orelse (threat 1 m b) then (queen1 b n (m-1)) +// else if (length b) = (n-1) then (m::b)::(queen1 b n (m-1)) +// else (queen1 (m::b) n n) @ (queen1 b n (m-1)); +// fun queen n = queen1 n [] n; + +queen(ret, n) >< () => + n1, n2 << Dup(n), + queen_(ret, [], n1)~n2; + + +queen_(r, b, n) >< Z => + r~[], Eraser~b, Eraser~n; + +queen_(r, b, n) >< S(m) => + mem_ret, done_m, done_b << member(S(m), b), + queen__chk_m_in_b(r, done_b, n, done_m)~mem_ret; + + +dec(r)><Z => r~Z; +dec(r)><S(n) => r~n; + +queen__chk_m_in_b(r, b, n, m) >< True => + m1 << dec(m), + queen_(r, b, n)~m1; + +queen__chk_m_in_b(r, b, n, m) >< False => + m1,m2 << Dup(m), + th_ret, done_b << threat(S(Z), m1, b), + queen__chk_threat(r, done_b, n, m2)~th_ret; + + + +queen__chk_threat(r, b, n, m) >< True => + m_dec << dec(m), + queen_(r, b, n)~m_dec; + +queen__chk_threat(r, b, n, m) >< False => + len_ret, done_b << len_list(b), + n1,nn << Dup(n), + n_dec << dec(nn), + eq_ret << eq(len_ret, n_dec), + queen__chk_lastelem(r, done_b, n1, m) ~ eq_ret; + + + +queen__chk_lastelem(r,b,n, m) >< True => + b1, b2 << Dup(b), + m1, mm << Dup(m), + m_dec << dec(mm), + r~(m1:b1):cnt, queen_(cnt, b2, n)~m_dec; + +queen__chk_lastelem(r,b,n, m) >< False => + b1, b2 << Dup(b), + r << append(cnt2, cnt1), + n1, Dup(n2,n3) << Dup(n), + m1, mm << Dup(m), + m_dec << dec(mm), + queen_(cnt1, m1:b1, n1)~n2, queen_(cnt2, b2, n3)~m_dec; + + + +// ---------------------------------------------------------- +// main +// ---------------------------------------------------------- +n~S(S(S(S(S(S(S(S(S(S(Z)))))))))), // 10 +queen(ret,n)~(), len(count)~ret; +prnat count;
\ No newline at end of file diff --git a/src/config.h b/src/config.h index cc8bb44..3fd0fc6 100644 --- a/src/config.h +++ b/src/config.h @@ -70,10 +70,6 @@ //#define USE_MKAGENT_N -// Optimisation inspired by Tail Call Optimisation -// -#define OPTIMISE_IMCODE_TCO - // // Optimisation of the intermediate codes // diff --git a/src/inpla.y b/src/inpla.y index 0bb37d5..a337f25 100644 --- a/src/inpla.y +++ b/src/inpla.y @@ -22,8 +22,8 @@ // ---------------------------------------------- -#define VERSION "0.12.1" -#define BUILT_DATE "8 Mar 2024" +#define VERSION "0.12.2" +#define BUILT_DATE "16 Mar 2024" // ------------------------------------------------------------------ @@ -3421,9 +3421,11 @@ typedef struct { // where x and y are int modified names, and i is an integer such as 1 int put_warning_for_cnct_property; - // a flag to output compiled codes + // flag: output compiled codes int put_compiled_codes; - + + // flag: tail-call-optimisation + int tco; } CmEnvironment; @@ -3439,6 +3441,7 @@ typedef struct { static CmEnvironment CmEnv = { .put_warning_for_cnct_property = 1, // with warning .put_compiled_codes = 0, // without outputting codes + .tco = 0, // without tail call opt. }; @@ -3641,14 +3644,17 @@ int CmEnv_find_var(char *key) { for (i=0; i<CmEnv.bindPtr; i++) { if (strcmp(key, CmEnv.bind[i].name) == 0) { -#ifndef OPTIMISE_IMCODE_TCO - CmEnv.bind[i].refnum++; -#else - // During compilation on ANNOTATE_TCO, ignore counting up. - if (CmEnv.annotateL != ANNOTATE_TCO) { + // #ifndef OPTIMISE_IMCODE_TCO + if (!CmEnv.tco) { CmEnv.bind[i].refnum++; - } -#endif + + + } else { + // During compilation on ANNOTATE_TCO, ignore counting up. + if (CmEnv.annotateL != ANNOTATE_TCO) { + CmEnv.bind[i].refnum++; + } + } return CmEnv.bind[i].reg; } @@ -7019,44 +7025,18 @@ int Compile_eqlist_on_ast_in_rulebody(Ast *at) { Ast *next = ast_getTail(at); -#ifndef OPTIMISE_IMCODE_TCO - // Without Tail Call Recursion Optimisation - - // 2021/9/6: It seems, always EnvAddCodePUSH is selected - // because at is not NULL in this step. Should be (next == NULL)? - // - // 2021/9/12: It is faster - // when we choose OP_PUSH always in parallel execution, - // though I am not sure the reason. - - int var1 = Compile_term_on_ast(eq->left, -1); - int var2 = Compile_term_on_ast(eq->right, -1); - - // Check whether compilation errors arise - if (CmEnv.count_compilation_errors != 0) { - return 0; - } - + //#ifndef OPTIMISE_IMCODE_TCO + if (!CmEnv.tco) { + // Without Tail Call Recursion Optimisation - /* - if (next == NULL) { - IMCode_genCode2(OP_MYPUSH, var1, var2); - } else { - IMCode_genCode2(OP_PUSH, var1, var2); - } - */ - - IMCode_genCode2(OP_PUSH, var1, var2); - - at = next; + // 2021/9/6: It seems, always EnvAddCodePUSH is selected + // because at is not NULL in this step. Should be (next == NULL)? + // + // 2021/9/12: It is faster + // when we choose OP_PUSH always in parallel execution, + // though I am not sure the reason. - -#else - // WITH Tail Call Optimisation - - if ((next != NULL) - || ((next == NULL) && (eq->id == AST_CNCT))) { int var1 = Compile_term_on_ast(eq->left, -1); int var2 = Compile_term_on_ast(eq->right, -1); @@ -7064,253 +7044,283 @@ int Compile_eqlist_on_ast_in_rulebody(Ast *at) { if (CmEnv.count_compilation_errors != 0) { return 0; } - + + + + /* + if (next == NULL) { + IMCode_genCode2(OP_MYPUSH, var1, var2); + } else { + IMCode_genCode2(OP_PUSH, var1, var2); + } + */ + IMCode_genCode2(OP_PUSH, var1, var2); + at = next; } else { - // operation for the last placed equation. - - - if (eq->id == AST_CNCT_TCO_INTVAR) { - // rule_left_agent ~ expression - - // It always becomes loop operation - // because of the form `(*L) ~ expression'. - - + + // WITH Tail Call Optimisation + + if ((next != NULL) + || ((next == NULL) && (eq->id == AST_CNCT))) { + int var1 = Compile_term_on_ast(eq->left, -1); int var2 = Compile_term_on_ast(eq->right, -1); + // Check whether compilation errors arise if (CmEnv.count_compilation_errors != 0) { return 0; } + + IMCode_genCode2(OP_PUSH, var1, var2); + + } else { + // operation for the last placed equation. + + + if (eq->id == AST_CNCT_TCO_INTVAR) { + // rule_left_agent ~ expression + + // It always becomes loop operation + // because of the form `(*L) ~ expression'. - int alloc[MAX_PORT]; - int arity = 0; + int var2 = Compile_term_on_ast(eq->right, -1); + // Check whether compilation errors arise + if (CmEnv.count_compilation_errors != 0) { + return 0; + } + + + + int alloc[MAX_PORT]; + int arity = 0; - // The `rule_left_aget' is annotated by (*L) manually - // in the function `Ast_make_annotation_TailCallOptimisation'. + // The `rule_left_aget' is annotated by (*L) manually + // in the function `Ast_make_annotation_TailCallOptimisation'. - // So, first - // Pealing (*L) - Ast *eq_lhs = eq->left; // (*L)(AGENT(Fib, arglist)) - Ast *deconst_term = eq_lhs->left; // (AGENT(Fib, arglist)) - Ast *arg_list = deconst_term->right; // arglist + // So, first + // Pealing (*L) + Ast *eq_lhs = eq->left; // (*L)(AGENT(Fib, arglist)) + Ast *deconst_term = eq_lhs->left; // (AGENT(Fib, arglist)) + Ast *arg_list = deconst_term->right; // arglist - // printf("TCO: %s><int\n", deconst_term->left->sym); + // printf("TCO: %s><int\n", deconst_term->left->sym); - for (int i=0; i<MAX_PORT; i++) { - if (arg_list == NULL) break; - arity++; + for (int i=0; i<MAX_PORT; i++) { + if (arg_list == NULL) break; + arity++; - // ast_puts(arg_list->left); puts(""); + // ast_puts(arg_list->left); puts(""); - alloc[i] = Compile_term_on_ast(arg_list->left, -1); + alloc[i] = Compile_term_on_ast(arg_list->left, -1); - // Check whether compilation errors arise - if (CmEnv.count_compilation_errors != 0) { - return 0; - } + // Check whether compilation errors arise + if (CmEnv.count_compilation_errors != 0) { + return 0; + } - arg_list = ast_getTail(arg_list); - } + arg_list = ast_getTail(arg_list); + } - for (int i=0; i<arity; i++) { - if (alloc[i] == VM_OFFSET_ANNOTATE_R) { + for (int i=0; i<arity; i++) { + if (alloc[i] == VM_OFFSET_ANNOTATE_R) { // VM_OFFSET_ANNOTATE_R should be preserved int newreg = CmEnv_newvar(); IMCode_genCode2(OP_LOAD, VM_OFFSET_ANNOTATE_R, newreg); alloc[i] = newreg; break; + } } - } - IMCode_genCode2(OP_LOAD_META, var2, VM_OFFSET_ANNOTATE_R); + IMCode_genCode2(OP_LOAD_META, var2, VM_OFFSET_ANNOTATE_R); - for (int i=0; i<arity; i++) { - for (int j=i+1; j<arity; j++) { - if (alloc[j] == VM_OFFSET_METAVAR_L(i)) { - // VM_OFFSET_METAVAR_L(i) should be preserved - int newreg = CmEnv_newvar(); - IMCode_genCode2(OP_LOAD, VM_OFFSET_METAVAR_L(i), newreg); - alloc[j] = newreg; - break; + for (int i=0; i<arity; i++) { + for (int j=i+1; j<arity; j++) { + if (alloc[j] == VM_OFFSET_METAVAR_L(i)) { + // VM_OFFSET_METAVAR_L(i) should be preserved + int newreg = CmEnv_newvar(); + IMCode_genCode2(OP_LOAD, VM_OFFSET_METAVAR_L(i), newreg); + alloc[j] = newreg; + break; + } } - } - IMCode_genCode2(OP_LOAD_META, alloc[i], VM_OFFSET_METAVAR_L(i)); - } + IMCode_genCode2(OP_LOAD_META, alloc[i], VM_OFFSET_METAVAR_L(i)); + } - IMCode_genCode0(OP_LOOP); + IMCode_genCode0(OP_LOOP); - // prevent putting FREE_L, and ignore counting up for name ref - CmEnv.annotateL = ANNOTATE_TCO; + // prevent putting FREE_L, and ignore counting up for name ref + CmEnv.annotateL = ANNOTATE_TCO; - // IMCode_puts(0); exit(1); + // IMCode_puts(0); exit(1); - } else if (eq->id == AST_CNCT_TCO) { - // rule_left_agent ~ name where the name is meta_R + } else if (eq->id == AST_CNCT_TCO) { + // rule_left_agent ~ name where the name is meta_R - // Pealing (*L) - Ast *eq_lhs = eq->left; // (*L)(AGENT(Fib, arglist)) - Ast *deconst_term = eq_lhs->left; // (AGENT(Fib, arglist)) + // Pealing (*L) + Ast *eq_lhs = eq->left; // (*L)(AGENT(Fib, arglist)) + Ast *deconst_term = eq_lhs->left; // (AGENT(Fib, arglist)) - int eq_rhs_name_reg = CmEnv_find_var(eq->right->left->sym); + int eq_rhs_name_reg = CmEnv_find_var(eq->right->left->sym); - int label1 = CmEnv_get_newlabel(); - if (CmEnv.idR == ID_CONS) { - // JMPCNCT_CONS reg pc - IMCode_genCode2(OP_JMPCNCT_CONS, - eq_rhs_name_reg, label1); + int label1 = CmEnv_get_newlabel(); + if (CmEnv.idR == ID_CONS) { + // JMPCNCT_CONS reg pc + IMCode_genCode2(OP_JMPCNCT_CONS, + eq_rhs_name_reg, label1); - } else { - // JMPCNCT reg id pc - IMCode_genCode3(OP_JMPCNCT, - eq_rhs_name_reg, CmEnv.idR, label1); - } + } else { + // JMPCNCT reg id pc + IMCode_genCode3(OP_JMPCNCT, + eq_rhs_name_reg, CmEnv.idR, label1); + } #ifdef OPTIMISE_TWO_ADDRESS - IMCode_genCode0(OP_BEGIN_JMPCNCT_BLOCK); + IMCode_genCode0(OP_BEGIN_JMPCNCT_BLOCK); #endif - int var1 = Compile_term_on_ast(deconst_term, -1); - //int var1 = Compile_term_on_ast(eq_lhs, -1); + int var1 = Compile_term_on_ast(deconst_term, -1); + //int var1 = Compile_term_on_ast(eq_lhs, -1); - // Check whether compilation errors arise - if (CmEnv.count_compilation_errors != 0) { - return 0; - } + // Check whether compilation errors arise + if (CmEnv.count_compilation_errors != 0) { + return 0; + } - IMCode_genCode2(OP_PUSH, var1, eq_rhs_name_reg); - Compile_gen_RET_for_rulebody(); + IMCode_genCode2(OP_PUSH, var1, eq_rhs_name_reg); + Compile_gen_RET_for_rulebody(); - // From now on, - // prevent putting FREE_L, and ignore counting up for name ref - CmEnv.annotateL = ANNOTATE_TCO; + // From now on, + // prevent putting FREE_L, and ignore counting up for name ref + CmEnv.annotateL = ANNOTATE_TCO; #ifdef OPTIMISE_TWO_ADDRESS - IMCode_genCode0(OP_BEGIN_JMPCNCT_BLOCK); + IMCode_genCode0(OP_BEGIN_JMPCNCT_BLOCK); #endif - IMCode_genCode1(OP_LABEL, label1); + IMCode_genCode1(OP_LABEL, label1); - Ast *arg_list = deconst_term->right; // arglist - int arity = 0; - int alloc[MAX_PORT]; + Ast *arg_list = deconst_term->right; // arglist + int arity = 0; + int alloc[MAX_PORT]; - for (int i=0; i<MAX_PORT; i++) { - if (arg_list == NULL) break; - arity++; + for (int i=0; i<MAX_PORT; i++) { + if (arg_list == NULL) break; + arity++; - alloc[i] = Compile_term_on_ast(arg_list->left, -1); - // Check whether compilation errors arise - if (CmEnv.count_compilation_errors != 0) { - return 0; - } + alloc[i] = Compile_term_on_ast(arg_list->left, -1); + // Check whether compilation errors arise + if (CmEnv.count_compilation_errors != 0) { + return 0; + } - arg_list = ast_getTail(arg_list); - } + arg_list = ast_getTail(arg_list); + } - for (int i=0; i<arity; i++) { - if (alloc[i] == VM_OFFSET_METAVAR_L(i)) - continue; + for (int i=0; i<arity; i++) { + if (alloc[i] == VM_OFFSET_METAVAR_L(i)) + continue; - if (eq_rhs_name_reg == VM_OFFSET_METAVAR_L(i)) { - // preserve eq_rhs_name_reg to be overwritten - // because it is used for OP_LOOP_RREC. - // Ex. - // MergeCC(ret, int y, ys) >< (int x):xs - // | _ => ret~(y:cnt), MergeCC(cnt, x, xs) ~ ys; - // The `ys' is stored in reg(3), but it is overwritten by `xs', - // though `ys' is required by LOOP_RREC2 `ys' placed later. - // So, the `ys' must be preserved. - - int newreg = CmEnv_newvar(); - IMCode_genCode2(OP_LOAD, eq_rhs_name_reg, newreg); - eq_rhs_name_reg = newreg; - } + if (eq_rhs_name_reg == VM_OFFSET_METAVAR_L(i)) { + // preserve eq_rhs_name_reg to be overwritten + // because it is used for OP_LOOP_RREC. + // Ex. + // MergeCC(ret, int y, ys) >< (int x):xs + // | _ => ret~(y:cnt), MergeCC(cnt, x, xs) ~ ys; + // The `ys' is stored in reg(3), but it is overwritten by `xs', + // though `ys' is required by LOOP_RREC2 `ys' placed later. + // So, the `ys' must be preserved. + + int newreg = CmEnv_newvar(); + IMCode_genCode2(OP_LOAD, eq_rhs_name_reg, newreg); + eq_rhs_name_reg = newreg; + } - for (int j=i+1; j<arity; j++) { - if (alloc[j] == VM_OFFSET_METAVAR_L(i)) { - // preserve VM_OFFSET_METAVAR_L(i) - // if it is used later. - // Ex. - // LD 3,1 - // LD 1,3 <-- 1 is disappeared. - // ==> - // It must be as follows: - // LD 1, newreg - // LD 3, 1 - // LD newreg, 3 - // - // Ex.2 A(a,b,c)>< (int x):xs => A(c,a,b)~xs; - // + for (int j=i+1; j<arity; j++) { + if (alloc[j] == VM_OFFSET_METAVAR_L(i)) { + // preserve VM_OFFSET_METAVAR_L(i) + // if it is used later. + // Ex. + // LD 3,1 + // LD 1,3 <-- 1 is disappeared. + // ==> + // It must be as follows: + // LD 1, newreg + // LD 3, 1 + // LD newreg, 3 + // + // Ex.2 A(a,b,c)>< (int x):xs => A(c,a,b)~xs; + // - int newreg = CmEnv_newvar(); - IMCode_genCode2(OP_LOAD, VM_OFFSET_METAVAR_L(i), newreg); - alloc[j] = newreg; - break; + int newreg = CmEnv_newvar(); + IMCode_genCode2(OP_LOAD, VM_OFFSET_METAVAR_L(i), newreg); + alloc[j] = newreg; + break; + } } - } - IMCode_genCode2(OP_LOAD_META, alloc[i], VM_OFFSET_METAVAR_L(i)); + IMCode_genCode2(OP_LOAD_META, alloc[i], VM_OFFSET_METAVAR_L(i)); - } + } - int arityR = IdTable_get_arity(CmEnv.idR); - if (CmEnv.annotateR == ANNOTATE_REUSE) { - switch (arityR) { - case 1: - IMCode_genCode1(OP_LOOP_RREC1, eq_rhs_name_reg); - break; - case 2: - IMCode_genCode1(OP_LOOP_RREC2, eq_rhs_name_reg); - break; - default: - IMCode_genCode2(OP_LOOP_RREC, eq_rhs_name_reg, arityR); + int arityR = IdTable_get_arity(CmEnv.idR); + if (CmEnv.annotateR == ANNOTATE_REUSE) { + switch (arityR) { + case 1: + IMCode_genCode1(OP_LOOP_RREC1, eq_rhs_name_reg); + break; + case 2: + IMCode_genCode1(OP_LOOP_RREC2, eq_rhs_name_reg); + break; + default: + IMCode_genCode2(OP_LOOP_RREC, eq_rhs_name_reg, arityR); + } + } else { + switch (arityR) { + case 1: + IMCode_genCode1(OP_LOOP_RREC1_FREE_R, eq_rhs_name_reg); + break; + case 2: + IMCode_genCode1(OP_LOOP_RREC2_FREE_R, eq_rhs_name_reg); + break; + default: + IMCode_genCode2(OP_LOOP_RREC_FREE_R, eq_rhs_name_reg, arityR); + } } - } else { - switch (arityR) { - case 1: - IMCode_genCode1(OP_LOOP_RREC1_FREE_R, eq_rhs_name_reg); - break; - case 2: - IMCode_genCode1(OP_LOOP_RREC2_FREE_R, eq_rhs_name_reg); - break; - default: - IMCode_genCode2(OP_LOOP_RREC_FREE_R, eq_rhs_name_reg, arityR); - } - } - // IMCode_puts(0); //exit(1); + // IMCode_puts(0); //exit(1); - } else { - // unknown AST id - puts("Fatal ERROR in Compile_eqlist_on_ast_in_rulebody"); exit(1); - } + } else { + // unknown AST id + puts("Fatal ERROR in Compile_eqlist_on_ast_in_rulebody"); exit(1); + } - } + } - at = next; -#endif + at = next; + + + } // #endif } @@ -8086,17 +8096,20 @@ int make_rule_oneway(Ast *ast) { //puts("Before:"); ast_puts(rule_mainbody); puts(""); -#ifdef OPTIMISE_IMCODE_TCO + + int is_tco=0; - int is_tco; - if (!Ast_mainbody_has_agentID(rule_mainbody, AST_ANNOTATION_L)) { + //#ifdef OPTIMISE_IMCODE_TCO + if (CmEnv.tco) { + + if (!Ast_mainbody_has_agentID(rule_mainbody, AST_ANNOTATION_L)) { - is_tco = Ast_make_annotation_TailCallOptimisation(rule_mainbody); + is_tco = Ast_make_annotation_TailCallOptimisation(rule_mainbody); - } else { + } else { - is_tco = 0; - } + is_tco = 0; + } #ifdef VERBOSE_TCO @@ -8111,22 +8124,28 @@ int make_rule_oneway(Ast *ast) { -#endif - + } // #endif + + + if (!Compile_rule_mainbody_on_ast(rule_mainbody)) return 0; -#ifdef OPTIMISE_IMCODE_TCO - if (is_tco) { + + + // #ifdef OPTIMISE_IMCODE_TCO + if (CmEnv.tco) { + + if (is_tco) { - // puts("Before:"); ast_puts(rule_mainbody); puts(""); + // puts("Before:"); ast_puts(rule_mainbody); puts(""); - Ast_undo_TCO_annotation(rule_mainbody); + Ast_undo_TCO_annotation(rule_mainbody); - // puts("After:"); ast_puts(rule_mainbody); puts(""); + // puts("After:"); ast_puts(rule_mainbody); puts(""); - } -#endif + } + } // #endif // #define DEBUG_MKRULE @@ -11641,6 +11660,7 @@ int main(int argc, char *argv[]) printf("Inpla version %s\n", VERSION); exit(-1); break; + case '-': case 'h': case '?': @@ -11676,11 +11696,17 @@ int main(int argc, char *argv[]) printf(" -w Enable Weak Reduction strategy (Default: disable)\n"); #endif - printf(" -c Enable to output compiled codes (Default: disable)\n"); + printf(" -c Enable output of compiled codes (Default: disable)\n"); + + + printf(" -h Print this help message\n"); + + printf(" -foptimise-tail-calls Enable tail call optimisation (Default: disable)\n"); + + puts(""); - printf(" -h Print this help message\n\n"); exit(-1); break; @@ -11815,6 +11841,22 @@ int main(int argc, char *argv[]) break; case 'f': + + // flags + if (!strcmp(argv[i], "-foptimise-tail-calls")) { + CmEnv.tco = 1; + break; + } + + + // for files + if (strcmp(argv[i], "-f")) { + printf("ERROR: Unknown option: `%s'\n", argv[i]); + exit(-1); + } + + + i++; if (i < argc) { fname = argv[i]; |
