влияния опасных и вредных факторов, во время работы на

автоматизированном рабочем месте

снижения влияния вредных и опасных факторов, во время работы

с программным средством

воздействий

зрения, частичная защита здоровья)

зрения, полная защита здоровья)

В результате проектирования был разработан интерпретатор языка Пролог с возможностью работы с универсальными базами данных.

Дж. Малпас Реляционный язык Пролог и его применение - М.:Наука,1990

Логический подход к искусственному интеллекту под ред. Г.П.Гаврилова - М.:Мир,1990

Д. Марселлус Программирование экспертных систем на Турбо Прологе - М.:Финансы и статистика, 1994

У. Клоксин, К.Меллиш Программирование на языке Пролог - М.:Мир, 1987

Язык Пролог в пятом поколении ЭВМ под ред. Н.И. Ильинского - М.:Мир, 1988

Дж. Доорс, А.Р.Рейблейн, С.Вандера Пролог-язык программирования будущего - М.:Финансы и статистика, 1990

И. Братко Программирование на языке Пролог для искусственного интеллекта - М.:Мир, 1990

Ахо А. Теория синтаксического анализа, перевода и компиляции - М.:Мир, 1979

Приложения

Интерфейсная часть модуля интерпретатора

unit CompileUnit;

interface

uses Windows,Classes, SysUtils, ProgFormUnit, ProgramClasses, SyncObjs,

Forms, dbTables, ProjectOptionsFormUnit;

{DEFINE PRED_COMPILER_DEBUG}

const

StandardLexemsCount=16;

type

TSubStackNodeType=(ssntPredicate, ssntStdPredicate,

ssntArithmetic, ssntExtData);

TProgramSubStackNode=class(TObject)

ClauseIndex :integer; //индекс предложения, на котором

//была достигнута истина

CreatedVariables :TStrings; //созданные на этом шаге переменные

FreeBefore :TStrings; //Переменные, которые перед этим шагом были свободны

TempVariables :TPrologVariables;

//Arithmetic :Boolean; //True-если арифметический терм

iType :TSubStackNodeType; //Тип элемента

Term :TPrologTerm; //Терм в программе, которому

//соответсвует данный элемент

Belong :TObject; //объект TProgramStackNode,

//которому принадлежит данный объект

ExtDataQuery :TQuery;

TheEndWasReached :Boolean;

//VarPacket :TPrologVariables; //пакет с переменными,

//который отправляется дальше

procedure ClearCreatedVariables;

procedure StepBack;

constructor Create;

destructor Destroy; override;

end;

TTraceMode=(tmNoTrace, tmTrace, tmStep);

//tmNoTrace - нет трассировки

//tmTrace - трассировка

//tmStep - трассировка, не заходя внутрь вызываемых предикатов

TProgramStackNode=class(TObject)

//полностью описывает текущее состояние программы

PredicateName :string; //имя предиката

Predicate :TProgramPredicate;

InputParameters :TPrologVariables;

Variables :TPrologVariables; //переменные

SubStack :array of TProgramSubStackNode;//integer; //массив, в котором хранятся индексы,

//на которых было достигнуто истинное значение терма

CreatedVariables :array of array of string; //Массив,

//в котором хранятся имена созданных на i-м шаге переменных

TermNumb :integer; //Номер терма, на котором стоит программа

ClauseNumb :integer; //Номер предложения в предикате

ClausesCount :integer;

TraceMode :TTraceMode;

OnBreakPoint :Boolean; //True-если в данный момент стоим на контрольной точке

constructor Create;

destructor Destroy; override;

end;

TPrologProgram=class(TObject)

Domains :array of TProgramDomain;

ExtData :array of TProgramExtData;

Predicates :array of TProgramPredicate;

Stack :array of TProgramStackNode;

BreakPoints :array of Integer;

StartPredicate :string;

OnTheRun :Boolean; //True-если программа запущена

Files :array of TPrologFile;

function CompileProgram:Boolean;

procedure RecieveStructurData;

procedure CutLexemsToPredicates(Lexems:TLexemsArray);

function CheckingBeforeCompile:Boolean;

procedure RunProgram(TraceMode:TTraceMode);

procedure EraseProgramStack;

function AddNodeToStack:TProgramStackNode;

function FindPredicate(PredicateName:string):TProgramPredicate;

function ExecutePredicate(var StackNode:TProgramStackNode):Boolean;

procedure DeleteLastNodeFromStack;

function DebugProcess(StackNode:TProgramStackNode):Boolean;

function PreDebugProcess(StackNode:TProgramStackNode):Boolean;

procedure CreateBreakPointsArray;

function CheckPredicateClausesCount(

Term:TPrologTerm;

SubStackNode:TProgramSubStackNode):Boolean;

constructor Create;

destructor Destroy; override;

function TranslateLexems (ProgPart:TStrings; //var Lexems:TStringList;

var LexemsRecs:TLexemsArray;

Comments:Boolean=False):TPoint;

function AnalizeLexem(st:string):TLexemRecord;

procedure AddLexem(var LexemsRecs:TLexemsArray;

st:string; x,y,APos:integer);

procedure CheckBreakPoints(StackNode:TProgramStackNode);

end;

var

PrologProgram :TPrologProgram;

function TranslateSintax (var Predicate:TProgramPredicate):TPoint;

function AnalizeListElements(LRecs:TLexemsArray;

var DstVar:TPrologVariable):Boolean;

function AnalizeStructElements(LRecs:TLexemsArray;

var DstVar:TPrologVariable):Boolean;

function AnalizeArguments(Predicate:TProgramPredicate;

Lexems:TLexemsArray; var VArr:TVariablesArray;

CheckFlag:Boolean=True):boolean;

function CheckConstantType(

Param:TPrologVariable; Domain:string):boolean;

function CheckPredicateParameters(SubTerm

:TSubTermPredicate):Boolean;

function GetHelpContext (Lexem: TLexemRecord):LongInt;

function TestReservedFunction(st:String):Boolean;

function TestReservedPredicate(st:String):Boolean;

Приложение 2

Интерфейсная часть модуля с дополнительными классами интерпретатора.

unit ProgramClasses;

interface

uses Classes, SysUtils, ProgFormUnit, dbtables, db, ProjectOptionsFormUnit;

type

TLexemErrors=(leString,leComment, leOk);

//leString Не найден конец строки

//leComment не найден конец комментария

//Виды лексем

TLexemType=(ltPredicate, ltDomain, ltExtData,

ltVariable, ltFunction, ltUnknown,

ltPlus,ltMinus,ltMultiply,ltDivide,

ltLeftBracket,ltRightBracket,

ltLeftSquareBracket,ltRightSquareBracket,

ltListDivider,ltComma,ltPoint,

ltPointAndComma,ltEqual,ltIf,ltExclamation,

ltString,ltReal,ltInteger,ltTrue,ltFalse,

ltAnonimous, ltGT, ltLT, ltGE, ltLE,

ltReservedPredicate, ltNil, ltAnd, ltOr, ltNotEqual,

ltComment);

TLexemRecord=record

iType :TLexemType;

//Для LPredicate и LDomain обязателен идентификатор в st

st :string;

x,y :integer; //координаты лексемы

AbsPos :integer; //абсолюная позиция в тексте

NoInverse :Boolean; //Для ltPredicate - признак отсутствия или

//наличия знака инверсии

end;

TLexemsArray=array of TLexemRecord;

TPrologVariablesTypes=(vtString,vtInteger,vtBoolean,

vtReal,vtList,vtStruct,vtUnknown,vtAnonimous);

TPrologVariable=class(TObject)

iType :TPrologVariablesTypes; //Тип переменной

Name :string; //Имя переменной

Data :Pointer; //Объект с хранимой информацией

procedure CreateVariable(DomainType:string; vName:string);

procedure DestroyVariable;

constructor Create;

destructor Destroy; override;

procedure ClearVariable;

function CreateCopy:TPrologVariable; //создает точную копию переменной

//Имя переменной переносится и в копию

procedure AssignVariable (v:TPrologVariable); //присваивает значение

//переменной. Имя переменной не меняется

end;

TVariablesArray=array of TPrologVariable;

TPrologListType=(pltStdList,pltHeadTail);

//pltStdList - Элементы списка хранятся в Elements

//pltHeadTail - представлен в виде головы и хвоста(используются только

//два элемента массива elements

TPrologVariableList=class(TObject)

ListName :string; //имя типа списка

ElemName :string; //Имена типа элементов

ListType :TPrologListType; //Тип списка.

Elements :TVariablesArray; //Элементы находятся в Data

DividerPos :integer; //позиция разделителя в случае ListType=pltHeadTail

//указывает, после какого элемента стоит разделитель

procedure ConvertList;

constructor Create;

destructor Destroy; override;

end;

TPrologVariableStruct=class(TObject)

StructName :string; //имя типа структуры

ElemTypes :array of string; //имена типов элементов

Elements :array of TPrologVariable; //Элементы находятся в Data

constructor Create;

destructor Destroy; override;

end;

TPrologVariables=class(TObject)

VarArr :array of TPrologVariable;

constructor Create;

destructor Destroy; override;

function Count:integer;

function High:integer;

procedure AddVariable(v:TPrologVariable);

procedure DeleteVariable(n:integer); overload;

procedure DeleteVariable(vName:string); overload;

procedure DeleteLastVariable;

function AddNewVariable:TPrologVariable;

function VariableByName(vName:string):TPrologVariable;

function GetVariable(ind:integer):TPrologVariable;

procedure SetVariable(ind:integer; v:TPrologVariable);

procedure ClearAndDestroyVariables;

property Variables[ind:integer]:TPrologVariable read GetVariable

write SetVariable; default;

end;

TSubTermPredicate=class(TObject)

Name :string;

StandardPredicate :Boolean; //True - если предикат стандартный

Params :TVariablesArray;

NoInverse :Boolean; //признак отсутствия инверсии

constructor Create;

destructor Destroy; override;

end;

TSubTermExtData=class(TObject)

Name :string;

Params :TVariablesArray;

NoInverse :Boolean; //признак отсутствия инверсии

constructor Create;

destructor Destroy; override;

end;

TExpressionOperation=

(eoPlus, eoMinus, eoMultiply, eoDivide, eoEqual,

eoGT, eoLT, eoGE, eoLE, eoVariable, eoFunction,

eoAnd, eoOR, eoNotEqual);

TSubTermExpression=class(TObject)

Operation :TExpressionOperation;

VarName :String; //имя перменной

FuncName :string; //имя функции

StringStr :string; //строка для строки константы

NumberInt :integer; //число для целой контанты

NumberReal :Extended; //число для реальной контанты

BooleanVal :Boolean; //Число для логической константы

Operand :TPrologVariable;

LeftHand :TSubTermExpression; //Указатель на данные тип

//TSubTermExpression, TPrologVariable

RightHand :TSubTermExpression;

FuncParams :array of TSubTermExpression;

constructor Create;

destructor Destroy; override;

end;

TPrologTermType=(pttExpression,pttPredicate,pttExtData,pttCutting);

TPrologTerm=class(TObject)

TermType :TPrologTermType; //тип терма

Data :pointer; //указатель на объектом с содержимым терма

x,y :integer;

constructor Create;

destructor Destroy; override;

end;

TTermsArray=array of TPrologTerm;

TProgramDomain=class(TObject)

//Внутренний формат доменов

iType :TDomainTypes;

Name :string;

Params :TStrings;

ListParam :string;

constructor Create;

destructor Destroy; override;

end;

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<Value2.

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<Freq1.

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<Proc1Numb.

{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<NewNumb.

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).