Cafe Version 2.3
山田邦博です。
Cafe の version up です。 Version 2.3 となりました。
複素数を手軽に扱える(RPN)関数電卓です。
電気・電子工学の研究開発に携わる研究者、技術者のためのものです。
今回の主な変更は、unary reduction operator を導入した事です。
ベクトルとベクトルの内積の例ならば
%+ ($vec1 * $vec2)
などと書けます。(ここで、$vec1 と $vec2 は同一サイズの一次元配列)
詳細は下記 web ペイジを参照して下さい。
http://www.tksa.gr.jp/king/Software/Cafe/Cafe.html
-...-
アーカイブ:
----------
Cafe Ver.2.3 の全てのファイルは
ftp://ftp.tksa.gr.jp/king/Cafe/Cafe_2.3.tgz
にあります。
最新の Cafe (patch 版を含む)については
http://www.tksa.gr.jp/king/Software/Cafe/
からたどって下さい。
-...-
以下に Ver.2.2 に対する diff を最後に添付します。
文書(doc)は diff だけ、プログラム(bin)は diff+shar です。
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
##### (BEGIN) cut here for documents #####
diff -uNr Cafe_2.2/doc/BNF.txt Cafe_2.3/doc/BNF.txt
--- Cafe_2.2/doc/BNF.txt 2004-11-18 22:19:20.000000000 +0900
+++ Cafe_2.3/doc/BNF.txt 2004-12-06 01:03:01.000000000 +0900
@@ -1,4 +1,4 @@
-This is BNF(Bakus-Naur Form) of Cafe Ver.2.2.
+This is BNF(Bakus-Naur Form) of Cafe Ver.2.3.
---------------------------------------------
<letter> ::= [a-zA-Z] # is one of upper or lower case of alphabets
@@ -23,10 +23,11 @@
| <fixed_number><exponent_mark><exponent_part>
<special_unary_operator> ::= '+' | '-' | '!' | '~'
-<special_binary_operator> ::= '//' | '.*' | '+' | '-' | '*' | '%'
+<special_binary_operator> ::= '//' | '.*' | '+' | '-' | '*'
| '/' | '^' | '.' | '&' | '|'
| '==' | '>=' | '>' | '<=' | '<' | '!='
-<special_reduction_operator> ::= '/+' | '/*' | '/.*'
+<special_reduction_operator> ::= '/+' | '/*' | '/.*'
+<special_unary_reduction_operator> ::= '%+' | '%*' | '%.*'
<stack_inserting_modifier> ::= '+:' | ':'
<stack_extracting_modifier> ::= '-:+' | '-:' | '=:'
@@ -35,7 +36,10 @@
<mnemonic_operator> ::= <ID> # is defined to be an operator.
<mnemonic_function> ::= <ID> # is defined to be a function.
+<unary_reduction_operator> ::= <special_unary_reduction_operator>
+ | '%'<binary_operator> | '%'<operator>
<unary_operator> ::= <special_unary_operator> | <mnemonic_unary_operator>
+ | <unary_reduction_operator>
<binary_operator> ::= <special_binary_operator> | <mnemonic_binary_operator>
<operator> ::= <mnemonic_operator>
<function> ::= <mnemonic_function>
@@ -153,6 +157,6 @@
.-.-.
-18 Nov.2004
+6 Dec.2004
YAMADA Kunihiro <king@tksa.gr.jp>
diff -uNr Cafe_2.2/doc/BUGS.jp.txt Cafe_2.3/doc/BUGS.jp.txt
--- Cafe_2.2/doc/BUGS.jp.txt 2004-11-23 23:14:51.000000000 +0900
+++ Cafe_2.3/doc/BUGS.jp.txt 2005-01-08 23:47:07.000000000 +0900
@@ -1,4 +1,4 @@
-Cafe Version 2.2 におけるこれまでに分かっているバグおよび使用上
+Cafe Version 2.3 におけるこれまでに分かっているバグおよび使用上
の注意を以下に記しておきます。
-...-
@@ -72,8 +72,12 @@
@"error" # エラー
@'error' # エラー
@pi # 正常：スタックに積まれる。
+
+ Unary reduction operator の reference は表現できません。 必要なら関数
+(Unary operator)として再定義してから rererence を表現して下さい。
+
.-.-.
-23 Nov.2003
+8 Jan.2005
山田邦博
YAMADA Kunihiro <king@tksa.gr.jp>
diff -uNr Cafe_2.2/doc/MUMBLE.jp.txt Cafe_2.3/doc/MUMBLE.jp.txt
--- Cafe_2.2/doc/MUMBLE.jp.txt 2004-11-23 23:39:25.000000000 +0900
+++ Cafe_2.3/doc/MUMBLE.jp.txt 2004-12-25 16:49:51.000000000 +0900
@@ -112,6 +112,9 @@
されている。 なんか object oriented の手法を取り入れたかって? いや、
Cafe にはそんな物は無縁だ。 極自然な発想、手法だ。
+Ver.2.2 と Ver.2.3 で配列演算が強化され、従来の cafe とは別物のような
+様相を示して来たのだが、プログラム的には僅かな変更でしかない。
+
-...-
従来(Ver.2.0 およびそれ以前)、reference の先の実体が undef 等でなくな
@@ -149,9 +152,12 @@
-...-
-私が使ったことのない binary operator が一個だけあった。 それは "%" だ。
-"mod" を使うことは良くある。 将来の version で "%" を別の用途に使い出す
-かも知れないな。
+Version 2.2 までで、私が使ったことのない binary operator が一個だけあっ
+た。 それは "%" だ。 ("mod" を使うことは良くある。)
+Version 2.3 で "%" を unary reduction operator の prefix として使用して
+しまった。
+従来の "%" は "residual" と書いてもらうことにした。 長ったらしいが、忘れ
+にくいだろうし、console での対話なら補間が効くから不便ではないはずだ。
-...-
@@ -170,8 +176,13 @@
$real_array1 + j $real_array2
関数を一発書けば可能だが、この方がスマートでしょう。
+Version 2.3 で unary reduction operator を導入したので、vector と
+vector の内積が簡単になった；
+ %+ ($vector1 * $vector2)
+という風に書ける。
+
.-.-.
-23 Nov.2004
+25 Dec.2004
山田邦博
YAMADA Kunihiro <king@tksa.gr.jp>
diff -uNr Cafe_2.2/doc/README.jp.txt Cafe_2.3/doc/README.jp.txt
--- Cafe_2.2/doc/README.jp.txt 2004-12-01 18:18:34.000000000 +0900
+++ Cafe_2.3/doc/README.jp.txt 2005-01-09 23:03:27.000000000 +0900
@@ -5,7 +5,7 @@
山田邦博
YAMADA Kunihiro <king@tksa.gr.jp>
- 1 Dec.2004 (Release 2.2)
+ 9 Jan.2005 (Release 2.3)
Copyright policy: GNU GPL Ver.2
@@ -25,7 +25,7 @@
Scalar 値を取り扱う unary および binary operator に関しては、配列の
各要素への自動適用が可能です(関数定義で array expandable が宣言されて
-いる場合)。(Ver.2.2 より)
+いる場合)。
強力なヘルプ機能を付けました。 ユーザ定義の関数はその定義を表示させ
ることができます。 また、関数や変数の定義に付属したコメントを表示させ
@@ -33,8 +33,8 @@
エラー発生時にはバックトラックが行われ、その原因と場所が表示されます。
-Cafe Ver.2.2 の全てのファイルは
- ftp://ftp.tksa.gr.jp/king/Cafe/Cafe_2.2.tgz
+Cafe Ver.2.3 の全てのファイルは
+ ftp://ftp.tksa.gr.jp/king/Cafe/Cafe_2.3.tgz
にあります。
最新の Cafe については
@@ -71,6 +71,11 @@
(MUMBLE.jp.txt を参照)
+Version 2.3 での主な変更点：
+---------------------------
+・Unary reduction operator を導入した。
+
+
Version 2.2 での主な変更点：
---------------------------
・Scalar 値を演算対象とした unary operator および binary operator につ
@@ -396,7 +401,7 @@
ものが僅かな演算誤差によって虚部が 0 にならないケースが当然考えられま
す。 これが問題になるなら、積極的に Re 関数を使うべきでしょう。
整数演算は特にサポートしていないので、必要なら int,round,floor,ceil 等
-の関数を積極的に使ってください。("%" が唯一ありますが)
+の関数を積極的に使ってください。("residual" が唯一ありますが)
Boolean value は複素数の特殊なケースである。 虚部が 0 でかつ実部が 0
または 1 である。 これ以外の数値は boolean value として不適当であると
@@ -558,32 +563,32 @@
記号 Priority 機能
-------------------------------------------
- ^ 100 Arithmetic Power
- " " 110 Blank operator (same as multiply "*" except priority)
- * 120 Multiply
- / 120 Divide
- % 120 Residual
- + 130 Add
- - 130 Subtract
- mod 150 Modulo
- // 200 Parallel impedance: ($left*$right)/($left+$right)
- max 250 Maximum (Larger value)
- min 250 Minimum (Smaller value)
- .* 300 String multiplication
- . 310 String concatination
- == 500 Arithmetic equality
- != 500 Arithmetic inequality
- > 500 Arithmetic greater than
- >= 500 Arithmetic greater than or equal to
- < 500 Arithmetic less than
- <= 500 Arithmetic less than or equal to
- eq 500 String equality
- ne 500 String inequality
- & 1000 Logical AND
- and 1000 Logical AND
- | 1010 Logical OR
- or 1010 Logical OR
- xor 1020 Logical EXCLUSIVE OR
+ ^ 100 Arithmetic Power
+ " " 110 Blank operator (same as multiply "*" except priority)
+ * 120 Multiply
+ / 120 Divide
+ residual 120 Residual
+ + 130 Add
+ - 130 Subtract
+ mod 150 Modulo
+ // 200 Parallel impedance: ($left*$right)/($left+$right)
+ max 250 Maximum (Larger value)
+ min 250 Minimum (Smaller value)
+ .* 300 String multiplication
+ . 310 String concatination
+ == 500 Arithmetic equality
+ != 500 Arithmetic inequality
+ > 500 Arithmetic greater than
+ >= 500 Arithmetic greater than or equal to
+ < 500 Arithmetic less than
+ <= 500 Arithmetic less than or equal to
+ eq 500 String equality
+ ne 500 String inequality
+ & 1000 Logical AND
+ and 1000 Logical AND
+ | 1010 Logical OR
+ or 1010 Logical OR
+ xor 1020 Logical EXCLUSIVE OR
Priority の値が小さい物程演算の優先度が高い。
@@ -594,9 +599,11 @@
関する制限がある。 最終的に 1 個の要素をスタックに乗せなければならない。
このスタックの長さのチェックは binary operator の実行の度になされる。
- "%" (剰余)と "mod" は似ていますが、少し動作が異なります。 前者は剰余
-の計算前に各オペランドの小数部を切捨てて整数としてから剰余を求めます。
-これは perl の剰余演算そのものです。
+ "residual" (剰余)と "mod" は似ていますが、少し動作が異なります。 前者
+は剰余の計算前に各オペランドの小数部を切捨てて整数としてから剰余を求めま
+す。 これは perl の剰余演算("%")そのものです。
+ 注：Ver.2.3 から "%" は unary reduction operator の接頭文字とし
+ て使用されます。
後者はいずれも整数とはせずに剰余を求めます。 これは例えば radian 角を
0 から 2pi の値に正規化する時に役立ちます。
例：
@@ -656,6 +663,24 @@
が表示されます。
+Unary reduction operator:
+------------------------
+ 後述の reduction 操作("/op") は stack に対して作用するが、この unary
+reduction operator ("%op") は配列に対して作用する。
+Unary reduction operator は合成 operator であるが、unary operator として
+機能する。
+%op における関数 op に対する制限は /op と同じである。(Reduction の節を
+参照)
+
+ Unary reduction operator は配列に作用して、その次元を一つ減ずる。 元の
+配列が一次元であればその結果はスカラー(0次元)に、元の配列が二次元であれ
+ばその結果は一次元の配列となる。
+
+ 典型的な使用例としてはベクトルとベクトルの内積がある。
+ %+ ($vec1 * $vec2)
+ここで、$vec1 と $vec2 は同一サイズの一次元配列である。
+
+
Nullary operator:
----------------
引数が 0 個で、演算結果を stack 上に一個だけ置く関数は通常の変数と同
@@ -667,7 +692,6 @@
date Local time
nstack Number of depth of the stack
sysver System version number
- untyp Make untype
null_array Make null array
undefined_value Make undefined value
@@ -792,6 +816,10 @@
# ら直接的あるいは間接的に print する文字列の
# 最後に改行 "\n" がない場合は強制的に改行が挿
# 入される。
+ warn # 引数は文字列。 STDERR に出力する。 スタックに
+ # は積まれない。 引数が文字列出ない場合は今日静
+ # 的に文字化される。 文字列の最後に改行 "\n" が
+ # ない場合は強制的に改行が挿入される。
ps # stack 上の要素を表示する。
pc # 引数は変数(関数)名。または文字列。
# 変数、関数に付けられたコメントを表示する。
@@ -1149,8 +1177,8 @@
は BNF 上、Cafe の正しい構文であり得ます。 この時 b は変数でも、binary
operator でも、unary operator でも、更には引数のない nullary operator
でもあり得るのです。 ID "b" がそれまでにどういう宣言、定義がなされたか
-によって解釈(意味)が変わって来ます。 Blank operator の挿入がされること
-もありますが、それは BNF だけでは決定できません。
+によって解釈(意味)が変わって来ます。 Blank operator が挿入されることも
+ありますが、それは BNF だけでは決定できません。
そういう semantics を無視した BNF を書く事もできるでしょうが、それは人
間にとってあまり意味のあるものではないでしょう。 そこで敢えて、冗長で
(文法的には意味のない)誤りとも思える形で書いてあります。 この方が私の
@@ -1230,4 +1258,4 @@
------
著作権は GNU GPL Version 2 に準じます。(GPL-2 参照)
無保証です。
-v バグレポート、意見等は歓迎します。
+ バグレポート、意見等は歓迎します。
diff -uNr Cafe_2.2/doc/TODO.jp.txt Cafe_2.3/doc/TODO.jp.txt
--- Cafe_2.2/doc/TODO.jp.txt 2004-11-19 23:38:38.000000000 +0900
+++ Cafe_2.3/doc/TODO.jp.txt 2004-12-11 23:26:41.000000000 +0900
@@ -8,12 +8,11 @@
ずなのだが。
誰か作ってくれると嬉しい。
-Array への reduction 適用。
- 現在の reduction は stack に適用される。 Reduction operator を
- unary operator 扱い出来るように拡張する。
- /op の "/" を別にする必要があるかな? "%op $array" でどうか? この
- 場合は既にある binary operator "%" を例えば "residual" に変える
- ことになるが。
+@%op
+ Unary reduction operator(%op) の reference が考えられるが、その
+ 必要性があるか?
+ Operator の rererence(@op) も必要性があるか?
+ これらは文字列で関数に渡して、関数側で eval すれば済むはず。
Reference の一般化。
ようは現在禁止している referenced value の変数への代入を、許す
@@ -25,7 +24,7 @@
今しばらくは考えない事にする。
.-.-.
-19 Nov.2004
+11 Dec.2004
山田邦博
YAMADA Kunihiro <king@tksa.gr.jp>
diff -uNr Cafe_2.2/doc/change.log Cafe_2.3/doc/change.log
--- Cafe_2.2/doc/change.log 2004-12-01 18:19:24.000000000 +0900
+++ Cafe_2.3/doc/change.log 2005-01-10 00:57:31.000000000 +0900
@@ -1,3 +1,33 @@
+10 Jan.2005
+ Version 2.3 : released.
+
+8 Jan.2005
+ word.cafe: retuned <<NULLARRAY>> if "" applied.
+
+25 Dec.2004
+ diagnosis.cafe: corrected typo.
+
+13 Dec.2004
+ Cafe.pm: removed system (nulary) function untype().
+ define.cafe: added function make_array.
+
+12 Dec.2004
+ diagnosis.cafe: added checking code for unary reduction operator.
+
+10 Dec.2004
+ Cafe.pm: residual operator : "%" -> "residual".
+ added and modified for unary reduction operator.
+ added "warn" system function.
+
+8 Dec.2004
+ define.cafe: corrected dup() for referenced value.
+ diagnosis.cafe: changed version-check.
+
+6 Dec.2004
+ BNF.txt: removed "%" from binary operators.
+ added <special_unary_reduction_operator> and
+ <unary_reduction_operator>
+
1 Dec.2004
Version 2.2 : released.
##### (END) cut here for documents #####
-...-
##### (BEGIN) cut here for binaries #####
#!/bin/sh
# This is a shell archive (produced by GNU sharutils 4.2.1).
# To extract the files from this archive, save it to some FILE, remove
# everything before the `!/bin/sh' line above, then type `sh FILE'.
#
# Made on 2005-01-10 01:45 JST by <king@owlin>.
# Source directory was `/home/king/tmp'.
#
# Existing files will *not* be overwritten unless `-c' is specified.
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 13775 -rw-r--r-- Cafe_2.3-bin.diff
#
save_IFS="${IFS}"
IFS="${IFS}:"
gettext_dir=FAILED
locale_dir=FAILED
first_param="$1"
for dir in $PATH
do
if test "$gettext_dir" = FAILED && test -f $dir/gettext \
&& ($dir/gettext --version >/dev/null 2>&1)
then
set `$dir/gettext --version 2>&1`
if test "$3" = GNU
then
gettext_dir=$dir
fi
fi
if test "$locale_dir" = FAILED && test -f $dir/shar \
&& ($dir/shar --print-text-domain-dir >/dev/null 2>&1)
then
locale_dir=`$dir/shar --print-text-domain-dir`
fi
done
IFS="$save_IFS"
if test "$locale_dir" = FAILED || test "$gettext_dir" = FAILED
then
echo=echo
else
TEXTDOMAINDIR=$locale_dir
export TEXTDOMAINDIR
TEXTDOMAIN=sharutils
export TEXTDOMAIN
echo="$gettext_dir/gettext -s"
fi
if touch -am -t 200112312359.59 $$.touch >/dev/null 2>&1 && test ! -f 200112312359.59 -a -f $$.touch; then
shar_touch='touch -am -t $1$2$3$4$5$6.$7 "$8"'
elif touch -am 123123592001.59 $$.touch >/dev/null 2>&1 && test ! -f 123123592001.59 -a ! -f 123123592001.5 -a -f $$.touch; then
shar_touch='touch -am $3$4$5$6$1$2.$7 "$8"'
elif touch -am 1231235901 $$.touch >/dev/null 2>&1 && test ! -f 1231235901 -a -f $$.touch; then
shar_touch='touch -am $3$4$5$6$2 "$8"'
else
shar_touch=:
echo
$echo 'WARNING: not restoring timestamps. Consider getting and'
$echo "installing GNU \`touch', distributed in GNU File Utilities..."
echo
fi
rm -f 200112312359.59 123123592001.59 123123592001.5 1231235901 $$.touch
#
if mkdir _sh15254; then
$echo 'x -' 'creating lock directory'
else
$echo 'failed to create lock directory'
exit 1
fi
# ============= Cafe_2.3-bin.diff ==============
if test -f 'Cafe_2.3-bin.diff' && test "$first_param" != -c; then
$echo 'x -' SKIPPING 'Cafe_2.3-bin.diff' '(file already exists)'
else
$echo 'x -' extracting 'Cafe_2.3-bin.diff' '(text)'
sed 's/^X//' << 'SHAR_EOF' > 'Cafe_2.3-bin.diff' &&
diff -uNr Cafe_2.2/bin/cafe Cafe_2.3/bin/cafe
--- Cafe_2.2/bin/cafe 2004-12-01 18:16:07.000000000 +0900
+++ Cafe_2.3/bin/cafe 2005-01-10 00:51:19.000000000 +0900
@@ -9,7 +9,7 @@
X
X # Author:
X # YAMADA Kunihiro <king@tksa.gr.jp>
-# (Please see my web page; http://www.tksa.gr.jp/king/)
+# <http://www.tksa.gr.jp/king/>
X #
X # Copyright policy:
X # GNU GPL Ver.2
@@ -29,6 +29,7 @@
X # 15 May 2003 Ver.2.0
X # 3 Jan.2004 Ver.2.1
X # 1 Dec.2004 Ver.2.2
+# 10 Jan.2005 Ver.2.3
X #
X
X no lib qw(:ALL .);
@@ -69,7 +70,7 @@
X if ($opt_v) {
X my @n = cafeine("sysver\n");
X print "\nThis is Cafe version $n[0].\n\n",
- "Copyright 2000-2004, YAMADA Kunihiro <king\@tksa.gr.jp>\n\n",
+ "Copyright 2000-2005, YAMADA Kunihiro <king\@tksa.gr.jp>\n\n",
X "You can get the latest version from\n",
X "\thttp://www.tksa.gr.jp/king/Software/Cafe/\n\n";
X exit 0;
diff -uNr Cafe_2.2/lib/Cafe.pm Cafe_2.3/lib/Cafe.pm
--- Cafe_2.2/lib/Cafe.pm 2004-12-01 18:21:19.000000000 +0900
+++ Cafe_2.3/lib/Cafe.pm 2005-01-10 00:54:20.000000000 +0900
@@ -5,7 +5,7 @@
X
X # Author:
X # YAMADA Kunihiro <king@tksa.gr.jp>
-# (Please see my web page; http://www.tksa.gr.jp/king/)
+# <http://www.tksa.gr.jp/king/>
X #
X # Copyright policy:
X # GNU GPL Ver.2
@@ -25,6 +25,7 @@
X # 15 May 2003 Ver.2.0
X # 3 Jan.2004 Ver.2.1
X # 1 Dec.2004 Ver.2.2
+# 10 Jan.2005 Ver.2.3
X #
X
X
@@ -80,7 +81,7 @@
X ### Constants ###
X ###################
X
-my $VERSION = "2.2";
+my $VERSION = "2.3";
X
X my $INF = 1e9999999999;
X my $NAN = $INF - $INF;
@@ -94,8 +95,8 @@
X my $PTN_ENDOFEXPRESSION = '$|[;,?:)}\]]|\+:|-:|=:';
X my $PTN_STACKMODIFIER = '\+:|-:\+|-:|=:|:';
X my $PTN_UNARY = '[+\-!~]';
-my $PTN_BINARY = '\/\/|\.\*|[+\-*%/^.&|]|==|>=|>|<=|<|!=';
-my $PTN_ASSIGN_BINARY = '\/\/|\.\*|[+\-*%/^.&|]|==|!=';
+my $PTN_BINARY = '\/\/|\.\*|[+\-*/^.&|]|==|>=|>|<=|<|!=';
+my $PTN_ASSIGN_BINARY = '\/\/|\.\*|[+\-*/^.&|]|==|!=';
X my $PTN_REDUCTION = '\/[+*]|\/\.\*';
X my $PTN_SPECIAL = "$PTN_BINARY|$PTN_REDUCTION|$PTN_UNARY";
X my $PTN_BRACKET = '\[[^\[\]]*\]\s*';
@@ -271,19 +272,43 @@
X # print "#",__LINE__,"# execute_function: check_stack=\"$check_stack\"\n" if $DEBUG;
X my $id;
X my $op;
+ my $reduction;
X if (ref $vid) {
X die "!!BUG!! exec: No name in vid: " unless exists $vid->{name};
X $id = $vid->{name};
X $op = $vid;
+ } elsif (not $vid) {
+ die "!!BUG!! exec: No vid specified: ";
+ } elsif ($vid =~ /^%(.*)/) { # Unary reduction operator
+ print "#",__LINE__,"# execute_function: \$vid=\"$vid\"\n" if $DEBUG;
+ $reduction = 1;
+ $id = $1;
+ $op = getID($id);
X } else {
- die "!!BUG!! exec: No vid specified: " unless $vid;
X $id = $vid;
X $op = getID($id);
X }
X # print "#",__LINE__,"# execute_function: id=\"$id\"\n" if $DEBUG;
X die "!!BUG!! exec: \"$id\" is not function: "
X unless $op->{type} eq 'F' or $op->{type} eq 'B';
- die "!!BUG!! exec: \"$id\" : too less stack: " if nvstack() < $op->{narg};
+ die "!!BUG!! exec: \"$id\" : too less stack: "
+ if ($reduction ? nvstack() < 1 : nvstack() < $op->{narg});
+
+ if ($reduction) {
+ die "!!BUG!! exec: $id->{narg} <= 1: " if $op->{narg} <= 1;
+ my $v = popvstack();
+ DIE("\"%$id \" needs an array for the argument.\n",$v)
+ unless $v->{type} eq 'A';
+ DIE("\"$v->{name}\" is empty array.\n",$v)
+ if @{$v->{value}} <= 0;
+ pushvstack(shift @{$v->{value}});
+ while (@{$v->{value}}) {
+ pushvstack(shift @{$v->{value}});
+ execute_function($op,1);
+ }
+ return;
+ }
+
X if (defined $op->{arrayex} and $op->{arrayex}) {
X if ($op->{type} eq 'F' and $op->{narg} == 1) {
X ### Unary ###
@@ -368,6 +393,7 @@
X die "!!BUG!! exec: Bad array extension : \"$id\" :"
X }
X }
+
X if (ref($op->{value}) eq 'CODE') {
X ## System defined function ##
X my $ref = $op->{ref};
@@ -535,10 +561,10 @@
X return cmplx($ai/$bi,-$ar/$bi) if $br == 0;
X return cmplx(($ar*$br + $ai*$bi)/$d,($ai*$br - $ar*$bi)/$d);
X }
- } elsif ($opid eq '%') {
- DIE("\"%\": Right side operand($b->{name}) should be real number.\n",$a,$b)
+ } elsif ($opid eq 'residual') {
+ DIE("\"residual\": Right side operand($b->{name}) should be real number.\n",$a,$b)
X unless Im($b) == 0;
- DIE("\"%\"(residual): divided by 0.\n", $a,$b)
+ DIE("residual: divided by 0.\n", $a,$b)
X if Re($b) == 0;
X return real(Re($a) % Re($b)) if Im($a)==0;
X return cmplx(Re($a) % Re($b), Im($a) % Re($b));
@@ -807,7 +833,7 @@
X sub op_sub () { _op_bin_arith('-') }
X sub op_mul () { _op_bin_arith('*') }
X sub op_div () { _op_bin_arith('/') }
-sub op_residual () { _op_bin_arith('%') }
+sub op_residual () { _op_bin_arith('residual') }
X sub op_pwr () { _op_bin_arith('^') }
X sub op_para () { _op_bin_arith('//') }
X sub op_blank () { _op_bin_arith($ID_BLANK_OP) }
@@ -950,7 +976,7 @@
X 'Blank operator (Same as complex multiplication "*" except priority)');
X setsysbin("*",\&op_mul,120,1,'Complex Multiplication');
X setsysbin("/",\&op_div,120,1,'Complex Division');
-setsysbin("%",\&op_residual,120,1,'Complex Residual');
+setsysbin("residual",\&op_residual,120,1,'Complex Residual');
X setsysbin("+",\&op_add,130,1,'Complex Addition');
X setsysbin("-",\&op_sub,130,1,'Complex Subtraction');
X setsysbin("//",\&op_para,200,1,'Parallel impedance');
@@ -1023,12 +1049,12 @@
X if ($t eq 'U') {
X die "Stringify: \"$v->{name}\" : undefined type.\n"
X if $check_error and not $NO_ERROR_STRINGIFY;
- return '<<UNTYPE>>';
+ return '<<UNDEFINED>>';
X }
X unless (defined $v->{value}) {
X die "Stringify: \"$v->{name}\" : undefined value.\n"
X if $check_error and not $NO_ERROR_STRINGIFY;
- return "<<UNDEFVALUE>>";
+ return ($t eq 'A' ? '<<NULLARRAY>>' : '<<UNDEFVALUE>>');
X }
X if ($t eq "N") {
X my ($re,$im) = (Re($v),Im($v));
@@ -1348,12 +1374,6 @@
X pushvstack(string($VERSION));
X }
X
-sub op_untype () {
- my $v = makevar();
- $v->{name} = 'untype:';
- pushvstack($v);
-}
-
X sub op_null_array () {
X my $v = makearray();
X $v->{name} = 'null_array:';
@@ -1371,7 +1391,6 @@
X setsysfunc("date",\&op_date,0,'"Nullary" Local time.');
X setsysfunc("nstack",\&op_nstack,0,'"Nullary" Number of depth of the stack');
X setsysfunc("sysver",\&op_version,0,'"Nullary" System version number.');
-setsysfunc("untype",\&op_untype,0,'"Nullary" Make untype');
X setsysfunc("null_array",\&op_null_array,0,'"Nullary" Make null array');
X setsysfunc("undefined_value",\&op_undefined_value,0,
X '"Nullary" Make undefined value');
@@ -1437,6 +1456,13 @@
X }
X }
X
+sub op_warn () {
+ my $v = popvstack();
+ my $s = Stringify($v,"check-error");
+ print STDERR $s;
+ print STDERR "\n" unless $s =~ /\n$/s;
+}
+
X sub op_print_flush () {
X print "\n" unless $last_print_char eq "\n";
X $last_print_char = "\n";
@@ -2214,6 +2240,7 @@
X setsysfunc("quit",\&op_quit,0,'Quit');
X setsysfunc("exit",\&op_exit,1,'Exit with return code');
X setsysfunc("die",\&op_die,1,'Die. Terminate execution with message.');
+setsysfunc("warn",\&op_warn,1,'Warn. Print message on STDERR.');
X setsysfunc("include",\&op_include,1,'Include file.');
X
X ###############
@@ -2963,6 +2990,21 @@
X $un = $ID_UN_MINUS if $un =~ /\-/;
X push_un [$un,$prepnt,$cmdpnt];
X next;
+ } elsif (s/^%($PTN_BINARY|$PTN_ID)//o) {
+ my $un = $&;
+ my $id = $1;
+ $cmdpnt += length($&);
+ print "#",__LINE__,"# term: unary reduction operator\n" if $DEBUG;
+ my $op = getID($id);
+ die "term: \"$id\" is not defined.\n" unless ref $op;
+ print "#",__LINE__,"# reduction: type=\"$op->{type}\"\n" if $DEBUG;
+ die "term: \"$id\" is not function.\n"
+ unless $op->{type} eq 'B' or $op->{type} eq 'F';
+ die "term: \"$id\" has too less arguments for unary reduction operator.\n"
+ if $op->{narg} < 2;
+ push_un [$un,$prepnt,$cmdpnt];
+ print "#",__LINE__,"### 5\n" if $DEBUG;
+ next;
X } elsif (s/^($PTN_REF)\s*($PTN_BINARY|$PTN_UNARY)//o) {
X $cmdpnt += length($&);
X pushvstack setref(getID($2));
@@ -3753,19 +3795,24 @@
X EOF
X c_assign();
X return;
- } elsif (s/^\/($PTN_ID|$PTN_BINARY)(\s*)($PTN_ENDOFCOMMAND)/$3/o) {
+ } elsif (s/^([\/%])($PTN_ID|$PTN_BINARY)(\s*)($PTN_ENDOFCOMMAND)/$4/o) {
X ###### Reduction #####
- $cmdpnt += length "$1$2";
- my $id = $1;
+ $cmdpnt += length "$1$2$3";
+ my $rd = $1;
+ my $id = $2;
X my $op = getID($id);
X die "command: \"$id\" is not declared.\n" unless ref $op;
X die "command: \"$id\" is not function or binary operator.\n"
X unless $op->{type} eq 'F' or $op->{type} eq 'B';
X die "command: Number of parameter of \"$id\" should be >= 2\n"
X unless $op->{narg} >= 2;
- while (nvstack() >= $op->{narg}) {
- my $svnvstack = nvstack();
- execute_function($op,1);
+ if ($rd eq '%') {
+ execute_function("$rd$id",1); # unary reduction operator for array
+ } else {
+ while (nvstack() >= $op->{narg}) {
+ my $svnvstack = nvstack();
+ execute_function($op,1);
+ }
X }
X die "reduction: Cannot reduce properly. Bad number of stack elements.\n"
X unless nvstack() <= 1;
@@ -3833,7 +3880,7 @@
X return;
X }
X } elsif (/^($PTN_ENDOFCOMMAND)/o) { ## Bare function (Id only)
- die "!! BUG !! command: Bare ID had beeb already checked: ";
+ die "!! BUG !! command: Bare ID had been already checked: ";
X } else {
X ### Function term .... ###
X # print "#",__LINE__,"# Function term ....\n" if $DEBUG;
diff -uNr Cafe_2.2/lib/define.cafe Cafe_2.3/lib/define.cafe
--- Cafe_2.2/lib/define.cafe 2004-12-01 18:22:16.000000000 +0900
+++ Cafe_2.3/lib/define.cafe 2005-01-10 00:54:43.000000000 +0900
@@ -1,9 +1,9 @@
-# define.cafe : Cafe auxiliary system definition file (Ver.2.2)
+# define.cafe : Cafe auxiliary system definition file (Ver.2.3)
X #
X
X # Author:
X # YAMADA Kunihiro <king@tksa.gr.jp>
-# (http://www.tksa.gr.jp/king/)
+# <http://www.tksa.gr.jp/king/>
X #
X # Copyright policy:
X # GNU GPL Ver.2
@@ -19,13 +19,14 @@
X # 15 May 2003 Ver.2.0
X # 3 Jan.2004 Ver.2.1
X # 1 Dec.2004 Ver.2.2
+# 10 Jan.2005 Ver.2.3
X #
X
-def DEFVER=="2.2"; # Version number of define.cafe
+def DEFVER=="2.3"; # Version number of define.cafe
X
X def Version() = { # Print version \
- print "\tCafe system : Version $(sysver)\n"; \
- print "\tdefine.cafe : Version $(DEFVER)\n"}
+ print "\tcafe system : version $(sysver)\n"; \
+ print "\tdefine.cafe : version $(DEFVER)\n"}
X
X # You can change version string to version number as following;
X # eval DEFVER # 1.9991 (pre-release) or 2.001 (patched) for example
@@ -63,13 +64,21 @@
X def not($a) ax = {!$a} # "Unary" Logical negation (same as "!")
X
X def copy($n) = {$n=:} # Copy stack[$n]
-def dup($a) = {push $a; $a} # Duplicate the last element on stack
+def dup() = {-1=:} # Duplicate the last element on stack
X def insert($n) = {$x=pop; $n +: $x} \
X # Insert last data on stack into n-th data on stack
X def extract($n) = {$n -:+ } # Extract n-th data on stack
X def swap(@$a) = {stack <=> $a} # Swap contents of stack and array $a
X def shrink() = {$x<=>stack; clear; $x} \
X # Shrink elements on the stack to an array
+def make_array($n,$initial_value) = { \
+ # Make array with initial value \
+ # $n : number of elements of the array \
+ # $initial_value : initail_value for all the elements \
+ $a = null_array; \
+ for(;$n>=1;--$n){ apush(@$a,$initial_value) }; \
+ $a; \
+}
X def q() = {quit} # Quit
X
X ########################
diff -uNr Cafe_2.2/lib/diagnosis.cafe Cafe_2.3/lib/diagnosis.cafe
--- Cafe_2.2/lib/diagnosis.cafe 2004-12-01 18:22:55.000000000 +0900
+++ Cafe_2.3/lib/diagnosis.cafe 2005-01-10 00:55:10.000000000 +0900
@@ -5,7 +5,7 @@
X
X # Author:
X # YAMADA Kunihiro <king@tksa.gr.jp>
-# (Please see my web page; http://www.tksa.gr.jp/king/)
+# <http://www.tksa.gr.jp/king/>
X #
X # Copyright policy:
X # GNU GPL Ver.2
@@ -21,17 +21,19 @@
X # 15 May 2003 Ver.2.0
X # 3 Jan.2004 Ver.2.1
X # 1 Dec.2004 Ver.2.2
+# 10 Jan.2005 Ver.2.3
X #
X
-$REQUIRED_VERSION = "2.2"
+$REQUIRED_VERSION = "2.3"
X print "\nThis diagnostic script is for cafe version $REQUIRED_VERSION or later.\n"
X Version
X print "\n"
+if (eval sysver != eval DEFVER) { \
+ die "Mismatch version: cafe($(sysver)) and define.cafe($(DEFVER)).\n" }
X if (eval sysver < eval $REQUIRED_VERSION) { \
X die "Use version $REQUIRED_VERSION or later for cafe.\n" }
-if (eval DEFVER < eval $REQUIRED_VERSION) { \
- die "Use version $REQUIRED_VERSION or later for define.cafe.\n" }
-
+if (eval sysver > eval $REQUIRED_VERSION) { \
+ warn "Warning: Mismatch version: cafe and diagnosis.cafe.\n\n" }
X
X ### test if ###
X
@@ -464,6 +466,11 @@
X if (reduce($cmpx==$reim,@&) != 1) { die "reduce($cmpx==$reim,@&) != 1"; }
X if (reduce($cmpx==$reim,@+) != 5) { die "reduce($cmpx==$reim,@+) != 5"; }
X
+### Check unary reduction operator ###
+
+$vec1 = ({1;2;3;4;5;shrink})
+$vec2 = ({2;3;4;5;6;shrink})
+if (%+($vec1 $vec2) != 70) {die "%+(\$vec1 \$vec2) != 70"; }
X
X #####################
X ### Trigonometric ###
diff -uNr Cafe_2.2/lib/word.cafe Cafe_2.3/lib/word.cafe
--- Cafe_2.2/lib/word.cafe 2004-01-03 14:10:12.000000000 +0900
+++ Cafe_2.3/lib/word.cafe 2005-01-08 23:02:58.000000000 +0900
@@ -2,12 +2,13 @@
X
X # Author:
X # YAMADA Kunihiro <king@tksa.gr.jp>
-# (http://www.tksa.gr.jp/king/)
+# <http://www.tksa.gr.jp/king/>
X #
X # Copyright policy:
X # GNU GPL Ver.2
X #
X # History:
+# (Please see other document "change.log" for detail.)
X # 3 Jan.2004 Released with cafe ver.2.1.
X #
X
@@ -22,6 +23,7 @@
X def word($s)={ # "Unary" split string into array of word \
X $a=split $s; \
X $w=''; \
+ $wa=null_array; \
X while(narray($a)>0) { \
X $c = ashift @$a; \
X if($c eq ' ' | $c eq "\t" | $c eq "\n"){ \
SHAR_EOF
(set 20 05 01 10 01 40 58 'Cafe_2.3-bin.diff'; eval "$shar_touch") &&
chmod 0644 'Cafe_2.3-bin.diff' ||
$echo 'restore of' 'Cafe_2.3-bin.diff' 'failed'
if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
&& ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
md5sum -c << SHAR_EOF >/dev/null 2>&1 \
|| $echo 'Cafe_2.3-bin.diff:' 'MD5 check failed'
f924461736a077db42519f6cebe2b47e Cafe_2.3-bin.diff
SHAR_EOF
else
shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'Cafe_2.3-bin.diff'`"
test 13775 -eq "$shar_count" ||
$echo 'Cafe_2.3-bin.diff:' 'original size' '13775,' 'current size' "$shar_count!"
fi
fi
rm -fr _sh15254
exit 0
Fnews-brouse 1.9(20180406) -- by Mizuno, MWE <mwe@ccsf.jp>
GnuPG Key ID = ECC8A735
GnuPG Key fingerprint = 9BE6 B9E9 55A5 A499 CD51 946E 9BDC 7870 ECC8 A735