Кожура.bsl

Var Map, Src, Pos, Len, Chr;
Var Scope;

Procedure Init()
	Var Abc, Num; Map = New Map; EOF = "";
	Abc = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ=+-*/<>%"+
	"абвгдеёжзийклмнопрстуфхцчшщъыьэюяАБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ";
	For Num = 1 To StrLen(Abc) Do Map[Mid(Abc, Num, 1)] = "Alpha" EndDo;
	For Num = 0 To 9 Do Map[String(Num)] = "Digit" EndDo;
	Src = Source; Len = StrLen(Src); Pos = 0; Read();
EndProcedure // Init()

Function Read()
	Pos = Pos + 1; Chr = Mid(Src, Pos, 1); Return Chr;
EndFunction // Read()

Procedure Next(Tok, Lit)
	Var Beg;
	While IsBlankString(Chr) And Chr <> "" Do Read() EndDo;
	Tok = Map[Chr];
	If Tok = "Alpha" Then
		Beg = Pos; While Map[Read()] <> Undefined Do EndDo;
		Lit = Mid(Src, Beg, Pos - Beg); Tok = "Symbol";
	ElsIf Tok = "Digit" Then
		Beg = Pos; While Map[Read()] = "Digit" Do EndDo;
		If Chr = "." Then While Map[Read()] = "Digit" Do EndDo EndIf;
		Lit = Mid(Src, Beg, Pos - Beg); Tok = "Number";
	ElsIf Chr = "'" Then
		Beg = Pos + 1; While Read() <> "'" And Chr <> "" Do EndDo;
		Lit = Mid(Src, Beg, Pos - Beg); Tok = "String"; Read();
	ElsIf Chr = "(" Or Chr = ")" Or Chr = "" Then
		Tok = Chr; Read();
	Else
		Raise "unknown char";
	EndIf;
EndProcedure // Next()

Function List(Type, Data, Next)
	Return New FixedStructure("Type, Data, Next", Type, Data, Next);
EndFunction // List()

Function Parse(IsList = False)
	Var Tok, Lit; Next(Tok, Lit);
	If Tok = "(" Then Return List("List", Parse(True), Parse(IsList))
	ElsIf Tok = ")" Then If Not IsList Then Raise "unexpected `)`" EndIf	
	ElsIf Tok = "" Then If IsList Then Raise "expected `)`" EndIf
	Else Return List(Tok, Lit, Parse(IsList)) EndIf;
	Return Undefined;
EndFunction // Parse()

Function OpenScope()
	Scope = New Structure("Outer, Items", Scope, New Map);
EndFunction // OpenScope()

Function CloseScope()
	Scope = Scope.Outer;
EndFunction // CloseScope()

Function Item(Name, Val Scope)
	Var Item;
	Item = Scope.Items[Name];
	While Item = Undefined And Scope.Outer <> Undefined Do
		Scope = Scope.Outer;
		Item = Scope.Items[Name];
	EndDo;
	If Item = Undefined Then
		Raise StrTemplate("unknown atom %1", Name);
	EndIf;
	Return Item;
EndFunction // Item()

Function Calc(List)
	Var Type, Data;
	Type = List.Type; Data = List.Data; 
	If Type = "Symbol" Then
		If Data = "let" Then
			Head = List.Next;
			Scope.Items[Head.Data] = Head.Next;
		ElsIf Data = "+" Then
			Return Calc(List.Next) + Calc(List.Next.Next);
		ElsIf Data = "-" Then
			Return Calc(List.Next) - Calc(List.Next.Next);
		ElsIf Data = "*" Then
			Return Calc(List.Next) * Calc(List.Next.Next);
		ElsIf Data = "/" Then
			Return Calc(List.Next) / Calc(List.Next.Next);
		ElsIf Data = "%" Then
			Return Calc(List.Next) % Calc(List.Next.Next);
		Else
			Func = Item(List.Data, Scope);
			If TypeOf(Func) = Type("FixedStructure") Then
				OpenScope();
				Args = List.Next;
				Pars = Func.Data;
				While Pars <> Undefined Do
					If Args = Undefined Then
						Raise "Error";
					EndIf; 
					Scope.Items[Pars.Data] = Calc(Args);
					Pars = Pars.Next;
					Args = Args.Next;
				EndDo; 
				Body = Func.Next.Data;
				Res = Calc(Body);
				CloseScope();
				Return Res;
			Else
				Return Func;
			EndIf; 
		EndIf;
	ElsIf Type = "Number" Then
		Return Number(Data);
	ElsIf Type = "String" Then
		Return Data;
	Else // List
		Return Calc(Data);	
	EndIf;
EndFunction

Function Run()
	List = Parse();
	OpenScope();
	While List <> Undefined Do
		Value = Calc(List.Data);
		If Value <> Undefined Then
			Message(Value);
		EndIf; 
		List = List.Next;
	EndDo;
	CloseScope();
EndFunction

Procedure CommandAtServer()
	Init();
	Run()	
EndProcedure 

&AtClient
Procedure Command1(Command)
	CommandAtServer();	
EndProcedure

&AtServer
Procedure OnCreateAtServer(Cancel, StandardProcessing)
	Source =
	"(let fun1 (x y) (+ x y))
	|(let fun2 (x y) (* x y))
	|(- (fun1 3 2) (fun2 (fun1 1 1) 2))";
EndProcedure