diff -ruN klic-3.003-2002-02-22d/compiler/macro.kl1 klic-3.003-2002-02-22e/compiler/macro.kl1 --- klic-3.003-2002-02-22d/compiler/macro.kl1 Wed Jan 23 16:42:17 2002 +++ klic-3.003-2002-02-22e/compiler/macro.kl1 Fri Feb 22 22:27:35 2002 @@ -693,13 +693,13 @@ macro_arg_n( [.( P, PP ), .( Q, QQ )] )-V-After-B+GB. % B # [...] -macro_N_10( [C|N], B, T, A ):- #"a" =< C, C =< #"z" | +macro_N_10( [C|N], B, T, A ) :- #"a" =< C, C =< #"z" | T1 := T*B + C - #"a" + 10, macro_N_10( N, B, T1, A ). -macro_N_10( [C|N], B, T, A ):- #"A" =< C, C =< #"Z" | +macro_N_10( [C|N], B, T, A ) :- #"A" =< C, C =< #"Z" | T1 := T*B + C - #"A" + 10, macro_N_10( N, B, T1, A ). -macro_N_10( [C|N], B, T, A ):- #"0" =< C, C =< #"9" | +macro_N_10( [C|N], B, T, A ) :- #"0" =< C, C =< #"9" | T1 := T*B + C - #"0", macro_N_10( N, B, T1, A ). macro_N_10( [], _B, T, A ) :- diff -ruN klic-3.003-2002-02-22d/runtime/atomt.kl1 klic-3.003-2002-02-22e/runtime/atomt.kl1 --- klic-3.003-2002-02-22d/runtime/atomt.kl1 Fri Feb 8 13:37:32 2002 +++ klic-3.003-2002-02-22e/runtime/atomt.kl1 Fri Feb 22 22:27:35 2002 @@ -1,51 +1,55 @@ -% /* ---------------------------------------------------------- -% % (C)1993,1994 Institute for New Generation Computer Technology -% % (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C)1993, 1994 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) -% ----------------------------------------------------------- */ +----------------------------------------------------------- */ -:- inline:"extern unsigned long enter_atom_string();". +:- inline:"#include /* enter_atom_string */". :- module atom_table. -make_atom(String,Atom) :- - string(String,_,8), - inline:"%1 = makesym(enter_atom_string(%0));":[String+any,Atom0-atom] | - Atom = Atom0. - -atom_number(Atom,Number):- - inline:"%1 = makeint(symval(%0));":[Atom+atom,Number0-int] | - Number = Number0. - -get_atom_string(Atom,String):- atom(Atom), - inline:"%1 = makeint(strlen((char*) namestringof(%0)));" - :[Atom+atom,Size-int] | - new_string(String0,Size,8), - set_atom_string(0,Size,Atom,String0,String). - -set_atom_string(Size,Size,_Atom,String0,String):- String=String0. -set_atom_string(N,Size,Atom,String0,String):- N0 | - make_atom(String,Atom), - Status=normal(Atom). - -get_atom_name(Atom,Status):- get_atom_string(Atom,String), - Status=normal(String). - -cache_table([get_atom(AtomName,Status)|S]):- string(AtomName,L,8),L>0 | - intern(AtomName,Status), - cache_table(S). -cache_table([get_atom_name(Atom,Status)|S]):- atom(Atom) | - get_atom_name(Atom,Status), - cache_table(S). -cache_table([intern(AtomName,Status)|S]):- string(AtomName,L,8),L>0 | - intern(AtomName,Status), - cache_table(S). +:- public get_atom_string/2, make_atom/2. + +make_atom(String, Atom) :- + string(String, _, 8), + inline:"%1 = makesym(enter_atom_string(%0));":[String+any, Atom0-atom] | + Atom = Atom0. + +atom_number(Atom, Number) :- + inline:"%1 = makeint(symval(%0));":[Atom+atom, Number0-int] | + Number = Number0. + +get_atom_string(Atom, String) :- atom(Atom), + inline:"%1 = makeint(strlen((char*) namestringof(%0)));": + [Atom+atom, Size-int] | + new_string(String0, Size, 8), + set_atom_string(0, Size, Atom, String0, String). + +set_atom_string(Size, Size, _Atom, String0, String) :- + String = String0. +set_atom_string(N, Size, Atom, String0, String) :- N0 | + make_atom(String, Atom), + Status = normal(Atom). + +get_atom_name(Atom, Status) :- + get_atom_string(Atom, String), + Status = normal(String). + +cache_table([get_atom(AtomName, Status)|S]) :- string(AtomName, L, 8), L>0 | + intern(AtomName, Status), + cache_table(S). +cache_table([get_atom_name(Atom, Status)|S]) :- atom(Atom) | + get_atom_name(Atom, Status), + cache_table(S). +cache_table([intern(AtomName, Status)|S]) :- string(AtomName, L, 8), L>0 | + intern(AtomName, Status), + cache_table(S). cache_table([]). diff -ruN klic-3.003-2002-02-22d/runtime/bag.kl1 klic-3.003-2002-02-22e/runtime/bag.kl1 --- klic-3.003-2002-02-22d/runtime/bag.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/bag.kl1 Fri Feb 22 22:27:35 2002 @@ -1,11 +1,13 @@ -/* ---------------------------------------------------------- -% (C) 1994 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C) 1994 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ :- module bag. +:- public create/1. + create(Stream) :- - sorted_bag:create(Stream). + sorted_bag:create(Stream). diff -ruN klic-3.003-2002-02-22d/runtime/bagk.kl1 klic-3.003-2002-02-22e/runtime/bagk.kl1 --- klic-3.003-2002-02-22d/runtime/bagk.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/bagk.kl1 Fri Feb 22 22:27:35 2002 @@ -1,17 +1,19 @@ -/* ---------------------------------------------------------- -% (C) 1994 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C) 1994 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ :- module keyed_bag. +:- public create/1, create/2, create/3. + create(Hasher,Stream,Size) :- - keyed_sorted_bag:create(Stream). + keyed_sorted_bag:create(Stream). create(Stream,Size) :- - keyed_sorted_bag:create(Stream). + keyed_sorted_bag:create(Stream). create(Stream) :- - keyed_sorted_bag:create(Stream). + keyed_sorted_bag:create(Stream). diff -ruN klic-3.003-2002-02-22d/runtime/bagks.kl1 klic-3.003-2002-02-22e/runtime/bagks.kl1 --- klic-3.003-2002-02-22d/runtime/bagks.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/bagks.kl1 Fri Feb 22 22:27:35 2002 @@ -1,137 +1,143 @@ -/* ---------------------------------------------------------- -% (C) 1994 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C) 1994 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ :- module keyed_sorted_bag. +:- public create/1. + create(Stream) :- - splay_tree:create(Pool), - main(Stream,[],Pool). + splay_tree:create(Pool), + main(Stream, [], Pool). -create(Cmpr,Stream) :- - splay_tree:create(Cmpr,Pool), - main(Stream,[],Pool). - -main([],[])+_Pool. -main([],[S|ST])+Pool :- main(S,ST)+Pool. -main([do(S)|T],ST)+Pool :- main(S,[T|ST])+Pool. +create(Cmpr, Stream) :- + splay_tree:create(Cmpr, Pool), + main(Stream, [], Pool). + +main([], [])+_Pool. +main([], [S|ST])+Pool :- main(S, ST)+Pool. +main([do(S)|T], ST)+Pool :- main(S, [T|ST])+Pool. otherwise. -main([Message|T],ST)+Pool :- message(Message)-Pool, main(T,ST)+Pool. +main([Message|T], ST)+Pool :- message(Message)-Pool, main(T, ST)+Pool. message(empty(YorN))-Pool :- - splay_tree:empty(YorN)-Pool. -message(empty(Key,YorN))-Pool :- - splay_tree:empty(Key,YorN)-Pool. -message(put(Key,Value))-Pool :- - splay_tree:empty(Key,Empty)-Pool, - ( - Empty=yes -> splay_tree:put(Key,[Value])-Pool - ; - Empty=no -> - splay_tree:update(Key,Values,New)-Pool, - append(Values,[Value],New) - ). -message(get(Key,Value))-Pool :- - splay_tree:get(Key,[Value|Rest])-Pool, - ( - Rest=[] -> true - ; otherwise ; - true -> splay_tree:put(Key,Rest)-Pool - ). -message(get_if_any(Key,Value))-Pool :- - splay_tree:empty(Key,Empty)-Pool, - ( - Empty=yes -> Value={}, New=[] - ; - Empty=no -> - message(get(Key,V))-Pool, - Value={V} - ). + splay_tree:empty(YorN)-Pool. +message(empty(Key, YorN))-Pool :- + splay_tree:empty(Key, YorN)-Pool. +message(put(Key, Value))-Pool :- + splay_tree:empty(Key, Empty)-Pool, + ( + Empty=yes -> splay_tree:put(Key, [Value])-Pool + ; + Empty=no -> + splay_tree:update(Key, Values, New)-Pool, + append(Values, [Value], New) + ). +message(get(Key, Value))-Pool :- + splay_tree:get(Key, [Value|Rest])-Pool, + ( + Rest=[] -> true + ; otherwise ; + true -> splay_tree:put(Key, Rest)-Pool + ). +message(get_if_any(Key, Value))-Pool :- + splay_tree:empty(Key, Empty)-Pool, + ( + Empty=yes -> Value={}, New=[] + ; + Empty=no -> + message(get(Key, V))-Pool, + Value = {V} + ). message(get_all(Values))-Pool :- - splay_tree:get_all(All)-Pool, - flatten(All,Values). -message(get_all(Key,Values))-Pool :- - splay_tree:get(Key,Values)-Pool. + splay_tree:get_all(All)-Pool, + flatten(All, Values). +message(get_all(Key, Values))-Pool :- + splay_tree:get(Key, Values)-Pool. message(carbon_copy(Values))-Pool :- - splay_tree:get_all(All)+Pool+_, - flatten(All,Values). -message(carbon_copy(Key,Values))-Pool :- - splay_tree:empty(Key,Empty)-Pool, - ( - Empty=yes -> Values=[] - ; - Empty=no -> - splay_tree:update(Key,Values,Values)-Pool - ). - -message(get_and_put(Key,Old,New))-Pool :- - splay_tree:empty(Key,no)-Pool, - splay_tree:update(Key,[Old|Values],NewValues)-Pool, - append(Values,[New],NewValues). -message(get_if_any_and_put(Key,Old,New))-Pool :- - splay_tree:empty(Key,Empty)-Pool, - ( - Empty=yes -> - message(put(Key,New))-Pool, - Old={} - ; - Empty=no -> - message(get_and_put(Key,V,New))-Pool, - Old={V} - ). -message(get_and_put_if_any(Key,Old,New0,New))-Pool :- - splay_tree:empty(Key,Empty)-Pool, - ( - Empty=yes -> Old={}, New={New0} - ; - Empty=no -> - message(get_and_put(Key,V,New0))-Pool, - Old={V}, New={} - ). + splay_tree:get_all(All)+Pool+_, + flatten(All, Values). +message(carbon_copy(Key, Values))-Pool :- + splay_tree:empty(Key, Empty)-Pool, + ( + Empty=yes -> Values=[] + ; + Empty=no -> + splay_tree:update(Key, Values, Values)-Pool + ). + +message(get_and_put(Key, Old, New))-Pool :- + splay_tree:empty(Key, no)-Pool, + splay_tree:update(Key, [Old|Values], NewValues)-Pool, + append(Values, [New], NewValues). +message(get_if_any_and_put(Key, Old, New))-Pool :- + splay_tree:empty(Key, Empty)-Pool, + ( + Empty=yes -> + message(put(Key, New))-Pool, + Old = {} + ; + Empty=no -> + message(get_and_put(Key, V, New))-Pool, + Old = {V} + ). +message(get_and_put_if_any(Key, Old, New0, New))-Pool :- + splay_tree:empty(Key, Empty)-Pool, + ( + Empty=yes -> Old={}, New={New0} + ; + Empty=no -> + message(get_and_put(Key, V, New0))-Pool, + Old={V}, New={} + ). message(get_max_if_any(Elem))-Pool :- - splay_tree:empty(Empty)-Pool, - ( - Empty=yes -> Elem={} - ; - Empty=no -> - splay_tree:get_max(Key,Values)-Pool, - last_elem(Values,Preceding,Last), - ( - Preceding=[] -> true /* AMANUMA */ - ; otherwise ; - true -> splay_tree:put(Key,Preceding)-Pool - ), - Elem={Key,Last} - ). + splay_tree:empty(Empty)-Pool, + ( + Empty=yes -> Elem={} + ; + Empty=no -> + splay_tree:get_max(Key, Values)-Pool, + last_elem(Values, Preceding, Last), + ( + Preceding=[] -> true /* AMANUMA */ + ; otherwise ; + true -> splay_tree:put(Key, Preceding)-Pool + ), + Elem = {Key, Last} + ). message(get_min_if_any(Elem))-Pool :- - splay_tree:empty(Empty)-Pool, - ( - Empty=yes -> Elem={} - ; - Empty=no -> - splay_tree:get_min(Key,[V|Values])-Pool, - ( - Values=[] -> true - ; otherwise ; - true -> splay_tree:put(Key,Values)-Pool - ), - Elem={Key,V} - ). + splay_tree:empty(Empty)-Pool, + ( + Empty=yes -> Elem={} + ; + Empty=no -> + splay_tree:get_min(Key, [V|Values])-Pool, + ( + Values=[] -> true + ; otherwise ; + true -> splay_tree:put(Key, Values)-Pool + ), + Elem = {Key, V} + ). -flatten([])+Flat :- Flat=[]. +flatten([])+Flat :- + Flat = []. flatten([K=L|T])+Flat :- - flatten(L,K)-Flat, flatten(T)+Flat. + flatten(L, K)-Flat, + flatten(T)+Flat. -flatten([],_K,Flat,FlatT) :- Flat=FlatT. -flatten([V|T],K,Flat,FlatT) :- - Flat=[{K,V}|Flat1], flatten(T,K,Flat1,FlatT). +flatten([], _K, Flat, FlatT) :- + Flat = FlatT. +flatten([V|T], K, Flat, FlatT) :- + Flat = [{K, V} | Flat1], + flatten(T, K, Flat1, FlatT). -append([],Y,Z) :- Y=Z. -append([W|X],Y,WZ) :- WZ=[W|Z], append(X,Y,Z). +append([], Y, Z) :- Y = Z. +append([W|X], Y, WZ) :- WZ = [W|Z], append(X, Y, Z). -last_elem([X],P,L) :- P=[], L=X. +last_elem([X], P, L) :- P = [], L = X. otherwise. -last_elem([H|T],P,L) :- P=[H|P1], last_elem(T,P1,L). +last_elem([H|T], P, L) :- P = [H|P1], last_elem(T, P1, L). diff -ruN klic-3.003-2002-02-22d/runtime/bags.kl1 klic-3.003-2002-02-22e/runtime/bags.kl1 --- klic-3.003-2002-02-22d/runtime/bags.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/bags.kl1 Fri Feb 22 22:27:35 2002 @@ -1,122 +1,117 @@ -/* ---------------------------------------------------------- -% (C) 1994 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C) 1994 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ :- module sorted_bag. +:- public create/1. + create(Stream) :- - splay_tree:create(Pool), - main(Stream,[],Pool). + splay_tree:create(Pool), + main(Stream, [], Pool). -create(Cmpr,Stream) :- - splay_tree:create(Cmpr,Pool), - main(Stream,[],Pool). - -main([],[])+_Pool. -main([],[S|ST])+Pool :- main(S,ST)+Pool. -main([do(S)|T],ST)+Pool :- main(S,[T|ST])+Pool. +create(Cmpr, Stream) :- + splay_tree:create(Cmpr, Pool), + main(Stream, [], Pool). + +main([], [])+_Pool. +main([], [S|ST])+Pool :- main(S, ST)+Pool. +main([do(S)|T], ST)+Pool :- main(S, [T|ST])+Pool. otherwise. -main([Message|T],ST)+Pool :- message(Message)-Pool, main(T,ST)+Pool. +main([Message|T], ST)+Pool :- message(Message)-Pool, main(T, ST)+Pool. message(empty(YorN))-Pool :- - splay_tree:empty(YorN)-Pool. + splay_tree:empty(YorN)-Pool. message(put(Value))-Pool :- - splay_tree:empty(Value,Empty)-Pool, - ( - Empty=yes -> splay_tree:put(Value,[Value])-Pool - ; - Empty=no -> - splay_tree:update(Value,Values,New)-Pool, - append(Values,[Value],New) - ). + splay_tree:empty(Value, Empty)-Pool, + ( + Empty=yes -> splay_tree:put(Value, [Value])-Pool + ; + Empty=no -> + splay_tree:update(Value, Values, New)-Pool, + append(Values, [Value], New) + ). message(get(Value))-Pool :- - splay_tree:empty(Empty)-Pool, + splay_tree:empty(Empty)-Pool, + ( + Empty=no -> + splay_tree:get_max(Key, Values)-Pool, + last_elem(Values, Preceding, Value), ( - Empty=no -> - splay_tree:get_max(Key,Values)-Pool, - last_elem(Values,Preceding,Value), - ( - Preceding=[] -> true /* AMANUMA */ - ; otherwise ; - true -> splay_tree:put(Key,Preceding)-Pool - ) - ). - + Preceding=[] -> true /* AMANUMA */ + ; otherwise ; + true -> splay_tree:put(Key, Preceding)-Pool + ) + ). message(get_if_any(Value))-Pool :- -/* - splay_tree:empty(Empty)-Pool, - ( - Empty=yes -> Value={}, New=[] - ; - Empty=no -> - message(get_min_if_any(V))-Pool, - Value={V} - ). -*/ - message(get_min_if_any(Value))-Pool. + message(get_min_if_any(Value))-Pool. message(get_all(Values))-Pool :- - splay_tree:get_all(All)-Pool, - flatten(All,Values). + splay_tree:get_all(All)-Pool, + flatten(All, Values). message(carbon_copy(Values))-Pool :- - splay_tree:get_all(All)+Pool+_, - flatten(All,Values). + splay_tree:get_all(All)+Pool+_, + flatten(All, Values). message(get_max_if_any(Elem))-Pool :- - splay_tree:empty(Empty)-Pool, + splay_tree:empty(Empty)-Pool, + ( + Empty=yes -> Elem={} + ; + Empty=no -> + splay_tree:get_max(Key, Values)-Pool, + last_elem(Values, Preceding, Value), + Elem = {Value}, ( - Empty=yes -> Elem={} - ; - Empty=no -> - splay_tree:get_max(Key,Values)-Pool, - last_elem(Values,Preceding,Value), - Elem = {Value}, - ( - Preceding=[] -> true /* AMANUMA */ - ; otherwise ; - true -> splay_tree:put(Key,Preceding)-Pool - ) - ). + Preceding=[] -> true /* AMANUMA */ + ; otherwise ; + true -> splay_tree:put(Key, Preceding)-Pool + ) + ). message(get_min_if_any(Elem))-Pool :- - splay_tree:empty(Empty)-Pool, + splay_tree:empty(Empty)-Pool, + ( + Empty=yes -> Elem={} + ; + Empty=no -> + splay_tree:get_min(Key, [Value|Values])-Pool, + Elem = {Value}, ( - Empty=yes -> Elem={} - ; - Empty=no -> - splay_tree:get_min(Key,[Value|Values])-Pool, - Elem = {Value}, - ( - Values=[] -> true - ; otherwise ; - true -> splay_tree:put(Key,Values)-Pool - ) - ). + Values=[] -> true + ; otherwise ; + true -> splay_tree:put(Key, Values)-Pool + ) + ). -flatten([])+Flat :- Flat=[]. +flatten([])+Flat :- + Flat = []. flatten([K=L|T])+Flat :- - flatten(L,K)-Flat, flatten(T)+Flat. + flatten(L, K)-Flat, + flatten(T)+Flat. -flatten([],_K,Flat,FlatT) :- Flat=FlatT. -flatten([V|T],K,Flat,FlatT) :- - Flat=[V|Flat1], flatten(T,K,Flat1,FlatT). +flatten([], _K, Flat, FlatT) :- + Flat = FlatT. +flatten([V|T], K, Flat, FlatT) :- + Flat = [V|Flat1], + flatten(T, K, Flat1, FlatT). -append([],Y,Z) :- Y=Z. -append([W|X],Y,WZ) :- WZ=[W|Z], append(X,Y,Z). +append([], Y, Z) :- Y=Z. +append([W|X], Y, WZ) :- WZ=[W|Z], append(X, Y, Z). -last_elem([X],P,L) :- P=[], L=X. +last_elem([X], P, L) :- P=[], L=X. otherwise. -last_elem([H|T],P,L) :- P=[H|P1], last_elem(T,P1,L). +last_elem([H|T], P, L) :- P=[H|P1], last_elem(T, P1, L). diff -ruN klic-3.003-2002-02-22d/runtime/bodyblt.kl1 klic-3.003-2002-02-22e/runtime/bodyblt.kl1 --- klic-3.003-2002-02-22d/runtime/bodyblt.kl1 Fri Dec 28 13:46:47 2001 +++ klic-3.003-2002-02-22e/runtime/bodyblt.kl1 Fri Feb 22 22:27:35 2002 @@ -1,6 +1,6 @@ -/* ---------------------------------------------------------- -% (C)1993 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C)1993 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ @@ -10,91 +10,96 @@ #include #include \"timing.h\" -extern print(); +extern void print(q x); timerstruct before, after; static long gctimes_before; ". :- module builtin. +:- public print/1, current_node/2. + print(X) :- inline:"print(%0); klic_putc('\\n', stdout);":[X+any] | true. -print(X,OK) :- inline:"print(%0);":[X+any] | OK=[]. +print(X, OK) :- inline:"print(%0);":[X+any] | OK=[]. -putc(C,OK) :- inline:"klic_putc(intval(%0),stdout);":[C+int] | OK=[]. +putc(C, OK) :- inline:"klic_putc(intval(%0), stdout);":[C+int] | OK=[]. -readint(X) :- inline:"{ +readint(X) :- inline:" + { int n; int c; char buf[1024]; - char *bufp = buf; - klic_fprintf(stderr,\"> \"); + char* bufp = buf; + klic_fprintf(stderr, \"> \"); do { c = klic_getc(stdin); *bufp++ = c; } while (c != '\\n' && c != -1); %0 = makeint(atol(buf)); }":[X0-int] | X=X0. - -start_measure :- inline:"{ + +start_measure :- inline:" + { measure(before); gctimes_before = gctimes; }":[] | true. + report_measure(X) :- inline:" - measure(after); - klic_fprintf(stdout, \"heap size = %%d words\\n\", heapsize); - { + measure(after); + klic_fprintf(stdout, \"heap size = %%d words\\n\", heapsize); + { #ifdef GETRUSAGE - long u_usec = diff_usec(ru_utime); - long s_usec = diff_usec(ru_stime); - long t_usec = u_usec + s_usec; - long swaps = field_diff(ru_nswap); - long minflt = field_diff(ru_minflt); - long majflt = field_diff(ru_majflt); - long inblock = field_diff(ru_inblock); - long outblock = field_diff(ru_oublock); - long nvcsw = field_diff(ru_nvcsw); - long nivcsw = field_diff(ru_nivcsw); - %0 = makeint(t_usec/1000); - klic_fprintf(stdout, - \"%%ld ms total; %%ld user; %%ld system\\n\", - t_usec/1000, u_usec/1000, s_usec/1000); - klic_fprintf(stdout, - \" %%ld swaps; %%ld minor page faults; %%ld major page faults\\n\", - swaps, minflt, majflt); - klic_fprintf(stdout, - \" %%ld block inputs; %%ld block outputs\\n\", - inblock, outblock); + long u_usec = diff_usec(ru_utime); + long s_usec = diff_usec(ru_stime); + long t_usec = u_usec + s_usec; + long swaps = field_diff(ru_nswap); + long minflt = field_diff(ru_minflt); + long majflt = field_diff(ru_majflt); + long inblock = field_diff(ru_inblock); + long outblock = field_diff(ru_oublock); + long nvcsw = field_diff(ru_nvcsw); + long nivcsw = field_diff(ru_nivcsw); + %0 = makeint(t_usec/1000); + klic_fprintf(stdout, + \"%%ld ms total; %%ld user; %%ld system\\n\", + t_usec/1000, u_usec/1000, s_usec/1000 ); + klic_fprintf(stdout, + \" %%ld swaps; %%ld minor page faults; %%ld major page faults\\n\", + swaps, minflt, majflt ); + klic_fprintf(stdout, + \" %%ld block inputs; %%ld block outputs\\n\", + inblock, outblock ); + klic_fprintf(stdout, + \" %%ld context switches (%%ld voluntary)\\n\", + nvcsw+nivcsw, nvcsw ); +#else /* not GETRUSAGE */ + long u_msec = (int) tick2msec(field_diff(tms_utime)); + long s_msec = (int) tick2msec(field_diff(tms_stime)); + long t_msec = + (int) (tick2msec(field_diff(tms_utime)) + + tick2msec(field_diff(tms_stime)) ); + %0 = makeint(t_msec); + klic_fprintf(stdout, + \"%%ld ms total; %%ld user; %%ld system\\n\", + t_msec, u_msec, s_msec ); +#endif /* not GETRUSAGE */ + klic_fprintf(stdout, \" \"); + if (measure_gc) { klic_fprintf(stdout, - \" %%ld context switches (%%ld voluntary)\\n\", - nvcsw+nivcsw, nvcsw); -#else - long u_msec = (int) tick2msec(field_diff(tms_utime)); - long s_msec = (int) tick2msec(field_diff(tms_stime)); - long t_msec = - (int) (tick2msec(field_diff(tms_utime)) + - tick2msec(field_diff(tms_stime))); - %0 = makeint(t_msec); + \"%%ld ms utime & %%ld ms stime in \", + gcums, gcsms ); + } + klic_fprintf(stdout, \"%%ld GC\\n\", gctimes-gctimes_before); + klic_fprintf(stdout, \" %%ld suspensions; %%ld resumptions\\n\", + suspensions, resumes); + if (cum_susps != 0 || cum_resumps != 0) { klic_fprintf(stdout, - \"%%ld ms total; %%ld user; %%ld system\\n\", - t_msec, u_msec, s_msec); -#endif - klic_fprintf(stdout, \" \"); - if (measure_gc) { - klic_fprintf(stdout, - \"%%ld ms utime & %%ld ms stime in \", - gcums, gcsms); - } - klic_fprintf(stdout, \"%%ld GC\\n\", gctimes-gctimes_before); - klic_fprintf(stdout, \" %%ld suspensions; %%ld resumptions\\n\", - suspensions, resumes); - if (cum_susps != 0 || cum_resumps != 0) { - klic_fprintf(stdout, - \" %%ld total suspensions; %%ld total resumptions\\n\", - cum_susps+suspensions, cum_resumps+resumes); - } + \" %%ld total suspensions; %%ld total resumptions\\n\", + cum_susps+suspensions, cum_resumps+resumes); + } }":[X0-int] | X=X0. -current_node(X,Y) :- current_node(X,Y). +current_node(X, Y) :- current_node(X, Y). idle :- true | true. diff -ruN klic-3.003-2002-02-22d/runtime/compare.kl1 klic-3.003-2002-02-22e/runtime/compare.kl1 --- klic-3.003-2002-02-22d/runtime/compare.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/compare.kl1 Fri Feb 22 22:27:35 2002 @@ -1,14 +1,15 @@ -/* ---------------------------------------------------------- -% (C)1993,1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C)1993,1994,1995 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ + :- module comparator. -/* - Default Comparator -*/ +:- public sort/5. % called in splay.kl1 + +/* Default Comparator */ sort(X0,Y0,X,Y,S) :- compare(X0,Y0,Ans), Ans=<0 | S= no, X=X0, Y=Y0. sort(X0,Y0,X,Y,S) :- compare(X0,Y0,Ans), Ans >0 | S=yes, X=Y0, Y=X0. diff -ruN klic-3.003-2002-02-22d/runtime/farith.kl1 klic-3.003-2002-02-22e/runtime/farith.kl1 --- klic-3.003-2002-02-22d/runtime/farith.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/farith.kl1 Fri Feb 22 22:27:35 2002 @@ -7,6 +7,8 @@ :- module floating_arithmetics. +% :- public floating_point_*/2, floating_point_*/3. + floating_point_add(X,Y,Z) :- generic:add(X,Y,Z). floating_point_subtract(X,Y,Z) :- generic:subtract(X,Y,Z). floating_point_multiply(X,Y,Z) :- generic:multiply(X,Y,Z). diff -ruN klic-3.003-2002-02-22d/runtime/functt.kl1 klic-3.003-2002-02-22e/runtime/functt.kl1 --- klic-3.003-2002-02-22d/runtime/functt.kl1 Sun Jan 13 10:27:34 2002 +++ klic-3.003-2002-02-22e/runtime/functt.kl1 Fri Feb 22 22:27:35 2002 @@ -1,89 +1,94 @@ -/* ---------------------------------------------------------- -% (C)1993,1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C)1993, 1994, 1995 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ -:- inline:"extern unsigned long enter_functor();". +:- inline:"#include /* enter_functor */". :- module functor_table. -new_functor(Funct,'.',2) :- Funct=[0|0]. -otherwise. -new_functor(Funct,Atom,0) :- atom(Atom) | Funct=Atom. -new_functor(Funct,Atom,Arity):- - Arity > 0, - inline:" -{ - long i, arity = intval(%1); - allocp[0] = makesym(enter_functor(symval(%0), arity)); - for (i=1; i<=arity; i++) allocp[i] = makeint(0); - %2 = makefunctor(allocp); - allocp += arity+1; -}":[Atom+atom,Arity+int,Funct0-functor] | - Funct = Funct0. +:- public new_functor/3, '=..'/2, setarg/5. -F=..[PF] :- F=PF. -F=..['.',X,Y] :- F=[X|Y]. +new_functor(Funct, '.', 2) :- + Funct = [0 | 0]. +otherwise. +new_functor(Funct, Atom, 0) :- atom(Atom) | + Funct = Atom. +new_functor(Funct, Atom, Arity) :- Arity > 0, inline:" + { + long i, arity = intval(%1); + allocp[0] = makesym(enter_functor(symval(%0), arity)); + for (i=1; i<=arity; i++) allocp[i] = makeint(0); + %2 = makefunctor(allocp); + allocp += arity+1; + }": [Atom+atom, Arity+int, Funct0-functor] | + Funct = Funct0. + +F =.. [PF] :- + F = PF. +F =.. ['.', X, Y] :- + F = [X | Y]. otherwise. -F=..[PF|L] :- - length(L,0,Arity), - new_functor(F0,PF,Arity), - fill_args(L,0,F0,F). - -length([],K,N) :- N=K. -length([_|T],K,N) :- length(T,~(K+1),N). - -fill_args([],_,F0,F) :- F=F0. -fill_args([H|T],K,F0,F) :- inline:" -{ - struct functor* f = functorp(%0); - f->args[intval(%1)] = %2; - %3 = makefunctor(f); -}":[F0+functor,K+int,H+any,F1-functor] | - K1 := K+1, - fill_args(T,K1,F1,F). - -functor(Funct,Atom,Arity) :- - functor(Funct,Atom0,Arity0) | - Atom = Atom0, Arity = Arity0. - -functor(Funct,Atom,Arity,NFunct) :- - functor(Funct,Atom0,Arity0) | - Atom = Atom0, Arity = Arity0, NFunct = Funct. - -arg(Index,Funct,Ele) :- - arg(Index,Funct,Ele0) | - Ele = Ele0. - -arg(Index,Funct,Ele,NFunct) :- - arg(Index,Funct,Ele0) | - Ele = Ele0, NFunct = Funct. - -setarg(Index,Funct,Old,Ele,NFunct) :- - arg(Index,Funct,Old0) | - Old=Old0, - setarg(Index,Funct,Ele,NFunct). - -setarg(N,[_Car|Cdr],NewCar,NFunct) :- N=1 | NFunct=[NewCar|Cdr]. -setarg(N,[Car|_Cdr],NewCdr,NFunct) :- N=2 | NFunct=[Car|NewCdr]. -setarg(Index,Funct,Ele,NFunct) :- inline:" -{ - if( !isfunctor(%0) ){ - goto %f; - }else{ +F =.. [PF | L] :- + length(L, 0, Arity), + new_functor(F0, PF, Arity), + fill_args(L, 0, F0, F). + +length([], K, N) :- N=K. +length([_|T], K, N) :- length(T, ~(K+1), N). + +fill_args([], _, F0, F) :- + F = F0. +fill_args([H|T], K, F0, F) :- inline:" + { struct functor* f = functorp(%0); - int index = intval(%1); - q pf = f->functor; - int size = arityof(pf); - int k; - allocp[0] = pf; - for (k=1; k<=size; k++) { - allocp[k] = (k == index ? %3 : f->args[k-1]); + f->args[intval(%1)] = %2; + %3 = makefunctor(f); + }": [F0+functor, K+int, H+any, F1-functor] | + K1 := K+1, + fill_args(T, K1, F1, F). + +functor(Funct, Atom, Arity) :- + functor(Funct, Atom0, Arity0) | + Atom = Atom0, Arity = Arity0. + +functor(Funct, Atom, Arity, NFunct) :- + functor(Funct, Atom0, Arity0) | + Atom = Atom0, Arity = Arity0, NFunct = Funct. + +arg(Index, Funct, Ele) :- + arg(Index, Funct, Ele0) | + Ele = Ele0. + +arg(Index, Funct, Ele, NFunct) :- + arg(Index, Funct, Ele0) | + Ele = Ele0, NFunct = Funct. + +setarg(Index, Funct, Old, Ele, NFunct) :- + arg(Index, Funct, Old0) | + Old = Old0, + setarg(Index, Funct, Ele, NFunct). + +setarg(N, [_Car|Cdr], NewCar, NFunct) :- N=1 | NFunct=[NewCar|Cdr]. +setarg(N, [Car|_Cdr], NewCdr, NFunct) :- N=2 | NFunct=[Car|NewCdr]. +setarg(Index, Funct, Ele, NFunct) :- inline:" + { + if( !isfunctor(%0) ){ + goto %f; + }else{ + struct functor* f = functorp(%0); + int index = intval(%1); + q pf = f->functor; + int size = arityof(pf); + int k; + allocp[0] = pf; + for (k=1; k<=size; k++) { + allocp[k] = (k == index ? %3 : f->args[k-1]); + } + %2 = makefunctor(allocp); + allocp += size+1; } - %2 = makefunctor(allocp); - allocp += size+1; - } -}":[Funct+functor,Index+int,NF0-functor,Ele+any] | - NFunct=NF0. + }":[Funct+functor, Index+int, NF0-functor, Ele+any] | + NFunct = NF0. diff -ruN klic-3.003-2002-02-22d/runtime/gcmerge.kl1 klic-3.003-2002-02-22e/runtime/gcmerge.kl1 --- klic-3.003-2002-02-22d/runtime/gcmerge.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/gcmerge.kl1 Fri Feb 22 22:27:35 2002 @@ -1,15 +1,17 @@ -/* ---------------------------------------------------------- -% (C)1993,1994 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C)1993,1994 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ :- module gcmerge. -in(Var,Vec,I,N):- I1:= I+1, I1 < N | - generic:element(Vec,I,E), - Var = {E,NVar}, - in(NVar,Vec,I1,N). -in(Var,Vec,I,N):- I1:= I+1, I1 =:= N | - generic:element(Vec,I,Var). +:- public in/4. % called in gmerge.c + +in(Var, Vec, I, N) :- I1 := I+1, I1 < N | + generic:element(Vec, I, E), + Var = {E, NVar}, + in(NVar, Vec, I1, N). +in(Var, Vec, I, N) :- I1 := I+1, I1 =:= N | + generic:element(Vec, I, Var). diff -ruN klic-3.003-2002-02-22d/runtime/gen.kl1 klic-3.003-2002-02-22e/runtime/gen.kl1 --- klic-3.003-2002-02-22d/runtime/gen.kl1 Sat Feb 16 11:56:15 2002 +++ klic-3.003-2002-02-22e/runtime/gen.kl1 Fri Feb 22 22:27:35 2002 @@ -1,39 +1,41 @@ -/* ---------------------------------------------------------- -% (C)1993,1994 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C)1993, 1994 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ :- inline:" +#include /* enter_functor */ #include \"gobj.h\" #include \"g_pointer.h\" #include \"g_termarray.h\" -extern unsigned long enter_functor(); - typedef q* (*gd_func)(); ". :- module generic. -new(X,Funct,Argv) :- inline:" -{ - unsigned long argc; - q* argv; - gd_func func = - (gd_func) (((struct pointer_object*) (data_objectp(%1)))->pointer); - argc = ((struct termarray_object*) (data_objectp(%2)))->nterm; - argv = ((struct termarray_object*) (data_objectp(%2)))->terms; - %0 = (q) func(argc, argv, allocp); - allocp = heapp(); -}":[X0-any,Funct+functor,Argv+functor] | X0=X. - -generic(Funct,Obj) :- inline:" - allocp = gd_generic(allocp, %1, symval((functorp(%0))->functor), - &(functorp(%0)->args[0])); -":[Funct+functor,Obj+object] | true . -generic(Funct,Obj) :- inline:"{ - unsigned long funct = enter_functor(symval(%0), 0); - allocp = gd_generic(allocp, %1, funct, 0); -}":[Funct+atom,Obj+object] | true . +:- public new/3, generic/2. + +new(X, Funct, Argv) :- inline:" + { + unsigned long argc; + q* argv; + gd_func func = + (gd_func) ((struct pointer_object*) data_objectp(%1))->pointer; + argc = ((struct termarray_object*) data_objectp(%2))->nterm; + argv = ((struct termarray_object*) data_objectp(%2))->terms; + %0 = (q) func(argc, argv, allocp); + allocp = heapp(); + }": [X0-any, Funct+functor, Argv+functor] | X0=X. + +generic(Funct, Obj) :- inline:" + allocp = gd_generic(allocp, %1, symval(functorp(%0)->functor), + &(functorp(%0)->args[0]) ); +": [Funct+functor, Obj+object] | true . +generic(Funct, Obj) :- inline:" + { + unsigned long funct = enter_functor(symval(%0), 0); + allocp = gd_generic(allocp, %1, funct, 0); + }": [Funct+atom, Obj+object] | true . diff -ruN klic-3.003-2002-02-22d/runtime/gunix.kl1 klic-3.003-2002-02-22e/runtime/gunix.kl1 --- klic-3.003-2002-02-22d/runtime/gunix.kl1 Wed Feb 20 16:11:39 2002 +++ klic-3.003-2002-02-22e/runtime/gunix.kl1 Fri Feb 22 22:27:35 2002 @@ -1,13 +1,13 @@ -/* ---------------------------------------------------------- -% (C)1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C)1994, 1995 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ :- inline:" #include -#include +#include /* getenv */ #include #include #include @@ -59,7 +59,6 @@ extern q convert_binary_c_string_to_klic_string(); extern q gd_new_pointer(); -extern char* getenv(); static NeverReturn void klic_exit(N) @@ -83,7 +82,7 @@ allocp = heapp(); \\ }while(0) -#define Fopen(P,F,L,M) \\ +#define Fopen(P, F, L, M) \\ do{ \\ char* path = KLIC2C(P); \\ FILE* file = fopen(path, (M)); \\ @@ -92,7 +91,7 @@ MakeFilePointer((F), file); \\ }while(0) -#define Fdopen(Fd,F,L,M) \\ +#define Fdopen(Fd, F, L, M) \\ do{ \\ FILE* file = fdopen((Fd), (M)); \\ if( file==NULL ) goto L; \\ @@ -152,13 +151,13 @@ #define MakeInBuf(klicvar, fd, size) \\ do{ \\ - (klicvar) = gd_new_pointer((q) make_iobuf((fd),(size),0), allocp); \\ + (klicvar) = gd_new_pointer((q) make_iobuf((fd), (size), 0), allocp); \\ allocp = heapp(); \\ }while(0) #define MakeOutBuf(klicvar, fd, size) \\ do{ \\ - (klicvar) = gd_new_pointer((q) make_iobuf((fd),(size),1), allocp); \\ + (klicvar) = gd_new_pointer((q) make_iobuf((fd), (size), 1), allocp); \\ allocp = heapp(); \\ }while(0) @@ -167,7 +166,7 @@ #define MakeBIOBuf(klicvar, ifd, ofd, size) \\ do{ \\ - (klicvar) = gd_new_pointer((q) make_biobuf((ifd),(ofd),(size)), allocp); \\ + (klicvar) = gd_new_pointer((q) make_biobuf((ifd), (ofd), (size)), allocp); \\ allocp = heapp(); \\ }while(0) @@ -181,7 +180,7 @@ for(;;){ int result = read(iob->fd, iob->buf, iob->bufsize); if( result == 0 ){ - return 0; /* end of file */ + return 0; /* end of file */ }else if( result > 0 ){ iob->lim = iob->buf + result; iob->ptr = iob->buf; @@ -200,11 +199,11 @@ #if defined(EWOULDBLOCK) && EWOULDBLOCK != EAGAIN case EWOULDBLOCK: #endif - return -1; + return -1; #endif /* ASINCIO */ default: - fatalp(\"read\", \"Error in asynchronous input\"); + fatalp(\"read\", \"Error in asynchronous input\"); } } } @@ -220,11 +219,11 @@ if( result >= 0 ){ wp += result; if( wp != iob->ptr ){ - continue; + continue; }else{ - iob->lim = iob->buf + iob->bufsize; - iob->ptr = iob->buf; - return 1; + iob->lim = iob->buf + iob->bufsize; + iob->ptr = iob->buf; + return 1; } }else{ /* write error */ switch( errno ){ @@ -243,42 +242,42 @@ /* * Patch to detour a suspected bug of SunOS 4.1.3 - * (1994/12/02 Takashi Chikayama) + * (1994/12/02 Takashi Chikayama) * * As SIGIO signal is not raised during sigpause for socket output, * we will use polling instead of signal-based I/O. * * The original code was the following. * - * return -1; + * return -1; */ /* Begin Patch */ - { - fd_set fdsw; - int fd_setsize; + { + fd_set fdsw; + int fd_setsize; #ifdef USEGETDTABLESIZE - fd_setsize = getdtablesize(); + fd_setsize = getdtablesize(); #else #ifdef USEULIMIT - fd_setsize = ulimit(4, 0); - if( fd_setsize < 0 ){ - fatal(\"Can't obtain file descriptor table size\"); - } + fd_setsize = ulimit(4, 0); + if( fd_setsize < 0 ){ + fatal(\"Can't obtain file descriptor table size\"); + } #else - fatal(\"Don't know how to obtaine file descriptor table size\"); + fatal(\"Don't know how to obtaine file descriptor table size\"); #endif #endif /* USEGETDTABLESIZE */ - FD_ZERO(&fdsw); - FD_SET(iob->fd, &fdsw); - select(fd_setsize, 0, &fdsw, 0, 0); - } - continue; + FD_ZERO(&fdsw); + FD_SET(iob->fd, &fdsw); + select(fd_setsize, 0, &fdsw, 0, 0); + } + continue; /* End of Patch */ #endif /* ASYNCIO */ default: - fatalp(\"write\", \"Error in asynchronous output\"); + fatalp(\"write\", \"Error in asynchronous output\"); } } } @@ -311,1010 +310,1041 @@ :- module unix. +:- public argc/1, argv/1, exit/1, unix/1. + exit(Stat) :- inline:" klic_exit(intval(%0)); -":[Stat+int] | true. +": [Stat+int] | true. unix([]). -unix([stdin(R)|Cmnds]) :- stdin(R0), cont(R0,R,Cmnds). -unix([stdout(R)|Cmnds]) :- stdout(R0), cont(R0,R,Cmnds). -unix([stderr(R)|Cmnds]) :- stderr(R0), cont(R0,R,Cmnds). -unix([stdio(R)|Cmnds]) :- stdio(R0), cont(R0,R,Cmnds). -unix([read_open(P,R)|Cmnds]) :- read_open(P,R0), cont(R0,R,Cmnds). -unix([write_open(P,R)|Cmnds]) :- write_open(P,R0), cont(R0,R,Cmnds). -unix([append_open(P,R)|Cmnds]) :- append_open(P,R0), cont(R0,R,Cmnds). -unix([update_open(P,R)|Cmnds]) :- update_open(P,R0), cont(R0,R,Cmnds). -unix([signal_stream(S,R)|Cmnds]):- signal_stream(S,R0), cont(R0,R,Cmnds). -unix([connect(A,R)|Cmnds]) :- connect(A,R0), cont(R0,R,Cmnds). -unix([connect2(A,R)|Cmnds]) :- connect2(A,R0), cont(R0,R,Cmnds). -unix([bind(A,R)|Cmnds]) :- bind(A,R0), cont(R0,R,Cmnds). -unix([pipe(R)|Cmnds]) :- pipe(R0), cont(R0,R,Cmnds). -unix([system(S,R)|Cmnds]) :- system(S,R0), cont(R0,R,Cmnds). -unix([cd(Dir,R)|Cmnds]) :- cd(Dir,R0), cont(R0,R,Cmnds). -unix([unlink(F,R)|Cmnds]) :- unlink(F,R0), cont(R0,R,Cmnds). -unix([mktemp(T,R)|Cmnds]) :- mktemp(T,R0), cont(R0,R,Cmnds). -unix([access(P,M,R)|Cmnds]) :- access(P,M,R0), cont(R0,R,Cmnds). -unix([chmod(P,N,R)|Cmnds]) :- chmod(P,N,R0), cont(R0,R,Cmnds). -unix([umask(R)|Cmnds]) :- umask(R0), cont(R0,R,Cmnds). -unix([umask(O,R)|Cmnds]) :- umask(O,R0), cont(R0,R,Cmnds). -unix([getenv(N,R)|Cmnds]) :- getenv(N,R0), cont(R0,R,Cmnds). -unix([putenv(S,R)|Cmnds]) :- putenv(S,R0), cont(R0,R,Cmnds). -unix([kill(P,S,R)|Cmnds]) :- kill(P,S,R0), cont(R0,R,Cmnds). -unix([fork(R)|Cmnds]) :- fork(R0), cont(R0,R,Cmnds). -unix([fork_with_pipes(R)|Cmnds]) :- fork_with_pipes(R0), cont(R0,R,Cmnds). -unix([sync(R)|Cmnds]) :- R=0, unix(Cmnds). +unix([stdin(R)|Cmnds]) :- stdin(R0), cont(R0, R, Cmnds). +unix([stdout(R)|Cmnds]) :- stdout(R0), cont(R0, R, Cmnds). +unix([stderr(R)|Cmnds]) :- stderr(R0), cont(R0, R, Cmnds). +unix([stdio(R)|Cmnds]) :- stdio(R0), cont(R0, R, Cmnds). +unix([read_open(P, R)|Cmnds]) :- read_open(P, R0), cont(R0, R, Cmnds). +unix([write_open(P, R)|Cmnds]) :- write_open(P, R0), cont(R0, R, Cmnds). +unix([append_open(P, R)|Cmnds]) :- append_open(P, R0), cont(R0, R, Cmnds). +unix([update_open(P, R)|Cmnds]) :- update_open(P, R0), cont(R0, R, Cmnds). +unix([signal_stream(S, R)|Cmnds]) :- signal_stream(S, R0), cont(R0, R, Cmnds). +unix([connect(A, R)|Cmnds]) :- connect(A, R0), cont(R0, R, Cmnds). +unix([connect2(A, R)|Cmnds]) :- connect2(A, R0), cont(R0, R, Cmnds). +unix([bind(A, R)|Cmnds]) :- bind(A, R0), cont(R0, R, Cmnds). +unix([pipe(R)|Cmnds]) :- pipe(R0), cont(R0, R, Cmnds). +unix([system(S, R)|Cmnds]) :- system(S, R0), cont(R0, R, Cmnds). +unix([cd(Dir, R)|Cmnds]) :- cd(Dir, R0), cont(R0, R, Cmnds). +unix([unlink(F, R)|Cmnds]) :- unlink(F, R0), cont(R0, R, Cmnds). +unix([mktemp(T, R)|Cmnds]) :- mktemp(T, R0), cont(R0, R, Cmnds). +unix([access(P, M, R)|Cmnds]) :- access(P, M, R0), cont(R0, R, Cmnds). +unix([chmod(P, N, R)|Cmnds]) :- chmod(P, N, R0), cont(R0, R, Cmnds). +unix([umask(R)|Cmnds]) :- umask(R0), cont(R0, R, Cmnds). +unix([umask(O, R)|Cmnds]) :- umask(O, R0), cont(R0, R, Cmnds). +unix([getenv(N, R)|Cmnds]) :- getenv(N, R0), cont(R0, R, Cmnds). +unix([putenv(S, R)|Cmnds]) :- putenv(S, R0), cont(R0, R, Cmnds). +unix([kill(P, S, R)|Cmnds]) :- kill(P, S, R0), cont(R0, R, Cmnds). +unix([fork(R)|Cmnds]) :- fork(R0), cont(R0, R, Cmnds). +unix([fork_with_pipes(R)|Cmnds]) :- fork_with_pipes(R0), cont(R0, R, Cmnds). +unix([sync(R)|Cmnds]) :- R=0, unix(Cmnds). -cont(R0,R,Cmnds) :- wait(R0) | R=R0, unix(Cmnds). +cont(R0, R, Cmnds) :- wait(R0) | R=R0, unix(Cmnds). /**************************************** - STRTEAM I/O + STRTEAM I/O ****************************************/ /* Opening streams */ -stdin(R) :- inline:"MakeFilePointer(%0, stdin);":[F-object] | - generic:new(file_io,S,F,"stdin",[],""), R=normal(S). +stdin(R) :- inline:"MakeFilePointer(%0, stdin);": [F-object] | + generic:new(file_io, S, F, "stdin", [], ""), R=normal(S). -stdout(R) :- inline:"MakeFilePointer(%0, stdout);":[F-object] | - generic:new(file_io,S,[],"",F,"stdout"), R=normal(S). +stdout(R) :- inline:"MakeFilePointer(%0, stdout);": [F-object] | + generic:new(file_io, S, [], "", F, "stdout"), R=normal(S). -stderr(R) :- inline:"MakeFilePointer(%0, stderr);":[F-object] | - generic:new(file_io,S,[],"",F,"stdout"), R=normal(S). +stderr(R) :- inline:"MakeFilePointer(%0, stderr);": [F-object] | + generic:new(file_io, S, [], "", F, "stdout"), R=normal(S). stdio(R) :- inline:" -{ - MakeFilePointer(%0, stdin); - MakeFilePointer(%1, stdout); -}":[FI-object, FO-object] | - generic:new(file_io,S,FI,"stdin",FO,"stdout"), R=normal(S). - -read_open(P,R) :- - inline:"Fopen(%0,%1,%f,\"r\");":[P+object(byte_string),F-object] | - generic:new(file_io,S,F,P,[],""), R=normal(S). + { + MakeFilePointer(%0, stdin); + MakeFilePointer(%1, stdout); + }": [FI-object, FO-object] | + generic:new(file_io, S, FI, "stdin", FO, "stdout"), R=normal(S). + +read_open(P, R) :- + inline:"Fopen(%0, %1, %f, \"r\");": [P+object(byte_string), F-object] | + generic:new(file_io, S, F, P, [], ""), R=normal(S). otherwise. -read_open(_,R) :- R=abnormal. +read_open(_, R) :- + R = abnormal. -write_open(P,R) :- - inline:"Fopen(%0,%1,%f,\"w\");":[P+object(byte_string),F-object] | - generic:new(file_io,S,[],"",F,P), R=normal(S). +write_open(P, R) :- + inline:"Fopen(%0, %1, %f, \"w\");": [P+object(byte_string), F-object] | + generic:new(file_io, S, [], "", F, P), R=normal(S). otherwise. -write_open(_,R) :- R=abnormal. +write_open(_, R) :- + R = abnormal. -append_open(P,R) :- - inline:"Fopen(%0,%1,%f,\"a\");":[P+object(byte_string),F-object] | - generic:new(file_io,S,[],"",F,P), R=normal(S). +append_open(P, R) :- + inline:"Fopen(%0, %1, %f, \"a\");": [P+object(byte_string), F-object] | + generic:new(file_io, S, [], "", F, P), R=normal(S). otherwise. -append_open(_,R) :- R=abnormal. +append_open(_, R) :- + R = abnormal. -update_open(P,R) :- - inline:"Fopen(%0,%1,%f,\"r+\");":[P+object(byte_string),F-object] | - generic:new(file_io,S,F,P,F,P), R=normal(S). +update_open(P, R) :- + inline:"Fopen(%0, %1, %f, \"r+\");": [P+object(byte_string), F-object] | + generic:new(file_io, S, F, P, F, P), R=normal(S). otherwise. -update_open(_,R) :- R=abnormal. +update_open(_, R) :- + R = abnormal. -signal_stream(S,R) :- signal_stream(S,R,_). +signal_stream(S, R) :- signal_stream(S, R, _). -signal_stream(S,R,X) :- inline:" -{ +signal_stream(S, R, X) :- inline:" #ifdef USESIG - set_heapp(allocp); - register_streamed_signal(intval(%0), %1); - allocp = heapp(); + { + set_heapp(allocp); + register_streamed_signal(intval(%0), %1); + allocp = heapp(); + } #else goto %f; #endif -}":[S+int,X+any] | - R = normal(X). - -net_convert(unix(Path),Fam,Addr) :- inline:" -{ - int family = PF_UNIX; - struct sockaddr* addr; - char* path = KLIC2C(%0); - - addr = - (struct sockaddr*) malloc_check(sizeof(struct sockaddr) + strlen(path)); - addr->sa_family = family; - strcpy(addr->sa_data, path); - free(path); - %1 = makeint(family); - %2 = gd_new_pointer((q) addr, allocp); - allocp = heapp(); -}":[Path+object(byte_string),Fam0-int,Addr0-object(pointer)] | - Fam=Fam0, Addr=Addr0. -net_convert(inet(HostName,Port),Fam,Addr) :- inline:" -{ - int family = PF_INET; - struct sockaddr_in* addr; - char* host = KLIC2C(%0); - struct hostent* ent = gethostbyname(host); - - if( ent == NULL ){ fatalf(\"Unknown host %%s\", host); } - free(host); - addr = (struct sockaddr_in*) - malloc_check(sizeof(struct sockaddr_in)); - addr->sin_family = family; - BCOPY((char*) *ent->h_addr_list, (char*) &addr->sin_addr, - sizeof(struct in_addr)); - /* - * The following is not used as some systems don't understand it. - * - * addr->sin_addr.S_un.S_addr = *(int*) *ent->h_addr_list; - */ - addr->sin_port = htons(intval(%1)); - %2 = makeint(family); - %3 = gd_new_pointer((q) addr, allocp); - allocp = heapp(); -}":[HostName+object(byte_string),Port+int, - Fam0-int,Addr0-object(pointer)] | - Fam=Fam0, Addr=Addr0. -net_convert(inet({B1,B2,B3,B4},Port),Fam,Addr) :- inline:" -{ - int family = PF_INET; - struct sockaddr_in* addr; - int b1, b2, b3, b4; - unsigned long laddr; - char buf[100]; - - addr = (struct sockaddr_in*) - malloc_check(sizeof(struct sockaddr_in)); - addr->sin_family = family; - b1 = intval(%0); b2 = intval(%1); b3 = intval(%2); b4 = intval(%3); - sprintf(buf, \"%%d.%%d.%%d.%%d\", b1, b2, b3, b4); - laddr = inet_addr(buf); - if( laddr == -1 ) goto %f; - BCOPY((char*) &laddr, (char*) &addr->sin_addr, sizeof(struct in_addr)); - /* - * The following is not used as some systems don't understand it. - * - * addr->sin_addr.S_un.S_un_b.s_b1 = intval(%0); - * addr->sin_addr.S_un.S_un_b.s_b2 = intval(%1); - * addr->sin_addr.S_un.S_un_b.s_b3 = intval(%2); - * addr->sin_addr.S_un.S_un_b.s_b4 = intval(%3); - */ - addr->sin_port = htons(intval(%4)); - %5 = makeint(family); - %6 = gd_new_pointer((q) addr, allocp); - allocp = heapp(); -}":[B1+int,B2+int,B3+int,B4+int,Port+int, - Fam0-int,Addr0-object(pointer)] | - Fam=Fam0, Addr=Addr0. - -connect(Spec,R) :- - net_convert(Spec,Fam,Addr), - connect(Fam,Addr,_Async,R). - -connect(Fam,Addr,Async,R) :- inline:" -{ - int family = intval(%0); - int sock = socket(family, SOCK_STREAM, 0); +": [S+int, X+any] | + R = normal(X). - if( sock < 0 ){ fatalp(\"socket\", \"Socket creation error\"); } -#ifdef ASYNCIO - init_asynchronous_io(); - setasync(sock, \"connection\"); - register_asynchronous_io_stream(sock, %1); +net_convert(unix(Path), Fam, Addr) :- inline:" + { + int family = PF_UNIX; + struct sockaddr* addr; + char* path = KLIC2C(%0); + + addr = (struct sockaddr*) + malloc_check(sizeof(struct sockaddr) + strlen(path)); + addr->sa_family = family; + strcpy(addr->sa_data, path); + free(path); + %1 = makeint(family); + %2 = gd_new_pointer((q) addr, allocp); + allocp = heapp(); + }": [Path+object(byte_string), Fam0-int, Addr0-object(pointer)] | + Fam=Fam0, Addr=Addr0. +net_convert(inet(HostName, Port), Fam, Addr) :- inline:" + { + int family = PF_INET; + struct sockaddr_in* addr; + char* host = KLIC2C(%0); + struct hostent* ent = gethostbyname(host); + + if( ent == NULL ){ fatalf(\"Unknown host %%s\", host); } + free(host); + addr = (struct sockaddr_in*) + malloc_check(sizeof(struct sockaddr_in)); + addr->sin_family = family; + BCOPY((char*) *ent->h_addr_list, (char*) &addr->sin_addr, + sizeof(struct in_addr)); + /* + * The following is not used as some systems don't understand it. + * + * addr->sin_addr.S_un.S_addr = *(int*) *ent->h_addr_list; + */ + addr->sin_port = htons(intval(%1)); + %2 = makeint(family); + %3 = gd_new_pointer((q) addr, allocp); + allocp = heapp(); + }": [HostName+object(byte_string), Port+int, + Fam0-int, Addr0-object(pointer)] | + Fam=Fam0, Addr=Addr0. +net_convert(inet({B1, B2, B3, B4}, Port), Fam, Addr) :- inline:" + { + int family = PF_INET; + struct sockaddr_in* addr; + int b1, b2, b3, b4; + unsigned long laddr; + char buf[100]; + + addr = (struct sockaddr_in*) + malloc_check(sizeof(struct sockaddr_in)); + addr->sin_family = family; + b1 = intval(%0); b2 = intval(%1); b3 = intval(%2); b4 = intval(%3); + sprintf(buf, \"%%d.%%d.%%d.%%d\", b1, b2, b3, b4); + laddr = inet_addr(buf); + if( laddr == -1 ) goto %f; + BCOPY((char*) &laddr, (char*) &addr->sin_addr, sizeof(struct in_addr)); + /* + * The following is not used as some systems don't understand it. + * + * addr->sin_addr.S_un.S_un_b.s_b1 = intval(%0); + * addr->sin_addr.S_un.S_un_b.s_b2 = intval(%1); + * addr->sin_addr.S_un.S_un_b.s_b3 = intval(%2); + * addr->sin_addr.S_un.S_un_b.s_b4 = intval(%3); + */ + addr->sin_port = htons(intval(%4)); + %5 = makeint(family); + %6 = gd_new_pointer((q) addr, allocp); + allocp = heapp(); + }": [B1+int, B2+int, B3+int, B4+int, Port+int, + Fam0-int, Addr0-object(pointer)] | + Fam=Fam0, Addr=Addr0. + +connect(Spec, R) :- + net_convert(Spec, Fam, Addr), + connect(Fam, Addr, _Async, R). + +connect(Fam, Addr, Async, R) :- inline:" + { + int family = intval(%0); + int sock = socket(family, SOCK_STREAM, 0); + + if( sock < 0 ){ fatalp(\"socket\", \"Socket creation error\"); } +#ifdef ASYNCIO + init_asynchronous_io(); + setasync(sock, \"connection\"); + register_asynchronous_io_stream(sock, %1); +#endif + %2 = makeint(sock); + }": [Fam+int, Async+any, FD-int] | + connect_sub(FD, Addr, Async, R). + +connect_sub(FD, Addr, Async, R) :- inline:" + { + int sock = intval(%0); + struct sockaddr* addr = (struct sockaddr*) + ((struct pointer_object*) data_objectp(%1))->pointer; + + again: + if( connect(sock, addr, sizeof(struct sockaddr)) < 0 ){ +#ifdef ASYNCIO + if( errno == EINTR ) goto again; + if( errno != EISCONN ){ + if( errno == EINPROGRESS || errno == EALREADY ) goto %f; #endif - %2 = makeint(sock); -}":[Fam+int,Async+any,FD-int] | - connect_sub(FD,Addr,Async,R). - -connect_sub(FD,Addr,Async,R) :- inline:" -{ - int sock = intval(%0); - struct sockaddr* addr = (struct sockaddr*) - ((struct pointer_object*) data_objectp(%1))->pointer; - - again: - if( connect(sock, addr, sizeof(struct sockaddr)) < 0 ){ + fatalp(\"connect\", \"Socket connection error\"); #ifdef ASYNCIO - if( errno == EINTR ) goto again; - if( errno != EISCONN ){ - if( errno == EINPROGRESS || errno == EALREADY ) goto %f; + } #endif - fatalp(\"connect\", \"Socket connection error\"); -#ifdef ASYNCIO } -#endif - } - free(addr); - MakeInBuf(%2, sock, 4096); - MakeOutBuf(%3, sock, 4096); -}":[FD+int,Addr+object(pointer),InB-object(pointer),OutB-object(pointer)] | - R=normal(S), - async_io(S,Async,InB,OutB,0). + free(addr); + MakeInBuf(%2, sock, 4096); + MakeOutBuf(%3, sock, 4096); + }": [FD+int, Addr+object(pointer), InB-object(pointer), OutB-object(pointer)] | + R = normal(S), + async_io(S, Async, InB, OutB, 0). alternatively. -connect_sub(FD,Addr,Async,R) :- true | - timer:instantiate_after(time(0,3,0), Timer), - connect_sub(FD, Addr, Async, Timer, R). +connect_sub(FD, Addr, Async, R) :- true | + timer:instantiate_after(time(0, 3, 0), Timer), + connect_sub(FD, Addr, Async, Timer, R). -connect_sub(FD,Addr,[_|Async],_,R) :- - connect_sub(FD,Addr,Async,R). +connect_sub(FD, Addr, [_|Async], _, R) :- + connect_sub(FD, Addr, Async, R). alternatively. -connect_sub(FD,Addr,Async,[],R) :- - connect_sub(FD,Addr,Async,R). - -connect2(Spec,R) :- - net_convert(Spec,Fam,Addr), - connect2(Fam,Addr,_Async,R). - -connect2(Fam,Addr,Async,R) :- inline:" -{ - int family = intval(%0); - int sock = socket(family, SOCK_STREAM, 0); +connect_sub(FD, Addr, Async, [], R) :- + connect_sub(FD, Addr, Async, R). - if( sock < 0 ){ fatalp(\"socket\", \"Socket creation error\"); } -#ifdef ASYNCIO - init_asynchronous_io(); - setasync(sock, \"connection\"); - register_asynchronous_io_stream(sock, %1); +connect2(Spec, R) :- + net_convert(Spec, Fam, Addr), + connect2(Fam, Addr, _Async, R). + +connect2(Fam, Addr, Async, R) :- inline:" + { + int family = intval(%0); + int sock = socket(family, SOCK_STREAM, 0); + + if( sock < 0 ){ fatalp(\"socket\", \"Socket creation error\"); } +#ifdef ASYNCIO + init_asynchronous_io(); + setasync(sock, \"connection\"); + register_asynchronous_io_stream(sock, %1); +#endif + %2 = makeint(sock); + }": [Fam+int, Async+any, FD-int] | + connect2_sub(FD, Addr, Async, R). + +connect2_sub(FD, Addr, Async, R) :- inline:" + { + int sock = intval(%0); + struct sockaddr* addr = (struct sockaddr*) + ((struct pointer_object*) data_objectp(%1))->pointer; + + again2: + if( connect(sock, addr, sizeof(struct sockaddr)) < 0 ){ +#ifdef ASYNCIO + if( errno == EINTR ) goto again2; + if( errno != EISCONN ){ + if( errno == EINPROGRESS || errno == EALREADY ) goto %f; #endif - %2 = makeint(sock); -}":[Fam+int,Async+any,FD-int] | - connect2_sub(FD,Addr,Async,R). - -connect2_sub(FD,Addr,Async,R) :- inline:" -{ - int sock = intval(%0); - struct sockaddr* addr = (struct sockaddr*) - ((struct pointer_object*) data_objectp(%1))->pointer; - - again2: - if( connect(sock, addr, sizeof(struct sockaddr)) < 0 ){ + fatalp(\"connect\", \"Socket connection error\"); #ifdef ASYNCIO - if( errno == EINTR ) goto again2; - if( errno != EISCONN ){ - if( errno == EINPROGRESS || errno == EALREADY ) goto %f; + } #endif - fatalp(\"connect\", \"Socket connection error\"); -#ifdef ASYNCIO } -#endif - } - free(addr); - MakeBIOBuf(%2, sock, sock, 4096); -}":[FD+int,Addr+object(pointer),IOB-object(pointer)] | - R=normal(SIn,SOut), - async_input(SIn,Async,IOB,0), - async_output(SOut,Async,IOB,0). + free(addr); + MakeBIOBuf(%2, sock, sock, 4096); + }": [FD+int, Addr+object(pointer), IOB-object(pointer)] | + R = normal(SIn, SOut), + async_input(SIn, Async, IOB, 0), + async_output(SOut, Async, IOB, 0). otherwise. -connect2_sub(FD,Addr,Async,R) :- true | - timer:instantiate_after(time(0,3,0), Timer), - connect2_sub(FD, Addr, Async, Timer, R). +connect2_sub(FD, Addr, Async, R) :- true | + timer:instantiate_after(time(0, 3, 0), Timer), + connect2_sub(FD, Addr, Async, Timer, R). -connect2_sub(FD,Addr,[_|Async],_,R) :- - connect2_sub(FD,Addr,Async,R). +connect2_sub(FD, Addr, [_|Async], _, R) :- + connect2_sub(FD, Addr, Async, R). otherwise. -connect2_sub(FD,Addr,Async,[],R) :- - connect2_sub(FD,Addr,Async,R). - -bind(unix(Path),R) :- - net_convert(unix(Path),Fam,Addr), - bind(Fam,Addr,_Async,R). -bind(inet(Port),R) :- - net_convert(inet({0,0,0,0},Port),Fam,Addr), - bind(Fam,Addr,_Async,R). +connect2_sub(FD, Addr, Async, [], R) :- + connect2_sub(FD, Addr, Async, R). -bind(Fam,Addr,Async,R) :- inline:" -{ - int family = intval(%0); - int reuse = 1; - struct sockaddr* addr = (struct sockaddr*) - ((struct pointer_object*) data_objectp(%1))->pointer; - int sock = socket(family, SOCK_STREAM, 0); - - if( sock < 0 ){ fatalp(\"socket\", \"Socket creation error\"); } -#ifdef ASYNCIO - init_asynchronous_io(); -#endif - - if( addr->sa_family == PF_INET ){ - if( setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, - (char*) &reuse, sizeof(reuse)) ){ - fatalp(\"setsockopt\", \"Socket reuse setting error for binding\"); +bind(unix(Path), R) :- + net_convert(unix(Path), Fam, Addr), + bind(Fam, Addr, _Async, R). +bind(inet(Port), R) :- + net_convert(inet({0, 0, 0, 0}, Port), Fam, Addr), + bind(Fam, Addr, _Async, R). + +bind(Fam, Addr, Async, R) :- inline:" + { + int family = intval(%0); + int reuse = 1; + struct sockaddr* addr = (struct sockaddr*) + ((struct pointer_object*) data_objectp(%1))->pointer; + int sock = socket(family, SOCK_STREAM, 0); + + if( sock < 0 ){ fatalp(\"socket\", \"Socket creation error\"); } +#ifdef ASYNCIO + init_asynchronous_io(); +#endif + + if( addr->sa_family == PF_INET ){ + if( setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, + (char*) &reuse, sizeof(reuse)) ){ + fatalp(\"setsockopt\", \"Socket reuse setting error for binding\"); + } } - } - if( bind(sock, addr, sizeof(struct sockaddr)) < 0 ){ - fatalp(\"bind\", \"Socket binding error\"); - } - free(addr); + if( bind(sock, addr, sizeof(struct sockaddr)) < 0 ){ + fatalp(\"bind\", \"Socket binding error\"); + } + free(addr); #ifdef ASYNCIO - setasync(sock, \"bound socket\"); + setasync(sock, \"bound socket\"); #endif - if( listen(sock, 5) < 0 ){ - fatalp(\"listen\", \"Socket listen error\"); - } + if( listen(sock, 5) < 0 ){ + fatalp(\"listen\", \"Socket listen error\"); + } #ifdef ASYNCIO - register_asynchronous_io_stream(sock, %2); + register_asynchronous_io_stream(sock, %2); #endif - %3 = makeint(sock); -}":[Fam+int,Addr+object(pointer),Async+any,FD-int] | - R=normal(S), - bound_sock(S,FD,Async,_). + %3 = makeint(sock); + }": [Fam+int, Addr+object(pointer), Async+any, FD-int] | + R = normal(S), + bound_sock(S, FD, Async, _). -bound_sock([],FD,_Async,_Async1) :- inline:" -{ - int fd = intval(%0); - int namelen = 1000; - struct sockaddr* name = (struct sockaddr*) malloc_check(namelen); - getsockname(fd, name, &namelen); - if( close(fd) != 0 ){ - fatalp(\"close\", \"Error in closing bound socket\"); - } -#ifdef ASYNCIO - close_asynchronous_io_stream(fd); -#endif - if( name->sa_family == PF_UNIX ){ - if( unlink(name->sa_data) ){ - fatalp(\"unlink\", \"Error in unlinking socket: %%s\", name->sa_data); +bound_sock([], FD, _Async, _Async1) :- inline:" + { + int fd = intval(%0); + int namelen = 1000; + struct sockaddr* name = (struct sockaddr*) malloc_check(namelen); + getsockname(fd, name, &namelen); + if( close(fd) != 0 ){ + fatalp(\"close\", \"Error in closing bound socket\"); } - } - free(name); -}":[FD+int] | true. -bound_sock([accept(R)|S],FD,Async,Async1) :- inline:" -{ - int sock; - struct sockaddr addr; - int socklen = sizeof(addr); #ifdef ASYNCIO - if( !poll_read_available(intval(%0)) ) goto %f; + close_asynchronous_io_stream(fd); #endif - for(;;){ - sock = accept(intval(%0), &addr, &socklen); - if( sock > 0 ) break; - if( errno != EINTR ){ - fatalp(\"accept\", \"Error in accept\"); + if( name->sa_family == PF_UNIX ){ + if( unlink(name->sa_data) ){ + fatalp(\"unlink\", \"Error in unlinking socket: %%s\", name->sa_data); + } + } + free(name); + }": [FD+int] | true. +bound_sock([accept(R)|S], FD, Async, Async1) :- inline:" + { + int sock; + struct sockaddr addr; + int socklen = sizeof(addr); +#ifdef ASYNCIO + if( !poll_read_available(intval(%0)) ) goto %f; +#endif + for(;;){ + sock = accept(intval(%0), &addr, &socklen); + if( sock > 0 ) break; + if( errno != EINTR ){ + fatalp(\"accept\", \"Error in accept\"); + } } - } -#ifdef ASYNCIO - setasync(sock, \"accepted socket\"); - register_asynchronous_io_stream(sock,%1); -#endif - MakeInBuf(%2, sock, 4096); - MakeOutBuf(%3, sock, 4096); -}":[FD+int,Async1+any,InB-object(pointer),OutB-object(pointer)] | - R=normal(In), - async_io(In,Async1,InB,OutB,0), - bound_sock(S,FD,Async,_). -bound_sock(S,FD,[_|Async],Async1) :- - bound_sock(S,FD,Async,Async1). - -bound_sock([accept2(R)|S],FD,Async,Async1) :- inline:" -{ - int sock; - struct sockaddr addr; - int socklen = sizeof(addr); #ifdef ASYNCIO - if( !poll_read_available(intval(%0)) ) goto %f; + setasync(sock, \"accepted socket\"); + register_asynchronous_io_stream(sock, %1); #endif - for(;;){ - sock = accept(intval(%0), &addr, &socklen); - if( sock > 0 ) break; - if( errno != EINTR ){ - fatalp(\"accept\", \"Error in accept\"); + MakeInBuf(%2, sock, 4096); + MakeOutBuf(%3, sock, 4096); + }": [FD+int, Async1+any, InB-object(pointer), OutB-object(pointer)] | + R = normal(In), + async_io(In, Async1, InB, OutB, 0), + bound_sock(S, FD, Async, _). +bound_sock(S, FD, [_|Async], Async1) :- + bound_sock(S, FD, Async, Async1). + +bound_sock([accept2(R)|S], FD, Async, Async1) :- inline:" + { + int sock; + struct sockaddr addr; + int socklen = sizeof(addr); +#ifdef ASYNCIO + if( !poll_read_available(intval(%0)) ) goto %f; +#endif + for(;;){ + sock = accept(intval(%0), &addr, &socklen); + if( sock > 0 ) break; + if( errno != EINTR ){ + fatalp(\"accept\", \"Error in accept\"); + } } - } #ifdef ASYNCIO - setasync(sock, \"accepted socket\"); - register_asynchronous_io_stream(sock,%1); -#endif - MakeBIOBuf(%2, sock, sock, 4096); -}":[FD+int,Async1+any,IOB-object(pointer)] | - R=normal(SIn,SOut), - async_input(SIn,Async1,IOB,0), - async_output(SOut,Async1,IOB,0), - bound_sock(S,FD,Async,_). -bound_sock(S,FD,[_|Async],Async1) :- - bound_sock(S,FD,Async,Async1). + setasync(sock, \"accepted socket\"); + register_asynchronous_io_stream(sock, %1); +#endif + MakeBIOBuf(%2, sock, sock, 4096); + }": [FD+int, Async1+any, IOB-object(pointer)] | + R = normal(SIn, SOut), + async_input(SIn, Async1, IOB, 0), + async_output(SOut, Async1, IOB, 0), + bound_sock(S, FD, Async, _). +bound_sock(S, FD, [_|Async], Async1) :- + bound_sock(S, FD, Async, Async1). pipe(R) :- inline:" -{ - int fd[2]; - if( pipe(fd) != 0 ) goto %f; - Fdopen(fd[0], %0, %f, \"r\"); - Fdopen(fd[1], %1, %f, \"w\"); -}":[Fin-object,Fout-object] | - generic:new(file_io,Sin,Fin,"pipe-input",[],""), - generic:new(file_io,Sout,[],"",Fout,"pipe-output"), - R=normal(Sin,Sout). + { + int fd[2]; + if( pipe(fd) != 0 ) goto %f; + Fdopen(fd[0], %0, %f, \"r\"); + Fdopen(fd[1], %1, %f, \"w\"); + }": [Fin-object, Fout-object] | + generic:new(file_io, Sin, Fin, "pipe-input", [], ""), + generic:new(file_io, Sout, [], "", Fout, "pipe-output"), + R = normal(Sin, Sout). otherwise. -pipe(R) :- R=abnormal. +pipe(R) :- + R = abnormal. /* Asynchronous Input/Output */ -async_io([],_Async,InB,OutB,_LC) :- inline:" -{ +async_io([], _Async, InB, OutB, _LC) :- inline:" #ifdef ASYNCIO - struct iobuf* outb = IOBuf(%0); - struct iobuf* inb = IOBuf(%1); - if( outb->ptr != outb->buf ){ - switch( write_buf(outb) ){ - case -1: goto %f; - case 1: break; + { + struct iobuf* outb = IOBuf(%0); + struct iobuf* inb = IOBuf(%1); + if( outb->ptr != outb->buf ){ + switch( write_buf(outb) ){ + case -1: goto %f; + case 1: break; + } } + if( close(outb->fd) != 0 ){ + fatalp(\"close\", \"Error in closing asynchronous I/O\"); + } + close_asynchronous_io_stream(outb->fd); + free(outb->buf); + free(inb->buf); } - if( close(outb->fd) != 0 ){ - fatalp(\"close\", \"Error in closing asynchronous I/O\"); - } - close_asynchronous_io_stream(outb->fd); - free(outb->buf); - free(inb->buf); #else goto %f; #endif -}":[OutB+object(pointer), InB+object(pointer)] | true. -async_io([C|S],Async,InB,OutB,LC) :- integer(C), inline:" -{ -#ifdef ASYNCIO - struct iobuf* iob = IOBuf(%0); - if( iob->ptr == iob->lim ){ - switch( write_buf(iob) ){ - case -1: goto %f; - case 1: break; +": [OutB+object(pointer), InB+object(pointer)] | + true. +async_io([C|S], Async, InB, OutB, LC) :- integer(C), inline:" +#ifdef ASYNCIO + { + struct iobuf* iob = IOBuf(%0); + if( iob->ptr == iob->lim ){ + switch( write_buf(iob) ){ + case -1: goto %f; + case 1: break; + } } + *iob->ptr = intval(%1); + iob->ptr++; } - *iob->ptr = intval(%1); - iob->ptr++; #else goto %f; #endif -}":[OutB+object(pointer),C+int] | - async_io(S,Async,InB,OutB,LC). -async_io([getc(C)|S],Async,InB,OutB,LC0) :- inline:" -{ -#ifdef ASYNCIO - struct iobuf* iob = IOBuf(%0); - int c; - if( iob->ptr == iob->lim ){ - switch( fill_buf(iob) ){ - case -1: goto %f; - case -2: goto %f; - case 0: c = -1; break; - case 1: c = *iob->ptr; iob->ptr++; break; +": [OutB+object(pointer), C+int] | + async_io(S, Async, InB, OutB, LC). +async_io([getc(C)|S], Async, InB, OutB, LC0) :- inline:" +#ifdef ASYNCIO + { + struct iobuf* iob = IOBuf(%0); + int c; + if( iob->ptr == iob->lim ){ + switch( fill_buf(iob) ){ + case -1: goto %f; + case -2: goto %f; + case 0: c = -1; break; + case 1: c = *iob->ptr; iob->ptr++; break; + } + }else{ + c = *iob->ptr; + iob->ptr++; } - }else{ - c = *iob->ptr; - iob->ptr++; + %3 = makeint(intval(%2) + (c=='\\n' ? 1 : 0)); + %1 = makeint(c); } - %3 = makeint(intval(%2) + (c=='\\n' ? 1 : 0)); - %1 = makeint(c); #else goto %f; #endif -}":[InB+object(pointer),C0-int,LC0+int,LC-int] | - C=C0, - async_io(S,Async,InB,OutB,LC). -async_io([fread(N,R)|S],Async,InB,OutB,LC0) :- inline:" -{ -#ifdef ASYNCIO - struct iobuf* iob = IOBuf(%0); - int toread = intval(%1); - int k, nnl; - int ready_bytes = iob->lim - iob->ptr; - q str; - if( ready_bytes==0 ){ - switch( fill_buf(iob) ){ - case -1: goto %f; - case -2: goto %f; - case 0: goto %f; - case 1: break; +": [InB+object(pointer), C0-int, LC0+int, LC-int] | + C = C0, + async_io(S, Async, InB, OutB, LC). +async_io([fread(N, R)|S], Async, InB, OutB, LC0) :- inline:" +#ifdef ASYNCIO + { + struct iobuf* iob = IOBuf(%0); + int toread = intval(%1); + int k, nnl; + int ready_bytes = iob->lim - iob->ptr; + q str; + if( ready_bytes==0 ){ + switch( fill_buf(iob) ){ + case -1: goto %f; + case -2: goto %f; + case 0: goto %f; + case 1: break; + } } + if( toread > iob->lim - iob->ptr ) toread = iob->lim - iob->ptr; + if( (char*) allocp + + sizeof(struct byte_string_object) + toread + sizeof(long) >= + (char*) real_heaplimit ){ + allocp = real_heaplimit; + goto async__io_5_ext_interrupt; + } + for( k=0, nnl=0; kptr[k] == '\\n' ) nnl++; + } + str = BC2KLIC(iob->ptr, toread, allocp); + if( isref(str) ){ + fatal(\"internal error: string allocation failure for fread\"); + } + %2 = str; + allocp = heapp(); + iob->ptr += toread; + %4 = makeint(intval(%3) + nnl); } - if( toread > iob->lim - iob->ptr ) toread = iob->lim - iob->ptr; - if( (char*) allocp + - sizeof(struct byte_string_object) + toread + sizeof(long) >= - (char*) real_heaplimit ){ - allocp = real_heaplimit; - goto async__io_5_ext_interrupt; - } - for( k=0, nnl=0; kptr[k] == '\\n' ) nnl++; - } - str = BC2KLIC(iob->ptr, toread, allocp); - if( isref(str) ){ - fatal(\"internal error: string allocation failure for fread\"); - } - %2 = str; - allocp = heapp(); - iob->ptr += toread; - %4 = makeint(intval(%3)+nnl); #else goto %f; #endif -}":[InB+object(pointer),N+int,R0-object(byte_string),LC0+int,LC-int] | - R=R0, - async_io(S,Async,InB,OutB,LC). -async_io([linecount(N)|S],Async,InB,OutB,LC) :- - N=LC, - async_io(S,Async,InB,OutB,LC). -async_io([feof(R)|S],Async,InB,OutB,LC) :- inline:" -{ -#ifdef ASYNCIO - struct iobuf* iob = IOBuf(%0); - if( iob->ptr == iob->lim ){ - switch( fill_buf(iob) ){ - case -1: goto %f; - case -2: goto %f; - case 0: %1 = makeint(1); break; - case 1: %1 = makeint(0); break; +": [InB+object(pointer), N+int, R0-object(byte_string), LC0+int, LC-int] | + R = R0, + async_io(S, Async, InB, OutB, LC). +async_io([linecount(N)|S], Async, InB, OutB, LC) :- + N = LC, + async_io(S, Async, InB, OutB, LC). +async_io([feof(R)|S], Async, InB, OutB, LC) :- inline:" +#ifdef ASYNCIO + { + struct iobuf* iob = IOBuf(%0); + if( iob->ptr == iob->lim ){ + switch( fill_buf(iob) ){ + case -1: goto %f; + case -2: goto %f; + case 0: %1 = makeint(1); break; + case 1: %1 = makeint(0); break; + } + }else{ + %1 = makeint(0); } - }else{ - %1 = makeint(0); } #else goto %f; #endif -}":[InB+object(pointer),R0-int] | - R=R0, - async_io(S,Async,InB,OutB,LC). -async_io([putc(C)|S],Async,InB,OutB,LC) :- true | - async_io([C|S],Async,InB,OutB,LC). -async_io([fwrite(X,R)|S],Async,InB,OutB,LC) :- string(X,L,8), inline:" -{ -#ifdef ASYNCIO - struct iobuf* iob = IOBuf(%0); - char* str = KLIC2C(%1); - int len = intval(%2); - int room = iob->lim - iob->ptr; - while( iob->ptr + len >= iob->lim ){ - BCOPY(str, iob->ptr, room); - len -= room; - str += room; - iob->ptr += room; - switch( write_buf(iob) ){ - case -1: goto %f; - case 1: break; +": [InB+object(pointer), R0-int] | + R = R0, + async_io(S, Async, InB, OutB, LC). +async_io([putc(C)|S], Async, InB, OutB, LC) :- true | + async_io([C|S], Async, InB, OutB, LC). +async_io([fwrite(X, R)|S], Async, InB, OutB, LC) :- string(X, L, 8), inline:" +#ifdef ASYNCIO + { + struct iobuf* iob = IOBuf(%0); + char* str = KLIC2C(%1); + int len = intval(%2); + int room = iob->lim - iob->ptr; + while( iob->ptr + len >= iob->lim ){ + BCOPY(str, iob->ptr, room); + len -= room; + str += room; + iob->ptr += room; + switch( write_buf(iob) ){ + case -1: goto %f; + case 1: break; + } } + BCOPY(str, iob->ptr, len); + iob->ptr += len; } - BCOPY(str, iob->ptr, len); - iob->ptr += len; #else goto %f; #endif -}":[OutB+object(pointer),X+object(byte_string),L+int] | - R=L, - async_io(S,Async,InB,OutB,LC). -async_io([fwrite(X)|S],Async,InB,OutB,LC) :- - async_io([fwrite(X,_)|S],Async,InB,OutB,LC). -async_io([fflush(R)|S],Async,InB,OutB,LC) :- inline:" -{ -#ifdef ASYNCIO - struct iobuf* iob = IOBuf(%0); - if( iob->ptr != iob->buf ){ - switch( write_buf(iob) ){ - case -1: goto %f; - case 1: break; +": [OutB+object(pointer), X+object(byte_string), L+int] | + R = L, + async_io(S, Async, InB, OutB, LC). +async_io([fwrite(X)|S], Async, InB, OutB, LC) :- + async_io([fwrite(X, _)|S], Async, InB, OutB, LC). +async_io([fflush(R)|S], Async, InB, OutB, LC) :- inline:" +#ifdef ASYNCIO + { + struct iobuf* iob = IOBuf(%0); + if( iob->ptr != iob->buf ){ + switch( write_buf(iob) ){ + case -1: goto %f; + case 1: break; + } } } #else goto %f; #endif -}":[OutB+object(pointer)] | - R=0, - async_io(S,Async,InB,OutB,LC). -async_io([sync(R)|S],Async,InB,OutB,LC) :- inline:" +": [OutB+object(pointer)] | + R = 0, + async_io(S, Async, InB, OutB, LC). +async_io([sync(R)|S], Async, InB, OutB, LC) :- inline:" #ifdef ASYNCIO -{ - struct iobuf* iob = IOBuf(%0); - switch( write_buf(iob) ){ - case -1: goto %f; - case 1: break; + { + struct iobuf* iob = IOBuf(%0); + switch( write_buf(iob) ){ + case -1: goto %f; + case 1: break; + } } -} #endif -":[OutB+object(pointer)] | - R=0, - async_io(S,Async,InB,OutB,LC). +": [OutB+object(pointer)] | + R = 0, + async_io(S, Async, InB, OutB, LC). alternatively. -async_io(S,[_|Async],InB,OutB,LC) :- - async_io(S,Async,InB,OutB,LC). +async_io(S, [_|Async], InB, OutB, LC) :- + async_io(S, Async, InB, OutB, LC). -async_input([],_Async,IOB,_LC) :- inline:" -{ +async_input([], _Async, IOB, _LC) :- inline:" #ifdef ASYNCIO - struct biobuf* biob = BIOBuf(%0); - struct iobuf* inb = &(biob->ibuf); - struct iobuf* outb = &(biob->obuf); - if( inb->fd != outb->fd ){ - if( close(inb->fd) != 0 ){ - fatalp(\"close\", \"Error in closing asynchronous input\"); + { + struct biobuf* biob = BIOBuf(%0); + struct iobuf* inb = &(biob->ibuf); + struct iobuf* outb = &(biob->obuf); + if( inb->fd != outb->fd ){ + if( close(inb->fd) != 0 ){ + fatalp(\"close\", \"Error in closing asynchronous input\"); + } + close_asynchronous_io_stream(inb->fd); } - close_asynchronous_io_stream(inb->fd); - } - if( outb->fd == -1 ){ - free(inb->buf); - free(outb->buf); + if( outb->fd == -1 ){ + free(inb->buf); + free(outb->buf); + } + inb->fd = -1; } - inb->fd = -1; #else goto %f; #endif -}":[IOB+object(pointer)] | true. -async_input([getc(C)|S],Async,IOB,LC0) :- inline:" -{ -#ifdef ASYNCIO - struct biobuf* biob = BIOBuf(%0); - struct iobuf* iob = &(biob->ibuf); - int c; - if( iob->ptr == iob->lim ){ - switch( fill_buf(iob) ){ - case -1: goto %f; - case -2: goto %f; - case 0: c = -1; break; - case 1: c = *iob->ptr; iob->ptr++; break; +": [IOB+object(pointer)] | + true. +async_input([getc(C)|S], Async, IOB, LC0) :- inline:" +#ifdef ASYNCIO + { + struct biobuf* biob = BIOBuf(%0); + struct iobuf* iob = &(biob->ibuf); + int c; + if( iob->ptr == iob->lim ){ + switch( fill_buf(iob) ){ + case -1: goto %f; + case -2: goto %f; + case 0: c = -1; break; + case 1: c = *iob->ptr; iob->ptr++; break; + } + }else{ + c = *iob->ptr; + iob->ptr++; } - }else{ - c = *iob->ptr; - iob->ptr++; + %3 = makeint(intval(%2) + (c=='\\n' ? 1 : 0)); + %1 = makeint(c); } - %3 = makeint(intval(%2) + (c=='\\n' ? 1 : 0)); - %1 = makeint(c); #else goto %f; #endif -}":[IOB+object(pointer),C0-int,LC0+int,LC-int] | - C=C0, - async_input(S,Async,IOB,LC). -async_input([fread(N,R)|S],Async,IOB,LC0) :- inline:" -{ -#ifdef ASYNCIO - struct biobuf* biob = BIOBuf(%0); - struct iobuf* iob = &(biob->ibuf); - int toread = intval(%1); - int k, nnl; - int ready_bytes = iob->lim - iob->ptr; - q str; - if( ready_bytes==0 ){ - switch( fill_buf(iob) ){ - case -1: goto %f; - case -2: goto %f; - case 0: goto %f; - case 1: break; +": [IOB+object(pointer), C0-int, LC0+int, LC-int] | + C = C0, + async_input(S, Async, IOB, LC). +async_input([fread(N, R)|S], Async, IOB, LC0) :- inline:" +#ifdef ASYNCIO + { + struct biobuf* biob = BIOBuf(%0); + struct iobuf* iob = &(biob->ibuf); + int toread = intval(%1); + int k, nnl; + int ready_bytes = iob->lim - iob->ptr; + q str; + if( ready_bytes==0 ){ + switch( fill_buf(iob) ){ + case -1: goto %f; + case -2: goto %f; + case 0: goto %f; + case 1: break; + } + } + if( toread > iob->lim - iob->ptr ) toread = iob->lim - iob->ptr; + if( (char*) allocp + + sizeof(struct byte_string_object) + toread + sizeof(long) >= + (char*) real_heaplimit ){ + allocp = real_heaplimit; + goto async__input_4_ext_interrupt; + } + for( k=0, nnl=0; kptr[k] == '\\n' ) nnl++; + } + str = BC2KLIC(iob->ptr, toread, allocp); + if( isref(str) ){ + fatal(\"internal error: string allocation failure for fread\"); } + %2 = str; + allocp = heapp(); + iob->ptr += toread; + %4 = makeint(intval(%3) + nnl); } - if( toread > iob->lim - iob->ptr ) toread = iob->lim - iob->ptr; - if( (char*) allocp + - sizeof(struct byte_string_object) + toread + sizeof(long) >= - (char*) real_heaplimit ){ - allocp = real_heaplimit; - goto async__input_4_ext_interrupt; - } - for( k=0, nnl=0; kptr[k] == '\\n' ) nnl++; - } - str = BC2KLIC(iob->ptr, toread, allocp); - if( isref(str) ){ - fatal(\"internal error: string allocation failure for fread\"); - } - %2 = str; - allocp = heapp(); - iob->ptr += toread; - %4 = makeint(intval(%3) + nnl); #else goto %f; #endif -}":[IOB+object(pointer),N+int,R0-object(byte_string),LC0+int,LC-int] | - R=R0, - async_input(S,Async,IOB,LC). -async_input([linecount(N)|S],Async,IOB,LC) :- - N=LC, - async_input(S,Async,IOB,LC). -async_input([feof(R)|S],Async,IOB,LC) :- inline:" -{ -#ifdef ASYNCIO - struct biobuf* biob = BIOBuf(%0); - struct iobuf* iob = &(biob->ibuf); - if( iob->ptr == iob->lim ){ - switch( fill_buf(iob) ){ - case -1: goto %f; - case -2: goto %f; - case 0: %1 = makeint(1); break; - case 1: %1 = makeint(0); break; +": [IOB+object(pointer), N+int, R0-object(byte_string), LC0+int, LC-int] | + R = R0, + async_input(S, Async, IOB, LC). +async_input([linecount(N)|S], Async, IOB, LC) :- + N = LC, + async_input(S, Async, IOB, LC). +async_input([feof(R)|S], Async, IOB, LC) :- inline:" +#ifdef ASYNCIO + { + struct biobuf* biob = BIOBuf(%0); + struct iobuf* iob = &(biob->ibuf); + if( iob->ptr == iob->lim ){ + switch( fill_buf(iob) ){ + case -1: goto %f; + case -2: goto %f; + case 0: %1 = makeint(1); break; + case 1: %1 = makeint(0); break; + } + }else{ + %1 = makeint(0); } - }else{ - %1 = makeint(0); } #else goto %f; #endif -}":[IOB+object(pointer),R0-int] | - R=R0, - async_input(S,Async,IOB,LC). +": [IOB+object(pointer), R0-int] | + R = R0, + async_input(S, Async, IOB, LC). alternatively. -async_input(S,[_|Async],IOB,LC) :- - async_input(S,Async,IOB,LC). +async_input(S, [_|Async], IOB, LC) :- + async_input(S, Async, IOB, LC). -async_output([],_Async,IOB,_LC) :- inline:" -{ +async_output([], _Async, IOB, _LC) :- inline:" #ifdef ASYNCIO - struct biobuf* biob = BIOBuf(%0); - struct iobuf* inb = &(biob->ibuf); - struct iobuf* outb = &(biob->obuf); - if( outb->ptr != outb->buf ){ - switch( write_buf(outb) ){ - case -1: goto %f; - case -2: break; - case 1: break; + { + struct biobuf* biob = BIOBuf(%0); + struct iobuf* inb = &(biob->ibuf); + struct iobuf* outb = &(biob->obuf); + if( outb->ptr != outb->buf ){ + switch( write_buf(outb) ){ + case -1: goto %f; + case -2: break; + case 1: break; + } } - } - if( inb->fd != outb->fd ){ - if( close(outb->fd) != 0 ){ - fatalp(\"close\", \"Error in closing asynchronous output\"); + if( inb->fd != outb->fd ){ + if( close(outb->fd) != 0 ){ + fatalp(\"close\", \"Error in closing asynchronous output\"); + } + close_asynchronous_io_stream(outb->fd); } - close_asynchronous_io_stream(outb->fd); - } - if( inb->fd == -1 ){ - free(inb->buf); - free(outb->buf); + if( inb->fd == -1 ){ + free(inb->buf); + free(outb->buf); + } + outb->fd = -1; } - outb->fd = -1; #else goto %f; #endif -}":[IOB+object(pointer)] | true. -async_output([C|S],Async,IOB,LC) :- integer(C), inline:" -{ -#ifdef ASYNCIO - struct biobuf* biob = BIOBuf(%0); - struct iobuf* iob = &(biob->obuf); - if( iob->ptr == iob->lim ){ - switch( write_buf(iob) ){ - case -1: goto %f; - case -2: goto %f; - case 1: break; +": [IOB+object(pointer)] | + true. +async_output([C|S], Async, IOB, LC) :- integer(C), inline:" +#ifdef ASYNCIO + { + struct biobuf* biob = BIOBuf(%0); + struct iobuf* iob = &(biob->obuf); + if( iob->ptr == iob->lim ){ + switch( write_buf(iob) ){ + case -1: goto %f; + case -2: goto %f; + case 1: break; + } } + *iob->ptr = intval(%1); + iob->ptr++; } - *iob->ptr = intval(%1); - iob->ptr++; #else goto %f; #endif -}":[IOB+object(pointer),C+int] | - async_output(S,Async,IOB,LC). -async_output([linecount(N)|S],Async,IOB,LC) :- - N=LC, - async_output(S,Async,IOB,LC). -async_output([putc(C)|S],Async,IOB,LC) :- true | - async_output([C|S],Async,IOB,LC). -async_output([fwrite(X,R)|S],Async,IOB,LC) :- string(X,L,8), inline:" -{ -#ifdef ASYNCIO - struct biobuf* biob = BIOBuf(%0); - struct iobuf* iob = &(biob->obuf); - char* str = KLIC2C(%1); - int len = intval(%2); - int room = iob->lim - iob->ptr; - while( iob->ptr + len >= iob->lim ){ - BCOPY(str, iob->ptr, room); - len -= room; - str += room; - iob->ptr += room; - switch( write_buf(iob) ){ - case -1: goto %f; - case -2: goto %f; - case 1: break; +": [IOB+object(pointer), C+int] | + async_output(S, Async, IOB, LC). +async_output([linecount(N)|S], Async, IOB, LC) :- + N = LC, + async_output(S, Async, IOB, LC). +async_output([putc(C)|S], Async, IOB, LC) :- true | + async_output([C|S], Async, IOB, LC). +async_output([fwrite(X, R)|S], Async, IOB, LC) :- string(X, L, 8), inline:" +#ifdef ASYNCIO + { + struct biobuf* biob = BIOBuf(%0); + struct iobuf* iob = &(biob->obuf); + char* str = KLIC2C(%1); + int len = intval(%2); + int room = iob->lim - iob->ptr; + while( iob->ptr + len >= iob->lim ){ + BCOPY(str, iob->ptr, room); + len -= room; + str += room; + iob->ptr += room; + switch( write_buf(iob) ){ + case -1: goto %f; + case -2: goto %f; + case 1: break; + } } + BCOPY(str, iob->ptr, len); + iob->ptr += len; } - BCOPY(str, iob->ptr, len); - iob->ptr += len; #else goto %f; #endif -}":[IOB+object(pointer),X+object(byte_string),L+int] | - R=L, - async_output(S,Async,IOB,LC). +": [IOB+object(pointer), X+object(byte_string), L+int] | + R = L, + async_output(S, Async, IOB, LC). otherwise. -async_output([fwrite(X,R)|S],Async,IOB,LC) :- true | - R = -1, - async_output(S,Async,IOB,LC). -async_output([fwrite(X)|S],Async,IOB,LC) :- - async_output([fwrite(X,_)|S],Async,IOB,LC). -async_output([fflush(R)|S],Async,IOB,LC) :- inline:" -{ -#ifdef ASYNCIO - struct biobuf* biob = BIOBuf(%0); - struct iobuf* iob = &(biob->obuf); - if( iob->ptr != iob->buf ){ - switch( write_buf(iob) ){ - case -1: goto %f; - case -2: goto %f; - case 1: break; +async_output([fwrite(X, R)|S], Async, IOB, LC) :- true | + R = -1, + async_output(S, Async, IOB, LC). +async_output([fwrite(X)|S], Async, IOB, LC) :- + async_output([fwrite(X, _)|S], Async, IOB, LC). +async_output([fflush(R)|S], Async, IOB, LC) :- inline:" +#ifdef ASYNCIO + { + struct biobuf* biob = BIOBuf(%0); + struct iobuf* iob = &(biob->obuf); + if( iob->ptr != iob->buf ){ + switch( write_buf(iob) ){ + case -1: goto %f; + case -2: goto %f; + case 1: break; + } } } #else goto %f; #endif -}":[IOB+object(pointer)] | - R = 0, - async_output(S,Async,IOB,LC). +": [IOB+object(pointer)] | + R = 0, + async_output(S, Async, IOB, LC). otherwise. -async_output([fflush(R)|S],Async,IOB,LC) :- true | - R = -1, - async_output(S,Async,IOB,LC). -async_output([sync(R)|S],Async,IOB,LC) :- inline:" -#ifdef ASYNCIO -{ - struct biobuf* biob = BIOBuf(%0); - struct iobuf* outb = &(biob->obuf); - switch( write_buf(outb) ){ - case -1: goto %f; - case -2: goto %f; - case 1: break; +async_output([fflush(R)|S], Async, IOB, LC) :- true | + R = -1, + async_output(S, Async, IOB, LC). +async_output([sync(R)|S], Async, IOB, LC) :- inline:" +#ifdef ASYNCIO + { + struct biobuf* biob = BIOBuf(%0); + struct iobuf* outb = &(biob->obuf); + switch( write_buf(outb) ){ + case -1: goto %f; + case -2: goto %f; + case 1: break; + } } -} #endif -":[IOB+object(pointer)] | - R=0, - async_output(S,Async,IOB,LC). +": [IOB+object(pointer)] | + R = 0, + async_output(S, Async, IOB, LC). otherwise. -async_output([sync(R)|S],Async,IOB,LC) :- true | - R = -1, - async_output(S,Async,IOB,LC). +async_output([sync(R)|S], Async, IOB, LC) :- true | + R = -1, + async_output(S, Async, IOB, LC). alternatively. -async_output(S,[_|Async],IOB,LC) :- - async_output(S,Async,IOB,LC). +async_output(S, [_|Async], IOB, LC) :- + async_output(S, Async, IOB, LC). /**************************************** - SYSTEM CALLS, etc + SYSTEM CALLS, etc ****************************************/ -system(S,R) :- inline:" -{ - char* buf = KLIC2C(%0); - %1 = makeint(system(buf)); - free(buf); -}":[S+object(byte_string),R0-int] | R = R0. - -cd(Dir,R) :- inline:" -{ - char* buf = KLIC2C(%0); - %1 = makeint(chdir(buf)); - free(buf); -}":[Dir+object(byte_string),R0-int] | R=R0. - -unlink(Path,R) :- inline:" -{ - char* path = KLIC2C(%0); - %1 = makeint(unlink(path)); - free(path); -}":[Path+object(byte_string),R0-int] | R=R0. - -mktemp(Template,Filename) :- inline:" -{ - char* template = KLIC2C(%0); - char* real_template = (char*) malloc_check(strlen(template) + 7); - strcpy(real_template, template); - strcat(real_template, \"XXXXXX\"); - if( mkstemp(real_template) < 0 ) real_template[0] = '\0'; - %1 = C2KLIC(real_template, allocp); - allocp = heapp(); - free(template); - free(real_template); -}":[Template+object(byte_string),Filename0-object(byte_string)] | - Filename=Filename0. - -access(Path,Mode,Result) :- inline:" -{ - char* path = KLIC2C(%0); - %2 = makeint(access(path, intval(%1))); - free(path); -}":[Path+object(byte_string),Mode+int,Result0-int] | Result=Result0. - -chmod(Path,New,Result) :- inline:" -{ - char* path = KLIC2C(%0); - %2 = makeint(chmod(path, intval(%1))); - free(path); -}":[Path+object(byte_string),New+int,Result0-int] | Result=Result0. - -umask(Old) :- inline:" -{ - %0 = makeint(umask(0)); - umask(intval(%0)); -}":[Old0-int] | Old=Old0. - -umask(Old,New) :- inline:" -{ - %0 = makeint(umask(0)); - umask(intval(%1)); -}":[Old0-int,New+int] | Old = Old0. - -getenv(Name,Value) :- inline:" -{ - char* str = KLIC2C(%0); - char* value = getenv(str); - free(str); - if( value==NULL ){ - %1 = makeint(0); - }else{ - %1 = C2KLIC(value, allocp); +system(S, R) :- inline:" + { + char* buf = KLIC2C(%0); + %1 = makeint(system(buf)); + free(buf); + }": [S+object(byte_string), R0-int] | R = R0. + +cd(Dir, R) :- inline:" + { + char* buf = KLIC2C(%0); + %1 = makeint(chdir(buf)); + free(buf); + }": [Dir+object(byte_string), R0-int] | R=R0. + +unlink(Path, R) :- inline:" + { + char* path = KLIC2C(%0); + %1 = makeint(unlink(path)); + free(path); + }": [Path+object(byte_string), R0-int] | R=R0. + +mktemp(Template, Filename) :- inline:" + { + char* template = KLIC2C(%0); + char* real_template = (char*) malloc_check(strlen(template) + 7); + strcpy(real_template, template); + strcat(real_template, \"XXXXXX\"); + if( mkstemp(real_template) < 0 ) real_template[0] = '\0'; + %1 = C2KLIC(real_template, allocp); allocp = heapp(); - } -}":[Name+object(byte_string),Value0-bound] | Value=Value0. - -putenv(Str,R) :- inline:" -{ - char* str = KLIC2C(%0); - %1 = makeint(putenv(str)); -}":[Str+object(byte_string),R0-int] | R=R0. + free(template); + free(real_template); + }": [Template+object(byte_string), Filename0-object(byte_string)] | + Filename = Filename0. + +access(Path, Mode, Result) :- inline:" + { + char* path = KLIC2C(%0); + %2 = makeint(access(path, intval(%1))); + free(path); + }": [Path+object(byte_string), Mode+int, Result0-int] | + Result = Result0. + +chmod(Path, New, Result) :- inline:" + { + char* path = KLIC2C(%0); + %2 = makeint(chmod(path, intval(%1))); + free(path); + }": [Path+object(byte_string), New+int, Result0-int] | + Result = Result0. -kill(Pid,Sig,R) :- inline:" -{ - %2 = makeint(kill(intval(%0),intval(%1))); -}":[Pid+int,Sig+int,R0-int] | R=R0. +umask(Old) :- inline:" + { + %0 = makeint(umask(0)); + umask(intval(%0)); + }": [Old0-int] | Old = Old0. + +umask(Old, New) :- inline:" + { + %0 = makeint(umask(0)); + umask(intval(%1)); + }": [Old0-int, New+int] | Old = Old0. + +getenv(Name, Value) :- inline:" + { + char* str = KLIC2C(%0); + char* value = getenv(str); + free(str); + if( value==NULL ){ + %1 = makeint(0); + }else{ + %1 = C2KLIC(value, allocp); + allocp = heapp(); + } + }": [Name+object(byte_string), Value0-bound] | Value = Value0. + +putenv(Str, R) :- inline:" + { + char* str = KLIC2C(%0); + %1 = makeint(putenv(str)); + }": [Str+object(byte_string), R0-int] | R=R0. + +kill(Pid, Sig, R) :- inline:" + { + %2 = makeint(kill(intval(%0), intval(%1))); + }": [Pid+int, Sig+int, R0-int] | R=R0. -fork(PID) :- inline:"%0 = makeint(fork());":[PID0-int] | PID=PID0. +fork(PID) :- inline:"%0 = makeint(fork());": [PID0-int] | PID = PID0. fork_with_pipes(R) :- inline:" -{ - int fd1[2], fd2[2]; - long pid; - if( pipe(fd1) != 0 ) goto %f; - Fdopen(fd1[0], %1, %f, \"r\"); - Fdopen(fd1[1], %2, %f, \"w\"); - if( pipe(fd2) != 0 ) goto %f; - Fdopen(fd2[0], %3, %f, \"r\"); - Fdopen(fd2[1], %4, %f, \"w\"); - pid = fork(); - if( pid==0 ){ - fclose(FilePointer(%1)); - fclose(FilePointer(%4)); - }else{ - fclose(FilePointer(%2)); - fclose(FilePointer(%3)); - } - %0 = makeint(pid); -}":[PID-int, - In1-object(pointer),Out1-object(pointer), - In2-object(pointer),Out2-object(pointer)] | - ( - PID=\=0 -> - R=parent(PID,In,Out), - generic:new(file_io,In,In1,"pipe-input",[],""), - generic:new(file_io,Out,[],"",Out2,"pipe-output") - ; - PID=:=0 -> - R=child(In,Out), - generic:new(file_io,In,In2,"pipe-input",[],""), - generic:new(file_io,Out,[],"",Out1,"pipe-output") - ). + { + int fd1[2], fd2[2]; + long pid; + if( pipe(fd1) != 0 ) goto %f; + Fdopen(fd1[0], %1, %f, \"r\"); + Fdopen(fd1[1], %2, %f, \"w\"); + if( pipe(fd2) != 0 ) goto %f; + Fdopen(fd2[0], %3, %f, \"r\"); + Fdopen(fd2[1], %4, %f, \"w\"); + pid = fork(); + if( pid==0 ){ + fclose(FilePointer(%1)); + fclose(FilePointer(%4)); + }else{ + fclose(FilePointer(%2)); + fclose(FilePointer(%3)); + } + %0 = makeint(pid); + }": [PID-int, + In1-object(pointer), Out1-object(pointer), + In2-object(pointer), Out2-object(pointer)] | + ( + PID=\=0 -> + R = parent(PID, In, Out), + generic:new(file_io, In, In1, "pipe-input", [], ""), + generic:new(file_io, Out, [], "", Out2, "pipe-output") + ; + PID=:=0 -> + R = child(In, Out), + generic:new(file_io, In, In2, "pipe-input", [], ""), + generic:new(file_io, Out, [], "", Out1, "pipe-output") + ). otherwise. -fork_with_pipes(R) :- R=abnormal. +fork_with_pipes(R) :- + R = abnormal. /**************************************** - COMMAND ARGUMENT ACCESS + COMMAND ARGUMENT ACCESS ****************************************/ -argc(C) :- inline:"%0 = makeint(command_argc);":[Argc-int] | C = Argc. +argc(C) :- inline:"%0 = makeint(command_argc);": [Argc-int] | C = Argc. -argv(L) :- inline:"%0 = makeint(command_argc);":[Argc-int] | - make_argv_list(0,Argc,L). +argv(L) :- inline:"%0 = makeint(command_argc);": [Argc-int] | + make_argv_list(0, Argc, L). -make_argv_list(N,N,L) :- L=[]. -make_argv_list(K,N,L) :- K>Y | Z=R. -shift_left(X,Y,Z) :- R:=X<> Y | Z=R. +shift_left(X, Y, Z) :- R := X << Y | Z=R. + +complement(X, Z) :- R := \(X) | Z=R. +plus(X, Z) :- R := +X | Z=R. +minus(X, Z) :- R := -X | Z=R. diff -ruN klic-3.003-2002-02-22d/runtime/io.kl1 klic-3.003-2002-02-22e/runtime/io.kl1 --- klic-3.003-2002-02-22d/runtime/io.kl1 Sat Feb 16 11:59:09 2002 +++ klic-3.003-2002-02-22e/runtime/io.kl1 Fri Feb 22 22:27:35 2002 @@ -1,11 +1,13 @@ -/* ---------------------------------------------------------- -% (C)1993 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C)1993 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ + :- inline:" #include +#include /* byte_string_object */ #include \"gobj.h\" #include \"g_pointer.h\" @@ -20,8 +22,6 @@ #define file_pointer(x) \\ ((FILE*) ((struct pointer_object*) data_objectp(x))->pointer) -struct byte_string_object; - static FILE* open_named_file(str, mode) struct byte_string_object* str; @@ -36,107 +36,115 @@ :- module io. -outstreamq(Path,S) :- - generic:string(Path):_:_, - inline:" -{ - FILE* file = - open_named_file((struct byte_string_object*) functorp(%0), \"w\"); - if( file==NULL ) goto %f; - %1 = gd_new_pointer((q) file, allocp); - allocp = heapp(); -}":[Path+functor,File-any] | - S=normal(Out), out(Out,File). +:- public outstream/1. + +outstreamq(Path, S) :- generic:string(Path):_:_, inline:" + { + FILE* file = + open_named_file((struct byte_string_object*) functorp(%0), \"w\"); + if( file==NULL ) goto %f; + %1 = gd_new_pointer((q) file, allocp); + allocp = heapp(); + }": [Path+functor, File-any] | + S = normal(Out), + out(Out, File). otherwise. -outstreamq(_Path,S) :- S=abnormal. +outstreamq(_Path, S) :- + S = abnormal. -outstream(Path,S) :- outstreamq(Path,S0), testok(S0,S). +outstream(Path, S) :- outstreamq(Path, S0), testok(S0, S). outstream(S) :- inline:" -{ - %0 = gd_new_pointer((q) stdout, allocp); - allocp = heapp(); -}":[File-any] | - out(S,File). - -out([],File) :- inline:" -{ - FILE* f = file_pointer(%0); - if( f != stdout && f != stderr ) fclose(f); -}":[File+bound] | true. -out([putc(X)|Rest],File) :- - inline:"klic_putc(intval(%1), file_pointer(%0));":[File+bound,X+int] | - out(Rest,File). -out([nl|Rest],File) :- out([putc(10)|Rest],File). -out([flush|Rest],File) :- - inline:"fflush(file_pointer(%0));":[File+bound] | - out(Rest,File). -out([print(X0)|Rest],File) :- functor(X0,_,A) | - waitAll(1,A,X0,X0,X), - wait_and_print(X,File,Rest,S), - out(S,File). -out([puts(S)|Rest],File) :- string(S,L,8) | - puts(S,0,L,Rest0,Rest), - out(Rest0,File). -out([sync(X)|Rest],File) :- - X=0, out(Rest,File). - -wait_and_print(X,File,S0,S) :- - inline:"fprint(file_pointer(%0), %1);":[File+bound,X+bound] | - S=S0. - -waitAll(A0,A,_,X0,X) :- A0>A | X=X0. -waitAll(A0,A,F,X0,X) :- A0=A | + X = X0. +waitAll(A0, A, F, X0, X) :- A0=Day1 | Result=(>). -compare(time(Day0,Sec0,Usec0),time(Day1,Sec1,Usec1),Result) :- - Day0Sec1 | Result=(>). -compare(time(Day0,Sec0,Usec0),time(Day1,Sec1,Usec1),Result) :- - Day0=:=Day1, Sec0Usec1 | Result=(>). +:- public add/3, instantiate_after/2. + +add(time(Day0, Sec0, Usec0), time(Day1, Sec1, Usec1), Time) :- inline:" + { + struct timeval time0, time1; + TimeSet(time0, Twotime2time(intval(%0), intval(%1)), intval(%2)); + TimeSet(time1, Twotime2time(intval(%3), intval(%4)), intval(%5)); + TimeAdd(time0, time1, time0); + %6 = makeint((unsigned long)time0.tv_sec / SEC_DAY); + %7 = makeint((unsigned long)time0.tv_sec %% SEC_DAY); + %8 = makeint(time0.tv_usec); + }": [Day0+int, Sec0+int, Usec0+int, + Day1+int, Sec1+int, Usec1+int, Day-int, Sec-int, Usec-int] | + Time = time(Day, Sec, Usec). + +sub(time(Day0, Sec0, Usec0), time(Day1, Sec1, Usec1), Time) :- inline:" + { + struct timeval time0, time1; + TimeSet(time0, Twotime2time(intval(%0), intval(%1)), intval(%2)); + TimeSet(time1, Twotime2time(intval(%3), intval(%4)), intval(%5)); + TimeSub(time0, time1, time0); + %6 = makeint((unsigned long)time0.tv_sec / SEC_DAY); + %7 = makeint((unsigned long)time0.tv_sec %% SEC_DAY); + %8 = makeint(time0.tv_usec); + }": [Day0+int, Sec0+int, Usec0+int, + Day1+int, Sec1+int, Usec1+int, Day-int, Sec-int, Usec-int] | + Time = time(Day, Sec, Usec). + +compare(time(Day0, Sec0, Usec0), time(Day1, Sec1, Usec1), Result) :- + Day0 > Day1 | Result=(>). +compare(time(Day0, Sec0, Usec0), time(Day1, Sec1, Usec1), Result) :- + Day0 < Day1 | Result=(<). +compare(time(Day0, Sec0, Usec0), time(Day1, Sec1, Usec1), Result) :- + Day0=:=Day1, Sec0 > Sec1 | Result=(>). +compare(time(Day0, Sec0, Usec0), time(Day1, Sec1, Usec1), Result) :- + Day0=:=Day1, Sec0 < Sec1 | Result=(<). +compare(time(Day0, Sec0, Usec0), time(Day1, Sec1, Usec1), Result) :- + Day0=:=Day1, Sec0=:=Sec1, Usec0 < Usec1 | Result=(<). +compare(time(Day0, Sec0, Usec0), time(Day1, Sec1, Usec1), Result) :- + Day0=:=Day1, Sec0=:=Sec1, Usec0=:=Usec1 | Result=(=). +compare(time(Day0, Sec0, Usec0), time(Day1, Sec1, Usec1), Result) :- + Day0=:=Day1, Sec0=:=Sec1, Usec0 > Usec1 | Result=(>). get_time_of_day(Time) :- inline:" -{ - struct timeval now; + { + struct timeval now; #ifdef USETIMER - klic_gettod(&now); - %0 = makeint((unsigned)now.tv_sec / SEC_DAY); - %1 = makeint((unsigned)now.tv_sec %% SEC_DAY); - %2 = makeint(now.tv_usec); + klic_gettod(&now); + %0 = makeint((unsigned)now.tv_sec / SEC_DAY); + %1 = makeint((unsigned)now.tv_sec %% SEC_DAY); + %2 = makeint(now.tv_usec); #else - %0 = 0; - %1 = 0; - %2 = 0; + %0 = 0; + %1 = 0; + %2 = 0; #endif -}":[Day-int, Sec-int,Usec-int] | - Time=time(Day,Sec,Usec). + }": [Day-int, Sec-int, Usec-int] | + Time = time(Day, Sec, Usec). -instantiate_at(time(Day,Sec,Usec),X) :- - 0= Term=end_of_file - ; WTerm\=end_of_file -> variable:unwrap(WTerm,Term) ), - Result = normal(Term). +:- public parse/3, wparse/3. % called in read.kl1 + +parse(Tokens, Ops, Result) :- + wparse(Tokens, Ops, Res1), + wait_parse(Res1, Result). + +wait_parse(Result0, Result) :- Result0 = normal(WTerm) | + ( WTerm=end_of_file -> Term=end_of_file + ; WTerm\=end_of_file -> variable:unwrap(WTerm, Term) ), + Result = normal(Term). otherwise. -wait_parse(Res1,Result):- Result=Res1. +wait_parse(Res1, Result) :- + Result = Res1. -wparse([eof], _, Result) :- Result = normal(end_of_file). +wparse([eof], _, Result) :- + Result = normal(end_of_file). otherwise. wparse(Tokens, Ops, Result) :- - wparse(Tokens, 1200, Ops, Result0), - last_check(Result0, Result). + wparse(Tokens, 1200, Ops, Result0), + last_check(Result0, Result). + % last_check(Result0, Result) last_check(normal(Term, []), Result) :- - Result = normal(Term). + Result = normal(Term). last_check(normal(_Term, [H|T]), Result) :- - Result = abnormal("operator expected", [H|T]). + Result = abnormal("operator expected", [H|T]). last_check(abnormal(X, ErrPos), Result) :- - Result = abnormal(X, ErrPos). + Result = abnormal(X, ErrPos). + % wparse(TokenList, Precedence, Operators, Result) wparse([], _, _, Result) :- - Result = abnormal("expression expected", []). + Result = abnormal("expression expected", []). wparse([Token|Rest], Prec, Ops, Result) :- - wparse(Token, Rest, Prec, Ops, Result). + wparse(Token, Rest, Prec, Ops, Result). + % wparse(Token, RestOfTokens, Precedence, Operators, Result) -wparse(variable(_Variable,_,VarName,_), S1, Prec, Ops, Result) :- - after_term(S1, 0, variable(VarName), Prec, Ops, Result). +wparse(variable(_Variable, _, VarName, _), S1, Prec, Ops, Result) :- + after_term(S1, 0, variable(VarName), Prec, Ops, Result). wparse(('|'), S1, Prec, Ops, Result) :- true | - wparse(atom('|'), S1, Prec, Ops, Result). + wparse(atom('|'), S1, Prec, Ops, Result). wparse(atom(Atom), S1, Prec, Ops, Result) :- true | + ( + S1 = [number(Number)|S2], Atom = (-) -> ( - S1 = [number(Number)|S2], Atom = (-) -> - ( - integer(Number) -> Negated = integer(~(-Number)) - ; otherwise ; - true -> - generic:new(float, Zero, 0), - generic:subtract(Zero, Number, MinusNumber), - Negated = floating_point(MinusNumber) - ), - after_term(S2, 0, Negated, Prec, Ops, Result) - ; - S1 = ['('|S2] -> - parse_comma_list(S2, Ops, 999, never, ')', Res1), - ( - Res1 = normal(Elements, S3) -> - wrap_functor([Atom|Elements],WTerm), - after_term(S3, 0, WTerm, Prec, Ops, Result) - ; otherwise ; - true -> Result = Res1 - ) + integer(Number) -> Negated = integer(~(-Number)) ; otherwise ; - true -> - prefixop(Atom, Ops, Prec, OP), - ( - OP = prefix(OPrec, APrec) -> - wparse(S1, APrec, Ops, Res1), - ( - Res1 = normal(Arg, S11) -> - wrap_functor([Atom,Arg],WTerm), - after_term(S11, OPrec, WTerm, Prec, Ops, Res0) - ; otherwise ; - true -> Res0 = Res1 - ), - after_term(S1, 0, atom(Atom), Prec, Ops, Res2), - select_better(Res0, Res2, Result) - ; - OP = none -> - after_term(S1, 0, atom(Atom), Prec, Ops, Result) - ) - ). + true -> + generic:new(float, Zero, 0), + generic:subtract(Zero, Number, MinusNumber), + Negated = floating_point(MinusNumber) + ), + after_term(S2, 0, Negated, Prec, Ops, Result) + ; + S1 = ['('|S2] -> + parse_comma_list(S2, Ops, 999, never, ')', Res1), + ( + Res1 = normal(Elements, S3) -> + wrap_functor([Atom | Elements], WTerm), + after_term(S3, 0, WTerm, Prec, Ops, Result) + ; otherwise ; + true -> Result = Res1 + ) + ; otherwise ; + true -> + prefixop(Atom, Ops, Prec, OP), + ( + OP = prefix(OPrec, APrec) -> + wparse(S1, APrec, Ops, Res1), + ( + Res1 = normal(Arg, S11) -> + wrap_functor([Atom, Arg], WTerm), + after_term(S11, OPrec, WTerm, Prec, Ops, Res0) + ; otherwise ; + true -> Res0 = Res1 + ), + after_term(S1, 0, atom(Atom), Prec, Ops, Res2), + select_better(Res0, Res2, Result) + ; + OP = none -> + after_term(S1, 0, atom(Atom), Prec, Ops, Result) + ) + ). wparse(number(Number), S0, Prec, Ops, Result) :- integer(Number) | - after_term(S0, 0, integer(Number), Prec, Ops, Result). + after_term(S0, 0, integer(Number), Prec, Ops, Result). wparse(number(Number), S0, Prec, Ops, Result) :- generic:float(Number) | - after_term(S0, 0, floating_point(Number), Prec, Ops, Result). + after_term(S0, 0, floating_point(Number), Prec, Ops, Result). wparse(string(String), S0, Prec, Ops, Result) :- - ( - S0=[string(Another)|S1] -> - generic:join(String, Another, Appended), - wparse(string(Appended), S1, Prec, Ops, Result) - ; otherwise ; - true -> - after_term(S0, 0, string(String), Prec, Ops, Result) - ). + ( + S0 = [string(Another)|S1] -> + generic:join(String, Another, Appended), + wparse(string(Appended), S1, Prec, Ops, Result) + ; otherwise ; + true -> + after_term(S0, 0, string(String), Prec, Ops, Result) + ). wparse('[', S1, Prec, Ops, Result) :- true | - ( - S1=[']'|S2] -> - wparse(atom([]), S2, Prec, Ops, Result) + ( + S1 = [']'|S2] -> + wparse(atom([]), S2, Prec, Ops, Result) + ; otherwise ; + true -> + parse_comma_list(S1, Ops, 999, '|', ']', Res1), + ( + Res1 = normal(Elements, S3) -> + wrap_list(Elements, WElements), + after_term(S3, 0, WElements, Prec, Ops, Result) ; otherwise ; - true -> - parse_comma_list(S1, Ops, 999, '|', ']', Res1), - ( - Res1 = normal(Elements, S3) -> - wrap_list(Elements,WElements), - after_term(S3, 0, WElements, Prec, Ops, Result) - ; otherwise ; - true -> Result = Res1 - ) - ). + true -> Result = Res1 + ) + ). wparse('{', S1, Prec, Ops, Result) :- true | - ( - S1=['}'|S2] -> - new_vector(V,0), - after_term(S2, 0, vector(V), Prec, Ops, Result) - ; otherwise ; - true -> - parse_comma_list(S1, Ops, 999, never, '}', Res1), - ( - Res1 = normal(Elements, S3) -> - generic:new(vector,Vector,Elements), - after_term(S3, 0, vector(Vector), Prec, Ops, Result) - ; otherwise ; - true -> Result = Res1 - ) - ). + ( + S1 = ['}'|S2] -> + new_vector(V, 0), + after_term(S2, 0, vector(V), Prec, Ops, Result) + ; otherwise ; + true -> + parse_comma_list(S1, Ops, 999, never, '}', Res1), + ( + Res1 = normal(Elements, S3) -> + generic:new(vector, Vector, Elements), + after_term(S3, 0, vector(Vector), Prec, Ops, Result) + ; otherwise ; + true -> Result = Res1 + ) + ). wparse(Token, S1, Prec, Ops, Result) :- (Token='('; Token=' (') | - wparse(S1, 1200, Ops, Res1), + wparse(S1, 1200, Ops, Res1), + ( + Res1 = normal(Term, S2) -> ( - Res1 = normal(Term, S2) -> - ( - S2=[')'|S3] -> - after_term(S3, 0, Term, Prec, Ops, Result) - ; otherwise ; - true -> - Result=abnormal("close parenthesis expected", S2) - ) - ; otherwise ; - true -> Result = Res1 - ). + S2 = [')'|S3] -> + after_term(S3, 0, Term, Prec, Ops, Result) + ; otherwise ; + true -> + Result = abnormal("close parenthesis expected", S2) + ) + ; otherwise ; + true -> Result = Res1 + ). wparse(Token, S0, _, _, Result) :- Token=error(Message) | - Result = abnormal(Message, S0). + Result = abnormal(Message, S0). otherwise. wparse(Token, S0, _, _, Result) :- - Result = abnormal("term expected to start", [Token|S0]). + Result = abnormal("term expected to start", [Token|S0]). + % after_term(Tokens, MinPrec, Term, MaxPrec, Ops, Result) after_term([atom(Atom)|S1], MinPrec, Term, Prec, Ops, Result) :- - infixop(Atom, Ops, MinPrec, Prec, IOP), - postfixop(Atom, Ops, MinPrec, Prec, POP), + infixop(Atom, Ops, MinPrec, Prec, IOP), + postfixop(Atom, Ops, MinPrec, Prec, POP), + ( + IOP = none -> ( - IOP = none -> - ( - POP = none -> Result = normal(Term, [atom(Atom)|S1]) - ; - POP = postfix(POprec) -> - wrap_functor([Atom,Term],WExpr), - after_term(S1, POprec, WExpr, Prec, Ops, Result) - ) + POP = none -> Result = normal(Term, [atom(Atom)|S1]) ; - IOP = infix(IOprec, Rprec) -> - wparse(S1, Rprec, Ops, Res0), - ( - POP = none -> - ( - Res0 = normal(Right, S2) -> - wrap_functor([Atom,Term,Right],WExpr), - after_term(S2, IOprec, WExpr, Prec, Ops, Result) - ; otherwise ; - true -> Result = Res0 - ) - ; - POP = postfix(POprec1) -> - wrap_functor([Atom,Term],WExpr), - after_term(S1, POprec1, WExpr, Prec, Ops, Res2), - select_better(Res0, Res2, Result) - ) - ). + POP = postfix(POprec) -> + wrap_functor([Atom, Term], WExpr), + after_term(S1, POprec, WExpr, Prec, Ops, Result) + ) + ; + IOP = infix(IOprec, Rprec) -> + wparse(S1, Rprec, Ops, Res0), + ( + POP = none -> + ( + Res0 = normal(Right, S2) -> + wrap_functor([Atom, Term, Right], WExpr), + after_term(S2, IOprec, WExpr, Prec, Ops, Result) + ; otherwise ; + true -> Result = Res0 + ) + ; + POP = postfix(POprec1) -> + wrap_functor([Atom, Term], WExpr), + after_term(S1, POprec1, WExpr, Prec, Ops, Res2), + select_better(Res0, Res2, Result) + ) + ). -after_term([(',')|S1], MinPrec, Term, Prec, Ops, Result) :- +after_term([(', ')|S1], MinPrec, Term, Prec, Ops, Result) :- MinPrec < 1000, Prec >= 1000 | - wparse(S1, 1000, Ops, Res1), - ( - Res1 = normal(Right, S2) -> - after_term(S2, 999, functor((Term,Right)), Prec, Ops, Result) - ; otherwise ; - true -> Result = Res1 - ). + wparse(S1, 1000, Ops, Res1), + ( + Res1 = normal(Right, S2) -> + after_term(S2, 999, functor((Term, Right)), Prec, Ops, Result) + ; otherwise ; + true -> Result = Res1 + ). after_term([('|')|S1], MinPrec, Term, Prec, Ops, Result) :- MinPrec < 1100, Prec >= 1100 | - wparse(S1, 1100, Ops, Res1), - ( - Res1 = normal(Right, S2) -> - after_term(S2, 1099, functor('|'(Term,Right)), Prec, Ops, Result) - ; otherwise ; - true -> Result = Res1 - ). + wparse(S1, 1100, Ops, Res1), + ( + Res1 = normal(Right, S2) -> + after_term(S2, 1099, functor('|'(Term, Right)), Prec, Ops, Result) + ; otherwise ; + true -> Result = Res1 + ). otherwise. after_term(S1, _MinPrec, Term, _Prec, _Ops, Result) :- - Result = normal(Term, S1). + Result = normal(Term, S1). + % parse_comma_list(Tokens, Ops, Prec, Bar, Closer, Result), parse_comma_list(S1, Ops, Prec, Bar, Close, Result) :- - parse_comma_list(S1, Ops, Prec, Bar, Close, Top, Top, Result). + parse_comma_list(S1, Ops, Prec, Bar, Close, Top, Top, Result). parse_comma_list(S1, Ops, Prec, Bar, Close, Top, Tail, Result) :- - wparse(S1, Prec, Ops, Res1), - ( - Res1 = normal(Term, S2) -> - Tail = [Term|NewTail], - ( - S2 = [','|S3] -> - parse_comma_list(S3, Ops, Prec, Bar, Close, - Top, NewTail, Result) - ; - S2 = [Close|S3] -> - NewTail = [], - Result = normal(Top, S3) - ; - S2 = [Bar|S3] -> - wparse(S3, Prec, Ops, Res2), - ( - Res2 = normal(ParsedTail, S4) -> - NewTail = ParsedTail, - ( - S4 = [Close|S5] -> - Result = normal(Top, S5) - ; otherwise ; - true -> - Result = abnormal("close parenthesis expected", S4) - ) - ; otherwise ; - true -> Result = Res2 - ) - ; otherwise ; - true -> - Result = abnormal("comma or close parenthesis expected", S2) - ) + wparse(S1, Prec, Ops, Res1), + ( + Res1 = normal(Term, S2) -> + Tail = [Term|NewTail], + ( + S2 = [', '|S3] -> + parse_comma_list(S3, Ops, Prec, Bar, Close, + Top, NewTail, Result) + ; + S2 = [Close|S3] -> + NewTail = [], + Result = normal(Top, S3) + ; + S2 = [Bar|S3] -> + wparse(S3, Prec, Ops, Res2), + ( + Res2 = normal(ParsedTail, S4) -> + NewTail = ParsedTail, + ( + S4 = [Close|S5] -> + Result = normal(Top, S5) + ; otherwise ; + true -> + Result = abnormal("close parenthesis expected", S4) + ) ; otherwise ; - true -> Result = Res1 - ). + true -> Result = Res2 + ) + ; otherwise ; + true -> + Result = abnormal("comma or close parenthesis expected", S2) + ) + ; otherwise ; + true -> Result = Res1 + ). list_to_comma_list([H|T], X) :- T=[] | X = H. -list_to_comma_list([H|T], X) :- T\=[] | X = (H,Y), list_to_comma_list(T, Y). +list_to_comma_list([H|T], X) :- T\=[] | X = (H, Y), list_to_comma_list(T, Y). -select_better(R1, R2, Result) :- - R1=normal(X1, S1), R2=normal(X2, S2) | - longer(S1, S2, Longer), - ( Longer = no -> Result = R1; Longer = yes -> Result = R2 ). +select_better(R1, R2, Result) :- R1=normal(X1, S1), R2=normal(X2, S2) | + longer(S1, S2, Longer), + ( Longer = no -> Result = R1; + Longer = yes -> Result = R2 ). select_better(R1, R2, Result) :- R1=normal(X, S), R2=abnormal(_, _) | - Result = R1. + Result = R1. select_better(R1, R2, Result) :- R1=abnormal(_, _), R2=normal(X, S) | - Result = R2. + Result = R2. select_better(R1, R2, Result) :- R1=abnormal(X1, S1), R2=abnormal(X2, S2) | - longer(S1, S2, Longer), - ( Longer = no -> Result = R1; Longer = yes -> Result = R2 ). - -prefixop(Atom, ops(Pre,_In,_Post), Prec, OP) :- - lookup_op(Pre, Atom, Kind, P), - ( - P > Prec -> OP = none - ; otherwise ; - Kind = fx -> P1 := P-1, OP = prefix(P, P1) - ; - Kind = fy -> OP = prefix(P, P) - ). + longer(S1, S2, Longer), + ( Longer = no -> Result = R1; + Longer = yes -> Result = R2 ). + +prefixop(Atom, ops(Pre, _In, _Post), Prec, OP) :- + lookup_op(Pre, Atom, Kind, P), + ( + P > Prec -> OP = none + ; otherwise ; + Kind = fx -> P1 := P-1, OP = prefix(P, P1) + ; + Kind = fy -> OP = prefix(P, P) + ). infixop(Atom, ops(_Pre, In, _Post), Min, Max, OP) :- - lookup_op(In, Atom, Kind, P), - ( - Kind = xfx, P > Min, P =< Max -> P1 := P-1, OP = infix(P, P1) - ; - Kind = xfy, P > Min, P =< Max -> OP = infix(P, P) - ; - Kind = yfx, P >= Min, P < Max -> P1 := P-1, OP = infix(P, P1) - ; otherwise ; - true -> OP = none - ). + lookup_op(In, Atom, Kind, P), + ( + Kind = xfx, P > Min, P =< Max -> P1 := P-1, OP = infix(P, P1) + ; + Kind = xfy, P > Min, P =< Max -> OP = infix(P, P) + ; + Kind = yfx, P >= Min, P < Max -> P1 := P-1, OP = infix(P, P1) + ; otherwise ; + true -> OP = none + ). postfixop(Atom, ops(_Pre, _In, Post), Min, Max, OP) :- - lookup_op(Post, Atom, Kind, P), - ( - P > Max -> OP = none - ; otherwise ; - Kind = xf, P > Min -> OP = postfix(P) - ; - Kind = yf, P >= Min -> OP = postfix(P) - ). + lookup_op(Post, Atom, Kind, P), + ( + P > Max -> OP = none + ; otherwise ; + Kind = xf, P > Min -> OP = postfix(P) + ; + Kind = yf, P >= Min -> OP = postfix(P) + ). -lookup_op([], _, Kind, P) :- Kind = none, P = 9999. +lookup_op([], _, Kind, P) :- + Kind = none, P = 9999. lookup_op([op(Atom0, Kind0, P0)|_T], Atom, Kind, P) :- Atom0=Atom | - Kind = Kind0, P = P0. -lookup_op([op(Atom0,_Kind0,_P0)| T], Atom, Kind, P) :- Atom0\=Atom | - lookup_op(T, Atom, Kind, P). + Kind = Kind0, P = P0. +lookup_op([op(Atom0, _Kind0, _P0)| T], Atom, Kind, P) :- Atom0\=Atom | + lookup_op(T, Atom, Kind, P). + % Auxiliary @@ -309,18 +321,17 @@ longer([_|T1], [_|T2], YorN) :- longer(T1, T2, YorN). longer([], _, YorN) :- YorN = no. -wrap_list([],WL):- WL=atom([]). -wrap_list([WE|R],WL):- WL = list([WE|WR]), - wrap_list(R,WR). +wrap_list([], WL) :- WL=atom([]). +wrap_list([WE|R], WL) :- WL = list([WE|WR]), wrap_list(R, WR). otherwise. -wrap_list(ETC,WETC):- WETC=ETC. +wrap_list(ETC, WETC) :- WETC=ETC. -wrap_functor(List,WF) :- - functor_table:(F=..List), - wrap_functor1(F,WF). +wrap_functor(List, WF) :- + functor_table:(F =.. List), + wrap_functor1(F, WF). -wrap_functor1(L,WF) :- L=[H|T] | WF=list(L). +wrap_functor1(L, WF) :- L=[H|T] | WF=list(L). otherwise. -wrap_functor1(F,WF):- WF = functor(F). +wrap_functor1(F, WF) :- WF = functor(F). -unwrap(W,T) :- variable:unwrap(W,T). +unwrap(W, T) :- variable:unwrap(W, T). diff -ruN klic-3.003-2002-02-22d/runtime/queue.kl1 klic-3.003-2002-02-22e/runtime/queue.kl1 --- klic-3.003-2002-02-22d/runtime/queue.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/queue.kl1 Fri Feb 22 22:27:35 2002 @@ -1,68 +1,67 @@ -/* ---------------------------------------------------------- -% (C)1993,1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C)1993, 1994, 1995 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ + :- module queue. +:- public create/1. + create(Stream) :- - CAR = CDR, - main(Stream,[],0)+CAR+CDR. + CAR = CDR, + main(Stream, [], 0)+CAR+CDR. -main([], [] )+No+CAR+CDR :- CDR = []. -main([], [S|ST] )+No+CAR+CDR :- main(S,ST)+No+CAR+CDR. -main([do(S)|T], ST )+No+CAR+CDR :- main(S,[T|ST])+No+CAR+CDR. +main([], [] )+No+CAR+CDR :- + CDR = []. +main([], [S|ST] )+No+CAR+CDR :- + main(S, ST)+No+CAR+CDR. +main([do(S)|T], ST )+No+CAR+CDR :- + main(S, [T|ST])+No+CAR+CDR. otherwise. -main([Message|T],ST )+No+CAR+CDR :- - message(Message)-No-CAR-CDR, - main(T,ST)+No+CAR+CDR. - - -message(empty(YorN))-No-CAR-CDR :- - No =:= 0 | - YorN = yes. -message(empty(YorN))-No-CAR-CDR :- - No =\= 0 | - YorN = no. - -message(put(Value),No1,No2)-CAR-CDR :- - No2 := No1 + 1, - dlist(Value)-CDR. - -message(get(Value),No1,No2)-CAR-CDR :- - No1 > 0 | - No2 := No1 -1, - dlist(Value)-CAR. - -message(get_if_any(Value),No1,No2)-CAR-CDR :- - No1 =:= 0 | - No2 = No1, - Value = {}. -message(get_if_any(Value1),No1,No2)-CAR-CDR :- - No1 =\= 0 | - message(get(Value2),No1,No2)-CAR-CDR, - Value1 = {Value2}. - -message(get_all(Values),No1,No2,CAR1,CAR2)-CDR :- - No2 = 0, - get_all(No1,CAR1,CAR2,Values). +main([Message|T], ST )+No+CAR+CDR :- + message(Message)-No-CAR-CDR, + main(T, ST)+No+CAR+CDR. + + +message(empty(YorN))-No-CAR-CDR :- No =:= 0 | + YorN = yes. +message(empty(YorN))-No-CAR-CDR :- No =\= 0 | + YorN = no. + +message(put(Value), No1, No2)-CAR-CDR :- + No2 := No1 + 1, + dlist(Value)-CDR. + +message(get(Value), No1, No2)-CAR-CDR :- No1 > 0 | + No2 := No1 - 1, + dlist(Value)-CAR. + +message(get_if_any(Value), No1, No2)-CAR-CDR :- No1 =:= 0 | + No2 = No1, + Value = {}. +message(get_if_any(Value1), No1, No2)-CAR-CDR :- No1 =\= 0 | + message(get(Value2), No1, No2)-CAR-CDR, + Value1 = {Value2}. + +message(get_all(Values), No1, No2, CAR1, CAR2)-CDR :- + No2 = 0, + get_all(No1, CAR1, CAR2, Values). message(carbon_copy(Values))-No-CAR-CDR :- - get_all(No,CAR,_,Values). + get_all(No, CAR, _, Values). -dlist(V,LIST,CDR) :- - LIST = [V|CDR]. +dlist(V, LIST, CDR) :- + LIST = [V | CDR]. -get_all(No,CAR,TAIL,V):- - No =:= 0 | - CAR = TAIL, - V = []. -get_all(No,[CAR|CDR],TAIL,V1):- - No =\= 0 | - V1 = [CAR|V2], - get_all(~(No-1),CDR,TAIL,V2). +get_all(No, CAR, TAIL, V) :- No =:= 0 | + CAR = TAIL, + V = []. +get_all(No, [CAR|CDR], TAIL, V1) :- No =\= 0 | + V1 = [CAR | V2], + get_all(~(No-1), CDR, TAIL, V2). diff -ruN klic-3.003-2002-02-22d/runtime/read.kl1 klic-3.003-2002-02-22e/runtime/read.kl1 --- klic-3.003-2002-02-22d/runtime/read.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/read.kl1 Fri Feb 22 22:27:35 2002 @@ -1,89 +1,101 @@ -/* ---------------------------------------------------------- -% (C) 1994 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C) 1994 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ :- module klic_reader. +% called in termio.kl1 +:- public parse_one_term_reporting_errors/4, + wparse_one_term_reporting_errors/4. + parse_one_term_reporting_errors(In, s(Ops,OnErr), Result, InT) :- - In = [linecount(Before)|In0], - scanner:scan(Tokens, In0, In1), - parser:parse(Tokens, Ops, Result0), - ( - Result0 = normal(Term) -> Result = Term, InT = In1 - ; - Result0 = abnormal(Reason, Rest) -> - unix:unix(U), - U = [stderr(normal(Err))], - In1 = [linecount(After)|In2], - report_syntax_error(Reason, Before, After, Tokens, Rest, Err, OnErr), - parse_one_term_reporting_errors(In2, s(Ops,OnErr), Result, InT) - ). + In = [linecount(Before) | In0], + scanner:scan(Tokens, In0, In1), + parser:parse(Tokens, Ops, Result0), + ( + Result0 = normal(Term) -> Result = Term, InT = In1 + ; + Result0 = abnormal(Reason, Rest) -> + unix:unix(U), + U = [stderr(normal(Err))], + In1 = [linecount(After) | In2], + report_syntax_error(Reason, Before, After, Tokens, Rest, Err, OnErr), + parse_one_term_reporting_errors(In2, s(Ops,OnErr), Result, InT) + ). wparse_one_term_reporting_errors(In, s(Ops,OnErr), Result, InT) :- - In = [linecount(Before)|In0], - scanner:scan(Tokens, In0, In1), - parser:wparse(Tokens, Ops, Result0), - ( - Result0 = normal(Term) -> Result = normal(Term), InT = In1 - ; - Result0 = abnormal(Reason, Rest) -> - unix:unix(U), - U = [stderr(normal(Err))], - In1 = [linecount(After)|In2], - report_syntax_error(Reason, Before, After, Tokens, Rest, Err, OnErr), - wparse_one_term_reporting_errors(In2, s(Ops,OnErr), Result, InT) - ). + In = [linecount(Before) | In0], + scanner:scan(Tokens, In0, In1), + parser:wparse(Tokens, Ops, Result0), + ( + Result0 = normal(Term) -> Result = normal(Term), InT = In1 + ; + Result0 = abnormal(Reason, Rest) -> + unix:unix(U), + U = [stderr(normal(Err))], + In1 = [linecount(After) | In2], + report_syntax_error(Reason, Before, After, Tokens, Rest, Err, OnErr), + wparse_one_term_reporting_errors(In2, s(Ops,OnErr), Result, InT) + ). report_syntax_error(Reason, LB, LA, Tokens, Rest, Err, OnErr) :- - integer(OnErr) | - Err = [fwrite("{SYNTAX ERROR: in lines ")|Err1], - LB1 := LB+1, - LA1 := LA+1, - write_number(LB1,Err1,[fwrite("-")|Err2]), - write_number(LA1,Err2, - [fwrite("}\n** "), - fwrite(Reason), - fwrite(" **\n")|Err3]), - length(Tokens, TotalLen), - length(Rest, RestLen), - write_tokens(~(TotalLen-RestLen), Tokens, Err3, - [fwrite("\n** here **\n")|Err4]), - write_tokens(RestLen, Rest, Err4, [putc(10), fflush(Sync)]), - ( OnErr < 0, wait(Sync) -> unix:exit(OnErr) - ; OnErr =:= 0 -> true ). + integer(OnErr) | + Err = [fwrite("{SYNTAX ERROR: in lines ") | Err1], + LB1 := LB+1, + LA1 := LA+1, + write_number(LB1, Err1, [fwrite("-") | Err2]), + write_number(LA1, Err2, + [fwrite("}\n** "), + fwrite(Reason), + fwrite(" **\n") | Err3 ]), + length(Tokens, TotalLen), + length(Rest, RestLen), + write_tokens(~(TotalLen-RestLen), Tokens, Err3, + [fwrite("\n** here **\n") | Err4] ), + write_tokens(RestLen, Rest, Err4, [putc(10), fflush(Sync)]), + ( OnErr < 0, wait(Sync) -> unix:exit(OnErr) + ; OnErr =:= 0 -> true ). write_tokens(0, _)-Err. write_tokens(N, [H|T])-Err :- N > 0 | - write_one_token(H)-Err, - write_tokens(~(N-1), T)-Err. + write_one_token(H)-Err, + write_tokens(~(N-1), T)-Err. write_one_token(variable(_,_,Name,_))-Err :- - write_string(Name)-Err, blank-Err. + write_string(Name)-Err, + blank-Err. write_one_token(number(Number))-Err :- - write_number(Number)-Err, blank-Err. + write_number(Number)-Err, + blank-Err. write_one_token(open(Atom))-Err :- - write_atom(Atom)-Err, write_char(0'()-Err, blank-Err. + write_atom(Atom)-Err, + write_char(0'()-Err, + blank-Err. write_one_token(atom(Atom))-Err :- - write_atom(Atom)-Err, blank-Err. + write_atom(Atom)-Err, + blank-Err. write_one_token(string(Elems))-Err :- - write_char(0'")-Err, write_string(Elems)-Err, - write_char(0'")-Err, blank-Err. + write_char(0'")-Err, + write_string(Elems)-Err, + write_char(0'")-Err, + blank-Err. write_one_token(eof)-Err. write_one_token(error(_))-Err. otherwise. write_one_token(Atom)-Err :- - write_atom(Atom)-Err, blank-Err. + write_atom(Atom)-Err, + blank-Err. -blank-Err :- write_char(0' )-Err. +blank-Err :- write_char(#" ")-Err. -write_char(C, Err0, Err) :- Err0 = [putc(C)|Err]. +write_char(C, Err0, Err) :- Err0 = [putc(C) | Err]. write_atom(Atom, Err0, Err) :- - atom_table:get_atom_string(Atom, String), - Err0 = [fwrite(String)|Err]. + atom_table:get_atom_string(Atom, String), + Err0 = [fwrite(String) | Err]. write_string(String)-Err :- Err <= fwrite(String). @@ -93,8 +105,8 @@ write_decimal(0)-Err. write_decimal(N)-Err :- N > 0 | - write_decimal(~(N/10))-Err, - write_char(~(N mod 10 + 0'0))-Err. + write_decimal(~(N/10))-Err, + write_char(~(N mod 10 + 0'0))-Err. length(L, N) :- length(L, 0, N). diff -ruN klic-3.003-2002-02-22d/runtime/scan.kl1 klic-3.003-2002-02-22e/runtime/scan.kl1 --- klic-3.003-2002-02-22d/runtime/scan.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/scan.kl1 Fri Feb 22 22:27:35 2002 @@ -5,433 +5,442 @@ % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ -/* - Character Type Encoding - - lowercase & kanji 0 - uppercase letter 1 - digit 2 - underbar 3 - symbol 4 - double quote 5 - single quote 6 - exclamation 7 - comma 8 - semicolon 9 - vertical bar 10 - open parenthesis 11 - close parenthesis 12 - open bracket 13 - close bracket 14 - open brace 15 - close brace 16 - percent 17 - - space and alike 20 - end of file 21 - - Tokens - variable(Var,Seq,Name,Kind): Variable - Var: logical variable itself - Seq: sequential number in one scan - Name: variable name string - Kind: `void' or `normal' - number(Value): Number (integer or floating) - string(String): String Literal - atom(Atom): Atom - ',': Comma - '|': Vertical bar - '(': Open parenthesis immediately following an atom - ' (': Open parenthesis not immediately following an atom - ')': Cloase parenthesis - '[': Open bracket - ']': Close bracket - '{': Open curly brace - '}': Close curly brace - error(ReasonString): Error found while scanning - eof: End of file -*/ +% Character Type Encoding +% +% lowercase & kanji 0 +% uppercase letter 1 +% digit 2 +% underbar 3 +% symbol 4 +% double quote 5 +% single quote 6 +% exclamation 7 +% comma 8 +% semicolon 9 +% vertical bar 10 +% open parenthesis 11 +% close parenthesis 12 +% open bracket 13 +% close bracket 14 +% open brace 15 +% close brace 16 +% percent 17 +% +% space and alike 20 +% end of file 21 +% +% Tokens +% variable(Var, Seq, Name, Kind): Variable +% Var: logical variable itself +% Seq: sequential number in one scan +% Name: variable name string +% Kind: `void' or `normal' +% number(Value): Number (integer or floating) +% string(String): String Literal +% atom(Atom): Atom +% ', ': Comma +% '|': Vertical bar +% '(': Open parenthesis immediately following an atom +% ' (': Open parenthesis not immediately following an atom +% ')': Cloase parenthesis +% '[': Open bracket +% ']': Close bracket +% '{': Open curly brace +% '}': Close curly brace +% error(ReasonString): Error found while scanning +% eof: End of file :- module scanner. +:- public scan/3, chartype/2. % called in read.kl1, unparse.kl1 + scan(Tokens)-F :- - getchar(C,Type)-F, - scan(Type,C,vtab(0,[]),Tokens)-F. + getchar(C, Type)-F, + scan(Type, C, vtab(0, []), Tokens)-F. -scan(0,C0,V0,T0)-F :- - getchar(C1,Type1)-F, - scan_name(Type1,C1,Name,Type,C)-F, - atom_chars(Atom,[C0|Name]), - scan_after_atom(Type,C,Atom,V0,T0,T)-F. -scan(1,C0,vtab(Seq0,Tab0),T0)-F :- - getchar(C1,Type1)-F, - scan_name(Type1,C1,Name,Type,C)-F, - make_new_string(VarName,[C0|Name]), - lookup_var(Tab0,Seq0,VarName,Vseq,Var,Kind,Tab,Seq), - T0=[variable(Var,Vseq,VarName,Kind)|T], - scan(Type,C,vtab(Seq,Tab),T)-F. -scan(2,C0,V0,T0)-F :- - scan_number(2,C0,Number,C,Type,L,L)-F, - T0=[number(Number)|T], - scan(Type,C,V0,T)-F. -scan(3,C0,vtab(Seq0,Tab),T0)-F :- - getchar(C1,Type1)-F, - scan_name(Type1,C1,Name,Type,C)-F, - make_new_string(VarName,[C0|Name]), - T0=[variable(_,Seq0,VarName,void)|T], - Seq := Seq0+1, - scan(Type,C,vtab(Seq,Tab),T)-F. -scan(4,C0,V0,T0)-F :- - getchar(C1,Type1)-F, - ( C0=:=0'., Type1>=20, V0=vtab(_,Tab) -> T0=[], finalize_vars(Tab) - ; C0=:=0'/ -> - ( C1=:=0'* -> - get0(C2)-F, - scan_comment(C2,Type,C)-F, - scan(Type, C, V0, T0)-F - ; C1=\=0'* -> - scan_sname(Type1,C1,Name,Type,C)-F, - atom_chars(Atom,[C0|Name]), - scan_after_atom(Type,C,Atom,V0,T0,T)-F - ) - ; otherwise; true -> - scan_sname(Type1,C1,Name,Type,C)-F, - atom_chars(Atom,[C0|Name]), - scan_after_atom(Type,C,Atom,V0,T0,T)-F - ). -scan(5,C0,V0,T0)-F :- - get0(C1)-F, - scan_string(C1,C0,Elements,C,Type,Err)-F, - ( - Err = [] -> - make_new_string(String,Elements), - T0=[string(String)|T], - scan(Type,C,V0,T)-F - ; otherwise ; - true -> - T0=[error(Err)|T], - scan(Type,C,V0,T)-F - ). -scan(6,C0,V0,T0)-F :- - get0(C1)-F, - scan_string(C1,C0,Name,C,Type,Err)-F, - ( - Err = [] -> - atom_chars(Atom,Name), - scan_after_atom(Type,C,Atom,V0,T0,T)-F - ; otherwise ; - true -> - T0=[error(Err)|T], - scan(Type,C,V0,T)-F - ). -scan(7,_,V0,T0)-F :- - getchar(C,Type)-F, - scan_after_atom(Type,C,(!),V0,T0,T)-F. -scan(9,_,V0,T0)-F :- - getchar(C,Type)-F, - scan_after_atom(Type,C,(;),V0,T0,T)-F. -scan(8,_,V0,T0)-F :- T0=[(',')|T], scan_rest(V0,T)-F. -scan(10,_,V0,T0)-F :- T0=['|'|T], scan_rest(V0,T)-F. -scan(11,_,V0,T0)-F :- T0=[' ('|T], scan_rest(V0,T)-F. -scan(12,_,V0,T0)-F :- T0=[')'|T], scan_rest(V0,T)-F. -scan(13,_,V0,T0)-F :- T0=['['|T], scan_rest(V0,T)-F. -scan(14,_,V0,T0)-F :- T0=[']'|T], getchar(C,Type)-F, - ( - Type=11 -> T=['('|T1], scan_rest(V0,T1)-F - ; otherwise ; - true -> scan(Type,C,V0,T)-F - ). -scan(15,_,V0,T0)-F :- T0=['{'|T], scan_rest(V0,T)-F. -scan(16,_,V0,T0)-F :- T0=['}'|T], scan_rest(V0,T)-F. -scan(17,_,V0,T0)-F :- get0(C)-F, scan_comment_line(C,V0,T0)-F. -scan(20,_,V0,T0)-F :- scan_rest(V0,T0)-F. -scan(21,_,vtab(_,Tab),T0)-F :- T0=[eof], finalize_vars(Tab). - -scan_after_atom(Type,C,Atom,V0,T0,T)-F :- Type=:=11 | - T0=[atom(Atom), '('|T], scan_rest(V0,T)-F. -scan_after_atom(Type,C,Atom,V0,T0,T)-F :- Type=\=11 | - T0=[atom(Atom)|T], scan(Type,C,V0,T)-F. - -scan_comment_line(C0,V,T)-F :- C0<0 | - scan(21,C0,V,T)-F. -scan_comment_line(C0,V,T)-F :- C0>=0, C0=:=10 | - scan_rest(V,T)-F. -scan_comment_line(C0,V,T)-F :- C0>=0, C0=\=10 | - getchar(C,_)-F, scan_comment_line(C,V,T)-F. - -scan_comment(C0,Type,C)-F :- C0=:=0'* | - get0(C1)-F, - ( C1=:=0'/ -> getchar(C,Type)-F - ; C1=\=0'/ -> scan_comment(C1,Type,C)-F - ). -scan_comment(C0,Type,C)-F :- C0=\=0'* | - get0(C1)-F, scan_comment(C1,Type,C)-F. - -scan_rest(V,T)-F :- getchar(C,Type)-F, scan(Type,C,V,T)-F. - -scan_name(Type0,C0,Name0,Type,C)-F :- Type0 =< 3 | - Name0=[C0|Name], - getchar(C1,Type1)-F, - scan_name(Type1,C1,Name,Type,C)-F. -scan_name(Type0,C0,Name0,Type,C)-F :- Type0 > 3 | - Name0=[], C=C0, Type=Type0. - -scan_sname(Type0,C0,Name0,Type,C)-F :- Type0 =:= 4 | - Name0=[C0|Name], - getchar(C1,Type1)-F, - scan_sname(Type1,C1,Name,Type,C)-F. -scan_sname(Type0,C0,Name0,Type,C)-F :- Type0 =\= 4 | - Name0=[], C=C0, Type=Type0. - -scan_number(2,C0,N,C,Type,L,LT0)-F :- - LT0=[C0|LT], - getchar(C1,Type1)-F, - scan_number(Type1,C1,N,C,Type,L,LT)-F. -scan_number(6,_,N,C,Type,L,LT)-F :- - LT=[], - char_list_to_int(L,0,N0), - getchar(C1,Type1)-F, - ( N0=:=0 -> N=C1, getchar(C,Type)-F - ; N0=\=0 -> scan_based_number(Type1,C1,N0,0,N,C,Type)-F - ). -scan_number(_,0'.,N,C,Type,L,LT0)-F :- - getchar(C1,Type1)-F, - ( Type1=:=2 -> - LT0=[0'.|LT], - scan_fraction(Type1,C1,N,C,Type,L,LT)-F - ; Type1=\=2 -> - ungetc(C1)-F, Type=4, C=0'., LT0=[], - char_list_to_int(L,0,N) - ). +scan(0, C0, V0, T0)-F :- + getchar(C1, Type1)-F, + scan_name(Type1, C1, Name, Type, C)-F, + atom_chars(Atom, [C0 | Name]), + scan_after_atom(Type, C, Atom, V0, T0, T)-F. +scan(1, C0, vtab(Seq0, Tab0), T0)-F :- + getchar(C1, Type1)-F, + scan_name(Type1, C1, Name, Type, C)-F, + make_new_string(VarName, [C0 | Name]), + lookup_var(Tab0, Seq0, VarName, Vseq, Var, Kind, Tab, Seq), + T0 = [variable(Var, Vseq, VarName, Kind) | T], + scan(Type, C, vtab(Seq, Tab), T)-F. +scan(2, C0, V0, T0)-F :- + scan_number(2, C0, Number, C, Type, L, L)-F, + T0 = [number(Number) | T], + scan(Type, C, V0, T)-F. +scan(3, C0, vtab(Seq0, Tab), T0)-F :- + getchar(C1, Type1)-F, + scan_name(Type1, C1, Name, Type, C)-F, + make_new_string(VarName, [C0 | Name]), + T0 = [variable(_, Seq0, VarName, void) | T], + Seq := Seq0+1, + scan(Type, C, vtab(Seq, Tab), T)-F. +scan(4, C0, V0, T0)-F :- + getchar(C1, Type1)-F, + ( C0=:=0'., Type1>=20, V0=vtab(_, Tab) -> T0=[], finalize_vars(Tab) + ; C0=:=0'/ -> + ( C1=:=0'* -> + get0(C2)-F, + scan_comment(C2, Type, C)-F, + scan(Type, C, V0, T0)-F + ; C1=\=0'* -> + scan_sname(Type1, C1, Name, Type, C)-F, + atom_chars(Atom, [C0 | Name]), + scan_after_atom(Type, C, Atom, V0, T0, T)-F + ) + ; otherwise; true -> + scan_sname(Type1, C1, Name, Type, C)-F, + atom_chars(Atom, [C0 | Name]), + scan_after_atom(Type, C, Atom, V0, T0, T)-F + ). +scan(5, C0, V0, T0)-F :- + get0(C1)-F, + scan_string(C1, C0, Elements, C, Type, Err)-F, + ( + Err = [] -> + make_new_string(String, Elements), + T0 = [string(String) | T], + scan(Type, C, V0, T)-F + ; otherwise ; + true -> + T0 = [error(Err) | T], + scan(Type, C, V0, T)-F + ). +scan(6, C0, V0, T0)-F :- + get0(C1)-F, + scan_string(C1, C0, Name, C, Type, Err)-F, + ( + Err = [] -> + atom_chars(Atom, Name), + scan_after_atom(Type, C, Atom, V0, T0, T)-F + ; otherwise ; + true -> + T0 = [error(Err) | T], + scan(Type, C, V0, T)-F + ). +scan(7, _, V0, T0)-F :- + getchar(C, Type)-F, + scan_after_atom(Type, C, (!), V0, T0, T)-F. +scan(9, _, V0, T0)-F :- + getchar(C, Type)-F, + scan_after_atom(Type, C, (;), V0, T0, T)-F. +scan(8, _, V0, T0)-F :- T0=[(', ')|T], scan_rest(V0, T)-F. +scan(10, _, V0, T0)-F :- T0=['|'|T], scan_rest(V0, T)-F. +scan(11, _, V0, T0)-F :- T0=[' ('|T], scan_rest(V0, T)-F. +scan(12, _, V0, T0)-F :- T0=[')'|T], scan_rest(V0, T)-F. +scan(13, _, V0, T0)-F :- T0=['['|T], scan_rest(V0, T)-F. +scan(14, _, V0, T0)-F :- + T0 = [']' | T], + getchar(C, Type)-F, + ( + Type=11 -> T=['('|T1], scan_rest(V0, T1)-F + ; otherwise ; + true -> scan(Type, C, V0, T)-F + ). +scan(15, _, V0, T0)-F :- T0=['{'|T], scan_rest(V0, T)-F. +scan(16, _, V0, T0)-F :- T0=['}'|T], scan_rest(V0, T)-F. +scan(17, _, V0, T0)-F :- get0(C)-F, scan_comment_line(C, V0, T0)-F. +scan(20, _, V0, T0)-F :- scan_rest(V0, T0)-F. +scan(21, _, vtab(_, Tab), T0)-F :- T0=[eof], finalize_vars(Tab). + +scan_after_atom(Type, C, Atom, V0, T0, T)-F :- Type=:=11 | + T0=[atom(Atom), '('|T], scan_rest(V0, T)-F. +scan_after_atom(Type, C, Atom, V0, T0, T)-F :- Type=\=11 | + T0=[atom(Atom)|T], scan(Type, C, V0, T)-F. + +scan_comment_line(C0, V, T)-F :- C0<0 | + scan(21, C0, V, T)-F. +scan_comment_line(C0, V, T)-F :- C0=:=10 | + scan_rest(V, T)-F. +scan_comment_line(C0, V, T)-F :- C0>=0, C0=\=10 | + getchar(C, _)-F, + scan_comment_line(C, V, T)-F. + +scan_comment(C0, Type, C)-F :- C0=:=0'* | + get0(C1)-F, + ( C1=:=0'/ -> getchar(C, Type)-F + ; C1=\=0'/ -> scan_comment(C1, Type, C)-F + ). +scan_comment(C0, Type, C)-F :- C0=\=0'* | + get0(C1)-F, + scan_comment(C1, Type, C)-F. + +scan_rest(V, T)-F :- getchar(C, Type)-F, scan(Type, C, V, T)-F. + +scan_name(Type0, C0, Name0, Type, C)-F :- Type0 =< 3 | + Name0 = [C0 | Name], + getchar(C1, Type1)-F, + scan_name(Type1, C1, Name, Type, C)-F. +scan_name(Type0, C0, Name0, Type, C)-F :- Type0 > 3 | + Name0 = [], + C=C0, Type=Type0. + +scan_sname(Type0, C0, Name0, Type, C)-F :- Type0 =:= 4 | + Name0 = [C0 | Name], + getchar(C1, Type1)-F, + scan_sname(Type1, C1, Name, Type, C)-F. +scan_sname(Type0, C0, Name0, Type, C)-F :- Type0 =\= 4 | + Name0 = [], + C=C0, Type=Type0. + +scan_number(2, C0, N, C, Type, L, LT0)-F :- + LT0 = [C0 | LT], + getchar(C1, Type1)-F, + scan_number(Type1, C1, N, C, Type, L, LT)-F. +scan_number(6, _, N, C, Type, L, LT)-F :- + LT = [], + char_list_to_int(L, 0, N0), + getchar(C1, Type1)-F, + ( N0=:=0 -> N=C1, getchar(C, Type)-F + ; N0=\=0 -> scan_based_number(Type1, C1, N0, 0, N, C, Type)-F + ). +scan_number(_, 0'., N, C, Type, L, LT0)-F :- + getchar(C1, Type1)-F, + ( Type1=:=2 -> + LT0 = [0'. | LT], + scan_fraction(Type1, C1, N, C, Type, L, LT)-F + ; Type1=\=2 -> + ungetc(C1)-F, Type=4, C=0'., + LT0 = [], + char_list_to_int(L, 0, N) + ). otherwise. -scan_number(Type0,C0,N,C,Type,L,LT)-F :- - Type=Type0, C=C0, LT=[], - char_list_to_int(L,0,N). - -scan_fraction(2,C0,N,C,Type,L,LT0)-F :- - LT0=[C0|LT], - getchar(C1,Type1)-F, - scan_fraction(Type1,C1,N,C,Type,L,LT)-F. -scan_fraction(Type0,C0,N,C,Type,L,LT0)-F :- (C0=0'e; C0=0'E) | - getchar(C1,Type1)-F, - ( (Type1=2; C1=0'- ; C1=0'+) -> - LT0=[C0|LT], - scan_exponent(Type1,C1,N,C,Type,L,LT)-F - ; otherwise ; - true -> - ungetc(C1)-F, Type=Type0, C=C0, - char_list_to_float(L,LT0,N) - ). +scan_number(Type0, C0, N, C, Type, L, LT)-F :- + Type=Type0, C=C0, + LT = [], + char_list_to_int(L, 0, N). + +scan_fraction(2, C0, N, C, Type, L, LT0)-F :- + LT0 = [C0 | LT], + getchar(C1, Type1)-F, + scan_fraction(Type1, C1, N, C, Type, L, LT)-F. +scan_fraction(Type0, C0, N, C, Type, L, LT0)-F :- (C0=0'e; C0=0'E) | + getchar(C1, Type1)-F, + ( (Type1=2; C1=0'- ; C1=0'+) -> + LT0 = [C0 | LT], + scan_exponent(Type1, C1, N, C, Type, L, LT)-F + ; otherwise ; + true -> + ungetc(C1)-F, Type=Type0, C=C0, + char_list_to_float(L, LT0, N) + ). otherwise. -scan_fraction(Type0,C0,N,C,Type,L,LT)-F :- - Type=Type0, C=C0, - char_list_to_float(L,LT,N). - -scan_exponent(Type0,Sign,N,C,Type,L,LT0)-F :- (Sign=0'- ; Sign=0'+) | - getchar(C1,Type1)-F, LT0=[Sign|LT], - scan_unsigned_exponent(Type1,C1,N,C,Type,L,LT)-F. +scan_fraction(Type0, C0, N, C, Type, L, LT)-F :- + Type=Type0, C=C0, + char_list_to_float(L, LT, N). + +scan_exponent(Type0, Sign, N, C, Type, L, LT0)-F :- (Sign=0'- ; Sign=0'+) | + getchar(C1, Type1)-F, LT0=[Sign|LT], + scan_unsigned_exponent(Type1, C1, N, C, Type, L, LT)-F. otherwise. -scan_exponent(Type0,C0,N,C,Type,L,LT)-F :- - scan_unsigned_exponent(Type0,C0,N,C,Type,L,LT)-F. +scan_exponent(Type0, C0, N, C, Type, L, LT)-F :- + scan_unsigned_exponent(Type0, C0, N, C, Type, L, LT)-F. -scan_unsigned_exponent(Type0,C0,N,C,Type,L,LT0)-F :- Type0 =:= 2 | - LT0=[C0|LT], - getchar(C1,Type1)-F, - scan_unsigned_exponent(Type1,C1,N,C,Type,L,LT)-F. -scan_unsigned_exponent(Type0,C0,N,C,Type,L,LT)-F :- Type0 =\= 2 | - Type=Type0, C=C0, - char_list_to_float(L,LT,N). - -char_list_to_int([],N0,N) :- N=N0. -char_list_to_int([C|T],N0,N) :- - char_list_to_int(T,~(10*N0+(C-0'0)),N). - -char_list_to_float(L,LT,N) :- - LT=[0' ], - generic:new(string,S,L,8), - generic:new(float,N,S). - -scan_based_number(2,C0,B,N0,N,C,Type)-F :- - V := C0-0'0, - ( V < B -> - N1 := B*N0+V, - getchar(C1,Type1)-F, - scan_based_number(Type1,C1,B,N1,N,C,Type)-F - ; V >= B -> N=N0, C=C0, Type=2 ). -scan_based_number(0,C0,B,N0,N,C,Type)-F :- - V := C0-0'a+10, - ( V < B -> - N1 := B*N0+V, - getchar(C1,Type1)-F, - scan_based_number(Type1,C1,B,N1,N,C,Type)-F - ; V >= B -> N=N0, C=C0, Type=0 ). -scan_based_number(1,C0,B,N0,N,C,Type)-F :- - V := C0-0'A+10, - ( V < B -> - N1 := B*N0+V, - getchar(C1,Type1)-F, - scan_based_number(Type1,C1,B,N1,N,C,Type)-F - ; V >= B -> N=N0, C=C0, Type=1 ). +scan_unsigned_exponent(Type0, C0, N, C, Type, L, LT0)-F :- Type0 =:= 2 | + LT0 = [C0 | LT], + getchar(C1, Type1)-F, + scan_unsigned_exponent(Type1, C1, N, C, Type, L, LT)-F. +scan_unsigned_exponent(Type0, C0, N, C, Type, L, LT)-F :- Type0 =\= 2 | + Type=Type0, C=C0, + char_list_to_float(L, LT, N). + +char_list_to_int([], N0, N) :- N=N0. +char_list_to_int([C|T], N0, N) :- + char_list_to_int(T, ~(10*N0+(C-0'0)), N). + +char_list_to_float(L, LT, N) :- + LT = [0' ], + generic:new(string, S, L, 8), + generic:new(float, N, S). + +scan_based_number(2, C0, B, N0, N, C, Type)-F :- + V := C0-0'0, + ( V < B -> + N1 := B*N0+V, + getchar(C1, Type1)-F, + scan_based_number(Type1, C1, B, N1, N, C, Type)-F + ; V >= B -> N=N0, C=C0, Type=2 ). +scan_based_number(0, C0, B, N0, N, C, Type)-F :- + V := C0-0'a+10, + ( V < B -> + N1 := B*N0+V, + getchar(C1, Type1)-F, + scan_based_number(Type1, C1, B, N1, N, C, Type)-F + ; V >= B -> N=N0, C=C0, Type=0 ). +scan_based_number(1, C0, B, N0, N, C, Type)-F :- + V := C0-0'A+10, + ( V < B -> + N1 := B*N0+V, + getchar(C1, Type1)-F, + scan_based_number(Type1, C1, B, N1, N, C, Type)-F + ; V >= B -> N=N0, C=C0, Type=1 ). otherwise. -scan_based_number(Type0,C0,_,N0,N,C,Type)-F :- - N=N0, C=C0, Type=Type0. +scan_based_number(Type0, C0, _, N0, N, C, Type)-F :- + N=N0, C=C0, Type=Type0. -lookup_var([],Seq0,Name,Vseq,Var,Kind,Tab,Seq) :- - Vseq=Seq0, Tab=[Name=var(Var,Seq0,Kind,1)], Seq := Seq0+1. -lookup_var([Name=var(Var0,Vseq0,Kind0,Occur0)|T], - Seq0,Name,Vseq,Var,Kind,Tab,Seq) :- - Var=Var0, Vseq=Vseq0, Kind=Kind0, - Tab=[Name=var(Var0,Vseq0,Kind0,~(Occur0+1))|T], Seq=Seq0. +lookup_var([], Seq0, Name, Vseq, Var, Kind, Tab, Seq) :- + Vseq=Seq0, Tab=[Name=var(Var, Seq0, Kind, 1)], Seq := Seq0+1. +lookup_var([Name=var(Var0, Vseq0, Kind0, Occur0)|T], + Seq0, Name, Vseq, Var, Kind, Tab, Seq) :- + Var=Var0, Vseq=Vseq0, Kind=Kind0, + Tab=[Name=var(Var0, Vseq0, Kind0, ~(Occur0+1))|T], Seq=Seq0. otherwise. -lookup_var([H|T],Seq0,Name,Vseq,Var,Kind,Tab,Seq) :- H=(Name0=V0) | - Tab=[H|TabT], - lookup_var(T,Seq0,Name,Vseq,Var,Kind,TabT,Seq). +lookup_var([H|T], Seq0, Name, Vseq, Var, Kind, Tab, Seq) :- H=(Name0=V0) | + Tab = [H | TabT], + lookup_var(T, Seq0, Name, Vseq, Var, Kind, TabT, Seq). finalize_vars([]). -finalize_vars([_Name=var(_,_,Kind,Occur)|T]) :- - ( - Occur=1 -> Kind=void - ; - Occur>1 -> Kind=normal - ), - finalize_vars(T). - -scan_string(Q,Q,E0,C,Type,Err)-F :- - get0(C1)-F, - ( C1 =:= Q -> E0=[Q|E], get0(C2)-F, scan_string(C2,Q,E,C,Type,Err)-F - ; C1 =\= Q -> E0=[], Err=[], C=C1, chartype(C1,Type) - ). -scan_string(0'\,Q,E0,C,Type,Err)-F :- - get0(C1)-F, - escape_char(C1,Meaning), - scan_escape(Meaning,Q,E0,C,Type,Err)-F. +finalize_vars([_Name=var(_, _, Kind, Occur)|T]) :- + ( + Occur=1 -> Kind=void + ; + Occur>1 -> Kind=normal + ), + finalize_vars(T). + +scan_string(Q, Q, E0, C, Type, Err)-F :- + get0(C1)-F, + ( C1 =:= Q -> E0=[Q|E], get0(C2)-F, scan_string(C2, Q, E, C, Type, Err)-F + ; C1 =\= Q -> E0=[], Err=[], C=C1, chartype(C1, Type) + ). +scan_string(0'\, Q, E0, C, Type, Err)-F :- + get0(C1)-F, + escape_char(C1, Meaning), + scan_escape(Meaning, Q, E0, C, Type, Err)-F. /* -scan_string(10,_Q,E0,C,Type,Err)-F :- - Err="newline within a string literal or a quoted atom name", - E0=[], - getchar(C,Type)-F. +scan_string(10, _Q, E0, C, Type, Err)-F :- + Err = "newline within a string literal or a quoted atom name", + E0 = [], + getchar(C, Type)-F. */ -scan_string(-1,_Q,E0,C,Type,Err)-F :- - Err="end of file within a string literal or a quoted atom name", - E0=[], C= -1, Type=21. +scan_string(-1, _Q, E0, C, Type, Err)-F :- + Err = "end of file within a string literal or a quoted atom name", + E0=[], C= -1, Type=21. otherwise. -scan_string(C0,Q,E0,C,Type,Err)-F :- - E0=[C0|E], get0(C1)-F, scan_string(C1,Q,E,C,Type,Err)-F. +scan_string(C0, Q, E0, C, Type, Err)-F :- + E0=[C0|E], get0(C1)-F, scan_string(C1, Q, E, C, Type, Err)-F. -escape_char(0'a,Meaning) :- Meaning=7. -escape_char(0'b,Meaning) :- Meaning=8. -escape_char(0't,Meaning) :- Meaning=9. -escape_char(0'n,Meaning) :- Meaning=10. -escape_char(0'v,Meaning) :- Meaning=11. -escape_char(0'f,Meaning) :- Meaning=12. -escape_char(0'r,Meaning) :- Meaning=13. -escape_char(0'',Meaning) :- Meaning=0''. -escape_char(0'",Meaning) :- Meaning=0'". -escape_char(0'?,Meaning) :- Meaning=0'?. -escape_char(0'\,Meaning) :- Meaning=0'\. -escape_char(0'x,Meaning) :- Meaning=hexadecimal. +escape_char(0'a, Meaning) :- Meaning=7. +escape_char(0'b, Meaning) :- Meaning=8. +escape_char(0't, Meaning) :- Meaning=9. +escape_char(0'n, Meaning) :- Meaning=10. +escape_char(0'v, Meaning) :- Meaning=11. +escape_char(0'f, Meaning) :- Meaning=12. +escape_char(0'r, Meaning) :- Meaning=13. +escape_char(0'', Meaning) :- Meaning=0''. +escape_char(0'", Meaning) :- Meaning=0'". +escape_char(0'?, Meaning) :- Meaning=0'?. +escape_char(0'\, Meaning) :- Meaning=0'\. +escape_char(0'x, Meaning) :- Meaning=hexadecimal. escape_char(10, Meaning) :- Meaning=escaped_newline. escape_char(C, Meaning) :- 0'0= - E0=[NN|E], - get0(C2)-F, - scan_string(C2,Q,E,C,Type,Err)-F - ; otherwise ; - true -> - Err="too large element in octal escape sequence", - scan_string(C1,Q,E0,C,Type,_)-F - ). +scan_octal_escape(C1, N, Q, E0, C, Type, Err)-F :- + E0 = [N | E], + scan_string(C1, Q, E, C, Type, Err)-F. + +scan_octal_escape_2(C1, N, Q, E0, C, Type, Err)-F :- 0'0= + E0 = [NN | E], + get0(C2)-F, + scan_string(C2, Q, E, C, Type, Err)-F + ; otherwise ; + true -> + Err = "too large element in octal escape sequence", + scan_string(C1, Q, E0, C, Type, _)-F + ). otherwise. -scan_octal_escape_2(C1,N,Q,E0,C,Type,Err)-F :- - E0=[N|E], - scan_string(C1,Q,E,C,Type,Err)-F. - -scan_hex_escape(C1,N,Q,E0,C,Type,Err)-F :- 0'0== 256 | - Err="too large element in hexadecimal escape sequence", - scan_string(C1,Q,E0,C,Type,_)-F. -scan_hex_escape(C1,N,Q,E0,C,Type,Err)-F :- N < 256 | - E0=[N|E], - get0(C2)-F, - scan_string(C2,Q,E0,C,Type,Err)-F. +scan_hex_escape(C1, N, Q, E0, C, Type, Err)-F :- N >= 256 | + Err = "too large element in hexadecimal escape sequence", + scan_string(C1, Q, E0, C, Type, _)-F. +scan_hex_escape(C1, N, Q, E0, C, Type, Err)-F :- N < 256 | + E0 = [N | E], + get0(C2)-F, + scan_string(C2, Q, E0, C, Type, Err)-F. atom_chars(Atom, Name) :- - generic:new(string, NameS, Name, 8), - atom_table:make_atom(NameS, Atom). + generic:new(string, NameS, Name, 8), + atom_table:make_atom(NameS, Atom). -make_new_string(Str,Elems) :- - generic:new(string,Str,Elems,8). +make_new_string(Str, Elems) :- + generic:new(string, Str, Elems, 8). get0(C)-F :- F<=getc(C). -getchar(C,Type)-F :- get0(C)-F, chartype(C,Type). +getchar(C, Type)-F :- get0(C)-F, chartype(C, Type). ungetc(C)-F :- F<=ungetc(C). -chartype(C,T) :- integer(C) | - V = { 21, - % eof - 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, - % nul soh stx etx eot enq ack bel bs ht nl vt np cr so si - 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, - % dle dc1 dc2 dc3 dc4 nak syn etb can em sub esc fs gs rs us - 20, 7, 5, 4, 4, 17, 4, 6, 11, 12, 4, 4, 8, 4, 4, 4, - % sp ! " # $ % & ' ( ) * + , - . / - 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 4, 9, 4, 4, 4, 4, - % 0 1 2 3 4 5 6 7 8 9 : ; < = > ? - 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, - % @ A B C D E F G H I J K L M N O - 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 13, 4, 14, 4, 3, - % P Q R S T U V W X Y Z [ \ ] ^ _ - 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - % ` a b c d e f g h i j k l m n o - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 10, 16, 4, 20, - % p q r s t u v w x y z { | } ~ del - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, - vector_element(V,~(C+1),T). +chartype(C, T) :- integer(C) | + V = { + % eof + 21, + % nul soh stx etx eot enq ack bel bs ht nl vt np cr so si + 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, + % dle dc1 dc2 dc3 dc4 nak syn etb can em sub esc fs gs rs us + 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, + % sp ! " # $ % & ' ( ) * + , - . / + 20, 7, 5, 4, 4, 17, 4, 6, 11, 12, 4, 4, 8, 4, 4, 4, + % 0 1 2 3 4 5 6 7 8 9 : ; < = > ? + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 4, 9, 4, 4, 4, 4, + % @ A B C D E F G H I J K L M N O + 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + % P Q R S T U V W X Y Z [ \ ] ^ _ + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 13, 4, 14, 4, 3, + % ` a b c d e f g h i j k l m n o + 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + % p q r s t u v w x y z { | } ~ del + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 10, 16, 4, 20, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }, + vector_element(V, ~(C+1), T). diff -ruN klic-3.003-2002-02-22d/runtime/setk.kl1 klic-3.003-2002-02-22e/runtime/setk.kl1 --- klic-3.003-2002-02-22d/runtime/setk.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/setk.kl1 Fri Feb 22 22:27:35 2002 @@ -1,17 +1,19 @@ -/* ---------------------------------------------------------- -% (C) 1994 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C) 1994 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ :- module keyed_set. -create(Hasher,Stream,Size) :- - keyed_sorted_set:create(Stream). +:- public create/1. -create(Stream,Size) :- - keyed_sorted_set:create(Stream). +create(Hasher, Stream, Size) :- + keyed_sorted_set:create(Stream). + +create(Stream, Size) :- + keyed_sorted_set:create(Stream). create(Stream) :- - keyed_sorted_set:create(Stream). + keyed_sorted_set:create(Stream). diff -ruN klic-3.003-2002-02-22d/runtime/setks.kl1 klic-3.003-2002-02-22e/runtime/setks.kl1 --- klic-3.003-2002-02-22d/runtime/setks.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/setks.kl1 Fri Feb 22 22:27:35 2002 @@ -1,110 +1,112 @@ -/* ---------------------------------------------------------- -% (C) 1994 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C) 1994 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ :- module keyed_sorted_set. +:- public create/1. + create(Stream) :- - splay_tree:create(Pool), - main(Stream,[],Pool). + splay_tree:create(Pool), + main(Stream, [], Pool). -create(Cmpr,Stream) :- - splay_tree:create(Cmpr,Pool), - main(Stream,[],Pool). - -main([],[])+_Pool. -main([],[S|ST])+Pool :- main(S,ST)+Pool. -main([do(S)|T],ST)+Pool :- main(S,[T|ST])+Pool. +create(Cmpr, Stream) :- + splay_tree:create(Cmpr, Pool), + main(Stream, [], Pool). + +main([], [])+_Pool. +main([], [S|ST])+Pool :- main(S, ST)+Pool. +main([do(S)|T], ST)+Pool :- main(S, [T|ST])+Pool. otherwise. -main([Message|T],ST)+Pool :- message(Message)-Pool, main(T,ST)+Pool. +main([Message|T], ST)+Pool :- message(Message)-Pool, main(T, ST)+Pool. message(empty(YorN))-Pool :- - splay_tree:empty(YorN)-Pool. -message(empty(Key,YorN))-Pool :- - splay_tree:empty(Key,YorN)-Pool. -message(put(Key,Value,ValueO))-Pool :- - message(get_if_any_and_put(Key,ValueO,Value))-Pool. -message(get(Key,Value))-Pool :- - splay_tree:empty(Key,no)-Pool, - splay_tree:get(Key,Value)-Pool. -message(get_if_any(Key,Value))-Pool :- - splay_tree:empty(Key,Empty)-Pool, - ( - Empty=yes -> Value={} - ; - Empty=no -> - splay_tree:get(Key,V)-Pool, - Value={V} - ). + splay_tree:empty(YorN)-Pool. +message(empty(Key, YorN))-Pool :- + splay_tree:empty(Key, YorN)-Pool. +message(put(Key, Value, ValueO))-Pool :- + message(get_if_any_and_put(Key, ValueO, Value))-Pool. +message(get(Key, Value))-Pool :- + splay_tree:empty(Key, no)-Pool, + splay_tree:get(Key, Value)-Pool. +message(get_if_any(Key, Value))-Pool :- + splay_tree:empty(Key, Empty)-Pool, + ( + Empty=yes -> Value={} + ; + Empty=no -> + splay_tree:get(Key, V)-Pool, + Value = {V} + ). message(get_all(Values))-Pool :- - splay_tree:get_all(All)-Pool, - convert(All,Values). -message(get_all(Key,Values))-Pool :- - splay_tree:empty(Key,Empty)-Pool, - ( - Empty=yes -> Values=[] - ; - Empty=no -> - splay_tree:get(Key,Value)-Pool, - Values = [Value] - ). + splay_tree:get_all(All)-Pool, + convert(All, Values). +message(get_all(Key, Values))-Pool :- + splay_tree:empty(Key, Empty)-Pool, + ( + Empty=yes -> Values=[] + ; + Empty=no -> + splay_tree:get(Key, Value)-Pool, + Values = [Value] + ). message(carbon_copy(Values))-Pool :- - splay_tree:get_all(All)+Pool+_, - convert(All,Values). -message(carbon_copy(Key,Values))-Pool :- - splay_tree:empty(Key,Empty)-Pool, - ( - Empty=yes -> Values=[] - ; - Empty=no -> - splay_tree:update(Key,Value,Value)-Pool, - Values = [Value] - ). - -message(get_and_put(Key,Old,New))-Pool :- - message(get_and_put_if_any(Key,Old0,New,_))-Pool, - Old0 = {Old}. -message(get_if_any_and_put(Key,Old,New))-Pool :- - splay_tree:empty(Key,Empty)-Pool, - ( - Empty=yes -> - splay_tree:put(Key,New)-Pool, - Old={} - ; - Empty=no -> - splay_tree:update(Key,V,New)-Pool, - Old={V} - ). -message(get_and_put_if_any(Key,Old,New0,New))-Pool :- - splay_tree:empty(Key,Empty)-Pool, - ( - Empty=yes -> Old={}, New={New0} - ; - Empty=no -> - splay_tree:update(Key,V,New0)-Pool, - Old={V}, New={} - ). + splay_tree:get_all(All)+Pool+_, + convert(All, Values). +message(carbon_copy(Key, Values))-Pool :- + splay_tree:empty(Key, Empty)-Pool, + ( + Empty=yes -> Values=[] + ; + Empty=no -> + splay_tree:update(Key, Value, Value)-Pool, + Values = [Value] + ). + +message(get_and_put(Key, Old, New))-Pool :- + message(get_and_put_if_any(Key, Old0, New, _))-Pool, + Old0 = {Old}. +message(get_if_any_and_put(Key, Old, New))-Pool :- + splay_tree:empty(Key, Empty)-Pool, + ( + Empty=yes -> + splay_tree:put(Key, New)-Pool, + Old = {} + ; + Empty=no -> + splay_tree:update(Key, V, New)-Pool, + Old = {V} + ). +message(get_and_put_if_any(Key, Old, New0, New))-Pool :- + splay_tree:empty(Key, Empty)-Pool, + ( + Empty=yes -> Old={}, New={New0} + ; + Empty=no -> + splay_tree:update(Key, V, New0)-Pool, + Old={V}, New={} + ). message(get_max_if_any(Elem))-Pool :- - splay_tree:empty(Empty)-Pool, - ( - Empty=yes -> Elem={} - ; - Empty=no -> - splay_tree:get_max(Key,Value)-Pool, - Elem={Key,Value} - ). + splay_tree:empty(Empty)-Pool, + ( + Empty=yes -> Elem={} + ; + Empty=no -> + splay_tree:get_max(Key, Value)-Pool, + Elem = {Key, Value} + ). message(get_min_if_any(Elem))-Pool :- - splay_tree:empty(Empty)-Pool, - ( - Empty=yes -> Elem={} - ; - Empty=no -> - splay_tree:get_min(Key,Value)-Pool, - Elem={Key,Value} - ). + splay_tree:empty(Empty)-Pool, + ( + Empty=yes -> Elem={} + ; + Empty=no -> + splay_tree:get_min(Key, Value)-Pool, + Elem = {Key, Value} + ). -convert([],F) :- F=[]. -convert([K=V|L],F) :- F=[{K,V}|F1], convert(L,F1). +convert([], F) :- F=[]. +convert([K=V|L], F) :- F=[{K, V}|F1], convert(L, F1). diff -ruN klic-3.003-2002-02-22d/runtime/splay.kl1 klic-3.003-2002-02-22e/runtime/splay.kl1 --- klic-3.003-2002-02-22d/runtime/splay.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/splay.kl1 Fri Feb 22 22:27:35 2002 @@ -1,193 +1,189 @@ -/* ---------------------------------------------------------- -% (C) 1994 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C) 1994 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ :- module splay_tree. -/* - Creation -*/ +% called in bagks.kl1, bags.kl1, setks.kl1 +:- public create/1, create/2, empty/3, empty/4, update/5, + put/4, get/4, get_min/4, get_max/4, get_all/3. + +/* Creation */ create(Pool) :- - default_comparator(Cmpr), - Pool=pool(Cmpr,[]). + default_comparator(Cmpr), + Pool = pool(Cmpr, []). -create(Cmpr,Pool) :- - Pool=pool(Cmpr,[]). +create(Cmpr, Pool) :- + Pool = pool(Cmpr, []). default_comparator(Cmpr) :- - Cmpr=predicate#(comparator:sort/5). + Cmpr = predicate#(comparator:sort/5). -refer(X0,Y0,X,Y,S) :- - comparator:sort(X0,Y0,X,Y,S). +refer(X0, Y0, X, Y, S) :- + comparator:sort(X0, Y0, X, Y, S). -/* - Emptiness Test -*/ -empty(Empty)-Pool :- true | - ( - Pool=pool(_Cmpr,[]) -> Empty=yes - ; otherwise ; - true -> Empty=no - ). - -empty(Key,Empty,pool(Cmpr,T),New) :- - empty_sub(T,Key,Empty,Cmpr), - New=pool(Cmpr,T). +/* Emptiness Test */ -empty_sub([],_,Empty,_) :- Empty=yes. -empty_sub(n(_,K,_,_),K,Empty,_) :- Empty=no. +empty(Empty)-Pool :- true | + ( + Pool=pool(_Cmpr, []) -> Empty=yes + ; otherwise ; + true -> Empty=no + ). + +empty(Key, Empty, pool(Cmpr, T), New) :- + empty_sub(T, Key, Empty, Cmpr), + New = pool(Cmpr, T). + +empty_sub([], _, Empty, _) :- + Empty = yes. +empty_sub(n(_, K, _, _), K, Empty, _) :- + Empty = no. otherwise. -empty_sub(n(L,K0,_,R),K,Empty,Cmpr) :- - generic:call(Cmpr,K,K0,_,_,S), - ( - S=no -> empty_sub(L,K,Empty,Cmpr) - ; - S=yes -> empty_sub(R,K,Empty,Cmpr) - ). - -/* - Updating an Element -*/ - -update(Key,Value,New,pool(Cmpr,T0),Pool) :- - update(T0,Key,Value,New,T,Cmpr), - Pool=pool(Cmpr,T). - -put(Key,New,pool(Cmpr,T0),Pool) :- - update(T0,Key,_Value,New,T,Cmpr), - Pool=pool(Cmpr,T). - -update(T0,K,VO,V,T,Cmpr) :- - update(T0,K,VO,V,LL,VN,RR,Cmpr), - T = n(LL,K,VN,RR). - -update([],K,_VO,V,LL,VN,RR,Cmpr) :- LL=[], VN=V, RR=[]. -update(n(L,K,V0,R),K,VO,V,LL,VN,RR,_Cmpr) :- - VO=V0, VN=V, LL=L, RR=R. +empty_sub(n(L, K0, _, R), K, Empty, Cmpr) :- + generic:call(Cmpr, K, K0, _, _, S), + ( + S=no -> empty_sub(L, K, Empty, Cmpr) + ; + S=yes -> empty_sub(R, K, Empty, Cmpr) + ). + +/* Updating an Element */ + +update(Key, Value, New, pool(Cmpr, T0), Pool) :- + update(T0, Key, Value, New, T, Cmpr), + Pool = pool(Cmpr, T). + +put(Key, New, pool(Cmpr, T0), Pool) :- + update(T0, Key, _Value, New, T, Cmpr), + Pool = pool(Cmpr, T). + +update(T0, K, VO, V, T, Cmpr) :- + update(T0, K, VO, V, LL, VN, RR, Cmpr), + T = n(LL, K, VN, RR). + +update([], K, _VO, V, LL, VN, RR, Cmpr) :- + LL=[], VN=V, RR=[]. +update(n(L, K, V0, R), K, VO, V, LL, VN, RR, _Cmpr) :- + VO=V0, VN=V, LL=L, RR=R. otherwise. -update(n(L,K0,V0,R),K,VO,V,LL,VN,RR,Cmpr) :- - generic:call(Cmpr,K,K0,_,_,S), - ( - S=no -> update_left(L,K,VO,V,K0,V0,R,LL,VN,RR,Cmpr) - ; - S=yes -> update_right(R,K,VO,V,K0,V0,L,LL,VN,RR,Cmpr) - ). +update(n(L, K0, V0, R), K, VO, V, LL, VN, RR, Cmpr) :- + generic:call(Cmpr, K, K0, _, _, S), + ( + S=no -> update_left(L, K, VO, V, K0, V0, R, LL, VN, RR, Cmpr) + ; + S=yes -> update_right(R, K, VO, V, K0, V0, L, LL, VN, RR, Cmpr) + ). /* K < K0, K1 > R0 */ -update_left([],K,_VO,V,K0,V0,R0,LL,VN,RR,Cmpr) :- - LL=[], VN=V, RR=n([],K0,V0,R0). -update_left(n(L1,K,V1,R1),K,VO,V,K0,V0,R0,LL,VN,RR,_Cmpr) :- - VO=V1, VN=V, LL=L1, RR=n(R1,K0,V0,R0). +update_left([], K, _VO, V, K0, V0, R0, LL, VN, RR, Cmpr) :- + LL=[], VN=V, RR=n([], K0, V0, R0). +update_left(n(L1, K, V1, R1), K, VO, V, K0, V0, R0, LL, VN, RR, _Cmpr) :- + VO=V1, VN=V, LL=L1, RR=n(R1, K0, V0, R0). otherwise. -update_left(n(L1,K1,V1,R1),K,VO,V,K0,V0,R0,LL,VN,RR,Cmpr) :- - generic:call(Cmpr,K1,K,_,_,S), - ( - S=yes -> - update(L1,K,VO,V,LL,VN,RR0,Cmpr), - RR=n(RR0,K1,V1,n(R1,K0,V0,R0)) - ; - S=no -> - update(R1,K,VO,V,LL0,VN,RR0,Cmpr), - LL=n(L1,K1,V1,LL0), - RR=n(RR0,K0,V0,R0) - ). +update_left(n(L1, K1, V1, R1), K, VO, V, K0, V0, R0, LL, VN, RR, Cmpr) :- + generic:call(Cmpr, K1, K, _, _, S), + ( + S=yes -> + update(L1, K, VO, V, LL, VN, RR0, Cmpr), + RR = n(RR0, K1, V1, n(R1, K0, V0, R0)) + ; + S=no -> + update(R1, K, VO, V, LL0, VN, RR0, Cmpr), + LL = n(L1, K1, V1, LL0), + RR = n(RR0, K0, V0, R0) + ). /* K > K0, K1 > L0 */ -update_right([],K,_VO,V,K0,V0,L0,LL,VN,RR,Cmpr) :- - LL=n(L0,K0,V0,[]), VN=V, RR=[]. -update_right(n(L1,K,V1,R1),K,VO,V,K0,V0,L0,LL,VN,RR,_Cmpr) :- - VO=V1, VN=V, LL=n(L0,K0,V0,L1), RR=R1. +update_right([], K, _VO, V, K0, V0, L0, LL, VN, RR, Cmpr) :- + LL=n(L0, K0, V0, []), VN=V, RR=[]. +update_right(n(L1, K, V1, R1), K, VO, V, K0, V0, L0, LL, VN, RR, _Cmpr) :- + VO=V1, VN=V, LL=n(L0, K0, V0, L1), RR=R1. otherwise. -update_right(n(L1,K1,V1,R1),K,VO,V,K0,V0,L0,LL,VN,RR,Cmpr) :- - generic:call(Cmpr,K1,K,_,_,S), - ( - S=yes -> - update(L1,K,VO,V,LL0,VN,RR0,Cmpr), - LL=n(L0,K0,V0,LL0), - RR=n(RR0,K1,V1,R1) - ; - S=no -> - update(R1,K,VO,V,LL0,VN,RR,Cmpr), - LL=n(n(L0,K0,V0,L1),K1,V1,LL0) - ). - -/* - Removing an Element -*/ - -get(Key,Value,pool(Cmpr,T0),Pool) :- - get(T0,Key,Value,T,Cmpr), - Pool=pool(Cmpr,T). - -get([],K,VO,T,Cmpr) :- /* AMANUMA */ - VO =[], - T = []. -get(n(L0,K,V0,R0),K,VO,T,Cmpr) :- - VO=V0, - ( - L0=n(L1,K1,V1,R1) -> - T=n(L1,K1,V1,RR), - reform_tree(R1,R0,RR) - ; - L0=[] -> T=R0 - ). +update_right(n(L1, K1, V1, R1), K, VO, V, K0, V0, L0, LL, VN, RR, Cmpr) :- + generic:call(Cmpr, K1, K, _, _, S), + ( + S=yes -> + update(L1, K, VO, V, LL0, VN, RR0, Cmpr), + LL = n(L0, K0, V0, LL0), + RR = n(RR0, K1, V1, R1) + ; + S=no -> + update(R1, K, VO, V, LL0, VN, RR, Cmpr), + LL = n(n(L0, K0, V0, L1), K1, V1, LL0) + ). + +/* Removing an Element */ + +get(Key, Value, pool(Cmpr, T0), Pool) :- + get(T0, Key, Value, T, Cmpr), + Pool = pool(Cmpr, T). + +get([], K, VO, T, Cmpr) :- /* AMANUMA */ + VO = [], + T = []. +get(n(L0, K, V0, R0), K, VO, T, Cmpr) :- + VO = V0, + ( + L0=n(L1, K1, V1, R1) -> + T = n(L1, K1, V1, RR), + reform_tree(R1, R0, RR) + ; + L0=[] -> T=R0 + ). otherwise. -get(n(L0,K0,V0,R0),K,VO,T,Cmpr) :- - generic:call(Cmpr,K,K0,_,_,S), - ( - S=no -> T=n(LL,K0,V0,R0), get(L0,K,VO,LL,Cmpr) - ; - S=yes -> T=n(L0,K0,V0,RR), get(R0,K,VO,RR,Cmpr) - ). - -/* - Getting All the Elements -*/ - -get_all(All,pool(Cmpr,T),Pool) :- - get_all_sub(T,All,[]), - Pool=pool(Cmpr,[]). - -get_all_sub([],All,AllT) :- All=AllT. -get_all_sub(n(L,K,V,R),All,AllT) :- - get_all_sub(L,All,All1), - All1=[K=V|All2], - get_all_sub(R,All2,AllT). - -/* - Obtaining the Maximum/Minimum Element -*/ - -get_max(Key,Value,pool(Cmpr,T0),Pool) :- - get_max_sub(T0,Key,Value,T), - Pool=pool(Cmpr,T). - -get_max_sub(n(L,K,V,[]),Key,Value,T) :- - Key=K, Value=V, T=L. -get_max_sub(n(L,K,V,n(LL,KK,VV,RR)),Key,Value,T) :- - T=n(L,K,V,TT), - get_max_sub(n(LL,KK,VV,RR),Key,Value,TT). - -get_min(Key,Value,pool(Cmpr,T0),Pool) :- - get_min_sub(T0,Key,Value,T), - Pool=pool(Cmpr,T). - -get_min_sub(n([],K,V,R),Key,Value,T) :- - Key=K, Value=V, T=R. -get_min_sub(n(n(LL,KK,VV,RR),K,V,R),Key,Value,T) :- - T=n(TT,K,V,R), - get_min_sub(n(LL,KK,VV,RR),Key,Value,TT). - -/* - Common Subroutine for Tree Reforming -*/ - -reform_tree(n(L0,K0,V0,R0),RT,T) :- - T=n(L0,K0,V0,RR), - reform_tree(R0,RT,RR). -reform_tree([],T0,T) :- T=T0. +get(n(L0, K0, V0, R0), K, VO, T, Cmpr) :- + generic:call(Cmpr, K, K0, _, _, S), + ( + S=no -> T=n(LL, K0, V0, R0), get(L0, K, VO, LL, Cmpr) + ; + S=yes -> T=n(L0, K0, V0, RR), get(R0, K, VO, RR, Cmpr) + ). + +/* Getting All the Elements */ + +get_all(All, pool(Cmpr, T), Pool) :- + get_all_sub(T, All, []), + Pool = pool(Cmpr, []). + +get_all_sub([], All, AllT) :- + All = AllT. +get_all_sub(n(L, K, V, R), All, AllT) :- + get_all_sub(L, All, All1), + All1 = [K=V | All2], + get_all_sub(R, All2, AllT). + +/* Obtaining the Maximum/Minimum Element */ + +get_max(Key, Value, pool(Cmpr, T0), Pool) :- + get_max_sub(T0, Key, Value, T), + Pool = pool(Cmpr, T). + +get_max_sub(n(L, K, V, []), Key, Value, T) :- + Key=K, Value=V, T=L. +get_max_sub(n(L, K, V, n(LL, KK, VV, RR)), Key, Value, T) :- + T = n(L, K, V, TT), + get_max_sub(n(LL, KK, VV, RR), Key, Value, TT). + +get_min(Key, Value, pool(Cmpr, T0), Pool) :- + get_min_sub(T0, Key, Value, T), + Pool = pool(Cmpr, T). + +get_min_sub(n([], K, V, R), Key, Value, T) :- + Key=K, Value=V, T=R. +get_min_sub(n(n(LL, KK, VV, RR), K, V, R), Key, Value, T) :- + T = n(TT, K, V, R), + get_min_sub(n(LL, KK, VV, RR), Key, Value, TT). + +/* Common Subroutine for Tree Reforming */ + +reform_tree(n(L0, K0, V0, R0), RT, T) :- + T = n(L0, K0, V0, RR), + reform_tree(R0, RT, RR). +reform_tree([], T0, T) :- + T = T0. diff -ruN klic-3.003-2002-02-22d/runtime/stack.kl1 klic-3.003-2002-02-22e/runtime/stack.kl1 --- klic-3.003-2002-02-22d/runtime/stack.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/stack.kl1 Fri Feb 22 22:27:35 2002 @@ -1,48 +1,50 @@ -/* ---------------------------------------------------------- -% (C)1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C)1994,1995 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ + :- module stack. +:- public create/1. create(Stream) :- - main(Stream,[],[]). + main(Stream,[],[]). -main([], [] )+Pool. -main([], [S|ST])+Pool :- main(S,ST )+Pool. -main([do(S)|T], ST )+Pool :- main(S,[T|ST])+Pool. +main([], [] )+Pool. +main([], [S|ST] )+Pool :- main(S, ST)+Pool. +main([do(S)|T], ST )+Pool :- main(S, [T|ST])+Pool. otherwise. -main([Message|T],ST )+Pool :- message(Message)-Pool, main(T,ST)+Pool. +main([Message|T], ST )+Pool :- message(Message)-Pool, main(T, ST)+Pool. -message(empty(YorN),[] )+Pool :- - YorN = yes, - Pool = []. -message(empty(YorN),[CAR|CDR])+Pool :- - YorN = no, - Pool = [CAR|CDR]. - - -message(put(Value),Pool1,Pool2) :- - Pool2 = [Value|Pool1]. - -message(get(Value),[CAR|CDR],Pool2) :- - Value = CAR, - Pool2 = CDR. - -message(get_if_any(Value),[], Pool2) :- - Value = {}, - Pool2 = []. -message(get_if_any(Value),[CAR|CDR],Pool2) :- - Value = {CAR}, - Pool2 = CDR. - -message(get_all(Value),Pool1,Pool2) :- - Value = Pool1, - Pool2 = []. - -message(carbon_copy(Value),Pool1,Pool2) :- - Value = Pool1, - Pool2 = Pool1. +message(empty(YorN), [] )+Pool :- + YorN = yes, + Pool = []. +message(empty(YorN), [CAR|CDR])+Pool :- + YorN = no, + Pool = [CAR | CDR]. + + +message(put(Value), Pool1, Pool2) :- + Pool2 = [Value | Pool1]. + +message(get(Value), [CAR|CDR], Pool2) :- + Value = CAR, + Pool2 = CDR. + +message(get_if_any(Value), [], Pool2) :- + Value = {}, + Pool2 = []. +message(get_if_any(Value), [CAR|CDR], Pool2) :- + Value = {CAR}, + Pool2 = CDR. + +message(get_all(Value), Pool1, Pool2) :- + Value = Pool1, + Pool2 = []. + +message(carbon_copy(Value), Pool1, Pool2) :- + Value = Pool1, + Pool2 = Pool1. diff -ruN klic-3.003-2002-02-22d/runtime/sysc.kl1 klic-3.003-2002-02-22e/runtime/sysc.kl1 --- klic-3.003-2002-02-22d/runtime/sysc.kl1 Tue Feb 19 15:24:21 2002 +++ klic-3.003-2002-02-22e/runtime/sysc.kl1 Fri Feb 22 22:27:35 2002 @@ -1,6 +1,6 @@ -/* ---------------------------------------------------------- -% (C)1993,1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C)1993, 1994, 1995 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ @@ -25,29 +25,32 @@ :- module system_control. -postmortem(ModName,Goal,Result) :- functor(Goal,PredName,Arity) | - generic:new(module,Module,ModName), - generic:new(predicate,Predicate,Module,PredName,Arity), - register_postmortem(Predicate,Goal,Result). +:- public gc/2, postmortem/3. -register_postmortem(Predicate,Goal,Result) :- inline:" -{ - postmortem_pred = ((struct predicate_object *)functorp(%0))->pdesc; - if (postmortem_args ==0) register_gc_hook(gc_postmortem_args); - postmortem_args = %1; -}":[Predicate+object(predicate),Goal+any] | Result=[]. - -gc(Before,After) :- inline:" -{ - %0 = makeint(allocp-new_space_top()); - allocp = real_heaplimit; - heaplimit = 0; -}":[Before0-int] | - Before=Before0, - after_gc(After). +postmortem(ModName, Goal, Result) :- functor(Goal, PredName, Arity) | + generic:new(module, Module, ModName), + generic:new(predicate, Predicate, Module, PredName, Arity), + register_postmortem(Predicate, Goal, Result). + +register_postmortem(Predicate, Goal, Result) :- inline:" + { + postmortem_pred = ((struct predicate_object*) functorp(%0))->pdesc; + if (postmortem_args == 0) register_gc_hook(gc_postmortem_args); + postmortem_args = %1; + }": [Predicate+object(predicate), Goal+any] | + Result = []. + +gc(Before, After) :- inline:" + { + %0 = makeint(allocp - new_space_top()); + allocp = real_heaplimit; + heaplimit = 0; + }": [Before0-int] | + Before = Before0, + after_gc(After). after_gc(After) :- inline:" -{ - %0 = makeint(allocp-new_space_top()); -}":[After0-int] | - After=After0. + { + %0 = makeint(allocp - new_space_top()); + }": [After0-int] | + After = After0. diff -ruN klic-3.003-2002-02-22d/runtime/termio.kl1 klic-3.003-2002-02-22e/runtime/termio.kl1 --- klic-3.003-2002-02-22d/runtime/termio.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/termio.kl1 Fri Feb 22 22:27:35 2002 @@ -1,316 +1,339 @@ -/* ---------------------------------------------------------- -% (C)1993,1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C)1993, 1994, 1995 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ + :- module klicio. -klicio(S) :- klicio(S,[]). +:- public klicio/1. + +klicio(S) :- klicio(S, []). -klicio([],U) :- close_unix(U). -klicio([stdin(R)|S],U) :- - send_unix(stdin(RU),U,UT), termin(RU,R), klicio(S,UT). -klicio([stdout(R)|S],U) :- - send_unix(stdout(RU),U,UT), termout(RU,R), klicio(S,UT). -klicio([stderr(R)|S],U) :- - send_unix(stderr(RU),U,UT), termout(RU,R), klicio(S,UT). -klicio([string_output(R,Str)|S],U) :- - string_output(RS,Str,Chars,Chars), termout(normal(RS),R), klicio(S,U). -klicio([string_input(R,Str)|S],U) :- string(Str,L,_) | - string_input(RS,Str,0,L,0), termin(normal(RS),R), klicio(S,U). -klicio([read_open(Path,R)|S],U) :- - send_unix(read_open(Path,RU),U,UT), termin(RU,R), klicio(S,UT). -klicio([write_open(Path,R)|S],U) :- - send_unix(write_open(Path,RU),U,UT), termout(RU,R), klicio(S,UT). -klicio([append_open(Path,R)|S],U) :- - send_unix(append_open(Path,RU),U,UT), termout(RU,R), klicio(S,UT). -klicio([update_open(Path,R)|S],U) :- - send_unix(update_open(Path,RU),U,UT), termupdt(RU,R), klicio(S,UT). -klicio([connect(What,R)|S],U) :- - send_unix(connect(What,RU),U,UT), termupdt(RU,R), klicio(S,UT). -klicio([connect2(What,R)|S],U) :- - send_unix(connect2(What,RU),U,UT), termupdt(RU,R), klicio(S,UT). -klicio([fork_with_pipes(R)|S],U) :- - send_unix(fork_with_pipes(RU),U,UT), fork_with_pipes(RU,R), klicio(S,UT). -klicio([bind(What,R)|S],U) :- - send_unix(bind(What,RU),U,UT), bind(RU,R), klicio(S,UT). +klicio([], U) :- + close_unix(U). +klicio([stdin(R)|S], U) :- + send_unix(stdin(RU), U, UT), termin(RU, R), klicio(S, UT). +klicio([stdout(R)|S], U) :- + send_unix(stdout(RU), U, UT), termout(RU, R), klicio(S, UT). +klicio([stderr(R)|S], U) :- + send_unix(stderr(RU), U, UT), termout(RU, R), klicio(S, UT). +klicio([string_output(R, Str)|S], U) :- + string_output(RS, Str, Chars, Chars), termout(normal(RS), R), klicio(S, U). +klicio([string_input(R, Str)|S], U) :- string(Str, L, _) | + string_input(RS, Str, 0, L, 0), termin(normal(RS), R), klicio(S, U). +klicio([read_open(Path, R)|S], U) :- + send_unix(read_open(Path, RU), U, UT), termin(RU, R), klicio(S, UT). +klicio([write_open(Path, R)|S], U) :- + send_unix(write_open(Path, RU), U, UT), termout(RU, R), klicio(S, UT). +klicio([append_open(Path, R)|S], U) :- + send_unix(append_open(Path, RU), U, UT), termout(RU, R), klicio(S, UT). +klicio([update_open(Path, R)|S], U) :- + send_unix(update_open(Path, RU), U, UT), termupdt(RU, R), klicio(S, UT). +klicio([connect(What, R)|S], U) :- + send_unix(connect(What, RU), U, UT), termupdt(RU, R), klicio(S, UT). +klicio([connect2(What, R)|S], U) :- + send_unix(connect2(What, RU), U, UT), termupdt(RU, R), klicio(S, UT). +klicio([fork_with_pipes(R)|S], U) :- + send_unix(fork_with_pipes(RU), U, UT), fork_with_pipes(RU, R), klicio(S, UT). +klicio([bind(What, R)|S], U) :- + send_unix(bind(What, RU), U, UT), bind(RU, R), klicio(S, UT). otherwise. -klicio([Msg|S],U) :- - send_unix(Msg,U,UT), klicio(S,UT). +klicio([Msg|S], U) :- + send_unix(Msg, U, UT), klicio(S, UT). -send_unix(Msg,[],UT) :- unix:unix([Msg|US]), UT=unix(US). -send_unix(Msg,unix(U),UT) :- U=[Msg|US], UT=unix(US). +send_unix(Msg, [], UT) :- unix:unix([Msg|US]), UT=unix(US). +send_unix(Msg, unix(U), UT) :- U=[Msg|US], UT=unix(US). close_unix([]). close_unix(unix(U)) :- U=[]. -termin(normal(SU),R) :- - R=normal(SI), - default_operator_table(Ops), - in(SI,SU,s(Ops,0)). +termin(normal(SU), R) :- + R = normal(SI), + default_operator_table(Ops), + in(SI, SU, s(Ops, 0)). otherwise. -termin(R0,R) :- R=R0. +termin(R0, R) :- + R = R0. -termout(normal(SU),R) :- - R=normal(SI), - default_operator_table(Ops), - out(SI,SU,s(Ops,0)). +termout(normal(SU), R) :- + R = normal(SI), + default_operator_table(Ops), + out(SI, SU, s(Ops, 0)). otherwise. -termout(R0,R) :- R=R0. +termout(R0, R) :- + R = R0. -termupdt(normal(SU),R) :- - R=normal(SI), - default_operator_table(Ops), - updt(SI,SU,s(Ops,0)). +termupdt(normal(SU), R) :- + R = normal(SI), + default_operator_table(Ops), + updt(SI, SU, s(Ops, 0)). otherwise. -termupdt(R0,R) :- R=R0. +termupdt(R0, R) :- + R = R0. -fork_with_pipes(parent(PID,InU,OutU),R) :- - R=parent(PID,In,Out), - termin(normal(InU),normal(In)), - termout(normal(OutU),normal(Out)). -fork_with_pipes(child(InU,OutU),R) :- - R=child(In,Out), - termin(normal(InU),normal(In)), - termout(normal(OutU),normal(Out)). - -bind(normal(SU),R) :- - R=normal(SI), - bound_sock(SI,SU). +fork_with_pipes(parent(PID, InU, OutU), R) :- + R = parent(PID, In, Out), + termin(normal(InU), normal(In)), + termout(normal(OutU), normal(Out)). +fork_with_pipes(child(InU, OutU), R) :- + R = child(In, Out), + termin(normal(InU), normal(In)), + termout(normal(OutU), normal(Out)). + +bind(normal(SU), R) :- + R = normal(SI), + bound_sock(SI, SU). otherwise. -bind(R0,R) :- R=R0. +bind(R0, R) :- + R = R0. -bound_sock([],U) :- U=[]. -bound_sock([accept(R)|S],U) :- - U=[accept(RU)|UT], termupdt(RU,R), bound_sock(S,UT). -bound_sock([accept2(R)|S],U) :- - U=[accept2(RU)|UT], termupdt(RU,R), bound_sock(S,UT). - -in([],U,_Ops) :- U=[]. -in([gett(Term)|S],U,Stat) :- - klic_reader:parse_one_term_reporting_errors(U,Stat,Term,UT), - in(S,UT,Stat). -in([getwt(Result)|S],U,Stat) :- - klic_reader:wparse_one_term_reporting_errors(U,Stat,Result,UT), - in(S,UT,Stat). -in([addop(Op,Type,Prec)|S],U,s(Ops,OnErr)) :- - addop(Type,Op,Prec,Ops,NewOps), - in(S,U,s(NewOps,OnErr)). -in([rmop(Op,Type)|S],U,s(Ops,OnErr)) :- - rmop(Type,Op,Ops,NewOps), - in(S,U,s(NewOps,OnErr)). -in([on_error(Pred)|S],U,s(Ops,_)) :- - in(S,U,s(Ops,Pred)). +bound_sock([], U) :- + U = []. +bound_sock([accept(R)|S], U) :- + U=[accept(RU)|UT], termupdt(RU, R), bound_sock(S, UT). +bound_sock([accept2(R)|S], U) :- + U=[accept2(RU)|UT], termupdt(RU, R), bound_sock(S, UT). + +in([], U, _Ops) :- + U = []. +in([gett(Term)|S], U, Stat) :- + klic_reader:parse_one_term_reporting_errors(U, Stat, Term, UT), + in(S, UT, Stat). +in([getwt(Result)|S], U, Stat) :- + klic_reader:wparse_one_term_reporting_errors(U, Stat, Result, UT), + in(S, UT, Stat). +in([addop(Op, Type, Prec)|S], U, s(Ops, OnErr)) :- + addop(Type, Op, Prec, Ops, NewOps), + in(S, U, s(NewOps, OnErr)). +in([rmop(Op, Type)|S], U, s(Ops, OnErr)) :- + rmop(Type, Op, Ops, NewOps), + in(S, U, s(NewOps, OnErr)). +in([on_error(Pred)|S], U, s(Ops, _)) :- + in(S, U, s(Ops, Pred)). otherwise. -in([Msg|S],U,Stat) :- - U=[Msg|UT], - in(S,UT,Stat). - -out([],U,_Ops) :- U=[]. -out([nl|S],U,Stat) :- - U=[putc(10)|UT], - out(S,UT,Stat). -out([putt(Term)|S],U,Stat) :- - unparser:unparse(Term,Stat,U,UT), - out(S,UT,Stat). -out([puttq(Term)|S],U,Stat) :- - unparser:unparse(Term,Stat,U,UT), - out(S,UT,Stat). -out([putwt(Term)|S],U,Stat) :- - unparser:unwparse(Term,Stat,U,UT), - out(S,UT,Stat). -out([putwtq(Term)|S],U,Stat) :- - unparser:unwparse(Term,Stat,U,UT), - out(S,UT,Stat). -out([addop(Op,Type,Prec)|S],U,s(Ops,OnErr)) :- - addop(Type,Op,Prec,Ops,NewOps), - out(S,U,s(NewOps,OnErr)). -out([rmop(Op,Type)|S],U,s(Ops,OnErr)) :- - rmop(Type,Op,Ops,NewOps), - out(S,U,s(NewOps,OnErr)). -out([on_error(Pred)|S],U,s(Ops,_)) :- - out(S,U,s(Ops,Pred)). +in([Msg|S], U, Stat) :- + U = [Msg | UT], + in(S, UT, Stat). + +out([], U, _Ops) :- + U = []. +out([nl|S], U, Stat) :- + U = [putc(10) | UT], + out(S, UT, Stat). +out([putt(Term)|S], U, Stat) :- + unparser:unparse(Term, Stat, U, UT), + out(S, UT, Stat). +out([puttq(Term)|S], U, Stat) :- + unparser:unparse(Term, Stat, U, UT), + out(S, UT, Stat). +out([putwt(Term)|S], U, Stat) :- + unparser:unwparse(Term, Stat, U, UT), + out(S, UT, Stat). +out([putwtq(Term)|S], U, Stat) :- + unparser:unwparse(Term, Stat, U, UT), + out(S, UT, Stat). +out([addop(Op, Type, Prec)|S], U, s(Ops, OnErr)) :- + addop(Type, Op, Prec, Ops, NewOps), + out(S, U, s(NewOps, OnErr)). +out([rmop(Op, Type)|S], U, s(Ops, OnErr)) :- + rmop(Type, Op, Ops, NewOps), + out(S, U, s(NewOps, OnErr)). +out([on_error(Pred)|S], U, s(Ops, _)) :- + out(S, U, s(Ops, Pred)). otherwise. -out([Msg|S],U,s(Ops,OnErr)) :- - U=[Msg|UT], - out(S,UT,s(Ops,OnErr)). - -updt([],U,_Stat) :- U=[]. -updt([nl|S],U,Stat) :- - U=[putc(10)|UT], - updt(S,UT,Stat). -updt([gett(Term)|S],U,Stat) :- - klic_reader:parse_one_term_reporting_errors(U,Stat,Term,UT), - updt(S,UT,Stat). -updt([getwt(Term)|S],U,Stat) :- - klic_reader:wparse_one_term_reporting_errors(U,Stat,Term,UT), - updt(S,UT,Stat). -updt([putt(Term)|S],U,Stat) :- - unparser:unparse(Term,Stat,U,UT), - updt(S,UT,Stat). -updt([puttq(Term)|S],U,Stat) :- - unparser:unparse(Term,Stat,U,UT), - updt(S,UT,Stat). -updt([putwt(Term)|S],U,Stat) :- - unparser:unwparse(Term,Stat,U,UT), - updt(S,UT,Stat). -updt([putwtq(Term)|S],U,Stat) :- - unparser:unwparse(Term,Stat,U,UT), - updt(S,UT,Stat). -updt([addop(Op,Type,Prec)|S],U,s(Ops,OnErr)) :- - addop(Type,Op,Prec,Ops,NewOps), - updt(S,U,s(NewOps,OnErr)). -updt([rmop(Op,Type)|S],U,s(Ops,OnErr)) :- - rmop(Type,Op,Ops,NewOps), - updt(S,U,s(NewOps,OnErr)). -updt([on_error(Pred)|S],U,s(Ops,_)) :- - updt(S,U,s(Ops,Pred)). +out([Msg|S], U, s(Ops, OnErr)) :- + U = [Msg | UT], + out(S, UT, s(Ops, OnErr)). + +updt([], U, _Stat) :- + U = []. +updt([nl|S], U, Stat) :- + U = [putc(10) | UT], + updt(S, UT, Stat). +updt([gett(Term)|S], U, Stat) :- + klic_reader:parse_one_term_reporting_errors(U, Stat, Term, UT), + updt(S, UT, Stat). +updt([getwt(Term)|S], U, Stat) :- + klic_reader:wparse_one_term_reporting_errors(U, Stat, Term, UT), + updt(S, UT, Stat). +updt([putt(Term)|S], U, Stat) :- + unparser:unparse(Term, Stat, U, UT), + updt(S, UT, Stat). +updt([puttq(Term)|S], U, Stat) :- + unparser:unparse(Term, Stat, U, UT), + updt(S, UT, Stat). +updt([putwt(Term)|S], U, Stat) :- + unparser:unwparse(Term, Stat, U, UT), + updt(S, UT, Stat). +updt([putwtq(Term)|S], U, Stat) :- + unparser:unwparse(Term, Stat, U, UT), + updt(S, UT, Stat). +updt([addop(Op, Type, Prec)|S], U, s(Ops, OnErr)) :- + addop(Type, Op, Prec, Ops, NewOps), + updt(S, U, s(NewOps, OnErr)). +updt([rmop(Op, Type)|S], U, s(Ops, OnErr)) :- + rmop(Type, Op, Ops, NewOps), + updt(S, U, s(NewOps, OnErr)). +updt([on_error(Pred)|S], U, s(Ops, _)) :- + updt(S, U, s(Ops, Pred)). otherwise. -updt([Msg|S],U,s(Ops,OnErr)) :- - U=[Msg|UT], - updt(S,UT,s(Ops,OnErr)). - -addop(Kind,Op,Prec,ops(Prefix,Infix,Postfix),NOps) :- - ( Kind=fx; Kind=fy ) | - addop2(Op,Kind,Prec,Prefix,NPrefix), - NOps = ops(NPrefix,Infix,Postfix). -addop(Kind,Op,Prec,ops(Prefix,Infix,Postfix),NOps) :- - ( Kind=xfx; Kind=xfy; Kind=yfx ) | - addop2(Op,Kind,Prec,Infix,NInfix), - NOps = ops(Prefix,NInfix,Postfix). -addop(Kind,Op,Prec,ops(Prefix,Infix,Postfix),NOps) :- - ( Kind=xf; Kind=yf ) | - addop2(Op,Kind,Prec,Postfix,NPostfix), - NOps = ops(Prefix,Infix,NPostfix). - -addop2(Op,Type,Prec,[op(Op,_Type,_)|Ops],NOps) :- NOps=[op(Op,Type,Prec)|Ops]. -addop2(Op,Type,Prec,[],NOps):- NOps=[op(Op,Type,Prec)]. +updt([Msg|S], U, s(Ops, OnErr)) :- + U = [Msg | UT], + updt(S, UT, s(Ops, OnErr)). + +addop(Kind, Op, Prec, ops(Prefix, Infix, Postfix), NOps) :- + ( Kind=fx; Kind=fy ) | + addop2(Op, Kind, Prec, Prefix, NPrefix), + NOps = ops(NPrefix, Infix, Postfix). +addop(Kind, Op, Prec, ops(Prefix, Infix, Postfix), NOps) :- + ( Kind=xfx; Kind=xfy; Kind=yfx ) | + addop2(Op, Kind, Prec, Infix, NInfix), + NOps = ops(Prefix, NInfix, Postfix). +addop(Kind, Op, Prec, ops(Prefix, Infix, Postfix), NOps) :- + ( Kind=xf; Kind=yf ) | + addop2(Op, Kind, Prec, Postfix, NPostfix), + NOps = ops(Prefix, Infix, NPostfix). + +addop2(Op, Type, Prec, [op(Op, _Type, _)|Ops], NOps) :- + NOps = [op(Op, Type, Prec) | Ops]. +addop2(Op, Type, Prec, [], NOps):- + NOps = [op(Op, Type, Prec)]. otherwise. -addop2(Op,Type,Prec,[Info|Ops],NOps) :- - NOps=[Info|NOpsT], - addop2(Op,Type,Prec,Ops,NOpsT). - -rmop(Kind,Op,ops(Prefix,Infix,Postfix),NOps) :- - ( Kind=fx; Kind=fy ) | - rmop2(Op,Kind,Prefix,NPrefix), - NOps = ops(NPrefix,Infix,Postfix). -rmop(Kind,Op,ops(Prefix,Infix,Postfix),NOps) :- - ( Kind=xfx; Kind=xfy; Kind=yfx ) | - rmop2(Op,Kind,Infix,NInfix), - NOps = ops(Prefix,NInfix,Postfix). -rmop(Kind,Op,ops(Prefix,Infix,Postfix),NOps) :- - ( Kind=xf; Kind=yf ) | - rmop2(Op,Kind,Postfix,NPostfix), - NOps = ops(Prefix,Infix,NPostfix). - -rmop2(Op,Type,[op(Op,_Type,_)|Ops],NOps) :- NOps=Ops. -rmop2(_Op,_Type,[],NOps):- NOps=[]. +addop2(Op, Type, Prec, [Info|Ops], NOps) :- + NOps = [Info | NOpsT], + addop2(Op, Type, Prec, Ops, NOpsT). + +rmop(Kind, Op, ops(Prefix, Infix, Postfix), NOps) :- + ( Kind=fx; Kind=fy ) | + rmop2(Op, Kind, Prefix, NPrefix), + NOps = ops(NPrefix, Infix, Postfix). +rmop(Kind, Op, ops(Prefix, Infix, Postfix), NOps) :- + ( Kind=xfx; Kind=xfy; Kind=yfx ) | + rmop2(Op, Kind, Infix, NInfix), + NOps = ops(Prefix, NInfix, Postfix). +rmop(Kind, Op, ops(Prefix, Infix, Postfix), NOps) :- + ( Kind=xf; Kind=yf ) | + rmop2(Op, Kind, Postfix, NPostfix), + NOps = ops(Prefix, Infix, NPostfix). + +rmop2(Op, Type, [op(Op, _Type, _)|Ops], NOps) :- + NOps = Ops. +rmop2(_Op, _Type, [], NOps) :- + NOps = []. otherwise. -rmop2(Op,Type,[Info|Ops],NOps) :- - NOps=[Info|NOpsT], - rmop2(Op,Type,Ops,NOpsT). +rmop2(Op, Type, [Info|Ops], NOps) :- + NOps = [Info | NOpsT], + rmop2(Op, Type, Ops, NOpsT). default_operator_table(Ops) :- - Ops=ops([op(#,fx,100), op(&,fx,200), op(+,fx,500), op(-,fx,500), - op((:-),fx,1200), op((?-),fx,1200), op((implicit),fx,1150), - op((local_implicit),fx,1150), op((mode),fx,1150), - op(module,fx,80), op(nospy,fy,900), op((public),fx,1150), - op(spy,fy,900), op((with_macro),fx,1150), - op(~,fy,300), op($~,fy,300), - op(\+,fy,900)], - [op(#,xfx,100), op($$:=,xfx,700), - op($$<,xfx,700), op($$<=,xfx,700), op($$=:=,xfx,700), - op($$=<,xfx,700), op($$=\=,xfx,700), op($$>,xfx,700), - op($$>=,xfx,700), op($:=,xfx,700), op($<,xfx,700), - op($<=,xfx,700), op($=:=,xfx,700), op($=<,xfx,700), - op($=\=,xfx,700), op($>,xfx,700), op($>=,xfx,700), - op(&<,xfx,700), op(&<=,xfx,700), - op(&=<,xfx,700), op(&>,xfx,700), op(&>=,xfx,700), - op($+=,xfx,700), op($-=,xfx,700), - op($*=,xfx,700), op($/=,xfx,700), - op(*,yfx,400), op(**,xfy,300), op(+,yfx,500), - op((','),xfy,1000), op(-,yfx,500), - op((-->),xfx,1200), op((->),xfy,1050), - op(/,yfx,400), op(//,yfx,400), op(/\,yfx,500), - op(:,xfy,800), op((:-),xfx,1200), op(::,xfx,90), - op(:=,xfx,700), op((;),xfy,1100), op(<,xfx,700), - op(<<,yfx,400), op(<<=,xfx,700), - op(<=,xfx,700), op(=>,xfx,700), op(<==,xfx,700), - op(=,xfx,700), op(=..,xfx,700), op(=:=,xfx,700), - op(=<,xfx,700), op(==,xfx,700), op((=>),xfx,1090), - op(=\=,xfx,700), op(>,xfx,700), op(>=,xfx,700), - op(+=,xfx,700), op(-=,xfx,700), - op(*=,xfx,700), op(/=,xfx,700), - op(>>,yfx,400), op(@,xfy,700), - op(@<,xfx,700), op(@=<,xfx,700), op(@>,xfx,700), - op(@>=,xfx,700), op(\/,yfx,500), - op(\=,xfx,700), op(\==,xfx,700), op(^,xfy,200), - op(is,xfx,700), op(mod,xfx,300), op(xor,yfx,500)], - [op(++,xf,150),op(--,xf,150)]). - -output_stream(Stream,String) :- - klicio:default_operator_table(Ops), - klicio:out(Stream,Out,s(Ops,0)), - string_output(Out,String,Chars,Chars). - -string_output([],String,Chars,CharsT) :- - CharsT=[], - compute_string_length(Chars,0,L), - generic:new(string,String0,L,8), - fill_string(Chars,String0,String,0). -string_output([C|T],String,Chars,CharsT) :- integer(C) | - CharsT=[C|CharsNT], - string_output(T,String,Chars,CharsNT). -string_output([putc(C)|T],String,Chars,CharsT) :- - CharsT=[C|CharsNT], - string_output(T,String,Chars,CharsNT). -string_output([fwrite(S)|T],String,Chars,CharsT) :- string(S,L,_) | - CharsT=[S|CharsNT], - string_output(T,String,Chars,CharsNT). -string_output([fwrite(S,N)|T],String,Chars,CharsT) :- string(S,L,_) | - N=L, - CharsT=[S|CharsNT], - string_output(T,String,Chars,CharsNT). - -compute_string_length([],K,L) :- L=K. -compute_string_length([C|T],K,L) :- integer(C) | - compute_string_length(T,~(K+1),L). -compute_string_length([S|T],K,L) :- string(S,SL,_) | - compute_string_length(T,~(K+SL),L). - -fill_string([],S0,S,_) :- S=S0. -fill_string([C|T],S0,S,K) :- integer(C) | - set_string_element(S0,K,C,S1), - fill_string(T,S1,S,~(K+1)). -fill_string([E|T],S0,S,K) :- string(E,EL,_) | - set_string_elements(S0,K,0,EL,E,S1), - fill_string(T,S1,S,~(K+EL)). - -set_string_elements(S0,_K,EK,EL,_E,S) :- EK>=EL | S=S0. -set_string_elements(S0,K,EK,EL,E,S) :- EK= L | - C = -1, - string_input(T,String,K,L,LC). -string_input([getc(C)|T],String,K,L,LC) :- K < L, - string_element(String,K,C0), K1:=K+1 | - C=C0, - update_lc(C,LC,LC1), - string_input(T,String,K1,L,LC). -string_input([ungetc(C)|T],String,K,L,LC) :- C=:= -1 | - string_input(T,String,K,L,LC). -string_input([ungetc(C)|T],String,K,L,LC) :- C=\= -1, K > 0, K1:=K-1, C=\=10 | - string_input(T,String,K1,L,LC). -string_input([ungetc(C)|T],String,K,L,LC) :- C=\= -1, K > 0, K1:=K-1, C=:=10 | - LC1 := LC-1, - string_input(T,String,K1,L,LC1). +Ops = ops( + [ op(#, fx, 100), op(&, fx, 200), op(+, fx, 500), op(-, fx, 500), + op((:-), fx, 1200), op((?-), fx, 1200), op((implicit), fx, 1150), + op((local_implicit), fx, 1150), op((mode), fx, 1150), + op(module, fx, 80), op(nospy, fy, 900), op((public), fx, 1150), + op(spy, fy, 900), op((with_macro), fx, 1150), + op(~, fy, 300), op($~, fy, 300), + op(\+, fy, 900) ], + [ op(#, xfx, 100), op($$:=, xfx, 700), + op($$<, xfx, 700), op($$<=, xfx, 700), op($$=:=, xfx, 700), + op($$=<, xfx, 700), op($$=\=, xfx, 700), op($$>, xfx, 700), + op($$>=, xfx, 700), op($:=, xfx, 700), op($<, xfx, 700), + op($<=, xfx, 700), op($=:=, xfx, 700), op($=<, xfx, 700), + op($=\=, xfx, 700), op($>, xfx, 700), op($>=, xfx, 700), + op(&<, xfx, 700), op(&<=, xfx, 700), + op(&=<, xfx, 700), op(&>, xfx, 700), op(&>=, xfx, 700), + op($+=, xfx, 700), op($-=, xfx, 700), + op($*=, xfx, 700), op($/=, xfx, 700), + op(*, yfx, 400), op(**, xfy, 300), op(+, yfx, 500), + op((', '), xfy, 1000), op(-, yfx, 500), + op((-->), xfx, 1200), op((->), xfy, 1050), + op(/, yfx, 400), op(//, yfx, 400), op(/\, yfx, 500), + op(:, xfy, 800), op((:-), xfx, 1200), op(::, xfx, 90), + op(:=, xfx, 700), op((;), xfy, 1100), op(<, xfx, 700), + op(<<, yfx, 400), op(<<=, xfx, 700), + op(<=, xfx, 700), op(=>, xfx, 700), op(<==, xfx, 700), + op(=, xfx, 700), op(=.., xfx, 700), op(=:=, xfx, 700), + op(=<, xfx, 700), op(==, xfx, 700), op((=>), xfx, 1090), + op(=\=, xfx, 700), op(>, xfx, 700), op(>=, xfx, 700), + op(+=, xfx, 700), op(-=, xfx, 700), + op(*=, xfx, 700), op(/=, xfx, 700), + op(>>, yfx, 400), op(@, xfy, 700), + op(@<, xfx, 700), op(@=<, xfx, 700), op(@>, xfx, 700), + op(@>=, xfx, 700), op(\/, yfx, 500), + op(\=, xfx, 700), op(\==, xfx, 700), op(^, xfy, 200), + op(is, xfx, 700), op(mod, xfx, 300), op(xor, yfx, 500) ], + [ op(++, xf, 150), op(--, xf, 150) ] ). + +output_stream(Stream, String) :- + klicio:default_operator_table(Ops), + klicio:out(Stream, Out, s(Ops, 0)), + string_output(Out, String, Chars, Chars). + +string_output([], String, Chars, CharsT) :- + CharsT = [], + compute_string_length(Chars, 0, L), + generic:new(string, String0, L, 8), + fill_string(Chars, String0, String, 0). +string_output([C|T], String, Chars, CharsT) :- integer(C) | + CharsT = [C | CharsNT], + string_output(T, String, Chars, CharsNT). +string_output([putc(C)|T], String, Chars, CharsT) :- + CharsT = [C | CharsNT], + string_output(T, String, Chars, CharsNT). +string_output([fwrite(S)|T], String, Chars, CharsT) :- string(S, L, _) | + CharsT = [S | CharsNT], + string_output(T, String, Chars, CharsNT). +string_output([fwrite(S, N)|T], String, Chars, CharsT) :- string(S, L, _) | + N = L, + CharsT = [S | CharsNT], + string_output(T, String, Chars, CharsNT). + +compute_string_length([], K, L) :- + L = K. +compute_string_length([C|T], K, L) :- integer(C) | + compute_string_length(T, ~(K+1), L). +compute_string_length([S|T], K, L) :- string(S, SL, _) | + compute_string_length(T, ~(K+SL), L). + +fill_string([], S0, S, _) :- + S = S0. +fill_string([C|T], S0, S, K) :- integer(C) | + set_string_element(S0, K, C, S1), + fill_string(T, S1, S, ~(K+1)). +fill_string([E|T], S0, S, K) :- string(E, EL, _) | + set_string_elements(S0, K, 0, EL, E, S1), + fill_string(T, S1, S, ~(K+EL)). + +set_string_elements(S0, _K, EK, EL, _E, S) :- EK>=EL | + S = S0. +set_string_elements(S0, K, EK, EL, E, S) :- EK= L | + C = -1, + string_input(T, String, K, L, LC). +string_input([getc(C)|T], String, K, L, LC) :- K < L, + string_element(String, K, C0) | + C = C0, + update_lc(C, LC, LC1), + K1 := K+1, + string_input(T, String, K1, L, LC). +string_input([ungetc(C)|T], String, K, L, LC) :- C=:= -1 | + string_input(T, String, K, L, LC). +string_input([ungetc(C)|T], String, K, L, LC) :- C=\= -1, K > 0, C=\=10 | + K1 := K-1, + string_input(T, String, K1, L, LC). +string_input([ungetc(C)|T], String, K, L, LC) :- C=\= -1, K > 0, C=:=10 | + K1 := K-1, + LC1 := LC-1, + string_input(T, String, K1, L, LC1). -update_lc(C,LC,LC1) :- C=:=10 | LC1:=LC+1. -update_lc(C,LC,LC1) :- C=\=10 | LC1=LC. +update_lc(C, LC, LC1) :- C=:=10 | LC1 := LC+1. +update_lc(C, LC, LC1) :- C=\=10 | LC1 = LC. diff -ruN klic-3.003-2002-02-22d/runtime/unparse.kl1 klic-3.003-2002-02-22e/runtime/unparse.kl1 --- klic-3.003-2002-02-22d/runtime/unparse.kl1 Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-02-22e/runtime/unparse.kl1 Fri Feb 22 22:27:35 2002 @@ -1,215 +1,222 @@ -/* ---------------------------------------------------------- -% (C) 1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C) 1994, 1995 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ :- module unparser. -unparse(X,Stat)-F :- - unparse(X,Stat,1200,predicate#(unparser:unparse/6),Tokens,[]), - unscan(Tokens,#" ")-F. - -unparse(Int,_,_,_)-T:- integer(Int) | - unparse_int(Int)-T. -unparse(Float,_,_,_)-T:- generic:float(Float) | - unparse_float(Float)-T. -unparse(Cons,Stat,_,P)-T :- Cons=[Car|Cdr] | - unparse_cons(Cons,Stat,P)-T. -unparse(Vec,Stat,_,P)-T :- vector(Vec,_) | - unparse_vector(Vec,Stat,P)-T. -unparse(Str,_,_,_)-T :- string(Str,_,_) | - unparse_string(Str)-T. +:- public unparse/4, unwparse/4. + +unparse(X, Stat)-F :- + unparse(X, Stat, 1200, predicate#(unparser:unparse/6), Tokens, []), + unscan(Tokens, #" ")-F. + +unparse(Int, _, _, _)-T :- integer(Int) | + unparse_int(Int)-T. +unparse(Float, _, _, _)-T :- generic:float(Float) | + unparse_float(Float)-T. +unparse(Cons, Stat, _, P)-T :- Cons=[Car|Cdr] | + unparse_cons(Cons, Stat, P)-T. +unparse(Vec, Stat, _, P)-T :- vector(Vec, _) | + unparse_vector(Vec, Stat, P)-T. +unparse(Str, _, _, _)-T :- string(Str, _, _) | + unparse_string(Str)-T. otherwise. -unparse(Funct,Stat,Prio,P)-T :- - unparse_general(Funct,Stat,Prio,P)-T. +unparse(Funct, Stat, Prio, P)-T :- + unparse_general(Funct, Stat, Prio, P)-T. -unwparse(X,Stat)-F :- - unwparse(X,Stat,1200,predicate#(unparser:unwparse/6),Tokens,[]), - unscan(Tokens,#" ")-F. - -unwparse(integer(Int),_,_,_)-T:- - unparse_int(Int)-T. -unwparse(floating_point(Float),_,_,_)-T :- - unparse_float(Float)-T. -unwparse(list(Cons),Stat,_,P)-T :- - unwparse_cons(Cons,Stat,P)-T. -unwparse(vector(Vec),Stat,_,P)-T :- - unparse_vector(Vec,Stat,P)-T. -unwparse(string(Str),_,_,_)-T :- - unparse_string(Str)-T. -unwparse(variable(Var),_,_,_)-T :- string(Var,_,_) | - T <= Var. -unwparse(X,Stat,Prio,P)-T :- (X=functor(Funct); X=atom(Funct)) | - unparse_general(Funct,Stat,Prio,P)-T. +unwparse(X, Stat)-F :- + unwparse(X, Stat, 1200, predicate#(unparser:unwparse/6), Tokens, []), + unscan(Tokens, #" ")-F. + +unwparse(integer(Int), _, _, _)-T :- + unparse_int(Int)-T. +unwparse(floating_point(Float), _, _, _)-T :- + unparse_float(Float)-T. +unwparse(list(Cons), Stat, _, P)-T :- + unwparse_cons(Cons, Stat, P)-T. +unwparse(vector(Vec), Stat, _, P)-T :- + unparse_vector(Vec, Stat, P)-T. +unwparse(string(Str), _, _, _)-T :- + unparse_string(Str)-T. +unwparse(variable(Var), _, _, _)-T :- string(Var, _, _) | + T <= Var. +unwparse(X, Stat, Prio, P)-T :- (X=functor(Funct); X=atom(Funct)) | + unparse_general(Funct, Stat, Prio, P)-T. % patch for error messages of compiler -unwparse(variable(VarNum),_,_,_)-T :- integer(VarNum) | - int_chars(VarNum,L,[]), - generic:new(string,S,[#"_"|L],8), - T <= S. +unwparse(variable(VarNum), _, _, _)-T :- integer(VarNum) | + int_chars(VarNum, L, []), + generic:new(string, S, [#"_"|L], 8), + T <= S. % Numbers unparse_int(Int)-T :- - int_chars(Int,L,[]), - generic:new(string,S,L,8), - T<=S. + int_chars(Int, L, []), + generic:new(string, S, L, 8), + T <= S. -int_chars(I)-L :- I>=0, I<10 | L <= ~(#"0"+I). +int_chars(I)-L :- I>=0, I<10 | + L <= ~(#"0"+I). int_chars(I)-L :- I>=0, I>=10 | - C:= #"0"+I mod 10, - int_chars(~(I/10))-L, - L <= C. + C := #"0"+I mod 10, + int_chars(~(I/10))-L, + L <= C. int_chars(I)-L :- I<0, I=:= -I | % I = 0x800...00 - L<= #"-", - I1:= -(I/10), I2:= -(I+I1*10), C:= ~(#"0"+I2), - int_chars(I1)-L, L <= C. + L <= #"-", + I1:= -(I/10), I2:= -(I+I1*10), C:= ~(#"0"+I2), + int_chars(I1)-L, L <= C. int_chars(I)-L :- I<0, I=\= -I | - L<= #"-", int_chars(~(-I))-L. + L <= #"-", + int_chars(~(-I))-L. unparse_float(Float)-T :- - generic:print(Float,S), T<=S. + generic:print(Float, S), + T <= S. % Cons -unparse_cons([Car|Cdr],Stat,P)-T :- - T <= #"[", - unparse_comma_list_elem(Car,Stat,P)-T, - unparse_cdr(Cdr,Stat,P)-T, - T <= #"]". - -unparse_cdr([Car|Cdr],Stat,P)-T :- - T <= #",", - unparse_comma_list_elem(Car,Stat,P)-T, - unparse_cdr(Cdr,Stat,P)-T. -unparse_cdr([],_,_)-T. -otherwise. -unparse_cdr(Cdr,Stat,P)-T :- - T <= #"|", - unparse_comma_list_elem(Cdr,Stat,P)-T. - -unwparse_cons([Car|Cdr],Stat,P)-T :- - T <= #"[", - unparse_comma_list_elem(Car,Stat,P)-T, - unwparse_cdr(Cdr,Stat,P)-T, - T <= #"]". - -unwparse_cdr(list([Car|Cdr]),Stat,P)-T :- - T <= #",", - unparse_comma_list_elem(Car,Stat,P)-T, - unwparse_cdr(Cdr,Stat,P)-T. -unwparse_cdr(atom([]),_,_)-T. -otherwise. -unwparse_cdr(Cdr,Stat,P)-T :- - T <= #"|", - unparse_comma_list_elem(Cdr,Stat,P)-T. +unparse_cons([Car|Cdr], Stat, P)-T :- + T <= #"[", + unparse_comma_list_elem(Car, Stat, P)-T, + unparse_cdr(Cdr, Stat, P)-T, + T <= #"]". + +unparse_cdr([Car|Cdr], Stat, P)-T :- + T <= #",", + unparse_comma_list_elem(Car, Stat, P)-T, + unparse_cdr(Cdr, Stat, P)-T. +unparse_cdr([], _, _)-T. +otherwise. +unparse_cdr(Cdr, Stat, P)-T :- + T <= #"|", + unparse_comma_list_elem(Cdr, Stat, P)-T. + +unwparse_cons([Car|Cdr], Stat, P)-T :- + T <= #"[", + unparse_comma_list_elem(Car, Stat, P)-T, + unwparse_cdr(Cdr, Stat, P)-T, + T <= #"]". + +unwparse_cdr(list([Car|Cdr]), Stat, P)-T :- + T <= #",", + unparse_comma_list_elem(Car, Stat, P)-T, + unwparse_cdr(Cdr, Stat, P)-T. +unwparse_cdr(atom([]), _, _)-T. +otherwise. +unwparse_cdr(Cdr, Stat, P)-T :- + T <= #"|", + unparse_comma_list_elem(Cdr, Stat, P)-T. % Vector -unparse_vector(Vec,Stat,P)-T :- vector(Vec,N) | - N1:= N-1, - T <= #"{", - unparse_vecelems(0,N1,Vec,Stat,P)-T, - T <= #"}". - -unparse_vecelems(M,N,_Vec,_,_)-T :- NM | - M1 := M + 1, - unparse_comma_list_elem(E,Stat,P)-T, - T <= #",", - unparse_vecelems(M1,N,Vec,Stat,P)-T. +unparse_vector(Vec, Stat, P)-T :- vector(Vec, N) | + N1 := N-1, + T <= #"{", + unparse_vecelems(0, N1, Vec, Stat, P)-T, + T <= #"}". + +unparse_vecelems(M, N, _Vec, _, _)-T :- NM | + M1 := M + 1, + unparse_comma_list_elem(E, Stat, P)-T, + T <= #",", + unparse_vecelems(M1, N, Vec, Stat, P)-T. % String -unparse_string(Str)-T :- string(Str,N,_) | - str_chars(0,N,Str,L,[#"\""]), - generic:new(string,Str1,[#"\""|L],8), - T <= Str1. - -str_chars(K,N,Str)-L :- K=:=N | true. -str_chars(K,N,Str)-L :- K=\=N, string_element(Str,K,E), K1:=K+1 | - str_elem_chars(E)-L, - str_chars(K1,N,Str)-L. +unparse_string(Str)-T :- string(Str, N, _) | + str_chars(0, N, Str, L, [#"\""]), + generic:new(string, Str1, [#"\""|L], 8), + T <= Str1. + +str_chars(K, N, Str)-L :- K=:=N | + true. +str_chars(K, N, Str)-L :- K=\=N, string_element(Str, K, E), K1:=K+1 | + str_elem_chars(E)-L, + str_chars(K1, N, Str)-L. str_elem_chars(E)-L :- E>= #" " | - ins_backslash(E)-L, L<=E. + ins_backslash(E)-L, L<=E. str_elem_chars(E)-L :- E< #" ", E=:= #"\n" | - L = [#"\\", #"n"|L1], - L <== L1. + L = [#"\\", #"n"|L1], + L <== L1. str_elem_chars(E)-L :- E< #" ", E=\= #"\n" | - L = [#"\\", ~(#"0"+E/64), ~(#"0"+((E/8)/\7)), ~(#"0"+(E/\7))|L1], - L <== L1. + L = [#"\\", ~(#"0"+E/64), ~(#"0"+((E/8)/\7)), ~(#"0"+(E/\7))|L1], + L <== L1. ins_backslash(C)-L :- C=\= #"\"", C=\= #"\\" | true. otherwise. ins_backslash(_)-L :- L<= #"\\". % Others -unparse_general(Funct,Stat,Prio,P)-T :- - functor(Funct,PF,N), Stat=s(ops(Pre,In,Pos),_) | - find_operator(Pre,PF,Prefix), - find_operator(In,PF,Infix), - find_operator(Pos,PF,Postfix), - max_op(Prefix,Infix,Postfix,Max), - ins_if_greater_than(Max,Prio,#"(")-T, - unparse_with_op(N,PF,Funct,Stat,Prefix,Infix,Postfix,P)-T, - ins_if_greater_than(Max,Prio,#")")-T. - -ins_if_greater_than(X,Y,S)-T :- X>Y | T <= S. -ins_if_greater_than(X,Y,S)-T :- X=Y | T <= S. +ins_if_greater_than(X, Y, S)-T :- X=0, string_element(Str,0,E) | - scanner:chartype(E,T), - first_char_kind(T,Kind0), - ( Kind0=qtd -> Kind=qtd - ; otherwise - ; true -> judge_quoted(Kind0,Kind0,1,N,Str,Kind) ). - -first_char_kind(0,Kind) :- Kind=alf. -first_char_kind(4,Kind) :- Kind=sym. -otherwise. -first_char_kind(_,Kind) :- Kind=qtd. - -judge_quoted(Kind0,Kind1,_K,_N,_Str,Kind) :- Kind0\=Kind1 | Kind=qtd. -judge_quoted(Kind0,Kind0, K, N, Str,Kind) :- K=:=N | Kind=Kind0. -judge_quoted(Kind0,Kind0, K, N, Str,Kind) :- K 4 | Kind=qtd. - -make_atom_string(alf,Str)-T :- T<=Str. -make_atom_string(sym,Str)-T :- T<=Str. -make_atom_string(qtd,Str)-T :- string(Str,N,_) | - quoted_atom_chars(0,N,Str,L), - generic:new(string,Str1,[#"'"|L],8), - T<=Str1. - -quoted_atom_chars(K,N,_Str,L) :- K=:=N | L=[#"'"]. -quoted_atom_chars(K,N,Str,L) :- K L=LT - ; otherwise - ; true -> L=[E|LT] ), - quoted_atom_chars(K1,N,Str,LT1). + atom_table:get_atom_string(Atom, Str), + generic:size(Str, N), + atom_kind(Str, N, Kind), + make_atom_string(Kind, Str)-T. + +atom_kind(_, 0, Kind) :- + Kind = qtd. +atom_kind(Str, N, Kind) :- N>0, string_element(Str, 0, E) | + scanner:chartype(E, T), + first_char_kind(T, Kind0), + ( Kind0=qtd -> Kind=qtd + ; otherwise + ; true -> judge_quoted(Kind0, Kind0, 1, N, Str, Kind) ). + +first_char_kind(0, Kind) :- Kind=alf. +first_char_kind(4, Kind) :- Kind=sym. +otherwise. +first_char_kind(_, Kind) :- Kind=qtd. + +judge_quoted(Kind0, Kind1, _K, _N, _Str, Kind) :- Kind0 \= Kind1 | + Kind = qtd. +judge_quoted(Kind0, Kind0, K, N, Str, Kind) :- K=:=N | + Kind = Kind0. +judge_quoted(Kind0, Kind0, K, N, Str, Kind) :- K 4 | Kind=qtd. + +make_atom_string(alf, Str)-T :- T<=Str. +make_atom_string(sym, Str)-T :- T<=Str. +make_atom_string(qtd, Str)-T :- string(Str, N, _) | + quoted_atom_chars(0, N, Str, L), + generic:new(string, Str1, [#"'"|L], 8), + T<=Str1. + +quoted_atom_chars(K, N, _Str, L) :- K=:=N | + L = [#"'"]. +quoted_atom_chars(K, N, Str, L) :- K L=LT + ; otherwise + ; true -> L=[E|LT] ), + quoted_atom_chars(K1, N, Str, LT1). % Operators -find_operator(_,(|),Op) :- Op=xfy(1100). -find_operator([],X,Op) :- Op=none(0). -find_operator([op(X,Kind,Prio)|_],X,Op) :- - functor_table:(Op=..[Kind,Prio]). -otherwise. -find_operator([_|T],X,Op) :- find_operator(T,X,Op). +find_operator(_, (|), Op) :- + Op = xfy(1100). +find_operator([], X, Op) :- + Op = none(0). +find_operator([op(X, Kind, Prio)|_], X, Op) :- + functor_table:(Op =.. [Kind, Prio]). +otherwise. +find_operator([_|T], X, Op) :- + find_operator(T, X, Op). -max_op(X,Y,Z,Max) :- arg(1,X,Px), arg(1,Y,Py), arg(1,Z,Pz) | - max(Px,Py,Pxy), max(Pxy,Pz,Max). +max_op(X, Y, Z, Max) :- arg(1, X, Px), arg(1, Y, Py), arg(1, Z, Pz) | + max(Px, Py, Pxy), max(Pxy, Pz, Max). -max(X,Y,Z) :- X>=Y | Z=X. -max(X,Y,Z) :- X=Y | Z=X. +max(X, Y, Z) :- X Kind = 0 - ; T=:=4 -> Kind = 1 - ; T=:=6 -> Kind = 2 - ; otherwise - ; true -> Kind = -1 ). +unscan([], _)-F. +unscan([H|T], Pre)-F :- H=:=0 | + unscan_after_op(T, Pre)-F. +unscan([H|T], _)-F :- H=\=0 | + F<=H, unscan(T, H)-F. +unscan([H|T], Pre)-F :- + string(H, N, _), + string_element(H, 0, Head), string_element(H, ~(N-1), Tail) | + chartype(Pre, PreType), + chartype(Head, HeadType), + delimit(PreType, HeadType)-F, + F <= fwrite(H), + unscan(T, Tail)-F. + +unscan_after_op([#"("|T], _)-F :- F<=fwrite(" ("), unscan(T, #"(")-F. +otherwise. +unscan_after_op(X, Pre)-F :- unscan(X, Pre)-F. + +chartype(C, Kind) :- + scanner:chartype(C, T), + ( T =<3 -> Kind = 0 + ; T=:=4 -> Kind = 1 + ; T=:=6 -> Kind = 2 + ; otherwise + ; true -> Kind = -1 ). -delimit(X,X)-F :- X>=0 | F <= #" ". +delimit(X, X)-F :- X>=0 | F <= #" ". otherwise. -delimit(_,_)-F. +delimit(_, _)-F. diff -ruN klic-3.003-2002-02-22d/runtime/uterms.kl1 klic-3.003-2002-02-22e/runtime/uterms.kl1 --- klic-3.003-2002-02-22d/runtime/uterms.kl1 Fri Dec 28 13:46:47 2001 +++ klic-3.003-2002-02-22e/runtime/uterms.kl1 Fri Feb 22 22:30:12 2002 @@ -1,34 +1,35 @@ -/* ---------------------------------------------------------- -% (C)1993,1994 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C)1993,1994 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ :- inline:"#include \"gobj.h\"". + :- module unify_term_dcode. -unify(X,Y) :- - functor(X,PX,AX), - functor(Y,PY,AY), - AX =:= AY | - unify_pf(PX,PY), - unify_args(AX,X,Y). - -unify_pf(PX,PY) :- - inline:" - if (isatomic(%0)) { - if (%0 != %1) goto %f; - } else if (isatomic(%1)) { - goto %f; - } else { - generic_active_unify(data_objectp(%0), - data_objectp(%1),allocp); - }":[PX+bound,PY+bound] | true. - -unify_args(0,_,_):- true | true. -unify_args(N,X,Y):- N>0, - arg(N,X,EX), arg(N,Y,EY) | - EX=EY, N1:=N-1, unify_args(N1,X,Y). +:- public unify/2. + +unify(X, Y) :- functor(X,PX,A), functor(Y,PY,A) | + unify_pf(PX, PY), + unify_args(A, X, Y). + +unify_pf(PX, PY) :- + inline:" + if (isatomic(%0)) { + if (%0 != %1) goto %f; + } else if (isatomic(%1)) { + goto %f; + } else { + generic_active_unify(data_objectp(%0), data_objectp(%1), allocp); + }": [PX+bound, PY+bound] | true. + +unify_args(0, _, _) :- true | + true. +unify_args(N, X, Y) :- N>0, arg(N,X,EX), arg(N,Y,EY) | + EX = EY, + N1 := N-1, + unify_args(N1, X, Y). -unify_goal(X,Y):- true | X = Y. +unify_goal(X,Y) :- true | X = Y. diff -ruN klic-3.003-2002-02-22d/runtime/var.kl1 klic-3.003-2002-02-22e/runtime/var.kl1 --- klic-3.003-2002-02-22d/runtime/var.kl1 Tue Feb 19 13:59:54 2002 +++ klic-3.003-2002-02-22e/runtime/var.kl1 Fri Feb 22 22:27:35 2002 @@ -1,112 +1,132 @@ -/* ---------------------------------------------------------- -% (C)1993,1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) +/* ---------------------------------------------------------- +% (C)1993, 1994, 1995 Institute for New Generation Computer Technology +% (Read COPYRIGHT for detailed information.) % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ + :- module variable. -wrap(X,W) :- variable:unbound(X,U), - ( - U={Value} -> wrap_bound(X,W) - ; - U={_,_,_} -> W=variable("_") - ). - -wrap_bound(X,W) :- integer(X) | W=integer(X). -wrap_bound(X,W) :- generic:float(X) | W=floating_point(X). -wrap_bound(X,W) :- atom(X) | W=atom(X). -wrap_bound([H|T],W) :- W=list([WH|WT]), wrap(H,WH), wrap(T,WT). -wrap_bound(X,W) :- string(X,_,_) | W=string(X). -wrap_bound(X,W) :- vector(X,N) | - wrap_vec_elems(0,N,X,WV), - W=vector(WV). -wrap_bound(X,W) :- functor(X,F,N), N>0 | - W=functor(WF), - wrap_funct_elems(0,N,X,[F|LT],LT,WF). +:- public wrap/2, unwrap/2, unbound/2. % called in parse.kl1 + +wrap(X, W) :- variable:unbound(X, U), + ( + U={Value} -> wrap_bound(X, W) + ; + U={_, _, _} -> W=variable("_") + ). + +wrap_bound(X, W) :- integer(X) | + W = integer(X). +wrap_bound(X, W) :- generic:float(X) | + W = floating_point(X). +wrap_bound(X, W) :- atom(X) | + W = atom(X). +wrap_bound([H|T], W) :- + W = list([WH | WT]), + wrap(H, WH), + wrap(T, WT). +wrap_bound(X, W) :- string(X, _, _) | + W = string(X). +wrap_bound(X, W) :- vector(X, N) | + wrap_vec_elems(0, N, X, WV), + W = vector(WV). +wrap_bound(X, W) :- functor(X, F, N), N>0 | + W = functor(WF), + wrap_funct_elems(0, N, X, [F|LT], LT, WF). otherwise. -wrap_bound(X,W) :- W=unknown(X). +wrap_bound(X, W) :- + W = unknown(X). -wrap_vec_elems(K,N,WV0,WV) :- K=:=N | WV=WV0. -wrap_vec_elems(K,N,WV0,WV) :- K < N | - set_vector_element(WV0,K,VK,WVK,WV1), - wrap(VK,WVK), - wrap_vec_elems(~(K+1),N,WV1,WV). - -wrap_funct_elems(N,N,F,L,LT,WF) :- - LT=[], functor_table:(WF=..L). -wrap_funct_elems(K,N,F,L,LT,WF) :- K1 := K+1, arg(K1,F,FK) | - wrap(FK,WFK), - LT=[WFK|LTT], - wrap_funct_elems(K1,N,F,L,LTT,WF). - -unwrap(WTerm,Term):- unwrap(WTerm,Term,[],_). -unwrap(WTerm,Term,NVT):- unwrap(WTerm,Term,[],NVT). - -unwrap(variable(VarName),Term)-VT :- get_variable(VarName,Term)-VT. -unwrap(atom(Atom),Term)-VT :- Term = Atom. -unwrap(integer(Int),Term)-VT :- Term = Int. -unwrap(floating_point(Float),Term)-VT :- Term = Float. -unwrap(list([CAR|CDR]),Term)-VT :- - Term = [NCAR|NCDR], - unwrap(CAR,NCAR)-VT, - unwrap(CDR,NCDR)-VT. -unwrap(functor(Func),Term)-VT :- functor(Func,PF,N) | - unwrap_functor(0,N,Func,[PF|Args],Args,Term)-VT. -unwrap(vector(Vec),Term)-VT :- vector(Vec,N) | - unwrap_vector(0,N,Vec,Term)-VT. -unwrap(string(String),Term)-VT :- Term = String. -unwrap(unknown(UNKN),Term)-VT :- Term = UNKN. - -unwrap_functor(N,N,_Func,List,Args,Term,VT,NVT) :- - Args=[], - functor_table:(Term=..List), - NVT=VT. -unwrap_functor(M,N,Func,List,Args,Term,VT,NVT):- - M < N, M1:= M+1, arg(M1,Func,OE) | - unwrap(OE,NE,VT,VT1), - Args=[NE|Args1], - unwrap_functor(M1,N,Func,List,Args1,Term,VT1,NVT). - -unwrap_vector(N,N,OV,NV,VT,NVT):- NV=OV, NVT=VT. -unwrap_vector(M,N,OV,NV,VT,NVT):- M =\= N | - M1:= M+1, - set_vector_element(OV,M,OE,NE,OV2), - unwrap(OE,NE,VT,VT2), - unwrap_vector(M1,N,OV2,NV,VT2,NVT). +wrap_vec_elems(K, N, WV0, WV) :- K=:=N | + WV = WV0. +wrap_vec_elems(K, N, WV0, WV) :- K < N | + set_vector_element(WV0, K, VK, WVK, WV1), + wrap(VK, WVK), + wrap_vec_elems(~(K+1), N, WV1, WV). + +wrap_funct_elems(N, N, F, L, LT, WF) :- + LT = [], + functor_table:(WF =.. L). +wrap_funct_elems(K, N, F, L, LT, WF) :- K1 := K+1, arg(K1, F, FK) | + wrap(FK, WFK), + LT = [WFK | LTT], + wrap_funct_elems(K1, N, F, L, LTT, WF). + +unwrap(WTerm, Term) :- unwrap(WTerm, Term, [], _). +unwrap(WTerm, Term, NVT) :- unwrap(WTerm, Term, [], NVT). + +unwrap(variable(VarName), Term)-VT :- + get_variable(VarName, Term)-VT. +unwrap(atom(Atom), Term)-VT :- + Term = Atom. +unwrap(integer(Int), Term)-VT :- + Term = Int. +unwrap(floating_point(Float), Term)-VT :- + Term = Float. +unwrap(list([CAR|CDR]), Term)-VT :- + Term = [NCAR | NCDR], + unwrap(CAR, NCAR)-VT, + unwrap(CDR, NCDR)-VT. +unwrap(functor(Func), Term)-VT :- functor(Func, PF, N) | + unwrap_functor(0, N, Func, [PF|Args], Args, Term)-VT. +unwrap(vector(Vec), Term)-VT :- vector(Vec, N) | + unwrap_vector(0, N, Vec, Term)-VT. +unwrap(string(String), Term)-VT :- + Term = String. +unwrap(unknown(UNKN), Term)-VT :- + Term = UNKN. + +unwrap_functor(N, N, _Func, List, Args, Term, VT, NVT) :- + Args = [], + functor_table:(Term =.. List), + NVT = VT. +unwrap_functor(M, N, Func, List, Args, Term, VT, NVT) :- + M < N, M1:= M+1, arg(M1, Func, OE) | + unwrap(OE, NE, VT, VT1), + Args = [NE | Args1], + unwrap_functor(M1, N, Func, List, Args1, Term, VT1, NVT). + +unwrap_vector(N, N, OV, NV, VT, NVT) :- + NV=OV, NVT=VT. +unwrap_vector(M, N, OV, NV, VT, NVT) :- M =\= N | + M1 := M+1, + set_vector_element(OV, M, OE, NE, OV2), + unwrap(OE, NE, VT, VT2), + unwrap_vector(M1, N, OV2, NV, VT2, NVT). -get_variable("_",_Term,VT,NVT):- - NVT = VT. +get_variable("_", _Term, VT, NVT) :- + NVT = VT. otherwise. -get_variable(VarName,Term,VT,NVT):- - get_variable2(VarName,Term,VT,NVT). +get_variable(VarName, Term, VT, NVT) :- + get_variable2(VarName, Term, VT, NVT). -get_variable2(VarName,Term,[],NVT):- - NVT = [var(VarName,Term)]. -get_variable2(VarName,Term,[var(VarName,Var)|VT],NVT):- - NVT = [var(VarName,Var)|VT], - Term= Var. +get_variable2(VarName, Term, [], NVT) :- + NVT = [var(VarName, Term)]. +get_variable2(VarName, Term, [var(VarName, Var)|VT], NVT) :- + NVT = [var(VarName, Var) | VT], + Term = Var. otherwise. -get_variable2(VarName,Term,[Var|VT],NVT):- - NVT=[Var|NVT2], - get_variable2(VarName,Term,VT,NVT2). - -unbound(X,Result) :- inline:" -{ - q tmp = %0; - while (isref(tmp)) { - q tmp1 = derefone(tmp); - if (tmp==tmp1 || (isref(tmp1) && tmp==derefone(tmp1))) { - goto really_unbound; +get_variable2(VarName, Term, [Var|VT], NVT) :- + NVT = [Var | NVT2], + get_variable2(VarName, Term, VT, NVT2). + +unbound(X, Result) :- inline:" + { + q tmp = %0; + while (isref(tmp)) { + q tmp1 = derefone(tmp); + if (tmp==tmp1 || (isref(tmp1) && tmp==derefone(tmp1))) { + goto really_unbound; + } + tmp = tmp1; } - tmp = tmp1; - } - goto %f; - really_unbound: - %1 = makeint((q*)tmp-new_space_top()); -}":[X+any,Addr-int] | - Result={0,Addr,X}. + goto %f; + really_unbound: + %1 = makeint((q*)tmp-new_space_top()); + }": [X+any, Addr-int] | + Result = {0, Addr, X}. otherwise. -unbound(X,Result) :- - Result={X}. +unbound(X, Result) :- + Result = {X}.