$EXTERN Lexer, Put, Arg, Open, Prout;
$ENTRY Go {
/*= <Open 'w' 2 <Arg 2>><Put 2 <Parser : <Lexer <Arg 1>>>>;*/
= <GenereateCode : <Semantic : <Parser : <Lexer <Arg 1>>>> >;
/* = <Open 'w' 2 <Arg 2>><PrintTree <Parser : <Lexer <Arg 1>>> >;*/
}
Parser {
: eTokens =
<Program
() /* список ошибок */
() /* список функций */
: eTokens
>;
}
/*
Program =
[$ENTRY] Name FunctionBody Program
| $EXTERN ExternList Program
| пусто .
*/
Program {
tErrorList tFunctions (Directive tPosDir '$ENTRY') (Name tPosName : eName) : eTokens =
<Program-Function
tFunctions eName tPosName Entry
<FunctionBody tErrorList : eTokens>
>;
tErrorList tFunctions (Directive tPosDir '$ENTRY') tOtherToken : eTokens =
<Program
/* Добавляет сообщение */
/* «позиция: unexpected token токен, expected function name» */
/* Позиция и значение неожиданного токена выбирается из tOtherToken */
<AddUnexpectedToken tErrorList tOtherToken 'function name'>
tFunctions tOtherToken : eTokens
>;
tErrorList tFunctions (Name tPos : eName) : eTokens =
<Program-Function
tFunctions eName tPos Local
<FunctionBody tErrorList : eTokens>
>;
tErrorList tFunctions (Directive tPos '$EXTERN') : eTokens =
<ExternList tErrorList tFunctions : eTokens>;
tErrorList tFunctions (EOF tPos '!') =
/* Корректное завершение */
(tErrorList <Reverse tFunctions>); /* REVERSE */
tErrorList tFunctions tOtherToken : eTokens =
<Program
<AddUnexpectedToken
tErrorList tOtherToken 'function definion or $EXTERN'
>
tFunctions : eTokens
>;
}
/*
ExternList = FunctionName "," ExternList | ";"
*/
ExternList {
tErrorList eFunctions (Name tPosName :eName) (Comma tPosComma ',') : eTokens =
<ExternList
tErrorList
((eName Extern tPosName NoBody) : eFunctions) : eTokens
>;
tErrorList eFunctions (Name tPosName :eName)(Semicolon tPos ';') : eTokens =
<Program tErrorList ((eName Extern tPosName NoBody) : eFunctions) : eTokens>;
/*тут ещё будет обработка ошибок (нет имени, нет запятой, внезапный EOF, нет точки с запятой)*/
}
FunctionBody {
tErrorList (OpenBlock tposOpenBlock '{') : eTokens =
<Pattern tErrorList () () () : eTokens >;
tErrorList token : eTokens =
<Pattern <AddExpectedCharacter tErrorList token 'open function body'> () () () token : eTokens >; /* ErrorList Sentences Stack Scanned :Terms */
}
/* ErrorList Sentences Stack Scanned :eTerms */
Pattern {
tErrorList sentences openBrackets eScanned (Name posName : eName) : eTokens =
<Pattern tErrorList sentences openBrackets ((Name posName : eName) :eScanned) : eTokens >;
tErrorList sentences openBrackets eScanned (Ref posRef '&') (Name posName : eName) : eTokens =
<Pattern tErrorList sentences openBrackets ((Func posName : eName) :eScanned) : eTokens >;
tErrorList sentences openBrackets eScanned (Char posChar : eChar) : eTokens =
<Pattern tErrorList sentences openBrackets ((Char posChar : eChar) : eScanned) : eTokens>;
tErrorList sentences openBrackets eScanned (Number posNumber : eNumber) : eTokens =
<Pattern tErrorList sentences openBrackets ((Number posNumber : eNumber) : eScanned) : eTokens>;
tErrorList sentences openBrackets eScanned (Variable posVariable : eVariable) : eTokens =
<Pattern tErrorList sentences openBrackets ((Variable posVariable : eVariable) : eScanned) : eTokens>;
tErrorList sentences openBrackets eScanned (Colon posCol : eCol) : eTokens =
<Pattern tErrorList sentences openBrackets ((Colon posCol : eCol) : eScanned) : eTokens>;
tErrorList sentences eOpenBrackets scanned (OpenBracket posBracket '(') : eTokens =
<Pattern tErrorList sentences (scanned : eOpenBrackets) (BRACKETS) : eTokens >;
tErrorList sentences (eScanned : eOpenBrackets) inBrackets (CloseBracket posBracket ')') : eTokens =
<Pattern tErrorList sentences eOpenBrackets (<ReverseCheckColon inBrackets> : eScanned) : eTokens >;
/* Если образец закончился, то есть мы встретили '=' и стек пуст: ()
значит начинаем разбирать результат */
tErrorList sentences () scanned (Assign posAssgn '=') : eTokens =
<Result tErrorList sentences <ReverseCheckColon scanned> () () : eTokens >; /* вызываем Result и ждем пока обработается результат, чтоб все это прикрепить к предложениям */
tErrorList eSentences () () (CloseBlock posCloseBlock '}') : eTokens =
<CompleteFunclion tErrorList eSentences : eTokens >;
}
Result {
tErrorList sentences pattern openBrackets eScanned (Name posName : eName) : eTokens =
<Result tErrorList sentences pattern openBrackets ((Name posName : eName) : eScanned) : eTokens>;
tErrorList sentences pattern openBrackets eScanned (Char posChar : eChar) : eTokens =
<Result tErrorList sentences pattern openBrackets ((Char posChar : eChar) : eScanned) : eTokens>;
tErrorList sentences pattern openBrackets eScanned (Number posNumber : eNumber) : eTokens =
<Result tErrorList sentences pattern openBrackets ((Number posNumber : eNumber) : eScanned) : eTokens>;
tErrorList sentences pattern openBrackets eScanned (Variable posVariable : eVariable) : eTokens =
<Result tErrorList sentences pattern openBrackets ((Variable posVariable : eVariable) : eScanned) : eTokens>;
tErrorList sentences pattern openBrackets eScanned (Colon posCol : eCol) : eTokens =
<Result tErrorList sentences pattern openBrackets ((Colon posCol : eCol) : eScanned) : eTokens>;
tErrorList sentences pattern eOpenBrackets scanned (OpenBracket posBracket '(') : eTokens =
<Result tErrorList sentences pattern (scanned : eOpenBrackets) (BRACKETS) : eTokens >;
tErrorList sentences pattern (eScanned : eOpenBrackets) inBrackets (CloseBracket posBracket ')') : eTokens =
<Result tErrorList sentences pattern eOpenBrackets (<ReverseCheckColon inBrackets> : eScanned) : eTokens >;
tErrorList sentences pattern eOpenBrackets scanned (OpenCall posBracket '<') : eTokens =
<Result tErrorList sentences pattern (scanned : eOpenBrackets) (CALL ) : eTokens >;
tErrorList sentences pattern (eScanned : eOpenBrackets) inBrackets (CloseCall posBracket '>') : eTokens =
<Result tErrorList sentences pattern eOpenBrackets (<ReverseCheckColon inBrackets> : eScanned) : eTokens >;
tErrorList eSentences pattern () scanned (Semicolon posSemicolon ';') : eTokens =
<Pattern tErrorList ((pattern <ReverseCheckColon scanned>) : eSentences) () () : eTokens >; /* ErrorList Sentences Stack Scanned :Terms */
}
CompleteFunclion {
tErrorList sentences : eTokens =
tErrorList <Reverse sentences> : eTokens;
}
ReverseCheckColon {
( term (Colon pos ':') :eTerms) =
<DoReverseCheck eTerms (LAST term)>;
terms = <DoReverseCheck terms (NIL)>;
/*tErrorList( term (Colon pos ':') :eTerms) =
<DoReverseCheck tErrorList eTerms (LAST term)>;
tErrorList terms = <DoReverseCheck tErrorList terms (NIL)>;*/
}
DoReverseCheck {
/* tErrorList ((Colon pos ':') : eTerms) reversed =
<DoReverseCheck
<AddUnexpectedToken tErrorList (Colon pos ':') 'colon'>
eTerms
reversed
>;*/
(term : eTerms) eReversed =
<DoReverseCheck eTerms (term : eReversed)>;
() reversed = reversed;
}
Reverse {
(term :eTerms) =
<DoReverse eTerms (term)>;
terms = <DoReverse terms ()>;
}
DoReverse {
(term : eTerms) eReversed =
<DoReverse eTerms (term : eReversed)>;
() reversed = reversed;
}
Program-Function {
eFunctions tName tPos sAccess
tErrorList tFunctionBody : eTokens =
<Program
tErrorList
((tName sAccess tPos tFunctionBody) : eFunctions) /* PUSH */
: eTokens
>;
}
AddUnexpectedToken {
((token : eMessage) : errorList) token : eMessage =
((token : eMessage) : errorList);
errorList token : eMessage =
((token : eMessage) : errorList);
}
AddExpectedCharacter {
errorList token : eMessage =
((token : eMessage) : errorList);
}
/*===================================== Semantic ======================================*/
Semantic {
myErorList tree =
<SemanticAnalysis myErorList tree tree>;
}
/* SemanticAnalysis(errorList 'tree to analyse' 'tree to compare') */
SemanticAnalysis {
myErorList ((functionName pos mode eFunctionBody) : eOtherFunctions) tree =
< SemanticAnalysis
<AnalyseFunction myErorList :eFunctionBody tree>
eOtherFunctions
tree
>;
myErorList (otherElem : eOtherFunctions) tree =
<SemanticAnalysis myErorList eOtherFunctions tree>;
myErrorList () tree =
(myErrorList tree);
}
AnalyseFunction {
myErorList (pattern result) :eOtherSentences tree =
<AnalyseFunction
<CheckVariable myErorList pattern result tree>
:eOtherSentences
tree
>;
myErorList atom :eOtherSentences tree =
<AnalyseFunction
myErorList
:eOtherSentences
tree
>;
myErorList tree = myErorList;
}
CheckVariable {
T myErrors :eOtherArgs =
<DoCheckVariable myErrors :eOtherArgs>;
myErrors :eOtherArgs =
<DoCheckVariable myErrors :eOtherArgs>;
}
/* CheckVariables(errorList pattern result tree) */
DoCheckVariable {
myErorList pattern ((Variable pos :eName) :eTali) tree =
<CheckVariable
<CheckPattern myErorList pattern (Variable pos :eName) tree>
pattern
eTali
tree
>;
myErorList pattern ((BRACKETS :eBody) :eTali) tree =
<CheckVariable
<CheckVariable myErorList pattern (BRACKETS :eBody) tree>
pattern
eTali
tree
>;
myErorList pattern ((CALL functionName :eBody) :eTali) tree =
<CheckVariable
<CheckVariable
<CheckFunction myErorList functionName tree>
pattern
(CALL :eBody)
tree
>
pattern
eTali
tree
>;
myErorList pattern (otherToken :eTali) tree =
<CheckVariable myErorList pattern eTali tree>;
myErorList pattern () tree =
myErorList;
}
/* CheckPattern(errorList pattern variable tree) */
CheckPattern {
T myErrorList:eOther =
T myErrorList;
myErorList ((Variable pos1 :eName) :eTali) (Variable pos2 :eName) tree
= T myErorList;
myErorList ((BRACKETS :eBody) :eTali) (Variable pos :eName) tree =
<CheckPattern
<CheckPatternInside myErorList eBody (Variable pos :eName) tree>
eTali
(Variable pos :eName)
tree
>;
myErorList (otherToken :eTali) (Variable pos :eName) tree =
<CheckPattern
myErorList
eTali
(Variable pos :eName)
tree
>;
myErorList () (Variable pos :eName) tree =
<AddUnexpectedToken myErorList (Variable pos :eName) 'undeclared variable in result on pos'>;
myErorList () (Variable pos :eName) tree =
myErorList;
}
CheckPatternInside {
T myErrorList :eOther =
T myErrorList;
myErorList ((Variable pos1 :eName) :eTali) (Variable pos2 :eName) tree
= T myErorList;
myErorList ((BRACKETS :eBody) :eTali) (Variable pos :eName) tree =
<CheckPattern
<CheckPatternInside myErorList eBody (Variable pos :eName) tree>
eTali
(Variable pos :eName)
tree
>;
myErorList (otherToken :eTali) (Variable pos :eName) tree =
<CheckPatternInside
myErorList
eTali
(Variable pos :eName)
tree
>;
myErorList () (Variable pos :eName) tree =
myErorList;
}
/* FunctionName (errorList (functionName) tree) */
CheckFunction {
myErorList functionName () =
<AddUnexpectedToken myErorList functionName 'undeclared function on pos'>;
myErorList (Name pos :eFname) (( eFname : eFunctionBody ) : eFunctions) =
myErorList;
myErorList functionName (term : eFunctions) =
<CheckFunction myErorList functionName eFunctions>;
}
/*======================================================================================*/
/*===================================== GenereateCode =====================================*/
GenereateCode {
() tree =
<AnalyseTree tree>;
myErrors tree =
/*<AnalyseTree tree>;*/
<PrintErrors myErrors>;
}
AnalyseTree {
((fName :eBody) : eOtherFunctions) =
(<GenerateFunction (fName :eBody)> : <AnalyseTree eOtherFunctions>);
(Atom : eOtherFunctions) =
<AnalyseTree eOtherFunctions>;
() = ();
}
GenerateFunction {
(eName Local pos body) =
(<Prout 'Fn' : eName '{'> <GenerateBody body> <Prout '}'> );
(eName Extern pos body) =
(<Prout '$EXTERN Fn' : eName ';'>);
(eName Entry pos body) =
(<Prout '$ENTRY Fn' : eName '{'> <GenerateBody body> <Prout '}'> );
}
Begin {
first next : elast = <Begin next : elast>;
last_term = last_term;
}
GenerateBody {
((pattern result) : eBodyTail) =
<Begin
/* <Prout pattern result>*/
<Prout :
<Concat
<PrintSentence-New <PrepareConsTree-Pat pattern>>
(' = ')
<PrintSentence-New <PrepareConsTree-Res result>>
(';')
>
>
<GenerateBody eBodyTail>
>;
() = ();
}
PrepareConsTree-Pat {
(LAST term) = <PrepareConsTree term>;
(head LAST tail) = (Cons <PrepareConsTree head> <PrepareConsTree tail>);
(NIL) = NIL;
(head : etail) = (Cons <PrepareConsTree head> <PrepareConsTree (BRACKETS : etail)>);
}
PrepareConsTree-Res {
(result NIL) = <PrepareConsTree result>;
(NIL) = NIL;
}
/*
<PrepareConsTree ?>
== tree
tree ::= (Cons tree1 tree2) | (Var : name) | (Char char) |
(Number num) | (Name : name) | (Func : ename) | NIL |
(CallCons name arg)
*/
PrepareConsTree {
(BRACKETS head LAST tail) =
(Cons <PrepareConsTree head> <PrepareConsTree tail>);
(BRACKETS head NIL) =
(Cons <PrepareConsTree head> NIL);
(BRACKETS NIL) = NIL;
(BRACKETS head : etail) =
(Cons <PrepareConsTree head> <PrepareConsTree (BRACKETS : etail)>);
(CALL (Name npos : ename) LAST tail) =
(CallCons ename <PrepareConsTree tail>);
(CALL (Name npos : ename) NIL) =
(CallCons ename NIL);
(CALL (Name npos : ename) head : etail) =
(CallCons ename <PrepareConsTree (BRACKETS head : etail)>);
(Variable pos 't' ename) = (Var : ename);
(Char pos char) = (Char char);
(Number pos number) = (Number number);
(Func pos : ename) = (Func : ename);
(Name pos : ename) = (Name : ename);
x = (Error x);
}
PrintSentence-New {
NIL = ('()');
(Cons t1 t2) = <Concat ('(') <PrintSentence-New t1> <PrintSentence-New t2> (')')>;
(CallCons ename arg) =
<Concat ('<Fn' : ename) <PrintSentence-New arg> ('>')>;
(Char char) = ('\'' char '\' ');
(Number number) = (number);
(Func : ename) = <Concat ('Fn' : ename) (' ')>;
(Name : ename) = <Concat ('Id' : ename) (' ')>;
(Var : ename) = <Concat ('t.' : ename) (' ')>;
x = x;
}
Concat {
= ();
(first : elast) : expected = (first : <Concat elast : expected>);
() : expected = <Concat : expected>;
}
PrintErrors {
() = <Prout 'No errors \n'>;
aEerror : eErrors= <Begin (<Prout aEerror '\n'><PrintErrors :eErrors >)>;
= ;
}
/*==========================================================================*/