$FORWARD GeneralizeResult, GenPattern, GenResult;
$EXTERN WriteLine;
$FORWARD LeftPtr, RightPtr;
$ENTRY MakeAlgorithm {
(e.Pattern) (e.Result) =
<WriteLine 'Start!'>
<GeneralizeResult
<GenPattern
(LeftPtr 0 0) e.Pattern (RightPtr 0 0)
(/* vars */) (/* commands */)
>
<GenResult
(/* vars */) (/* commands */) 0 // счётчик новых элементов
e.Result
>
>;
}
/*
e.Vars ::= (s.Count s.Mode e.Index)*
*/
//==============================================================================
// Генерация образца
//==============================================================================
//FROM Lexer
$EXTERN
TkOpenBracket, TkCloseBracket, TkOpenADT, TkCloseADT,
TkName, TkNumber, TkVariable, TkChar, TkBrackets, TkADT;
//FROM LibraryEx
$EXTERN Inc;
$ENUM LeftPtr, RightPtr;
// Направление распознавания
$EENUM AlgLeft, AlgRight;
/*
Тип идентификатора следует сделать доступным
и из Driver'а, и из Generator'а.
Остаётся только импортировать отсюда.
*/
$EENUM TkIdentifier;
/*
Команды распознавания
Литералы, формат (Cmd*** s.Direction s.BracketNum e.Literal)
Скобки, формат (CmdBrackets s.Direction s.BracketNum)
АТД, формат
(CmdADT s.Direction s.BracketNum s.InnerNum e.Name)
Пустые скобки, формат (CmdEmpty s.BracketNum)
Переменные:
повторные, формат
(CmdRepeated s.Direction s.BracketNum s.Usings s.Mode e.Index)
новые s и t, формат (CmdVar s.Direction s.BracketNum s.Mode e.Index)
открытые e, формат (CmdOpenedE AlgLeft s.BracketNum 'e' e.Index)
закрытые e, формат
(CmdClosedE AlgLeft s.BracketNum 'e' e.Index (e.BracketsForSave))
Комментарий, вносимый в исходный код (CmdComment e.Text)
*/
/*
Recognition commands
Literals, format (Cmd*** s.Direction s.BracketNum e.Literal)
Brackets, format (CmdBrackets s.Direction s.BracketNum s.InnerNum)
ADT, format (CmdADT s.Direction s.BracketNum s.InnerNum e.Name)
Empty braces, format (CmdEmpty s.BracketNum)
Variables:
repeated, format
(CmdRepeated s.Direction s.BracketNum s.Usings s.Mode e.Index)
new s & t, format (CmdVar s.Direction s.BracketNum s.Mode e.Index)
opened e, format (CmdOpenedE AlgLeft s.BracketNum 'e' e.Index)
closed e, format
(CmdClosedE AlgLeft s.BracketNum 'e' e.Index) (e.BracketsForSave))
Create vector of fixed-size variables
(CmdCreateVector s.Direction s.BracketNum)
Take fixed variables to vector
(CmdTakeFixed s.Direction s.BracketNum s.FixedElemCount e.FixedElements)
Comment (CmdComment e.Text)
*/
$EENUM
CmdChar, CmdNumber, CmdName, CmdIdent,
CmdBrackets, CmdADT, CmdEmpty,
CmdRepeated, CmdVar, CmdOpenedE, CmdClosedE,
CmdComment, CmdPrint, CmdCreateVector, CmdTakeFixed;
$FORWARD SaveBrackets;
// (LeftPtr s.Num s.FixCount t.FixedCommand1 ... t.FixedCommandN)
// (RightPtr s.Num s.FixCount t.FixedCommand1 ... t.FixedCommandN)
GenPattern {
// LeftPtr fixed-size recognition
e.Pattern-B (LeftPtr s.Num) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'new left ptr'>
<GenPattern
e.Pattern-B (LeftPtr s.Num 0) e.Pattern-E
(e.Vars) (e.Commands (CmdCreateVector AlgLeft s.Num))
>;
e.Pattern-B (LeftPtr s.Num s.FixCount e.FixedCommands) (TkChar s.Char) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'next char left'>
<GenPattern
e.Pattern-B
(LeftPtr s.Num <Inc s.FixCount> e.FixedCommands (CmdChar AlgLeft s.Num s.Char))
e.Pattern-E
(e.Vars)
(e.Commands)
>;
e.Pattern-B (LeftPtr s.Num s.FixCount e.FixedCommands) (TkNumber s.Number) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'next number left'>
<GenPattern
e.Pattern-B
(LeftPtr s.Num <Inc s.FixCount> e.FixedCommands (CmdNumber AlgLeft s.Num s.Number))
e.Pattern-E
(e.Vars)
(e.Commands)
>;
e.Pattern-B (LeftPtr s.Num s.FixCount e.FixedCommands) (TkName e.Name) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'next name left'>
<GenPattern
e.Pattern-B
(LeftPtr s.Num <Inc s.FixCount> e.FixedCommands (CmdName AlgLeft s.Num e.Name))
e.Pattern-E
(e.Vars)
(e.Commands)
>;
e.Pattern-B (LeftPtr s.Num s.FixCount e.FixedCommands) (TkIdentifier e.Name) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'next ident left'>
<GenPattern
e.Pattern-B
(LeftPtr s.Num <Inc s.FixCount> e.FixedCommands (CmdIdent AlgLeft s.Num e.Name))
e.Pattern-E
(e.Vars)
(e.Commands)
>;
// RightPtr fixed-size recognition
e.Pattern-B (RightPtr s.Num) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'new right ptr'>
<GenPattern
e.Pattern-B (RightPtr s.Num 0) e.Pattern-E
(e.Vars) (e.Commands (CmdCreateVector AlgRight s.Num))
>;
e.Pattern-B (TkChar s.Char) (RightPtr s.Num s.FixCount e.FixedCommands) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'next char right'>
<GenPattern
e.Pattern-B
(RightPtr s.Num <Inc s.FixCount> e.FixedCommands (CmdNumber AlgRight s.Num s.Char))
e.Pattern-E
(e.Vars)
(e.Commands)
>;
e.Pattern-B (TkNumber s.Number) (RightPtr s.Num s.FixCount e.FixedCommands) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'next number right'>
<GenPattern
e.Pattern-B
(RightPtr s.Num <Inc s.FixCount> e.FixedCommands (CmdNumber AlgRight s.Num s.Number))
e.Pattern-E
(e.Vars)
(e.Commands)
>;
e.Pattern-B (TkName e.Name) (RightPtr s.Num s.FixCount e.FixedCommands) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'next name right'>
<GenPattern
e.Pattern-B
(RightPtr s.Num <Inc s.FixCount> e.FixedCommands (CmdName AlgRight s.Num e.Name))
e.Pattern-E
(e.Vars)
(e.Commands)
>;
e.Pattern-B (TkIdentifier e.Name) (RightPtr s.Num s.FixCount e.FixedCommands) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'next ident right'>
<GenPattern
e.Pattern-B
(RightPtr s.Num <Inc s.FixCount> e.FixedCommands (CmdIdent AlgRight s.Num e.Name))
e.Pattern-E
(e.Vars)
(e.Commands)
>;
// Brackets recognition
e.Pattern-B (LeftPtr s.Num s.FixCount e.FixedCommands) (TkOpenBracket s.Inner)
e.Pattern-M (TkCloseBracket s.Inner) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'brackets left'>
<WriteLine s.FixCount>
<GenPattern
e.Pattern-B
(LeftPtr s.Num <Inc s.FixCount> e.FixedCommands (CmdBrackets AlgLeft s.Num s.Inner (LeftPtr s.Inner 0) e.Pattern-M (RightPtr s.Inner 0)))
e.Pattern-E
(e.Vars) (e.Commands)
>;
e.Pattern-B (TkOpenBracket s.Inner) e.Pattern-M (TkCloseBracket s.Inner)
(RightPtr s.Num s.FixCount e.FixedCommands) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'brackets right'>
<WriteLine s.FixCount>
<GenPattern
e.Pattern-B
(RightPtr s.Num <Inc s.FixCount> e.FixedCommands s.Num s.Inner (CmdBrackets AlgRight s.Num s.Inner (LeftPtr s.Inner 0) e.Pattern-M (RightPtr s.Inner 0)))
e.Pattern-E
(e.Vars) (e.Commands)
>;
//ADT scopes recognition
e.Pattern-B (LeftPtr s.Num s.FixCount e.FixedCommands) (TkOpenADT s.Inner)
(TkName e.Name) e.Pattern-M (TkCloseADT s.Inner) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'adt left'>
<WriteLine s.FixCount>
<GenPattern
e.Pattern-B
(LeftPtr s.Num <Inc s.FixCount> e.FixedCommands (CmdADT AlgLeft s.Num s.Inner e.Name (TkName e.Name) (LeftPtr s.Inner 0) e.Pattern-M (RightPtr s.Inner 0)))
e.Pattern-E
(e.Vars)
(e.Commands)
>;
e.Pattern-B (TkOpenADT s.Inner) (TkName e.Name) e.Pattern-M
(TkCloseADT s.Inner) (RightPtr s.Num s.FixCount e.FixedCommands) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'adt right'>
<WriteLine s.FixCount>
<GenPattern
e.Pattern-B
(RightPtr s.Num <Inc s.FixCount> e.FixedCommands (CmdADT AlgLeft s.Num s.Inner e.Name (TkName e.Name) (LeftPtr s.Inner 0) e.Pattern-M (RightPtr s.Inner 0)))
e.Pattern-E
(e.Vars)
(e.Commands)
>;
// Pointers which meets will be annihilated
e.Pattern-B (LeftPtr s.Num s.FixCountLeft e.FixedCommandsLeft)
(RightPtr s.Num s.FixCountRight e.FixedCommandsRight) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'Annihilate and take fixed data'>
<WriteLine 'from left of size' s.FixCountLeft>
<WriteLine 'from right of size' s.FixCountRight>
<GenPattern
e.Pattern-B e.Pattern-E
(e.Vars) (e.Commands (CmdTakeFixed AlgLeft s.Num s.FixCountLeft e.FixedCommandsLeft) (CmdTakeFixed AlgRight s.Num s.FixCountRight e.FixedCommandsRight))
>;
// Variable recognition
e.Pattern-B (LeftPtr s.Num s.FixCount e.FixedCommands) (TkVariable 'e' e.Index) e.Pattern-E
(e.Vars-B (s.Count s.Mode e.Index) e.Vars-E) (e.Commands) =
<WriteLine 'repeated e-variable on left'>
<GenPattern
e.Pattern-B (TkVariable s.Mode e.Index) (LeftPtr s.Num 0) e.Pattern-E
(e.Vars-B (<Inc s.Count> 'e' e.Index) e.Vars-E)
(e.Commands (CmdTakeFixed AlgLeft s.Num s.FixCount e.FixedCommands) (CmdRepeated AlgLeft s.Num <Inc s.Count> 'e' e.Index))
>;
e.Pattern-B (TkVariable 'e' e.Index) (RightPtr s.Num s.FixCount e.FixedCommands) e.Pattern-E
(e.Vars-B (s.Count 'e' e.Index) e.Vars-E) (e.Commands) =
<WriteLine 'repeated e-variable on right'>
<GenPattern
e.Pattern-B (RightPtr s.Num 0) (TkVariable 'e' e.Index) e.Pattern-E
(e.Vars-B (<Inc s.Count> 'e' e.Index) e.Vars-E)
(e.Commands (CmdTakeFixed AlgRight s.Num s.FixCount e.FixedCommands) (CmdRepeated AlgRight s.Num <Inc s.Count> 'e' e.Index))
>;
e.Pattern-B (LeftPtr s.Num s.FixCount e.FixedCommands) (TkVariable s.Mode e.Index) e.Pattern-E
(e.Vars-B (s.Count s.Mode e.Index) e.Vars-E) (e.Commands) =
<WriteLine 'repeated st-variable on left'>
<GenPattern
e.Pattern-B (LeftPtr s.Num <Inc s.FixCount> e.FixedCommands (TkVariable s.Mode e.Index)) e.Pattern-E
(e.Vars-B (<Inc s.Count> s.Mode e.Index) e.Vars-E)
(e.Commands (CmdRepeated AlgLeft s.Num <Inc s.Count> s.Mode e.Index))
>;
e.Pattern-B (TkVariable s.Mode e.Index) (RightPtr s.Num s.FixCount e.FixedCommands) e.Pattern-E
(e.Vars-B (s.Count s.Mode e.Index) e.Vars-E) (e.Commands) =
<WriteLine 'repeated st-variable on right'>
<GenPattern
e.Pattern-B (RightPtr s.Num <Inc s.FixCount> e.FixedCommands (TkVariable s.Mode e.Index)) e.Pattern-E
(e.Vars-B (<Inc s.Count> s.Mode e.Index) e.Vars-E)
(e.Commands (CmdRepeated AlgRight s.Num <Inc s.Count> s.Mode e.Index))
>;
// Closed e-variable pointers annihilation
e.Pattern-B (LeftPtr s.Num s.FixCountLeft e.FixedCommandsLeft) (TkVariable 'e' e.Index)
(RightPtr s.Num s.FixCountRight e.FixedCommandsRight) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'closed e-variable pointers annihilation'>
<GenPattern
e.Pattern-B (TkVariable 'e' e.Index) e.Pattern-E
(e.Vars (1 'e' e.Index))
(e.Commands (CmdClosedE AlgLeft s.Num 'e' e.Index))
>;
e.Pattern-B (LeftPtr s.Num s.FixCount e.FixedCommands) (TkVariable 's' e.Index) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 's-variable on left'>
<GenPattern
e.Pattern-B (LeftPtr s.Num <Inc s.FixCount> e.FixedCommands (CmdVar AlgLeft s.Num 's' e.Index)) e.Pattern-E
(e.Vars (1 's' e.Index)) (e.Commands (CmdVar AlgLeft s.Num 's' e.Index))
>;
e.Pattern-B (LeftPtr s.Num s.FixCount e.FixedCommands) (TkVariable 't' e.Index) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 't-variable on left'>
<GenPattern
e.Pattern-B (LeftPtr s.Num <Inc s.FixCount> e.FixedCommands (TkVariable 't' e.Index)) e.Pattern-E
(e.Vars (1 't' e.Index)) (e.Commands (CmdVar AlgLeft s.Num 't' e.Index))
>;
e.Pattern-B (TkVariable 's' e.Index) (RightPtr s.Num s.FixCount e.FixedCommands) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 's-variable on right'>
<GenPattern
e.Pattern-B (RightPtr s.Num <Inc s.FixCount> e.FixedCommands (TkVariable 's' e.Index)) e.Pattern-E
(e.Vars (1 's' e.Index)) (e.Commands (CmdVar AlgRight s.Num 's' e.Index))
>;
e.Pattern-B (TkVariable 't' e.Index) (RightPtr s.Num s.FixCount e.FixedCommands) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 't-variable on right'>
<GenPattern
e.Pattern-B (RightPtr s.Num <Inc s.FixCount> e.FixedCommands (TkVariable 't' e.Index)) e.Pattern-E
(e.Vars (1 't' e.Index)) (e.Commands (CmdVar AlgRight s.Num 't' e.Index))
>;
e.Pattern-B (LeftPtr s.Num s.FixCount e.FixedCommands) (TkVariable 'e' e.Index) e.Pattern-E
(e.Vars) (e.Commands) =
<WriteLine 'opened e-variable on left'>
<GenPattern
e.Pattern-B (TkVariable 'e' e.Index) (LeftPtr s.Num 0) e.Pattern-E
(e.Vars (1 'e' e.Index))
(e.Commands (CmdTakeFixed AlgLeft s.Num s.FixCount e.FixedCommands) (CmdOpenedE AlgLeft s.Num 'e' e.Index))
>;
// All pointers nave been annihilated. End of work.
e.Pattern (e.Vars) (e.Commands) =
(e.Vars)
(
<SaveBrackets e.Commands>
);
}
$FORWARD DoSaveBrackets, DoSaveBrackets-Aux;
SaveBrackets {
e.Commands = <DoSaveBrackets () e.Commands>;
}
DoSaveBrackets {
(e.Scanned)
e.Commands-B (CmdOpenedE AlgLeft s.Num 'e' e.Index) e.Commands-E =
<DoSaveBrackets-Aux
(e.Scanned
e.Commands-B
(CmdOpenedE AlgLeft s.Num 'e' e.Index)
)
e.Commands-E
>;
(e.Scanned) e.Commands = e.Scanned e.Commands;
}
$FORWARD CalcSavedBrackets;
DoSaveBrackets-Aux {
(e.Scanned (CmdOpenedE AlgLeft s.Num 'e' e.Index )) e.Commands =
<DoSaveBrackets
(e.Scanned
(CmdOpenedE
AlgLeft s.Num 'e' e.Index
(
<CalcSavedBrackets
(e.Scanned (CmdOpenedE AlgLeft s.Num 'e' e.Index))
e.Commands (CmdOpenedE AlgLeft s.Num 'e' e.Index)
>
)
)
)
e.Commands
>;
}
$FORWARD Brackets-Intersect, Brackets-Set, ExtractBrackets;
//FROM LibraryEx
$EXTERN Map;
CalcSavedBrackets {
(e.Scanned) e.Commands =
<Brackets-Intersect
( <Brackets-Set <Map ExtractBrackets e.Scanned>> )
( <Brackets-Set <Map ExtractBrackets e.Commands>> )
>;
}
ExtractBrackets {
/*
Все команды распознавания, кроме CmdEmpty содержат номер скобок
третьим термом, общий формат
(s.Command s.Direction s.BracketNum e.Info)
*/
(CmdEmpty s.BracketNum) = s.BracketNum;
(CmdBrackets s.Direction s.BracketNum s.InnerNum) =
s.BracketNum s.InnerNum;
(s.Command s.Direction s.BracketNum e.Info) = s.BracketNum;
}
Brackets-Set {
e.Unique s.Repeated e.Middle s.Repeated e.Rest =
e.Unique <Brackets-Set s.Repeated e.Middle e.Rest>;
e.Unique = e.Unique;
}
Brackets-Intersect {
(e.Set1-B s.Common e.Set1-E) (e.Set2-B s.Common e.Set2-E) =
s.Common <Brackets-Intersect (e.Set1-E) (e.Set2-B e.Set2-E)>;
(e.Set1) (e.Set2) = ;
}
//FROM Library
$EXTERN StrFromInt;
Escape {
'\n' = '\\n';
'\r' = '\\r';
'\t' = '\\t';
'\\' = '\\\\';
'' = '\\' '';
'"' = '\\"';
s.Other = s.Other;
}
//==============================================================================
// Генерация результата
//==============================================================================
// Тип команды
$ENUM CtAlloc, CtInsert, CtBrackets, CtInsertVar;
// Подтип команды
$ENUM
StChar, StName, StNumber, StIdent,
StOpenBracket, StCloseBracket, StOpenCall, StCloseCall,
StOpenADT, StCloseADT,
StLink, StStack;
//FROM Lexer
$EXTERN TkOpenCall, TkCloseCall;
$FORWARD GenResult-Commands;
GenResult {
// Literals creation
(e.Vars) (e.Commands) s.Counter (LeftPtr s.FixedElemCount s.FixedCommands) (TkChar s.Value) e.Result =
<GenResult
(e.Vars)
(e.Commands)
>;
}
GenResult {
// Создаём литералы
(e.Vars) (e.Commands) s.Counter (TkChar s.Value) e.Result =
<GenResult
(e.Vars)
(e.Commands
(CtAlloc StChar s.Counter s.Value)
(CtInsert s.Counter)
)
<Inc s.Counter> e.Result
>;
(e.Vars) (e.Commands) s.Counter (TkName e.Name) e.Result =
<GenResult
(e.Vars)
(e.Commands
(CtAlloc StName s.Counter e.Name)
(CtInsert s.Counter)
)
<Inc s.Counter> e.Result
>;
(e.Vars) (e.Commands) s.Counter (TkNumber s.Number) e.Result =
<GenResult
(e.Vars)
(e.Commands
(CtAlloc StNumber s.Counter s.Number)
(CtInsert s.Counter)
)
<Inc s.Counter> e.Result
>;
(e.Vars) (e.Commands) s.Counter (TkIdentifier e.Name) e.Result =
<GenResult
(e.Vars)
(e.Commands
(CtAlloc StIdent s.Counter e.Name)
(CtInsert s.Counter)
)
<Inc s.Counter> e.Result
>;
/*
Обработка открывающих скобок обоих типов ничем не отличается
от обработки литералов.
*/
(e.Vars) (e.Commands) s.Counter (TkOpenBracket s.Num) e.Result =
<GenResult
(e.Vars)
(e.Commands
(CtAlloc StOpenBracket s.Counter s.Num)
(CtInsert s.Counter)
)
<Inc s.Counter> e.Result
>;
(e.Vars) (e.Commands) s.Counter (TkOpenCall s.Num) e.Result =
<GenResult
(e.Vars)
(e.Commands
(CtAlloc StOpenCall s.Counter s.Num)
(CtInsert s.Counter)
)
<Inc s.Counter> e.Result
>;
(e.Vars) (e.Commands) s.Counter (TkOpenADT s.Num) e.Result =
<GenResult
(e.Vars)
(e.Commands
(CtAlloc StOpenADT s.Counter s.Num)
(CtInsert s.Counter)
)
<Inc s.Counter> e.Result
>;
/*
Закрывающие скобки надо обрабатывать особым образом.
Круглые скобки и АТД --
слинковать, угловые -- добавить в стек.
*/
(e.Vars)
(e.Commands-B (CtAlloc StOpenBracket s.OpenCounter s.Num) e.Commands-E)
s.Counter (TkCloseBracket s.Num) e.Result =
<GenResult
(e.Vars)
(
e.Commands-B
(CtAlloc StOpenBracket s.OpenCounter s.Num)
e.Commands-E
(CtAlloc StCloseBracket s.Counter s.Num)
(CtInsert s.Counter)
(CtBrackets StLink s.OpenCounter s.Counter)
)
<Inc s.Counter> e.Result
>;
(e.Vars)
(e.Commands-B (CtAlloc StOpenADT s.OpenCounter s.Num) e.Commands-E)
s.Counter (TkCloseADT s.Num) e.Result =
<GenResult
(e.Vars)
(
e.Commands-B
(CtAlloc StOpenADT s.OpenCounter s.Num)
e.Commands-E
(CtAlloc StCloseADT s.Counter s.Num)
(CtInsert s.Counter)
(CtBrackets StLink s.OpenCounter s.Counter)
)
<Inc s.Counter> e.Result
>;
(e.Vars)
(e.Commands-B (CtAlloc StOpenCall s.OpenCounter s.Num) e.Commands-E)
s.Counter (TkCloseCall s.Num) e.Result =
<GenResult
(e.Vars)
(
e.Commands-B
(CtAlloc StOpenCall s.OpenCounter s.Num)
e.Commands-E
(CtAlloc StCloseCall s.Counter s.Num)
(CtInsert s.Counter)
(CtBrackets StStack s.OpenCounter)
(CtBrackets StStack s.Counter)
)
<Inc s.Counter> e.Result
>;
// Обработка переменных
(e.Vars-B (s.Usings s.Mode e.Index) e.Vars-E)
(e.Commands) s.Counter (TkVariable s.Mode e.Index) e.Result =
<GenResult
(e.Vars-B (<Inc s.Usings> s.Mode e.Index) e.Vars-E)
(e.Commands
(CtInsertVar <Inc s.Usings> s.Mode e.Index)
)
s.Counter e.Result
>;
(e.Vars) (e.Commands) s.Counter (TkVariable s.Mode e.Index) e.Result =
<GenResult
(e.Vars (1 s.Mode e.Index))
(e.Commands
(CtInsertVar 1 s.Mode e.Index)
)
s.Counter e.Result
>;
// Завершение просмотра
(e.Vars) (e.Commands) s.Counter =
(e.Vars) ( e.Commands );
}
/*
Порядок выполнения команд.
1. Все выделения памяти (в порядке перечисления)
2. Связывание крулых и угловых скобок и
построение результата (в обратном порядке)
*/
$FORWARD ConvertCommands-Separated;
//FROM LibraryEx
$EXTERN MapReduce, Map;
SeparateAllocates {
(e.Allocates) (CtAlloc e.Info) =
(e.Allocates (CtAlloc e.Info));
(e.Allocates) t.Other = (e.Allocates) t.Other;
}
GenResult-Commands {
e.Commands =
<ConvertCommands-Separated
<MapReduce
SeparateAllocates
(/* Allocates */)
e.Commands
>
>;
}
$FORWARD Reverse, ConvertAllocates, ConvertCommand;
ConvertCommands-Separated {
(e.Allocates) e.OtherCommands =
<Map ConvertAllocates e.Allocates>
<Map ConvertCommand <Reverse e.OtherCommands>>;
}
Reverse {
t.First e.Medium t.Last = t.Last <Reverse e.Medium> t.First;
t.One = t.One;
= ;
}
// Основные команды работы с образцом
// (CmdAllocateElem s.Number s.ElType e.Info)
// (CmdLinkBrackets s.Left s.Right)
// (CmdPushStack s.Number)
// (CmdInsertElem s.Number)
// (CmdInsertEVar s.Usings 'e' e.Index)
$EENUM
CmdAllocateElem,
CmdLinkBrackets,
CmdPushStack,
CmdInsertElem,
CmdInsertEVar;
// Спецификаторы команд (элементы)
$EENUM
ElChar, ElName, ElNumber, ElIdent,
ElOpenADT, ElCloseADT,
ElOpenBracket, ElCloseBracket,
ElOpenCall, ElCloseCall,
ElElem, ElSTVar;
ElemType {
StChar s.Char = ElChar s.Char;
StName e.Name = ElName e.Name;
StNumber s.Number = ElNumber s.Number;
StIdent e.Name = ElIdent e.Name;
StOpenADT s.Num = ElOpenADT;
StCloseADT s.Num = ElCloseADT;
StOpenBracket s.Num = ElOpenBracket;
StCloseBracket s.Num = ElCloseBracket;
StOpenCall s.Num = ElOpenCall;
StCloseCall s.Num = ElCloseCall;
}
ConvertAllocates {
(CtAlloc s.Type s.Number e.Value) =
(CmdAllocateElem s.Number <ElemType s.Type e.Value>);
}
ConvertCommand {
(CtInsert s.Number) = (CmdInsertElem ElElem s.Number);
(CtInsertVar s.Usings 'e' e.Index) = (CmdInsertEVar s.Usings 'e' e.Index);
(CtInsertVar s.Usings s.STMode e.Index) =
(CmdInsertElem ElSTVar s.Usings s.STMode e.Index);
(CtBrackets StStack s.Number) = (CmdPushStack s.Number);
(CtBrackets StLink s.LeftNumber s.RightNumber) =
(CmdLinkBrackets s.LeftNumber s.RightNumber);
}
//==============================================================================
// Обобщение информации -- уничтожение ненужных переменных,
// копирование повторных.
//==============================================================================
$FORWARD GeneralizeResult-Vars, ReplicateVars;
GeneralizeResult {
(e.PatternVars) (e.PatternCommands)
(e.ResultVars) (e.ResultCommands) =
<GeneralizeResult-Vars
( <ReplicateVars e.PatternVars> )
( <ReplicateVars e.ResultVars> )
(e.PatternCommands) (e.ResultCommands)
>;
}
//FROM LibraryEx
$EXTERN Dec;
ReplicateVar {
(1 s.Mode e.Index) = (1 s.Mode e.Index);
(s.Using s.Mode e.Index) =
<ReplicateVar (<Dec s.Using> s.Mode e.Index)>
(s.Using s.Mode e.Index);
}
ReplicateVars {
e.Vars = <Map ReplicateVar e.Vars>;
}
$FORWARD GeneralizeResult-CopyVars, VarSetUnion, VarSetDifference;
GeneralizeResult-Vars {
( e.PatternVars ) ( e.ResultVars )
( e.PatternCommands ) ( e.ResultCommands ) =
<GeneralizeResult-CopyVars
( <VarSetUnion (e.PatternVars) (e.ResultVars)> )
( e.PatternCommands )
( <VarSetDifference (e.ResultVars) (e.PatternVars)> )
( e.ResultCommands )
>;
}
VarSetUnion {
( e.Set1-B t.Common e.Set1-E ) ( e.Set2-B t.Common e.Set2-E ) =
t.Common
<VarSetUnion (e.Set1-B e.Set1-E) (e.Set2-B e.Set2-E)>;
( e.Set1 ) ( e.Set2 ) = e.Set1 e.Set2;
}
VarSetDifference {
( e.Set1-B t.Common e.Set1-E ) ( e.Set2-B t.Common e.Set2-E ) =
e.Set1-B <VarSetDifference (e.Set1-E) ( e.Set2-B e.Set2-E )>;
( e.Set1 ) ( e.Set2 ) = e.Set1;
}