diff -ruN klic-3.003-2002-03-12a/compiler/bb.kl1 klic-3.003-2002-03-15/compiler/bb.kl1 --- klic-3.003-2002-03-12a/compiler/bb.kl1 Tue Jan 22 13:41:07 2002 +++ klic-3.003-2002-03-15/compiler/bb.kl1 Fri Mar 15 22:52:24 2002 @@ -9,6 +9,12 @@ :- public is_body_builtin/2. % called in normalize.kl1 +% Ans = no +% Ans = yes( bblt_*(A, B) or bblt_*(A, B, C), +% integer_arithmetics or floating_arithmetics, +% [int] or [int, int] or [object(float)] or .., +% [int] or [object(float)] ) + /* Integer Arithmetics */ is_body_builtin( add( A, B, C ), Ans ) :- diff -ruN klic-3.003-2002-03-12a/compiler/cmacro.kl1 klic-3.003-2002-03-15/compiler/cmacro.kl1 --- klic-3.003-2002-03-12a/compiler/cmacro.kl1 Tue Jan 22 13:41:07 2002 +++ klic-3.003-2002-03-15/compiler/cmacro.kl1 Fri Mar 15 22:52:24 2002 @@ -7,112 +7,136 @@ :- module klic_comp_cmacro. -:- public expand/2, insDefs/1, replaceClause/4. % called in kl1cmp.kl1 +:- public expand/2, % called in kl1pp.kl1 + insDefs/3, replaceClause/4. % called in kl1cmp.kl1 -% expand/2 is called only in kl1pp.kl1 +% Terms +% ':-' with(Var=Def, ..) -> Pool += (Var=Def), .. +% ':-'(Dec) -> ':-'(Dec) +% H ':-' G '|' B -> H ':-' G1 '|' B1 +% H ':-' B -> H ':-' true '|' B1 +% H -> H ':-' true '|' true expand( Terms0, Terms ) :- true | keyed_set:create( Pool ), - expand( Terms0, Terms )+Pool+[]. + expand( Terms0, Terms, Pool ). -expand( [], Terms )-P :- - Terms = []. -expand( [functor( ':-'( functor( with( Defs )))) | Rest], Terms )-P :- - insDefs( Defs )-P, - expand( Rest, Terms )-P. -otherwise. -expand( [Cls0 | Rest], Terms0 )-P :- - replaceClause( Cls0, Cls )-P, - Terms0 = [Cls | Terms], - expand( Rest, Terms )-P. - -insDefs( functor( ','( functor( '='( variable( S ), Def )), Rest )))-P :- true | - P <= put( S, Def, _ ), - insDefs( Rest )-P. -insDefs( functor( '='( variable( S ), Def )))-P :- true | - P <= put( S, Def, _ ). -otherwise. -insDefs( functor( ','( Arg, Rest )))-P :- true | - klic_comp_message:report_error( "Unrecognized macro definition: ~w", [Arg] ), - insDefs( Rest )-P. -otherwise. -insDefs( Rest )-P :- true | - klic_comp_message:report_error( "Unrecognized macro definition: ~w", [Rest] ). - -replaceClause( functor( ':-'( Dec )), WFunc )-P :- true | - WFunc = functor( ':-'( Dec )). -replaceClause( functor( ':-'( H0, functor( '|'( G0, B0 )))), WFunc )-P :- true | - replaceHead( H0, H, Gs )-P, - replaceGoals( G0, Gs, G1 )-P, - replaceGoals( B0, [], B1 )-P, - reconstGoals( G1, G ), - reconstGoals( B1, B ), - WFunc = functor( ':-'( H, functor( '|'( G, B )))). -otherwise. -replaceClause( functor( ':-'( H0, B0 )), WFunc )-P :- true | - replaceClause( - functor( ':-'( H0, functor( '|'( atom( true ), B0 )))), - WFunc )-P. -otherwise. -replaceClause( functor( Func ), WFunc )-P :- true | - replaceClause( - functor( :-( functor( Func ), functor( '|'( atom( true ), atom( true ))))), - WFunc )-P. +expand( [], Terms, Pool ) :- + Terms = [], + Pool = []. +expand( [functor(':-'(functor(with(Defs)))) | Rest], Terms, Pool ) :- + insDefs( Defs ) +Pool +Pool1, + expand( Rest, Terms, Pool1 ). +otherwise. +expand( [Cls | Rest], Terms, Pool ) :- + Terms = [Cls1 | Terms1], + replaceClause( Cls, Cls1, Pool, Pool1 ), + expand( Rest, Terms1, Pool1 ). + +insDefs( functor(','(functor('='(variable(S), Def)), Rest)) ) -P :- true | + P <= put(S, Def, _), + insDefs(Rest) -P. +insDefs( functor('='(variable(S), Def)) ) -P :- true | + P <= put(S, Def, _). +otherwise. +insDefs( functor(','(Arg, Rest)) ) -P :- true | + klic_comp_message:report_error("Unrecognized macro definition: ~w", [Arg]), + insDefs( Rest ) -P. +otherwise. +insDefs(Rest) -P :- true | + klic_comp_message:report_error("Unrecognized macro definition: ~w", [Rest]). + +replaceClause( functor(':-'(Dec)), WFunc ) -P :- true | + WFunc = functor(':-'(Dec)). +replaceClause( functor(':-'(H, functor('|'(G, B)))), WFunc ) -P :- true | + replaceClause1( H, G, B, WFunc ) -P. otherwise. -replaceClause( WTerm0, WTerm )-P :- true | +replaceClause( functor(':-'(H, B)), WFunc ) -P :- true | + replaceClause1( H, atom(true), B, WFunc ) -P. +otherwise. +replaceClause( functor(H), WFunc )-P :- true | + replaceClause1( functor(H), atom(true), atom(true), WFunc ) -P. +otherwise. +replaceClause( WTerm0, WTerm ) -P :- true | WTerm0 = WTerm. -replaceGoals( Gs0, GTail, GHead )-P :- true | - replaceGoals( Gs0, GHead, GList0, GList0, GTail )-P. - -replaceHead( functor( H0 ), WFunc, Goals )-P :- functor( H0, PFunc, A ) | - replace( 1, A, H0, Goals, [] )-P, - WFunc = functor( H0 ). -otherwise. -replaceHead( WFunc0, WFunc, Goals )-P :- true | - WFunc0 = WFunc, - Goals = []. - -replaceGoals( functor( ','( G0,Goals )), GHead, GTail, U0, U )-P :- true | - replace( G0, U0, U1 )-P, - GHead = [G0 | GHead1], - replaceGoals( Goals, GHead1, GTail, U1, U )-P. -otherwise. -replaceGoals( G0, GHead, GTail, U0, U )-P :- true | - replace( G0, U0, U )-P, - GHead = [G0 | GTail]. - -replace( functor( Func0 ), U0, U )-P :- functor( Func0, PFunc, A ) | - replace( 1, A, Func0, U0, U )-P. -replace( list( [H0 | T0] ), U0, U )-P :- true | - replace( H0, U0, U1 )-P, - replace( T0, U1, U )-P. -replace( variable( S ), U0, U )-P :- true | - P <= empty( S,YorN ), - replace( YorN, S, U0, U )-P. -otherwise. -replace( WT0, U0, U )-P :- true | - U0 = U. - -replace( yes, _, U0, U )-P :- true | - U0 = U. -replace( no, S, U0, U )-P :- true | - P <= get_and_put( S, V, V ), - U0 = [functor( variable( S ) = V ) | U]. - -replace( A, N, _, U0, U )-P :- A > N | - U0 = U. -replace( A, N, Func0, U0, U )-P :- A =< N | - arg( A, Func0, Arg0 ), - replace( Arg0, U0, U1 )-P, +replaceClause1( H, G, B, WFunc ) -P :- + replaceGuard( H, G, GL ) -P, + replaceGoals( B, BL ) -P, + reconstGoals( GL, G1 ), + reconstGoals( BL, B1 ), + WFunc = functor(':-'(H, functor('|'(G1, B1)))). + +/** +* replaceGuard/5 +* + Head +* + functor(','(G1, functor(','(G2, ..)))) +* - [G1, G2, .., functor(variable(S) = V), ..] +* P <= empty/2, get_and_put/3 +*/ +replaceGuard( H, G, GL ) -P :- H = functor(_) | + replace( H ) +GL+GL1 -P, + replaceGoals( G, GL1 ) -P. +otherwise. +replaceGuard( H, G, GL ) -P :- true | + replaceGoals( G, GL ) -P. + +/** +* replaceGoals/4 +* functor(','(G1, functor(','(G2, ..)))) -> +* [G1, G2, .., functor(variable(S) = V), ..] +* P <= empty/2, get_and_put/3 +*/ + +replaceGoals( functor(','(G, Goals)), GL ) -P :- true | + GL = [G | GL1], + replace( G ) +GL1+GL2 -P, + replaceGoals( Goals, GL2 ) -P. +otherwise. +replaceGoals( G, GL ) -P :- true | + GL = [G | GL1], + replace( G ) +GL1+[] -P. + +/** +* replace/5 +* + functor/1, list/1, variable/1, .. +* U <= functor(variable(S) = V) +* P <= empty/2, get_and_put/3 +*/ + +replace( functor(Func) ) -U -P :- functor( Func, _, A ) | + replace( 1, A, Func ) -U -P. +replace( list([H | T]) ) -U -P :- true | + replace( H ) -U -P, + replace( T ) -U -P. +replace( variable(S) ) -U -P :- true | + P <= empty(S, YorN), + replace( YorN, S ) -U -P. +otherwise. +replace( WT ) -U -P. + +replace( yes, _ ) -U -P. +replace( no, S ) -U -P :- true | + P <= get_and_put(S, V, V), + U <= functor(variable(S) = V). + +replace( A, N, _ ) -U -P :- A > N | + true. +replace( A, N, Func ) -U -P :- A =< N | + arg( A, Func, Arg ), + replace( Arg ) -U -P, A1 := A+1, - replace( A1, N, Func0, U1, U )-P. + replace( A1, N, Func ) -U -P. + +/** +* reconstGoals/2 +* [G1, G2, ..] -> functor(','(G1, functor(','(G2, ..)))) +*/ reconstGoals( [], Goals ) :- true | - Goals = atom( true ). + Goals = atom(true). reconstGoals( [G], Goals ) :- true | Goals = G. -otherwise. -reconstGoals( [G | Rest], Goals ) :- - Goals = functor( ','( G, Goals1 )), +reconstGoals( [G | Rest], Goals ) :- Rest \= [] | + Goals = functor(','(G, Goals1)), reconstGoals( Rest, Goals1 ). diff -ruN klic-3.003-2002-03-12a/compiler/extern.kl1 klic-3.003-2002-03-15/compiler/extern.kl1 --- klic-3.003-2002-03-12a/compiler/extern.kl1 Wed Jan 23 16:42:17 2002 +++ klic-3.003-2002-03-15/compiler/extern.kl1 Fri Mar 15 22:52:24 2002 @@ -9,6 +9,22 @@ :- public make_ext_table/3. % called in write.kl1 +% Messages +% funct(FA) -> funct(FA) +% ext(M,_,_) -> module(M) +% gnew(Class) -> class(Class) +% const(_,Const) -> ext_struct(Const) +% atom([]) -> +% atom(.) -> +% atom(Atom) -> atom(Atom) +% integer(_) -> +% float(_) -> class(float) +% predicate(M,P,_) -> class(predicate), module(M), atom(M), atom(P) +% string(_) -> class(byte_string) +% list([H|T]) -> [H], [T] +% functor(S) -> funct(F/A), [Args] +% vector(V) -> class(vector), [Elems] + make_ext_table( [] )-E. make_ext_table( [One | Rest] )-E :- ext_struct( One )-E, diff -ruN klic-3.003-2002-03-12a/compiler/gb.kl1 klic-3.003-2002-03-15/compiler/gb.kl1 --- klic-3.003-2002-03-12a/compiler/gb.kl1 Tue Jan 22 13:41:07 2002 +++ klic-3.003-2002-03-15/compiler/gb.kl1 Fri Mar 15 22:52:24 2002 @@ -9,6 +9,9 @@ :- public is_guard_builtin/2. % called in normalize.kl1 +% Ans = yes([ $([A: Type, ..], B: Type, gblt_*), ..]) +% Ans = no(X) + is_guard_builtin( hash( A, B ), Ans ) :- builtin( [A: bound], B: int, gblt_hash, Ans ). is_guard_builtin( hash( A, B, C ), Ans ) :- diff -ruN klic-3.003-2002-03-12a/compiler/generate.kl1 klic-3.003-2002-03-15/compiler/generate.kl1 --- klic-3.003-2002-03-12a/compiler/generate.kl1 Tue Jan 22 13:41:07 2002 +++ klic-3.003-2002-03-15/compiler/generate.kl1 Fri Mar 15 22:52:24 2002 @@ -52,6 +52,15 @@ :- public gen_code/14. % called in normalize.kl1 +% Messages +% other(SC, Next) -> SC, otherwise, Next +% alter(SC, Next) -> SC, alternatively, Next +% e -> Lab or none +% l(Body) -> Lab, Body +% x(If, Then, Uncond) -> Lab, If, Then, Uncond +% v(P, e, e, e, B, U) -> Lab, load_pos P, Loop, if_ref(Reg, Ltest), deref(Reg, Loop, Luncond) +% v(P, A, C, F, B, U) -> + gen_code( other( SC, Next ), Lint, Lab, AL )-W-L-S-I-Code :- W0 = W, S0 = S, gen_code( SC, Loth, Lab, AL )-W-L-S-I-Code, diff -ruN klic-3.003-2002-03-12a/compiler/insert.kl1 klic-3.003-2002-03-15/compiler/insert.kl1 --- klic-3.003-2002-03-12a/compiler/insert.kl1 Wed Jan 23 16:42:17 2002 +++ klic-3.003-2002-03-15/compiler/insert.kl1 Fri Mar 15 22:52:24 2002 @@ -49,6 +49,21 @@ % called in normalize.kl1, generate.kl1 :- public make_index_tree/5, subsumed_type/3. +% Messages +% Cond - Body -> l(Body) +% otherwise -> other(T0, T) +% alternatively -> alter(T0, T) + +% Cond +% (X; Y) -> +% Position: Pattern -> (Position = Pattern) +% gp(C) -> +% gg(C, K) -> +% il(F, A, I) -> +% gb(C, OT) -> +% x(Cond, Node, U0) -> x(Cond, Node, U) +% v(Pos0, A, L, F, B, U0) -> v(Pos0, A, L, F, B, U) + make_index_tree( [], _V, T0, T, _ ) :- T = T0. make_index_tree( [Cond-Body | CT], V0, T0, T, Info ) :- diff -ruN klic-3.003-2002-03-12a/compiler/macro.kl1 klic-3.003-2002-03-15/compiler/macro.kl1 --- klic-3.003-2002-03-12a/compiler/macro.kl1 Fri Feb 22 22:27:35 2002 +++ klic-3.003-2002-03-15/compiler/macro.kl1 Fri Mar 15 22:52:24 2002 @@ -9,6 +9,27 @@ public macro/2, macro/3. % called in kl1cmp.kl1, macropp.kl1 +% Messages +% atom(otherwise) -> otherwise +% atom(alternatively) -> alternatively +% H :- G | B -> +% H :- B -> H :- true | B +% H -> H :- true | true +% H - variable(I) +% H + X +% functor(X; Y) +% functor(G -> B) +% functor(X @ Y) +% functor(atom(inline): X) +% functor(atom(MN): X) +% functor(variable(I) <== Term) +% functor(variable(I) <= Term) +% functor(Term => variable(I)) +% functor(variable(I) += Expr) +% functor(variable(I) -= Expr) +% functor(variable(I) *= Expr) +% functor(variable(I) /= Expr) + macro( In, Out ) :- macro( In, Out, _ ). macro( atom( otherwise ), R, Tbl ) :- diff -ruN klic-3.003-2002-03-12a/compiler/macropp.kl1 klic-3.003-2002-03-15/compiler/macropp.kl1 --- klic-3.003-2002-03-12a/compiler/macropp.kl1 Thu Dec 27 19:15:58 2001 +++ klic-3.003-2002-03-15/compiler/macropp.kl1 Fri Mar 15 22:52:24 2002 @@ -5,7 +5,7 @@ % (Read COPYRIGHT-JIPDEC for detailed information.) % ----------------------------------------------------------- */ -:- module klic_comp_macro_interface. +:- module klic_comp_macro_interface. % called in kl1pp.kl1 expand_macro(InTerms, ExpTerms0) :- true | expMacro(InTerms, ExpTerms0, ExpTerms, Ext0, []), diff -ruN klic-3.003-2002-03-12a/runtime/bagks.kl1 klic-3.003-2002-03-15/runtime/bagks.kl1 --- klic-3.003-2002-03-12a/runtime/bagks.kl1 Fri Feb 22 22:27:35 2002 +++ klic-3.003-2002-03-15/runtime/bagks.kl1 Fri Mar 15 22:52:24 2002 @@ -7,7 +7,25 @@ :- module keyed_sorted_bag. -:- public create/1. +:- public create/1. % bagk.kl1 + +% Messages +% do(S) -> +% empty(YorN) -> YorN = Pool is_empty? +% empty(Key, YorN) -> YorN = Key is_in Pool? +% put(Key, Value) -> Pool += (Key = [Value]) +% get(Key, Value) -> Value = Pool.Key +% get_if_any(Key, Value) -> Value = {} or {Pool.Key} +% get_all(Values) -> [{Key, Value}, ..] +% get_all(Key, Values) -> Values = [Pool.Key, ..] +% carbon_copy(Values) -> [{Key, Value}, ..] +% carbon_copy(Key, Values) -> Values = [] or [Pool.Key, ..] +% get_and_put(Key, Old, New) -> Old = Pool.Key +% get_if_any_and_put(Key, Old, New) -> Old = {} or {Pool.Key} +% get_and_put_if_any(Key, Old, New0, New) -> Old = {} or {Pool.Key} +% New = {} or {New0} +% get_max_if_any(Elem) -> Elem = {} or {Key, Pool.max} +% get_min_if_any(Elem) -> Elem = {} or {Key, Pool.min} create(Stream) :- splay_tree:create(Pool), @@ -46,7 +64,7 @@ message(get_if_any(Key, Value))-Pool :- splay_tree:empty(Key, Empty)-Pool, ( - Empty=yes -> Value={}, New=[] + Empty=yes -> Value={} ; Empty=no -> message(get(Key, V))-Pool, diff -ruN klic-3.003-2002-03-12a/runtime/bags.kl1 klic-3.003-2002-03-15/runtime/bags.kl1 --- klic-3.003-2002-03-12a/runtime/bags.kl1 Fri Feb 22 22:27:35 2002 +++ klic-3.003-2002-03-15/runtime/bags.kl1 Fri Mar 15 22:52:24 2002 @@ -7,7 +7,18 @@ :- module sorted_bag. -:- public create/1. +:- public create/1. % called in bag.kl1 + +% Messages +% do(S) -> +% empty(YorN) -> YorN = Pool is_empty? +% put(Value) -> Pool += (Value = [Value]) +% get(Value) -> Value = Pool.max +% get_if_any(Value) -> Value = {} or {Pool.min} +% get_all(Values) -> Values = [Value, ..] +% carbon_copy(Values) -> Values = [Value, ..] +% get_max_if_any(Elem) -> Elem = {} or {Pool.max} +% get_min_if_any(Elem) -> Elem = {} or {Pool.min} create(Stream) :- splay_tree:create(Pool), diff -ruN klic-3.003-2002-03-12a/runtime/compare.kl1 klic-3.003-2002-03-15/runtime/compare.kl1 --- klic-3.003-2002-03-12a/runtime/compare.kl1 Fri Feb 22 22:27:35 2002 +++ klic-3.003-2002-03-15/runtime/compare.kl1 Fri Mar 15 22:52:24 2002 @@ -11,5 +11,9 @@ /* Default Comparator */ +% X = min(X0, Y0) +% Y = max(X0, Y0) +% S = swapped? + 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-03-12a/runtime/gcmerge.kl1 klic-3.003-2002-03-15/runtime/gcmerge.kl1 --- klic-3.003-2002-03-12a/runtime/gcmerge.kl1 Fri Feb 22 22:27:35 2002 +++ klic-3.003-2002-03-15/runtime/gcmerge.kl1 Fri Mar 15 22:52:24 2002 @@ -9,6 +9,8 @@ :- public in/4. % called in gmerge.c +% Var = {Vec.0, {Vec.1, ..}} + in(Var, Vec, I, N) :- I1 := I+1, I1 < N | generic:element(Vec, I, E), Var = {E, NVar}, diff -ruN klic-3.003-2002-03-12a/runtime/parse.kl1 klic-3.003-2002-03-15/runtime/parse.kl1 --- klic-3.003-2002-03-12a/runtime/parse.kl1 Fri Feb 22 22:27:35 2002 +++ klic-3.003-2002-03-15/runtime/parse.kl1 Fri Mar 15 22:52:24 2002 @@ -9,6 +9,28 @@ :- public parse/3, wparse/3. % called in read.kl1 +% Result = normal(Term) +% Result = abnormal(X, ErrPos) + +% Tokens +% eof -> end_of_file +% variable(_, _, VarName, _) -> variable(VarName) +% - number(Int) -> integer(-Int) +% - number(Float) -> floating_point(-Float) +% atom(Atom) '(' Args ')' -> +% atom(Atom) -> +% number(Int) -> integer(Int) +% number(Float) -> floating_point(Float) +% string(String) -> string(String) +% '[' ']' -> atom([]) +% '[' Elems '|' ']' -> list([Elems|]) +% '{' '}' -> vector({}) +% '{' Elems '}' -> vector({Elems}) +% '(' Term ')' -> +% error(Message) -> +% ',' -> +% '|' -> + parse(Tokens, Ops, Result) :- wparse(Tokens, Ops, Res1), wait_parse(Res1, Result). @@ -54,45 +76,35 @@ wparse(('|'), S1, Prec, Ops, Result) :- true | wparse(atom('|'), S1, Prec, Ops, Result). wparse(atom(Atom), S1, Prec, Ops, Result) :- true | - ( - S1 = [number(Number)|S2], Atom = (-) -> - ( - integer(Number) -> Negated = integer(~(-Number)) - ; otherwise ; - true -> + ( 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] -> + ; S1 = ['('|S2] -> parse_comma_list(S2, Ops, 999, never, ')', Res1), - ( - Res1 = normal(Elements, S3) -> + ( Res1 = normal(Elements, S3) -> wrap_functor([Atom | Elements], WTerm), after_term(S3, 0, WTerm, Prec, Ops, Result) ; otherwise ; true -> Result = Res1 ) - ; otherwise ; - true -> + ; otherwise ; true -> prefixop(Atom, Ops, Prec, OP), - ( - OP = prefix(OPrec, APrec) -> + ( OP = prefix(OPrec, APrec) -> wparse(S1, APrec, Ops, Res1), - ( - Res1 = normal(Arg, S11) -> + ( Res1 = normal(Arg, S11) -> wrap_functor([Atom, Arg], WTerm), after_term(S11, OPrec, WTerm, Prec, Ops, Res0) ; otherwise ; - true -> Res0 = Res1 - ), + 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) + ; OP = none -> + after_term(S1, 0, atom(Atom), Prec, Ops, Result) ) ). wparse(number(Number), S0, Prec, Ops, Result) :- integer(Number) | @@ -100,23 +112,18 @@ wparse(number(Number), S0, Prec, Ops, Result) :- generic:float(Number) | after_term(S0, 0, floating_point(Number), Prec, Ops, Result). wparse(string(String), S0, Prec, Ops, Result) :- - ( - S0 = [string(Another)|S1] -> + ( S0 = [string(Another)|S1] -> generic:join(String, Another, Appended), wparse(string(Appended), S1, Prec, Ops, Result) - ; otherwise ; - true -> + ; otherwise ; true -> after_term(S0, 0, string(String), Prec, Ops, Result) ). wparse('[', S1, Prec, Ops, Result) :- true | - ( - S1 = [']'|S2] -> + ( S1 = [']'|S2] -> wparse(atom([]), S2, Prec, Ops, Result) - ; otherwise ; - true -> + ; otherwise ; true -> parse_comma_list(S1, Ops, 999, '|', ']', Res1), - ( - Res1 = normal(Elements, S3) -> + ( Res1 = normal(Elements, S3) -> wrap_list(Elements, WElements), after_term(S3, 0, WElements, Prec, Ops, Result) ; otherwise ; @@ -124,15 +131,12 @@ ) ). wparse('{', S1, Prec, Ops, Result) :- true | - ( - S1 = ['}'|S2] -> + ( S1 = ['}'|S2] -> new_vector(V, 0), after_term(S2, 0, vector(V), Prec, Ops, Result) - ; otherwise ; - true -> + ; otherwise ; true -> parse_comma_list(S1, Ops, 999, never, '}', Res1), - ( - Res1 = normal(Elements, S3) -> + ( Res1 = normal(Elements, S3) -> generic:new(vector, Vector, Elements), after_term(S3, 0, vector(Vector), Prec, Ops, Result) ; otherwise ; @@ -141,13 +145,10 @@ ). wparse(Token, S1, Prec, Ops, Result) :- (Token='('; Token=' (') | wparse(S1, 1200, Ops, Res1), - ( - Res1 = normal(Term, S2) -> - ( - S2 = [')'|S3] -> + ( Res1 = normal(Term, S2) -> + ( S2 = [')'|S3] -> after_term(S3, 0, Term, Prec, Ops, Result) - ; otherwise ; - true -> + ; otherwise ; true -> Result = abnormal("close parenthesis expected", S2) ) ; otherwise ; @@ -165,29 +166,22 @@ after_term([atom(Atom)|S1], MinPrec, Term, Prec, Ops, Result) :- infixop(Atom, Ops, MinPrec, Prec, IOP), postfixop(Atom, Ops, MinPrec, Prec, POP), - ( - IOP = none -> - ( - POP = none -> Result = normal(Term, [atom(Atom)|S1]) - ; - POP = postfix(POprec) -> + ( 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) ) - ; - IOP = infix(IOprec, Rprec) -> + ; IOP = infix(IOprec, Rprec) -> wparse(S1, Rprec, Ops, Res0), - ( - POP = none -> - ( - Res0 = normal(Right, S2) -> + ( 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) -> + ; POP = postfix(POprec1) -> wrap_functor([Atom, Term], WExpr), after_term(S1, POprec1, WExpr, Prec, Ops, Res2), select_better(Res0, Res2, Result) @@ -197,8 +191,7 @@ after_term([(', ')|S1], MinPrec, Term, Prec, Ops, Result) :- MinPrec < 1000, Prec >= 1000 | wparse(S1, 1000, Ops, Res1), - ( - Res1 = normal(Right, S2) -> + ( Res1 = normal(Right, S2) -> after_term(S2, 999, functor((Term, Right)), Prec, Ops, Result) ; otherwise ; true -> Result = Res1 @@ -206,8 +199,7 @@ after_term([('|')|S1], MinPrec, Term, Prec, Ops, Result) :- MinPrec < 1100, Prec >= 1100 | wparse(S1, 1100, Ops, Res1), - ( - Res1 = normal(Right, S2) -> + ( Res1 = normal(Right, S2) -> after_term(S2, 1099, functor('|'(Term, Right)), Prec, Ops, Result) ; otherwise ; true -> Result = Res1 @@ -224,25 +216,19 @@ parse_comma_list(S1, Ops, Prec, Bar, Close, Top, Tail, Result) :- wparse(S1, Prec, Ops, Res1), - ( - Res1 = normal(Term, S2) -> + ( Res1 = normal(Term, S2) -> Tail = [Term|NewTail], - ( - S2 = [', '|S3] -> + ( S2 = [', '|S3] -> parse_comma_list(S3, Ops, Prec, Bar, Close, Top, NewTail, Result) - ; - S2 = [Close|S3] -> + ; S2 = [Close|S3] -> NewTail = [], Result = normal(Top, S3) - ; - S2 = [Bar|S3] -> + ; S2 = [Bar|S3] -> wparse(S3, Prec, Ops, Res2), - ( - Res2 = normal(ParsedTail, S4) -> + ( Res2 = normal(ParsedTail, S4) -> NewTail = ParsedTail, - ( - S4 = [Close|S5] -> + ( S4 = [Close|S5] -> Result = normal(Top, S5) ; otherwise ; true -> @@ -251,8 +237,7 @@ ; otherwise ; true -> Result = Res2 ) - ; otherwise ; - true -> + ; otherwise ; true -> Result = abnormal("comma or close parenthesis expected", S2) ) ; otherwise ; @@ -277,34 +262,27 @@ prefixop(Atom, ops(Pre, _In, _Post), Prec, OP) :- lookup_op(Pre, Atom, Kind, P), - ( - P > Prec -> OP = none + ( P > Prec -> OP = none ; otherwise ; Kind = fx -> P1 := P-1, OP = prefix(P, P1) - ; - Kind = fy -> OP = prefix(P, P) + ; 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) + ( 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 + ( P > Max -> OP = none ; otherwise ; Kind = xf, P > Min -> OP = postfix(P) - ; - Kind = yf, P >= Min -> OP = postfix(P) + ; Kind = yf, P >= Min -> OP = postfix(P) ). lookup_op([], _, Kind, P) :- diff -ruN klic-3.003-2002-03-12a/runtime/setks.kl1 klic-3.003-2002-03-15/runtime/setks.kl1 --- klic-3.003-2002-03-12a/runtime/setks.kl1 Fri Feb 22 22:27:35 2002 +++ klic-3.003-2002-03-15/runtime/setks.kl1 Fri Mar 15 22:52:24 2002 @@ -7,7 +7,25 @@ :- module keyed_sorted_set. -:- public create/1. +:- public create/1. % called in setk.kl1, kl1cmp.kl1 + +% Messages +% do(S) -> +% empty(YorN) -> YorN = Pool is_empty? +% empty(Key, YorN) -> YorN = Key is_in Pool? +% put(Key, Value, ValueO) -> ValueO = {} or {Pool.Key} +% get(Key, Value) -> Value = Pool.Key +% get_if_any(Key, Value) -> Value = {} or {Pool.Key} +% get_all(Values) -> Values = [{Key, Value}, ..] +% get_all(Key, Values) -> Values = [] or [Pool.Key] +% carbon_copy(Values) -> Values = [{Key, Value}, ..] +% carbon_copy(Key, Value) -> Values = [] or [Pool.Key] +% get_and_put(Key, Old, New) -> Old = Pool.Key +% get_if_any_and_put(Key, Old, New) -> Old = {} or {Pool.Key} +% get_and_put_if_any(Key, Old, New0, New) -> Old = {} or {Pool.Key} +% New = {} or {New0} +% get_max_if_any(Elem) -> Elem = {} or {Key, Value} +% get_min_if_any(Elem) -> Elem = {} or {Key, Value} create(Stream) :- splay_tree:create(Pool), diff -ruN klic-3.003-2002-03-12a/runtime/splay.kl1 klic-3.003-2002-03-15/runtime/splay.kl1 --- klic-3.003-2002-03-12a/runtime/splay.kl1 Fri Feb 22 22:27:35 2002 +++ klic-3.003-2002-03-15/runtime/splay.kl1 Fri Mar 15 22:52:24 2002 @@ -11,7 +11,11 @@ :- public create/1, create/2, empty/3, empty/4, update/5, put/4, get/4, get_min/4, get_max/4, get_all/3. +% Tree = [] +% Tree = n(Left_subtree, Key, Value, Right_subtree) + /* Creation */ +% Pool = pool(Cmpr, []) create(Pool) :- default_comparator(Cmpr), @@ -29,6 +33,7 @@ /* Emptiness Test */ +% Empty = Tree is_empty? empty(Empty)-Pool :- true | ( Pool=pool(_Cmpr, []) -> Empty=yes @@ -36,6 +41,7 @@ true -> Empty=no ). +% Empty = Key is_in Tree? empty(Key, Empty, pool(Cmpr, T), New) :- empty_sub(T, Key, Empty, Cmpr), New = pool(Cmpr, T). @@ -119,6 +125,8 @@ ). /* Removing an Element */ +% Value = [] +% Value = Value_associated_with Key get(Key, Value, pool(Cmpr, T0), Pool) :- get(T0, Key, Value, T, Cmpr), @@ -146,6 +154,7 @@ ). /* Getting All the Elements */ +% All = [Key=Value, ..] get_all(All, pool(Cmpr, T), Pool) :- get_all_sub(T, All, []),