|
/* LPA Prolog predicates
emulating Visual Prolog predicates */
/* DESCRIPTION: This file contains numerous new predicates for LPA
Win Prolog 4.* which emulate precisely certain built-in
PDC/Visual Prolog predicates of exactly the same functors
and arities, as well as "flow patterns" (structures of inputs
and outputs allowed in their arguments). The intent is not
to... discourage the use of Visual Prolog, but -on the contrary- to encourage
the optimal use of both these good compilers, offering some help
to people who (like myself) wish to take advantage of both, and/or
have written code in one compiler which is tedious to translate into the
other. In any case -to be fair-
PDC and Visual Prolog analogs of LPA predicates
have been listed in another web page of this site. */
/* eq/2 is the closest analogue to PDC's equality, which is both
numeric and symbolic at the same time: */
:- op(700,xfx,eq).
A eq B:- simple(B), A=B.
A eq B:- functor(B,Pred,Arity), Arity=2, current_op(X,Y,Pred),
A is B.
% bit-manipulation PDC- predicates modelled in LPA
Prolog:
bitand(NumINP1,NumINP2,OUTx):-
OUTx is NumINP1 /\ NumINP2, !.
bitleft(NumINP,NbitsINP,OUTx):-
OUTx is NumINP << NbitsINP, !.
bitnot(NumINP,OUTx):-
OUTx is \(NumINP), !.
bitor(NumINP1,NumINP2,OUTx):-
OUTx is NumINP1 \/ NumINP2, !.
bitright(NumINP,NbitsINP,OUTx):-
OUTx is NumINP >> NbitsINP, !.
bitxor(NumINP1,NumINP2,OUTx):-
OUTx is x(NumINP1,NumINP2), !.
% bound(i)
bound(VAR):- nonvar(VAR).
% concat(i,i,o),(i,o,i),(o,i,i),(i,i,i)
concat(STR1,STR2,STR3):- nonvar(STR1), nonvar(STR2),
cat([STR1,STR2],STR12,_), STR3=STR12, !
;
nonvar(STR3), nonvar(STR1), len(STR1,L1),
len(STR3,L3), L2 is L3-L1, cat(S12,STR3,[L1,L2]),
S12 = [STR1,STR2|_], !
;
nonvar(STR2), nonvar(STR3), len(STR3,L3), len(STR2,L2),
L1 is L3-L2, cat(S12,STR3,[L1,L2]),
S12 = [STR1,STR2|_], !.
% date/3
date(Year,Month,Day):-
time(Year,Month,Day,_,_,_,_), !.
/* date/4: PDC standard flow pattern: -(o,o,o,o) */
date(Year,Month,Day,DayOfWeek):-
var(Year), var(Month), var(Day), var(DayOfWeek),
time(Year,Month,Day,_,_,_,_),
time(NDaySince1Jan1600,Year,Month,Day),
DayOfWeek is (NDaySince1Jan1600 - 1) mod 7, !.
/* novel flow-pattern: -(i,i,i,o) */
date(Year,Month,Day,DayOfWeek):-
nonvar(Year), nonvar(Month), nonvar(Day), var(DayOfWeek),
time(NDaySince1Jan1600,Year,Month,Day),
DayOfWeek is (NDaySince1Jan1600 - 1) mod 7, !.
/** NOTE: This new flow-pattern allows calculation (out to arg4)
of "which day of the week it was" for ANY previous date
(as input arguments 1,2 and 3). (It didn't exist in PDC) **/
% existfile/1
existfile(File):- file,-1,EX), EX=1.
% file_str/2
implements precise modelling
of the PDC/Visual Prolog
% predicate "file_str/2",
with both flow-patterns (i,o) and (o,i).
% Of course it's better to load disk-files
into LPA Prolog "memory-
% files" instead. Still, "file_str/2" is useful
for many practical purposes;
% (especially if one wants to re-use code
written for PDC, within LPA)
file_str(Fname,Str):- nonvar(Fname), var(Str), file(Fname,4,Size),
fcreate(inp,Fname,0,Size,0), input(inp), inpos(0),
copy(Size,Cop) ~> Str, fclose(inp), !, flush, Cop=Size.
file_str(Fname,Str):- nonvar(Str), nonvar(Fname),
tell(Fname), write(Str), told, !.
/* testing predicate:
testf:- ms(file_str('English_SYNONYMS_mini.dic',TX),TM1),
write(time1(TM1)), nl,
ms(file_str('English_SYNONYMS_mini.xxx',TX),TM2),
write(time2(TM2)), nl, !.
*/
% filesize/2
filesize(File,Size):- file(File,4,Size).
% frontchar(i,i,o),(i,o,o),(o,o,i)
frontchar(STR,CHAR,REST):- var(REST), len(STR,Len), Len >= 1,
cat(SLx,STR,[1]), SLx=[S1,REST], string_chars(S1,[CHAR])
;
nonvar(REST), nonvar(CHAR), string_chars(S1,[CHAR]),
cat([S1,REST],STR,_).
% frontstr(i,i,o,o)
frontstr(NumCH,STR,S1x,S2x):- len(STR,Len), Len >= NumCH,
cat(SLx,STR,[NumCH]), SLx=[S1x,S2x], !.
% fronttoken/3:
fronttoken(TEXT,X,Y):- nonvar(TEXT), frontchar(TEXT,CH,MORE),
CH=32, !, fronttoken(MORE,X,Y).
fronttoken(TEXT,TOKEN,REST):- nonvar(TEXT),
prolog_text(TEXT,TEXTok), etoks(X) <~ TEXTok,
X = [ (_,TOKENatom) | _ ], len(TOKENatom,L1),
cat(SLx,TEXT,[L1]), SLx = [ TOKEN , REST ], !.
fronttoken(TEXT,TOKEN,REST):- nonvar(TOKEN), /* -(o,i,i)
*/
nonvar(REST), cat([TOKEN,REST],X,_),
fronttoken(X,X1,X2), X1=TOKEN, X2=REST, !.
% random/1
random(RNDx):- RNDx is rand(1), !.
% random/2
random(MAXinp,RNDx):- RNDx is int(rand(MAXinp)), !.
% randominit/1
randominit(SEEDinput):- seed(SEEDinput), !.
% readchar(o)
readchar(CH):- get(C).
% readln(o)
readln(Sx):- fread(s,0,-1,Sx).
% searchchar(i,i,o)
searchchar(SOURCE,SUBch,POSx):- string_chars(ChStr,[SUBch]),
( find(ChStr,2,_),inpos(POSx) ) <~ SOURCE, !.
% searchstring(i,i,o)
searchstring(SOURCE,SUBSTRi,POSx):-
( find(SUBSTRi,2,Sfx),inpos(Px) ) <~ SOURCE,
not(Sfx=``),
len(SUBSTRi,L1), POSx is Px-L1+1, !.
% str_char(i,o),(o,i)
str_char(STR,CHAR):- string_chars(STR,[CHAR]).
% str_int(i,o),(o,i),(i,i)
str_int(STR,Num):- number_string(N,STR).
% str_len(i,o),(o,i),(i,i)
str_len(Str,Len):- nonvar(Str), len(Str,L), Len=L, !
;
var(Str), nonvar(Len),
/* case of (o,i). In PDC Prolog, a string of Len Spaces is generated
*/
forall(integer_bound(1,_,Len),put(32)) ~> Str, !.
% subchar(i,i,o)
subchar(STRi,POSi,CHARx):- POS is POSi-1,
(inpos(POS), get(CHARx)) <~ STRi.
% substring(i,i,i,o)
substring(STRi,POSi,LENi,SUBxx):- POS is POSi-1,
(inpos(POS), fread(s,LENi,0,SUBxx)) <~ STRi.
% upper_lower(i,o),(o,i),(i,i)
upper_lower(UP,LOW):- nonvar(UP), nonvar(LOW), /* -(i,i) both
bound */
lwrupr(LOW1,UP), /* LOW1 is (new) lower of "UP" */
lwrupr(LOW,UP1), /* UP1 is (new) upper of
"LOW" */
lwrupr(L2,UP1), /* L2 is the (new) lower of upper of "LOW"
*/
L2=LOW1,
! /* the lower_of_upper_of:LOW must equal lower_of_:UP
*/
;
nonvar(LOW), lwrupr(LOW,UP), !
;
nonvar(UP), lwrupr(LOW,UP), !.
|