47097 (588464), страница 10
Текст из файла (страница 10)
TProgramExtData=class(TObject)
Name :string;
Fields :TStrings;
FieldsTypes :TStrings;
FieldsLengths :TStrings;
FileName :string;
Table :TTable;
DataSource :TDataSource;
constructor Create;
destructor Destroy; override;
function Open:Boolean;
procedure Close;
end;
TPredicateClause=class(TObject)
Params :TVariablesArray;
Terms :TTermsArray;
x,y, Endx, EndY :integer;
constructor Create;
destructor Destroy; override;
end;
TProgramPredicate=class(TObject)
Name :string;
Params :TStrings;
Text :TStrings;
Lexems :TLexemsArray;
Clauses :array of TPredicateClause;
constructor Create;
destructor Destroy; override;
end;
TFileOpenMode=(fomRead,fomWrite,fomNotOpened);
TPrologFile=class(TObject)
Name :string;
HandlerNumb :integer;
OpenMode :TFileOpenMode;
FileVar :TextFile;
constructor Create;
destructor Destroy; override;
procedure OpenRead(FileName:string);
procedure OpenWrite(FileName:string);
procedure Close;
function EndOfFile:Boolean;
procedure ReadFile(var st:string);
procedure WriteFile(st:string);
end;
TVariableSize=record
Name :string;
iType :TPrologVariablesTypes;
size :integer;
end;
const
SimplePrologTypesCount=4;
SimplePrologTypes:set of TPrologVariablesTypes=
[vtString, vtInteger, vtBoolean, vtReal];
PrologVariablesSizes:array [0..5] of TVariableSize=
((Name:'STRING'; iType:vtString; Size:SizeOf(string)),
(Name:'INTEGER'; iType:vtInteger; Size:SizeOf(integer)),
(Name:'BOOLEAN'; iType:vtBoolean; Size:SizeOf(Boolean)),
(Name:'REAL'; iType:vtReal; Size:SizeOf(Extended)),
(Name:'LIST'; iType:vtList; Size:SizeOf(TPrologVariableList)),
(Name:'STRUCT'; iType:vtStruct; Size:SizeOf(TPrologVariableStruct)));
Приложение 3
Интерфейсная часть модуля с функциями и предикатами интерпретатора.
unit PrologRunTime;
interface
Uses SysUtils,CompileUnit, ProgramClasses, CommonFunctions;
type
TErrorCode=(ecType, ecNo, ecOverflow, ecDivideZero, ecExpressionValue,
ecArgsCount, ecArgType, ecTan, ecRealAsInteger, ecTypeInExtData,
ecListTail,ecPredicateParams,ecExtDataAbsent, ecExtDataDelete,
ecRangeError,ecConvertError,ecFileOpenError,ecFileCloseError,
ecFileAccessError,
ecCloseProgram,
ecStopPrologProgram);
//ecType - ошибка типа
//ecNo - нет ошибок
//ecOverflow - переполнение
//ecDivideZero - деление на ноль
//ecExpressionValue - выражение возвращает нелогическое значение
//ecArgsCount - неверное количество аргументов у функции
//ecArgType - ошибка типа аргумента функции
//ecTan - ошибка выполнения операции тангенса
//ecRealAsInteger - ошибка конвертирования реального числа в целое
// возникает, когда функции требуется целое число, а у предлагаемого
// аргумента функции есть ненулевая дробная часть
//ecTypeInExtData - ошибка типа при вызове базы данных
//ecListTail - разделение списка на голову и хвост оказалось неуспешным
//ecCloseProgram - закрытие программы
//ecStopPrologProgram - остановка программы
//ecPredicateParams - неверные параметры предиката
TRunTimeError=class(TObject)
Code :TErrorCode;
PredicateName :string;
x,y :integer;
constructor Create;
procedure SetError(err:TErrorCode);
procedure ShowOnScreen;
end;
TOperatorFunction=function (
Oper1:TPrologVariable; Oper2:TPrologVariable):TPrologVariable;
TStdFunction=function (Args:TPrologVariables):TPrologVariable;
TStdPredicate=function (VarPacket:TPrologVariables; BackTracking:Boolean):Boolean;
function VariableToStr(v:TPrologVariable;
PrintName:Boolean=True; PrintCommas:Boolean=True;
SquareBrackets:boolean=True):string;
function EqualOperator (Dst:TPrologVariable;
Src:TPrologVariable):Boolean;
function OperatorEQ (
Oper1:TPrologVariable; Oper2:TPrologVariable;
Variables:TPrologVariables):TPrologVariable;
function OperatorPlus (
Oper1:TPrologVariable; Oper2:TPrologVariable):TPrologVariable;
function OperatorMinus (
Oper1:TPrologVariable; Oper2:TPrologVariable):TPrologVariable;
function OperatorMultiply (
Oper1:TPrologVariable; Oper2:TPrologVariable):TPrologVariable;
function OperatorDivide (
Oper1:TPrologVariable; Oper2:TPrologVariable):TPrologVariable;
function OperatorGT (
Oper1:TPrologVariable; Oper2:TPrologVariable):TPrologVariable;
function OperatorLT (
Oper1:TPrologVariable; Oper2:TPrologVariable):TPrologVariable;
function OperatorGE (
Oper1:TPrologVariable; Oper2:TPrologVariable):TPrologVariable;
function OperatorLE (
Oper1:TPrologVariable; Oper2:TPrologVariable):TPrologVariable;
function OperatorNotEQ (
Oper1:TPrologVariable; Oper2:TPrologVariable):TPrologVariable;
function OperatorAND (
Oper1:TPrologVariable; Oper2:TPrologVariable):TPrologVariable;
function OperatorOR (
Oper1:TPrologVariable; Oper2:TPrologVariable):TPrologVariable;
function StdFunctionNot(Args:TPrologVariables):TPrologVariable;
function StdFunctionSin(Args:TPrologVariables):TPrologVariable;
function StdFunctionCos(Args:TPrologVariables):TPrologVariable;
function StdFunctionTan(Args:TPrologVariables):TPrologVariable;
function StdFunctionInt(Args:TPrologVariables):TPrologVariable;
function StdFunctionFrac(Args:TPrologVariables):TPrologVariable;
function StdFunctionSubStr(Args:TPrologVariables):TPrologVariable;
function StdFunctionFindStr(Args:TPrologVariables):TPrologVariable;
function StdFunctionChr(Args:TPrologVariables):TPrologVariable;
function StdFunctionAsc(Args:TPrologVariables):TPrologVariable;
function StdFunctionExp(Args:TPrologVariables):TPrologVariable;
function StdFunctionLn(Args:TPrologVariables):TPrologVariable;
function StdFunctionNumbToStr(Args:TPrologVariables):TPrologVariable;
function StdFunctionStrToNumb(Args:TPrologVariables):TPrologVariable;
function StdFunctionAbs(Args:TPrologVariables):TPrologVariable;
function StdPWrite(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPWriteLn(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPnl(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPIsInteger(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPIsReal(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPIsNumeric(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPIsString(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPIsBoolean(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPIsList(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPIsStruct(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPIsFree(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPReadInt(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPReadString(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPReadReal(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPDBAppendZ(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPDBAppendA(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPDBDelete(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPDBClear(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPFileOpenRead(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPFileOpenWrite(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPFileClose(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPFileRead(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPFileWrite(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPEOF(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPStringToList(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
function StdPFail(VarPacket:TPrologVariables;
BackTracking:Boolean):Boolean;
var
RunTimeError :TRuntimeError;
Приложение 4.
Текст демонтрационной программы.
DOMAINS
ListElement:Complex {}
Integer {}
Real {}
String {}
StringList {}
ParamsList:List of ListElement {Список параметров конфигурации}
StringList:List of String {Список с запросами}
ALIAS
DBDEMOS
DATABASES
Configs:'Configs.DB' {}
Task:String[33] {}
Frequency:Integer[4] {}
Processor:String[17] {}
Memory:Integer[4] {}
VideoMemory:Integer[4] {}
HDD:Integer[4] {}
MonitorSize:Integer[4] {}
Addition1Name:String[17] {}
Addition1Value:String[9] {}
Addition2Name:String[17] {}
Addition2Value:String[9] {}
Addition3Name:String[17] {}
Addition3Value:String[9] {}
Addition4Name:String[17] {}
Addition4Value:String[9] {}
DeviceClass:'DeviceClass.db' {}
TypeName:String[17] {}
SubType:String[33] {}
SubTypeIndex:Real{}
PREDICATES
_ReadParameters {Вспомогательный к ReadParameters}
String {Элемент списка}
StringList {Входной список}
StringList {Выходной список}
AddElementToStringList {Добавляет элемент к списку}
String {Элемент}
StringList {Входной список}
StringList {Выходной список}
AddNewAddition {Добавить в список дополнительных устройств}
StringList {список имен доп. уст-в}
StringList {список типов доп. уст-в}
String {новое имя доп. уст-ва}
String {новый тип доп. уст-ва}
StringList {вых. список имен доп. уст-в}
StringList {вых. список типов доп. уст-в}
ChooseConfig {выбор конфигурации}
StringList {список с запросами}
ParamsList {Входной список с параметрами}
ParamsList {Выходной список с параметрами}
GetListElement {Выдает по номеру элемент списка}
ParamsList {Список, в котором ищется элемент}
Integer {Номер искомого элемента}
Integer {Текущий счетчик}
ListElement {Возвращаемое значение}
Max {Выбирает максимальное значение}
ListElement {Значение 1}
ListElement {Значение 2}
ListElement {возвращаемое значение }
PrintAdditions {Печать дополнительных устройств}
StringList {Имена устройств}
StringList {Типы устройств}
ReadParameters {Читает параметры в список}
StringList {входной список}
StringList {выходной список}
run {Запускаемый предикат}
SelectProcessor {выбор процессора}
String {Процессор 1}
Integer {Частота 1}
String {Процессор 2}
Integer {Частота 2}
String {Выбранный процессор}
Integer {Выбранная частота}
GOAL
run
CLAUSES
ReadParameters(InList, OutList) if
ReadString(St),nl,
_ReadParameters(St, InList, OutList).
_ReadParameters("", InList, InList).
_ReadParameters(St, InList, OutList) if
AddElementToStringList(St, InList, InList2),
ReadParameters(InList2, OutList).
AddElementToStringList(A,T,[A|T]).
GetListElement([H|_],N,N,H).
GetListElement([_|T],N,N1,K) if
N2=N1+1,
GetListElement(T,N,N2,K).
Max (Value1, Value2, Value1) if Value1>=Value2.
Max (Value1, Value2, Value2) if Value1 SelectProcessor(OldProc,OldFreq,Proc1,Freq1,Proc1,OldFreq) if DeviceClass("Processor",OldProc,OldProcNumb), DeviceClass("Processor",Proc1,Proc1Numb), OldProcNumb=Proc1Numb, OldFreq>=Freq1. SelectProcessor(OldProc,OldFreq1,Proc1,Freq1,Proc1,Freq1) if DeviceClass("Processor",OldProc,OldProcNumb), DeviceClass("Processor",Proc1,Proc1Numb), OldProcNumb=Proc1Numb, OldFreq SelectProcessor(OldProc,OldFreq,Proc1,Freq1,OldProc,OldFreq) if DeviceClass("Processor",OldProc,OldProcNumb), DeviceClass("Processor",Proc1,Proc1Numb), OldProcNumb>Proc1Numb. SelectProcessor(OldProc,OldFreq,Proc1,Freq1,Proc1,Freq1) if DeviceClass("Processor",OldProc,OldProcNumb), DeviceClass("Processor",Proc1,Proc1Numb), OldProcNumb {CreateParamsList(Freq,Proc,Mem,VMem,HDD,Monitor,Names,Vals, [Freq,Proc,Mem,VMem,HDD,Monitor,Names,Vals]).} AddNewAddition(N,V,"","",N,V). AddNewAddition([],[],An,Av,[An],[Av]). AddNewAddition([Hn|Tn],[Hv|Tv],Hn,Av,[Hn|Tn],[Hv|Tv]) if DeviceClass(Hn,Hv,OldNumb), DeviceClass(Hn,Av,NewNumb), OldNumb>=NewNumb. AddNewAddition([Hn|Tn],[Hv|Tv],Hn,Av,[Hn|Tn],[Av|Tv]) if DeviceClass(Hn,Hv,OldNumb), DeviceClass(Hn,Av,NewNumb), OldNumb AddNewAddition([Hn|Tn],[Hv|Tv],An,Av,[Hn|NewN],[Hv|NewV]) if AddNewAddition(Tn,Tv,An,Av,NewN,NewV). ChooseConfig([],InParams,InParams). ChooseConfig([H|T], InParams, OutParams) if Configs(H,Freq1,Proc1,Mem1,VMem1,HDD1,Monitor1,an1,av1,an2,av2,an3,av3,an4,av4), GetListElement(InParams,6,0,OldAddsNames), GetListElement(InParams,7,0,OldAddsVals), AddNewAddition(OldAddsNames,OldAddsVals,an1,av1,AddsNames1,AddsVals1), AddNewAddition(AddsNames1,AddsVals1,an2,av2,AddsNames2,AddsVals2), AddNewAddition(AddsNames2,AddsVals2,an3,av3,AddsNames3,AddsVals3), AddNewAddition(AddsNames3,AddsVals3,an4,av4,AddsNames4,AddsVals4), GetListElement(InParams,5,0,OldMonitor), Max(Monitor1,OldMonitor,NewMonitor), GetListElement(InParams,4,0,OldHDD), {Max(HDD1,OldHDD,NewHDD),} NewHDD=OldHDD+HDD1, GetListElement(InParams,3,0,OldVMem), Max(VMem1,OldVMem,NewVMem), GetListElement(InParams,2,0,OldMem), Max(Mem1,OldMem,NewMem), GetListElement(InParams,1,0,OldProc), GetListElement(InParams,0,0,OldFreq), SelectProcessor(OldProc,OldFreq,Proc1,Freq1,NewProc,NewFreq), {CreateParamsList(NewFreq,NewProc,NewMem,NewVMem,NewHDD,NewMonitor,AddsNames4,AddsVals4,InParams1), ChooseConfig(T,InParams1,OutParams)} ChooseConfig(T,[NewFreq,NewProc,NewMem,NewVMem,NewHDD,NewMonitor,AddsNames4,AddsVals4],OutParams). PrintAdditions([],[]). PrintAdditions([Hn|Tn],[Hv|Tv]) if Write(Hn), Write(" "), WriteLn(Hv), PrintAdditions(Tn,Tv). run if {ReadParameters([],A), WriteLn(A),} ChooseConfig(["Internet","сочинение музыки","Delphi 3"],[0,"86",0,0,0,0,[],[]],B), {WriteLn(B),} GetListElement(B,0,0,Freq), GetListElement(B,1,0,Proc), WriteLn("Процессор: ",Proc," ",Freq," MHz"), GetListElement(B,2,0,Mem), WriteLn("Память: ",Mem," МБайт"), GetListElement(B,3,0,VMem), WriteLn("Видео память: ",VMem," МБайт"), GetListElement(B,4,0,HDD), WriteLn("Винчестер: ",HDD," МБайт"), GetListElement(B,5,0,Monitor), WriteLn("Монитор: ",Monitor,""""), GetListElement(B,6,0,Names), GetListElement(B,7,0,Vals), PrintAdditions(Names,Vals).