исправлен баг сохранения полей данных

Src/JSon/Mod/Formatter.cp

@@ -1,514 +1,254 @@
 MODULE JSonFormatter;
-
-	
-
 (**
-
 	project	= "JSon"
-
 	organization	= ""
-
 	contributors	= ""
-
 	version	= "System/Rsrc/About"
-
 	copyright	= "Kushnir Piotr Michailovich"
-
 	license	= "Docu/BB-License"
-
 	purpose	= "генерация json вручную, этот способ полезен тем, кто не использует YSonModels, по каким-то причинам"
-
 	changes	= "
-
 	- 20130112, pk, автогенерация заголовка
-
 	- 20150204, pk, порт для fw
-
 "
-
 	issues	= ""
-
 **)
 
-	
-
 	IMPORT
-
 		JSonGenerator,
-
 		Str, Out;
 
-	
-
 	CONST
-
 		objBegin* = 1;
-
 		objEnd* = 2;
-
 		arrBegin* = 3;
-
 		arrEnd* = 4;
-
 		name = 5;
-
 		value = 6;
 
-		
-
 		stringVal* = 1;
-
 		unicodeStringVal* = 10;
-
 		intVal* = 2;
-
 		realVal* =3;
-
 		atomVal*= 4;
 
-		
-
 		errWrongSym* = -1;
-
 		errUnexpected* = -2;
 
-		
-
 	TYPE
-
 		Formatter* = POINTER TO ABSTRACT RECORD END;
-
-		
-
 		Directory* = POINTER TO ABSTRACT RECORD END;
 
-		
-
 		StdDir = POINTER TO RECORD (Directory) END;
-
-		
-
 		StdF = POINTER TO RECORD (Formatter) 
-
 			wr: JSonGenerator.Writer;
-
 			this: StackItem;
-
 		END;
 
-		
-
 		StackItem = POINTER TO RECORD
-
 			depth: INTEGER;
-
 			expect: SET;
-
 			values: LONGINT;
-
 			next: StackItem;
-
 		END;
 
-		
-
 	VAR 
-
 		dir-, prev-, stdDir-: Directory;
 
-		
-
 	PROCEDURE (d: Directory) New* (wr: JSonGenerator.Writer): Formatter, NEW, ABSTRACT;
-
-	
-
 	PROCEDURE (f: Formatter) ConnectTo- (wr: JSonGenerator.Writer), NEW, ABSTRACT;
-
 	PROCEDURE (f: Formatter) WriteSym* (sym: INTEGER; OUT res: INTEGER), NEW, ABSTRACT;
-
 	PROCEDURE (f: Formatter) WriteName* (IN s: ARRAY OF CHAR; OUT res: INTEGER), NEW, ABSTRACT;
-
 	PROCEDURE (f: Formatter) WriteValue* (type: INTEGER; IN val: ARRAY OF CHAR; OUT res: INTEGER), NEW, ABSTRACT;
 
-	
-
 	PROCEDURE NewStackItem(): StackItem;
-
 		VAR s: StackItem;
-
 	BEGIN
-
 		NEW(s);
-
 		s.depth:=1;
-
 		s.expect:={};
-
 		s.values:=0;
-
 	RETURN s;
-
 	END NewStackItem;
 
-	
-
 	PROCEDURE Push(VAR root: StackItem);
-
 		VAR new: StackItem;
-
 	BEGIN
-
 		new:=NewStackItem();
-
 		new.next:=root;
-
 		root:=new;
-
 		IF root.next#NIL THEN root.depth:=root.next.depth+1 END
-
 	END Push;
-
 	
-
 	PROCEDURE Pop(VAR root: StackItem);
-
 		VAR old: StackItem;
-
 	BEGIN
-
 		IF root#NIL THEN
-
 			old:=root;
-
 			root:=old.next;
-
 			old:=NIL;
-
 		END;
-
 	END Pop;
-
 	
-
 	PROCEDURE (f: StdF) ConnectTo (wr: JSonGenerator.Writer);
-
 	BEGIN
-
 		ASSERT(wr#NIL, 20); ASSERT(wr.Base()#NIL, 21);
-
 		f.wr:=wr;
-
 		f.this:=NIL;
-
 	END ConnectTo;
 
-	
-
 	PROCEDURE String (wr: JSonGenerator.Writer; IN s: ARRAY OF CHAR);
-
 		VAR i: INTEGER;
-
 	BEGIN
-
 		i:=0;
-
 		WHILE i<LEN(s$) DO
-
 			CASE s[i] OF
-
 				'"': wr.Char('\'); wr.Char('"');
-
 				|'\': wr.Char('\'); wr.Char('\');
-
 				|09X: wr.Char('\'); wr.Char('t');
-
 				|0DX: wr.Char('\'); wr.Char('r');
-
 				|0AX: wr.Char('\'); wr.Char('n');
-
 				|0CX: wr.Char('\'); wr.Char('f');
-
 				|08X: wr.Char('\'); wr.Char('b');
-
 			ELSE wr.Char(s[i]) END;
-
 			INC(i)
-
 		END;
-
 	END String;
 
-	
-
 	PROCEDURE UniString (wr: JSonGenerator.Writer; IN s: ARRAY OF CHAR);
-
 		VAR i: INTEGER;
-
 	BEGIN
-
 		i:=0;
-
 		WHILE i<LEN(s$) DO
-
 			CASE s[i] OF
-
 				'"': wr.Char('\'); wr.Char('"');
-
 				|'\': wr.Char('\'); wr.Char('\');
-
 				|09X: wr.Char('\'); wr.Char('t');
-
 				|0DX: wr.Char('\'); wr.Char('r');
-
 				|0AX: wr.Char('\'); wr.Char('n');
-
 				|0CX: wr.Char('\'); wr.Char('f');
-
 				|08X: wr.Char('\'); wr.Char('b');
-
 			ELSE wr.UnicodeChar(s[i]) END;
-
 			INC(i)
-
 		END;
-
 	END UniString;
 
-	
-
 	PROCEDURE (f: StdF) WriteName (IN s: ARRAY OF CHAR; OUT res: INTEGER);
-
 		VAR i: INTEGER;
-
 	BEGIN
-
 		ASSERT(s$#'', 20);
-
 		res:=0;
-
 		IF (f.this#NIL) & (name IN f.this.expect) THEN
-
 			IF (objEnd IN f.this.expect) THEN 
-
 				IF f.this.values > 0 THEN 
-
 					f.wr.Char(','); 
-
 					f.wr.Whitespace(0DX);
-
 				END;
-
 				FOR i:=1 TO f.this.depth DO f.wr.Whitespace(09X) END;
-
 			END;
-
 			f.wr.Char('"'); String(f.wr, s); f.wr.Char('"'); f.wr.Char(':'); f.wr.Whitespace(' '); f.this.expect:={value, arrBegin, objBegin};
-
 			INC(f.this.values);
-
 		ELSE
-
 			res:=errUnexpected
-
 		END;
-
 	END WriteName;
 
-	
-
 	PROCEDURE (f: StdF) WriteValue (type: INTEGER; IN v: ARRAY OF CHAR; OUT res: INTEGER);
-
 		VAR i: INTEGER; vs: ARRAY 20 OF CHAR;
-
 	BEGIN
-
 		ASSERT(type IN {stringVal, atomVal, intVal, realVal, unicodeStringVal}, 20);
-
 		ASSERT((type IN {stringVal, unicodeStringVal}) OR (v$#''), 21); 
-
 		res:=0;
-
 		IF (f.this#NIL) & (value IN f.this.expect) THEN
-
 			IF (arrEnd IN f.this.expect) THEN
-
 				IF f.this.values > 0 THEN 
-
 					f.wr.Char(','); 
-
 					f.wr.Whitespace(0DX);
-
 				END;
-
 				FOR i:=1 TO f.this.depth DO f.wr.Whitespace(09X) END;
-
 			END;
-
 			CASE type OF
-
 				stringVal: f.wr.Char('"'); String(f.wr, v); f.wr.Char('"');
-
 				|unicodeStringVal: f.wr.Char('"'); UniString(f.wr, v); f.wr.Char('"');
-
 				|intVal, realVal: String(f.wr, v);
-
 				|atomVal: Str.ToLower(v, vs); String(f.wr, vs); (* null, true, false точно поместятся в 20 символов *)
-
 			ELSE HALT(100) END;	
-
 			INC(f.this.values);
-
 			IF ~(arrEnd IN f.this.expect) THEN f.this.expect:={objEnd, name} END;
-
 		ELSE
-
 			res:=errUnexpected
-
 		END;
-
 	END WriteValue;
 
-	
-
 	PROCEDURE (f: StdF) WriteSym (sym: INTEGER; OUT res: INTEGER);
-
 		VAR expect: SET; i: INTEGER;
-
 	BEGIN
-
 		res:=0;
-
 		IF f.this#NIL THEN expect:=f.this.expect ELSE expect:={objBegin, arrBegin} END;
 		IF (sym IN expect) THEN
-
 			CASE sym OF
-
 				objBegin: 
-
 					IF (f.this#NIL) THEN
-
 						IF ~(arrEnd IN f.this.expect) THEN 
-
-							f.this.expect:={objEnd, name} 
-
+						f.this.expect:={objEnd, name} 
 						ELSE
-
 							IF f.this.values > 0 THEN 
-
 								f.wr.Char(','); 
-
 								f.wr.Whitespace(0DX);
-
 							END;
-
 							FOR i:=1 TO f.this.depth DO f.wr.Whitespace(09X) END;
-
 						END;
-
 					END;
-
 					Push(f.this); f.wr.Char('{'); f.wr.Whitespace(0DX); f.this.expect:={objEnd, name}
-
 				|arrBegin: 
-
 					IF (f.this#NIL) THEN
-
 						IF ~(arrEnd IN f.this.expect) THEN f.this.expect:={objEnd, name} 
-
 						ELSE
-
 							IF f.this.values > 0 THEN 
-
 								f.wr.Char(','); 
-
 								f.wr.Whitespace(0DX);
-
 							END;
-
 							FOR i:=1 TO f.this.depth DO f.wr.Whitespace(09X) END;
-
 						END;
-
 					END;
-
 					Push(f.this); f.wr.Char('['); f.wr.Whitespace(0DX); f.this.expect:={arrEnd, objBegin, arrBegin, value}
-
 				|objEnd: 
-
 					f.wr.Whitespace(0DX); FOR i:=1 TO f.this.depth-1 DO f.wr.Whitespace(09X) END;
-
 					f.wr.Char('}'); Pop(f.this);
-
 				|arrEnd: 
-
 					f.wr.Whitespace(0DX); FOR i:=1 TO f.this.depth-1 DO f.wr.Whitespace(09X) END; 
-
 					f.wr.Char(']'); Pop(f.this)
-
 			ELSE HALT(101) END;
-
 		ELSE
-
 			res:=errWrongSym;
-
 			HALT(100);
-
 		END;
-
 	END WriteSym;
 
-	
-
 	PROCEDURE (d: StdDir) New (wr: JSonGenerator.Writer): Formatter;
-
 		VAR f: StdF;
-
 	BEGIN
-
 		ASSERT(wr#NIL, 20); ASSERT(wr.Base()#NIL, 21);
-
 		NEW(f);
-
 		f.ConnectTo(wr);
-
 	RETURN f
-
 	END New;
 
-	
-
 	PROCEDURE Install* (d: Directory);
-
 	BEGIN
-
 		ASSERT(d#NIL, 20);
-
 		prev:=dir;
-
 		dir:=d;
-
 	END Install;
-
 	
-
 	PROCEDURE Init;
-
 		VAR d: StdDir;
-
 	BEGIN
-
 		NEW(d);
-
 		Install(d);
-
 		stdDir:=d;
-
 	END Init;
-
 	
-
 BEGIN
-
 	Init
-
 END JSonFormatter.

Src/JSon/Mod/ObxNoModel.cp

@@ -1,153 +1,159 @@
 MODULE JSonObxNoModel;
 
 (**
-
 	project	= "YSon"
-
 	organization	= ""
-
 	contributors	= ""
-
 	version	= "System/Rsrc/About"
-
 	copyright	= "Kushnir Piotr Michailovich"
-
 	license	= "Docu/BB-License"
-
 	purpose	= "демонстрация работы форматтера  без использования динамических моделей данных"
-
 	changes	= "
-
 	- 20130527, pk, автогенерация заголовка, документирование
-
 	- 20150204, pk, порт для fw
-
 "
-
 	issues	= ""
-
 **)
 
-
-
-
-
 	IMPORT 
-
-		Gen:=JSonGenerator, F:=JSonFormatter,
-
-		Out;
-
-	
+		Gen:=JSonGenerator, F:=JSonFormatter, P:=JSonParser,
+		Str, Out;
 
 	TYPE
-
 		Wr = POINTER TO RECORD (Gen.Writer) END; (* дефолтный вывод - в лог *)
-
 		
-
+		Reader = POINTER TO RECORD (P.Reader) 
+			base: Str.Dyn;
+			pos: INTEGER;
+		END;
+		
+		StdTarget = POINTER TO RECORD (P.Target) 
+			(* res, root, this: YSonModels.Value; *)
+			name: ARRAY 256 OF CHAR;
+		END;
+	
+	PROCEDURE (t: StdTarget) Result(): ANYPTR;
+	BEGIN
+		RETURN NIL
+	END Result;
+	
+	PROCEDURE (t: StdTarget) LevelDown (id, type: INTEGER);
+	BEGIN
+		Out.String("down"); Out.Int(id); Out.Int(type); Out.Ln;
+	END LevelDown;
+	
+	PROCEDURE (t: StdTarget) NextName (IN s: ARRAY OF CHAR);
+	BEGIN
+		t.name:=s$;
+		Out.String("name:"); Out.String(s); Out.Ln;
+	END NextName;
+	
+	PROCEDURE (t: StdTarget) LevelUp;
+	BEGIN
+		Out.String("up"); Out.Ln;
+	END LevelUp;
+	
+	PROCEDURE (t: StdTarget) ThisValue (IN x: ARRAY OF CHAR; quoted: BOOLEAN);
+	BEGIN
+		Out.String("value:"); Out.String(x); Out.Bool(quoted); Out.Ln;
+	END ThisValue;
+		
+	PROCEDURE (r: Reader) Read (OUT ch: CHAR): BOOLEAN;
+		VAR ok: BOOLEAN;
+	BEGIN
+		ASSERT(r.Base()#NIL, 20); 
+		ok:=~r.Eot();
+		IF ok THEN ch:=r.base.Char(r.pos); INC(r.pos);END;
+	RETURN ok  
+	END Read;
+	
+	PROCEDURE (r: Reader) SetPos (x: INTEGER);
+	BEGIN
+		r.pos:=x;
+	END SetPos;
+	
+	PROCEDURE (r: Reader) Pos (): INTEGER;
+	BEGIN
+	RETURN r.pos
+	END Pos;
+	
+	PROCEDURE (r: Reader) ConnectTo (source: ANYPTR);
+	BEGIN
+		ASSERT(source#NIL, 20); 
+		WITH source: Str.Dyn DO
+			r.base:=source; r.pos:=0;
+		ELSE HALT(100) END;
+	END ConnectTo;
+	
+	PROCEDURE (r: Reader) Base (): ANYPTR;
+	BEGIN
+	RETURN r.base
+	END Base;
+	
+	PROCEDURE (r: Reader) Eot(): BOOLEAN;
+	BEGIN
+	RETURN ~(r.pos<r.base.Len());
+	END Eot;
+		
 	PROCEDURE (w: Wr) Char (c: CHAR);
-
 	BEGIN
-
 		Out.Char(c);
-
 	END Char;
 
-	
-
 	PROCEDURE (w: Wr) Whitespace (s: ARRAY OF CHAR);
-
 	BEGIN
-
 		CASE s[0] OF
-
 		09X: Out.Tab;
-
 		|0DX, 0AX: Out.Ln;
-
 		|' ': Out.Char(' ');
-
 		ELSE Out.String(s$) END
-
 	END Whitespace;
 
-
-
 	(* формирование структуры JSON непосредственно при выполнении комманд форматтера *)
-
 	PROCEDURE Do*;
-
 		TYPE Base = POINTER TO RECORD END;
-
 		VAR b: Base; wr: Wr; f: F.Formatter; res: INTEGER;
-
 	BEGIN
-
 		Out.Ln;
-
 		NEW(wr); 
-
 		NEW(b);
-
 		wr.SetBase(b);
-
 		f:=F.dir.New(wr);
-
 (* демонстрация пошагового результата *)
-
 		f.WriteSym(F.arrBegin, res);	(* [ *)
-
 		f.WriteSym(F.objBegin, res);		(* { *)
-
 		f.WriteName('obj', res);			(* "obj" *)
-
 		f.WriteSym(F.objBegin, res);			(* { *)
-
 		f.WriteSym(F.objEnd, res);			(* } *)
-
 		f.WriteName('arr', res);			(* "arr" *)
-
 		f.WriteSym(F.arrBegin, res);				(* [ *)
-
 		f.WriteValue(F.atomVal, 'true', res);					(* true *)
-
 		f.WriteValue(F.atomVal, 'true', res);					(* true *)
-
 		f.WriteValue(F.atomVal, 'true', res);					(* true *)
-
 		f.WriteSym(F.objBegin, res);					(* { *)
-
 		f.WriteSym(F.objEnd, res);					(* } *)
-
 		f.WriteSym(F.arrBegin, res);					(* [ *)
-
 		f.WriteSym(F.arrEnd, res);					(* ] *)
-
 		f.WriteSym(F.arrEnd, res);				(* ] *)
-
 		f.WriteName('sss', res);			(* "sss" *)
-
 		f.WriteValue(F.atomVal, 'true', res);			(* true *)
-
 		f.WriteName('sss1', res);			(* "sss1" *)
-
 		f.WriteValue(F.stringVal, 'hello, world!', res);			(* "hello, world!" *)
-
 		f.WriteSym(F.objEnd, res);		(* } *)
-
 		f.WriteSym(F.arrEnd, res);	(* ] *)
-
 	END Do;
-
 	
-
+	PROCEDURE Do2*;
+		VAR source: Str.Dyn; rd: Reader; p: P.Parser; x: ANYPTR; res: INTEGER; t: StdTarget;
+	BEGIN
+		source:=Str.NewFrom('{"hello":"world"}');
+		NEW(rd); rd.ConnectTo(source);
+		NEW(t);
+		p:=P.dir.New(rd);
+		p.SetTarget(t);
+		x:=p.Parse(res);
+	END Do2;
+	
 BEGIN
-
-
-
 END JSonObxNoModel.
-
-
-
 (*JediPlain*gvFEZXZDb21tYW5kZXJzLlN0ZFZpZXdEZXNjAPFEZXZDb21tYW5kZXJzLlZpZXdEZXNjAPFWaWV3cy5WaWV3RGVzYwDwU3RvcmVzLlN0b3JlRGVzYwAAAAAAAAAAAAAAAAAGAAAAAAAAFQAA*)YSonObxNoModel.Do

Src/JSon/Mod/Parser.cp

@@ -0,0 +1,459 @@
+MODULE JSonParser;
+
+(**
+	project	= "JSon"
+	organization	= ""
+	contributors	= ""
+	version	= "System/Rsrc/About"
+	copyright	= "Kushnir Piotr Michailovich"
+	license	= "Docu/BB-License"
+	purpose	= "Парсер"
+	changes	= "
+	- 20130103, pk, автогенерация заголовка
+	- 20130103, pk, реализовал парсинг структур пока без вложенности и обработки ошибок
+	- 20130109, pk, переделал сканер с учётом экранирования символов и вайтспейсов
+	-20130112, pk, поправил баг с неочищаемым буфером
+	- 20120117, pk, добавил дополнительный разбор на целые и вещественные числа в StdTarget, добавил пошаговый парсинг для источников, пополняющихся постепенно
+	- 20130718, pk, убрал зависимость от ypk
+	- 20140109, pk, пофиксил парсинг спецсимволов
+	- 20140117, pk, исправил обработку пустых строковых полей
+	- 20140301, pk, модифицировал типы переменных в Target, ведь Holder теперь скрыт
+	- 20150209, pk, портирование для fw
+"
+	issues	= ""
+**)
+	
+	IMPORT 
+		Out, Str;
+	
+	CONST
+		eot* = 1;
+		err* = 2;
+		continue* = 0;
+		
+		none = 0;
+		objBegin = 1;
+		objEnd = 2;
+		arrBegin = 3;
+		arrEnd = 4;
+		valueSep = 5;
+		nameSep = 6;
+		
+		obj* = 1;
+		arr* = 2;
+		
+	TYPE
+		Reader* = POINTER TO ABSTRACT RECORD END;
+		
+		Parser* = POINTER TO ABSTRACT RECORD END;
+		
+		Target* = POINTER TO ABSTRACT RECORD END;
+		
+		Directory* = POINTER TO ABSTRACT RECORD END;
+		
+		StdDir = POINTER TO RECORD (Directory) END;
+		
+		StdParser = POINTER TO RECORD (Parser) 
+			sc: Scanner;
+			root: StackItem;
+			t: Target;
+		END;
+		
+		(* StdTarget = POINTER TO RECORD (Target) 
+			res, root, this: YSonModels.Value;
+			name: ARRAY 256 OF CHAR;
+		END; *)
+		
+		StackItem = POINTER TO RECORD
+			pos, type: INTEGER;
+			next: StackItem;
+		END;
+		
+		Scanner = RECORD
+			rd: Reader;
+			res: INTEGER;
+			this: RECORD
+				inQuotes: BOOLEAN;
+				buf: Buffer;
+				sym: INTEGER;
+			END;
+		END;
+		
+		Buffer = RECORD
+			empty: BOOLEAN;
+			quoted: BOOLEAN;
+			x: Str.Dyn;
+		END;
+		
+		Char = RECORD
+			x: CHAR;
+			esc: BOOLEAN;
+		END;
+		
+	VAR
+		dir-, prev-, stdDir-: Directory;
+
+	PROCEDURE (r: Reader) Read- (OUT ch: CHAR): BOOLEAN, NEW, ABSTRACT;
+	PROCEDURE (r: Reader) SetPos- (x: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (r: Reader) Pos* (): INTEGER, NEW, ABSTRACT;
+	PROCEDURE (r: Reader) ConnectTo* (source: ANYPTR), NEW, ABSTRACT;
+	PROCEDURE (r: Reader) Base* (): ANYPTR, NEW, ABSTRACT;
+	PROCEDURE (r: Reader) Eot*(): BOOLEAN, NEW, ABSTRACT;
+	
+	PROCEDURE (d: Directory) New* (rd: Reader): Parser, NEW, ABSTRACT;
+	
+	PROCEDURE (p: Parser) Parse*(OUT res: INTEGER): ANYPTR, NEW, ABSTRACT;
+	PROCEDURE (p: Parser) SetTarget* (t: Target), NEW, EMPTY;
+	PROCEDURE (p: Parser) Result*(): ANYPTR, NEW, ABSTRACT;
+	PROCEDURE (p: Parser) Begin*, NEW, ABSTRACT;	
+	PROCEDURE (p: Parser) Step* (OUT res: INTEGER), NEW, ABSTRACT;
+	
+	PROCEDURE (t: Target) LevelDown* (id, type: INTEGER), NEW, ABSTRACT;
+	PROCEDURE (t: Target) NextName* (IN s: ARRAY OF CHAR), NEW, ABSTRACT;
+	PROCEDURE (t: Target) LevelUp*, NEW, ABSTRACT;
+	PROCEDURE (t: Target) ThisValue* (IN x: ARRAY OF CHAR; quoted: BOOLEAN), NEW, ABSTRACT;
+	PROCEDURE (t: Target) Result- (): ANYPTR, NEW, ABSTRACT;
+	
+(*	PROCEDURE (t: StdTarget) Result(): ANYPTR;
+	BEGIN
+		RETURN t.res
+	END Result;
+	
+	PROCEDURE (t: StdTarget) LevelDown (id, type: INTEGER);
+		VAR new, root: YSonModels.Value;
+	BEGIN
+		CASE type OF 
+			obj: new:=YSonModels.NewObject();
+			|arr: new:=YSonModels.NewArray(0);
+		ELSE HALT(100) END;
+		ASSERT(new#NIL, 40);
+		IF t.res=NIL THEN
+			t.res:=new;
+			t.root:=NIL;
+			t.this:=new;
+		ELSE
+			root:=t.this;
+			WITH root: YSonModels.Array DO
+				root.SetLength(root.NofVal()+1);
+				root.Set(root.NofVal()-1, new);
+			|root: YSonModels.Object DO
+				ASSERT(t.name$#'', 41);
+				root.Add(t.name$, new);
+			ELSE HALT(100) END;
+			t.root:=t.this;
+			t.this:=new;
+		END;
+	END LevelDown;
+	
+	PROCEDURE (t: StdTarget) NextName (IN s: ARRAY OF CHAR);
+	BEGIN
+		t.name:=s$;
+	END NextName;
+	
+	PROCEDURE (t: StdTarget) LevelUp;
+	BEGIN
+		t.this:=t.root;
+		IF t.this#NIL THEN
+			t.root:=t.this.Owner();
+		END;
+	END LevelUp;
+	
+	PROCEDURE (t: StdTarget) ThisValue (IN x: ARRAY OF CHAR; quoted: BOOLEAN);
+		CONST decimal = '.';
+		VAR root: YSonModels.Value; v: YSonModels.Value; r: REAL; res: INTEGER;
+	BEGIN
+		root:=t.this;
+		ASSERT(root#NIL, 20);
+		IF quoted THEN
+			v:=YSonModels.NewString(x$)
+		ELSE
+			IF (x$='true') THEN v:=YSonModels.NewLiteral(YSonModels.true)
+			ELSIF (x$='false') THEN v:=YSonModels.NewLiteral(YSonModels.false)
+			ELSIF (x$='null') THEN v:=YSonModels.NewLiteral(YSonModels.null)
+			ELSIF (x$#'') THEN
+				Str.StringToReal(x$, r, res);
+				IF res=0 THEN
+					Str.Find(x$, decimal, 0, res);
+					IF res>-1 THEN
+						v:=YSonModels.NewNumber(YSonModels.real, r)
+					ELSE 
+						v:=YSonModels.NewNumber(YSonModels.int, r)
+					END;
+				ELSE HALT(100) END;
+			ELSE HALT(100) END
+		END;
+		WITH root: YSonModels.Array DO
+			root.SetLength(root.NofVal()+1);
+			root.Set(root.NofVal()-1, v);
+		|root: YSonModels.Object DO
+			ASSERT(t.name$#'', 40);
+			root.Add(t.name$, v);
+		ELSE HALT(100) END;
+	END ThisValue;
+	*)
+	PROCEDURE NewStackItem(pos: INTEGER): StackItem;
+		VAR s: StackItem;
+	BEGIN
+		NEW(s);
+		s.pos:=pos;
+	RETURN s;
+	END NewStackItem;
+	
+	PROCEDURE Push(root: StackItem; pos, type: INTEGER);
+		VAR new: StackItem;
+	BEGIN
+		new:=NewStackItem(pos); new.type:=type;
+		new.next:=root.next;
+		root.next:=new;
+	END Push;
+	
+	PROCEDURE Pop(root: StackItem): StackItem;
+		VAR old: StackItem;
+	BEGIN
+		IF root.next#NIL THEN
+			old:=root.next;
+			root.next:=old.next;
+			old.next:=NIL;
+		END;
+	RETURN old;
+	END Pop;
+	
+	PROCEDURE (VAR sc: Scanner) ConnectTo (rd: Reader), NEW;
+	BEGIN
+		ASSERT(rd#NIL, 20); ASSERT(rd.Base()#NIL, 21); ASSERT(~rd.Eot(), 22);
+		sc.rd:=rd;
+	END ConnectTo;
+	
+	PROCEDURE (VAR sc: Scanner) Init, NEW;
+	BEGIN
+		sc.res:=continue;
+		sc.this.inQuotes:=FALSE;
+	END Init;
+	
+	PROCEDURE (VAR b: Buffer) Empty, NEW;
+	BEGIN
+		b.empty:=TRUE;
+	END Empty;
+	
+	PROCEDURE (VAR b: Buffer) AddChar(x: CHAR), NEW;
+	BEGIN
+		b.empty:=FALSE;
+		IF b.x=NIL THEN b.x:=Str.NewFrom('') END;
+		b.x.Add(x)
+	END AddChar;
+	
+	PROCEDURE (VAR b: Buffer) Clear, NEW;
+	BEGIN
+		b.empty:=FALSE;
+		b.quoted:=FALSE;
+		b.x:=NIL;
+	END Clear;
+	
+	PROCEDURE (VAR b: Buffer) Len(): INTEGER, NEW;
+		VAR res: INTEGER;
+	BEGIN
+		res:=0;
+		IF b.x#NIL THEN res:=b.x.Len() END;
+	RETURN res
+	END Len;
+	
+	PROCEDURE SkipWhite (rd: Reader; OUT res: INTEGER);
+		VAR x: CHAR; stop: BOOLEAN; pos: INTEGER;
+	BEGIN
+		stop:=FALSE;
+		pos:=rd.Pos();
+		WHILE~stop & rd.Read(x) DO
+			CASE x OF
+				09X, 0AX, 0DX, ' ': stop:=FALSE;
+			ELSE 
+				stop:=TRUE;
+				rd.SetPos(pos); 
+				res:=continue
+			END;
+			pos:=rd.Pos();
+		END;
+		IF ~stop THEN res:=eot END;
+	END SkipWhite;
+	
+	PROCEDURE ReadChar (rd: Reader; OUT ch: Char; OUT res: INTEGER);
+		VAR x: CHAR; stop: BOOLEAN; u: ARRAY 6 OF CHAR; uc: INTEGER; 
+	BEGIN
+		res:=continue; stop:=FALSE; ch.esc:=FALSE; uc:=-1;
+		WHILE ~stop & rd.Read(x)  DO
+			IF (x='\') & ~ch.esc THEN
+				ch.esc:=TRUE;
+			ELSIF ch.esc & (uc<0) THEN
+				CASE x OF
+					'\', '"', '/' (*, 08X, 09X, 0DX, 0AX, 0CX *): ch.x:=x; stop:=TRUE;
+					|'u': uc:=0; 
+					|'b': ch.x:=08X; stop:=TRUE;
+					|'f': ch.x:=0CX; stop:=TRUE;
+					|'n': ch.x:=0AX; stop:=TRUE;
+					|'r': ch.x:=0DX; stop:=TRUE;
+					|'t': ch.x:=09X; stop:=TRUE;
+				ELSE 
+					res:=err; stop:=TRUE;
+				END
+			ELSIF ch.esc & (uc>=0) THEN 
+				IF uc < 4 THEN 
+					u[uc]:=x; INC(uc);
+				ELSE 
+					u[4]:='H'; u[5]:=0X;
+					Str.StringToInt(u$, uc, res);
+					IF res=0 THEN
+						ch.x:=CHR(uc);
+					ELSE 
+						res:=err;
+					END;
+					stop:=TRUE;
+					uc:=-1;
+				END;
+			ELSIF (x#'\') & ~ch.esc THEN 
+				ch.x:=x;
+				stop:=TRUE;
+			END;
+		END;
+		IF ~stop THEN res:=eot END;
+	END ReadChar;
+	
+	PROCEDURE (VAR sc: Scanner) ClearBuffer, NEW;
+	BEGIN
+		sc.this.buf.Clear;
+	END ClearBuffer;
+	
+	PROCEDURE (VAR sc: Scanner) Read, NEW;	
+		VAR c: Char;
+	BEGIN
+		ASSERT(sc.rd#NIL, 20);
+		sc.res:=continue;
+		IF ~sc.this.inQuotes THEN SkipWhite(sc.rd, sc.res) END;
+		IF sc.res=continue THEN
+			sc.this.sym:=none;
+			ReadChar(sc.rd, c, sc.res);
+			IF ~c.esc THEN
+				CASE c.x OF
+					'"': sc.this.inQuotes:=~sc.this.inQuotes; 
+						IF sc.this.inQuotes THEN sc.this.buf.Empty; sc.this.buf.quoted:=TRUE END
+				ELSE
+					IF ~sc.this.inQuotes THEN
+						CASE c.x OF
+							|'{': sc.this.sym:=objBegin;
+							|'[': sc.this.sym:=arrBegin;
+							|':': sc.this.sym:=nameSep;
+							|',': sc.this.sym:=valueSep;
+							|'}': sc.this.sym:=objEnd;
+							|']': sc.this.sym:=arrEnd;
+						ELSE sc.this.buf.AddChar(c.x) END;
+					ELSE sc.this.buf.AddChar(c.x) END;
+				END;
+			ELSE
+				sc.this.buf.AddChar(c.x)
+			END;
+		END;
+	END Read;
+	
+	PROCEDURE (p: StdParser) Begin;
+		(* VAR t: StdTarget; *)
+	BEGIN
+		p.root:=NewStackItem(-1);
+		(* IF p.t=NIL THEN
+			NEW(t); p.t:=t;
+		END; *)
+		ASSERT(p.t#NIL, 60);
+		p.sc.Init;
+	END Begin;
+	
+	PROCEDURE (p: StdParser) Step(OUT res: INTEGER);
+		VAR type: INTEGER; i: StackItem; x: POINTER TO ARRAY OF CHAR;
+		
+		PROCEDURE Value;
+		BEGIN
+			IF p.sc.this.buf.empty THEN NEW(x, 1); x[0]:=0X; 
+			ELSIF p.sc.this.buf.Len()>0 THEN x:=p.sc.this.buf.x.CopyOf() END;
+			IF x#NIL THEN p.t.ThisValue(x$, p.sc.this.buf.quoted) END;
+		END Value;
+		
+	BEGIN
+		ASSERT(p.sc.res=continue, 20);
+		p.sc.Read; 
+		CASE p.sc.this.sym OF
+			|objBegin:
+				Push(p.root, p.sc.rd.Pos(), obj);
+				p.t.LevelDown(p.sc.rd.Pos(), obj);
+			|arrBegin:
+				Push(p.root, p.sc.rd.Pos(), arr); 
+				p.t.LevelDown(p.sc.rd.Pos(), arr);
+			|objEnd:
+				Value;
+				p.t.LevelUp;
+				p.sc.ClearBuffer;
+			|arrEnd:
+				Value;
+				p.t.LevelUp;
+				p.sc.ClearBuffer;
+			|nameSep:
+				IF p.sc.this.buf.Len()>0 THEN 
+					x:=p.sc.this.buf.x.CopyOf();
+					p.t.NextName(x$)
+				END;
+				p.sc.ClearBuffer;
+			|valueSep:
+				Value;
+				p.sc.ClearBuffer;
+		ELSE END;
+		res:=p.sc.res;
+	END Step;
+	
+	PROCEDURE (p: StdParser) Parse(OUT res: INTEGER): ANYPTR;
+		VAR x: ANYPTR;
+	BEGIN
+		p.Begin;
+		res:=p.sc.res;
+		WHILE ~(res IN {err, eot}) DO 
+			p.Step(res);
+		END;
+		IF res=eot THEN 
+			x:=p.Result();
+		END;
+	RETURN x;
+	END Parse;
+	
+	PROCEDURE (p: StdParser) Result(): ANYPTR;
+		VAR x: ANYPTR;
+	BEGIN
+		IF p.t#NIL THEN x:=p.t.Result() END;
+	RETURN x
+	END Result;
+	
+	PROCEDURE (p: StdParser) SetTarget(t: Target);
+	BEGIN
+		ASSERT(t#NIL, 20);
+		p.t:=t;
+	END SetTarget;
+	
+	PROCEDURE (d: StdDir) New (rd: Reader): Parser;
+		VAR p: StdParser;
+	BEGIN
+		ASSERT(rd#NIL, 20); ASSERT(rd.Base()#NIL, 21);
+		NEW(p);
+		p.sc.ConnectTo(rd);
+		RETURN p;
+	END New;
+	
+	PROCEDURE Install* (d: Directory);
+	BEGIN
+		ASSERT(d#NIL, 20);
+		prev:=dir;
+		dir:=d;
+	END Install;
+	
+	PROCEDURE Init;
+		VAR d: StdDir;
+	BEGIN
+		NEW(d); Install(d);
+		stdDir:=d;
+	END Init;
+	
+BEGIN
+	Init;
+END JSonParser.

Src/System/Mod/Cons.cp

@@ -1,221 +1,105 @@
 MODULE Cons;
-
 	
-
-	IMPORT 
-
-		Log:=Out, Console, Str;
-
-		
+	IMPORT
+		Log := Out, Console, Str;
 
 	TYPE
-
 		Hook = POINTER TO RECORD (Log.Hook) END;
 
-
-
 	PROCEDURE (log: Hook) ClearBuf;
-
 	BEGIN
-
-	
-
 	END ClearBuf;
 
-	
-
 	PROCEDURE (log: Hook) FlushBuf;
-
 	BEGIN
-
-	
-
 	END FlushBuf;
 
-	
-
 	PROCEDURE (log: Hook) Beep;
-
 	BEGIN
-
-	
-
 	END Beep;
 
-	
-
 	PROCEDURE (log: Hook) Char (ch: CHAR);
-
 	BEGIN
-
 		Console.Char(ch)
-
 	END Char;
 
-	
-
 	PROCEDURE (log: Hook) Int (n: LONGINT);
-
 	BEGIN
-
 		Console.Int(n)
-
 	END Int;
 
-	
-
 	PROCEDURE (log: Hook) Real (x: REAL);
-
 		VAR vs: ARRAY 64 OF CHAR;
-
 	BEGIN
-
 		Str.RealToString(x, vs);
-
 		Console.String(" ");
-
-		Console.String(vs);
-
+		Console.String(vs)
 	END Real;
 
-	
-
 	PROCEDURE (log: Hook) String (IN str: ARRAY OF CHAR);
-
 	BEGIN
-
 		Console.String(str)
-
 	END String;
 
-	
-
 	PROCEDURE (log: Hook) Bool (x: BOOLEAN);
-
 	BEGIN
-
 		Console.Bool(x)
-
 	END Bool;
 
-	
-
 	PROCEDURE (log: Hook) Set (x: SET);
-
 		VAR i: INTEGER; ret: ARRAY 100 OF CHAR; vs: ARRAY 15 OF CHAR;
-
 	BEGIN
-
 		ret := "{"; i := MIN(SET);
-
 		WHILE x # {} DO
-
-			IF i IN x THEN 
-
+			IF i IN x THEN
 				Str.IntToString(i, vs);
-
-				ret:=ret$+vs$; 
-
+				ret := ret$ + vs$;
 				EXCL(x, i);
-
-				IF (i + 2 <= MAX(SET)) & (i+1 IN x) & (i+2 IN x) THEN 
-
-					ret:=ret$+"..";
-
-					x := x - {i+1, i+2}; INC(i, 3);
-
+				IF (i + 2 <= MAX(SET)) & (i + 1 IN x) & (i + 2 IN x) THEN
+					ret := ret$ + "..";
+					x := x - {i + 1, i + 2}; INC(i, 3);
 					WHILE (i <= MAX(SET)) & (i IN x) DO EXCL(x, i); INC(i) END;
-
-					Str.IntToString(i-1, vs);
-
-					ret:=ret$+vs$;
-
+					Str.IntToString(i - 1, vs);
+					ret := ret$ + vs$
 				END;
-
-				IF x # {} THEN ret:=ret+", "; END
-
+				IF x # {} THEN ret := ret + ", " END
 			END;
-
-			INC(i);
-
+			INC(i)
 		END;
-
-		ret:=ret$+"}";
-
+		ret := ret$ + "}";
 		Console.String(" ");
-
-		Console.String(ret);
-
+		Console.String(ret)
 	END Set;
 
-	
-
 	PROCEDURE (log: Hook) Tab;
-
 	BEGIN
-
-		Console.Tab;
-
+		Console.Tab
 	END Tab;
 
-	
-
 	PROCEDURE (log: Hook) Ln;
-
 	BEGIN
-
-		Console.Ln;
-
+		Console.Ln
 	END Ln;
 
-	
-
 	PROCEDURE (log: Hook) ParamMsg (IN s, p0, p1, p2: ARRAY OF CHAR);
-
 	BEGIN
-
-	
-
 	END ParamMsg;
 
-	
-
 	PROCEDURE (log: Hook) IntForm (x: INTEGER; base, minWidth: INTEGER; fillCh: CHAR; showBase: BOOLEAN);
-
 	BEGIN
-
-	
-
 	END IntForm;
 
-	
-
 	PROCEDURE (log: Hook) RealForm (x: REAL; precision, minW, expW: INTEGER; fillCh: CHAR);
-
 	BEGIN
-
-	
-
 	END RealForm;
 
-	
-
 	PROCEDURE Init;
-
 		VAR h: Hook;
-
 	BEGIN
-
 		NEW(h);
-
-		Log.SetHook(h);
-
+		Log.SetHook(h)
 	END Init;
 
-	
-
 BEGIN
-
 	Init
-
 END Cons.

Src/System/Mod/Console.cp

@@ -1,100 +1,56 @@
 MODULE Console;
 
-
-
-	IMPORT
-
-		Str;
-
-		
+	IMPORT Str;
 
 	VAR
-
 		go_process*: PROCEDURE (IN s: ARRAY OF SHORTCHAR);
 
-		
-
 	PROCEDURE String*(s: ARRAY OF CHAR);
-
 		VAR x: ARRAY 1024 OF CHAR;
-
 	BEGIN
-
 		x:='{"type": "log", "data": "'+s$+'"}';
-
 		go_process(SHORT(x));
-
 	END String;
 
-	
-
 	PROCEDURE Bool*(x: BOOLEAN);
-
 	BEGIN
-
 		IF x THEN String(" $TRUE") ELSE String(" $FALSE") END
-
 	END Bool;
 
-	
-
 	PROCEDURE Int*(i: LONGINT);
-
 		VAR s: ARRAY 32 OF CHAR;
-
 	BEGIN
-
 		Str.IntToString(i, s);
-
 		String(" ");
-
 		String(s)
-
 	END Int;
 
-	
-
 	PROCEDURE Ln*;
-
 	BEGIN
-
 		String("\n")
-
 	END Ln;
 
-	
-
 	PROCEDURE Tab*;
-
 	BEGIN
-
 		String("\t")
-
 	END Tab;
 
 	PROCEDURE Char*(ch: CHAR);
 		VAR vs: ARRAY 3 OF CHAR;
-
 	BEGIN
 		vs[0]:="\";
 		vs[2]:=0X; 
 		CASE ch OF
-
 				'"', '\': vs[1]:=ch;
-
 				|09X: vs[1]:='t';
-
 				|0DX: vs[1]:='r';
-
 				|0AX: vs[1]:='n';
-
 				|0CX: vs[1]:='f';
-
 				|08X: vs[1]:='b';
-
-			ELSE 		vs[0]:=ch;
-
-		vs[1]:=0X; END;
+		ELSE 		
+			vs[0]:=ch;
+			vs[1]:=0X; 
+		END;
 		String(vs)
 	END Char;
 

Src/System/Mod/Start3.cp

@@ -3,5 +3,6 @@ MODULE Start3;
 	IMPORT Cons, Core, JSonObxNoModel;
 
 BEGIN
-	JSonObxNoModel.Do
+	JSonObxNoModel.Do;
+	JSonObxNoModel.Do2
 END Start3.

Src/System/Mod/Str.cp

@@ -29,6 +29,28 @@ MODULE Str;
 	RETURN d
 	END New;
 	
+	PROCEDURE NewFrom*(IN s: ARRAY OF CHAR): Dyn;
+		VAR d: Dyn; tmp: POINTER TO ARRAY OF CHAR; len: INTEGER;
+	BEGIN
+		NEW(d);
+		len:=LEN(s$)+1;
+		NEW(tmp, len);
+		tmp^:=s$;
+		d.x:=tmp;
+	RETURN d
+	END NewFrom;
+	
+	PROCEDURE (d: Dyn) Len*(): INTEGER, NEW;
+		VAR len: INTEGER;
+	BEGIN
+		IF d.x = NIL THEN
+			len:=0
+		ELSE
+			len:=LEN(d.x)
+		END;
+	RETURN len
+	END Len;
+	
 	PROCEDURE (d: Dyn) Add* (c: CHAR), NEW;
 		VAR i, next: INTEGER; tmp: POINTER TO ARRAY OF CHAR;
 	BEGIN
@@ -47,6 +69,12 @@ MODULE Str;
 		d.x[next]:=c
 	END Add;
 	
+	PROCEDURE (d: Dyn) Char*(idx: INTEGER): CHAR, NEW;
+	BEGIN
+		ASSERT(d.Len()>idx, 20);
+	RETURN d.x[idx]
+	END Char;
+	
 	PROCEDURE (d: Dyn) CopyOf*(): POINTER TO ARRAY OF CHAR, NEW;
 		VAR tmp, new: POINTER TO ARRAY OF CHAR;
 	BEGIN
@@ -57,6 +85,7 @@ MODULE Str;
 	RETURN new;
 	END CopyOf;
 	
+	
 	(* integer conversions *)
 
 	PROCEDURE IntToString* (x: LONGINT; OUT s: ARRAY OF CHAR);
@@ -161,6 +190,86 @@ MODULE Str;
 		IF si < LEN(s) THEN s[si] := 0X ELSE HALT(23) END
 	END IntToStringForm;
 	
+	PROCEDURE StringToInt* (IN s: ARRAY OF CHAR; OUT x: INTEGER; OUT res: INTEGER);
+		CONST hexLimit = MAX(INTEGER) DIV 8 + 1;
+		VAR i, j, k, digits: INTEGER; ch, top: CHAR; neg: BOOLEAN; base: INTEGER;
+	BEGIN
+		res := 0; i := 0; ch := s[0];
+		WHILE (ch # 0X) & (ch <= " ") OR (ch = 8BX) OR (ch = 8FX) OR (ch = 0A0X) DO	(* ignore leading blanks *)
+			INC(i); ch := s[i]
+		END;
+		j := i; top := "0";
+		WHILE (ch # 0X) & (ch # "H") & (ch # "X") & (ch # "%") DO 
+			IF ch > top THEN top := ch END;
+			INC(j); ch := s[j]
+		END;
+		IF (ch = "H") OR (ch = "X") THEN
+			x := 0; ch := s[i];
+			IF ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") THEN
+				WHILE ch = "0" DO INC(i); ch := s[i] END;
+				digits := 0;
+				WHILE (res = 0) & (("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F")) DO
+					IF ch < "A" THEN k := ORD(ch) - ORD("0")
+					ELSE k := ORD(ch) - ORD("A") + 10
+					END;
+					IF digits < 8 THEN
+						x := x MOD hexLimit;
+						IF x >= hexLimit DIV 2 THEN x := x - hexLimit END;
+						x := x * 16 + k; INC(i); ch := s[i]
+					ELSE res := 1
+					END;
+					INC(digits)
+				END;
+				IF res = 0 THEN
+					IF (ch # "H") & (ch # "X") OR (s[i+1] # 0X) THEN res := 2 END
+				END
+			ELSE res := 2
+			END
+		ELSE
+			IF ch = "%" THEN
+				INC(j); ch := s[j]; base := 0;
+				IF ("0" <= ch) & (ch <= "9") THEN
+					k := ORD(ch) - ORD("0");
+					REPEAT
+						base := base * 10 + k;
+						INC(j); ch := s[j]; k := ORD(ch) - ORD("0")
+					UNTIL (ch < "0") OR (ch > "9") OR (base > (MAX(INTEGER) - k) DIV 10);
+					IF ("0" <= ch) & (ch <= "9") THEN base := 0 END
+				END
+			ELSE
+				base := 10
+			END;
+			
+			IF (base < 2) OR (base > 16) THEN
+				res := 2
+			ELSIF (base <= 10) & (ORD(top) < base + ORD("0"))
+			OR (base > 10) & (ORD(top) < base - 10 + ORD("A")) THEN
+				x := 0; ch := s[i]; neg := FALSE;
+				IF ch = "-" THEN INC(i); ch := s[i]; neg := TRUE ELSIF ch = "+" THEN INC(i); ch := s[i] END;
+				WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := s[i] END; 
+				IF ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") THEN
+					IF ch <= "9" THEN k := ORD(ch) - ORD("0") ELSE k := ORD(ch) - ORD("A") + 10 END;
+					WHILE (("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F")) & (res = 0) DO
+						IF x >= (MIN(INTEGER) + (base - 1) + k) DIV base THEN
+							x := x * base - k; INC(i); ch := s[i];
+							IF ch <= "9" THEN k := ORD(ch) - ORD("0") ELSE k := ORD(ch) - ORD("A") + 10 END
+						ELSE res := 1
+						END
+					END
+				ELSE res := 2
+				END;
+				IF res = 0 THEN
+					IF ~neg THEN
+						IF x > MIN(INTEGER) THEN x := -x ELSE res := 1 END
+					END;
+					IF (ch # 0X) & (ch # "%") THEN res := 2 END
+				END
+			ELSE
+				res := 2
+			END
+		END
+	END StringToInt;
+	
 		(* real conversions *)
 
 	PROCEDURE RealToStringForm* (x: REAL; precision, minW, expW: INTEGER; fillCh: CHAR;
@@ -269,7 +378,87 @@ MODULE Str;
 	BEGIN
 		RealToStringForm(x, 16, 0, 0, digitspace, s)
 	END RealToString;
+
+	PROCEDURE StringToReal* (IN s: ARRAY OF CHAR; OUT x: REAL; OUT res: INTEGER);
+		VAR first, last, point, e, n, i, exp: INTEGER; y: REAL; ch: CHAR; neg, negExp, dig: BOOLEAN;
+	BEGIN
+		res := 0; i := 0; ch := s[0]; dig := FALSE;
+		WHILE (ch # 0X) & (ch <= " ") OR (ch = 8BX) OR (ch = 8FX) OR (ch = 0A0X) DO INC(i); ch := s[i] END;
+		IF ch = "+" THEN
+			neg := FALSE; INC(i); ch := s[i]
+		ELSIF ch = "-" THEN
+			neg := TRUE; INC(i); ch := s[i]
+		ELSE
+			neg := FALSE
+		END;
+		WHILE ch = "0" DO INC(i); ch := s[i]; dig := TRUE END;
+		first := i; e := 0;
+		WHILE ("0" <= ch) & (ch <= "9") DO INC(i); ch := s[i]; INC(e); dig := TRUE END;
+		point := i;
+		IF ch = "." THEN
+			INC(i); ch := s[i];
+			IF e = 0 THEN
+				WHILE ch = "0" DO INC(i); ch := s[i]; DEC(e); dig := TRUE END;
+				first := i
+			END;
+			WHILE ("0" <= ch) & (ch <= "9") DO INC(i); ch := s[i]; dig := TRUE END
+		END;
+		last := i - 1; exp := 0;
+		IF (ch = "E") OR (ch = "D") THEN
+			INC(i); ch := s[i]; negExp := FALSE;
+			IF ch = "-" THEN negExp := TRUE; INC(i); ch := s[i]
+			ELSIF ch = "+" THEN INC(i); ch := s[i]
+			END;
+			WHILE ("0" <= ch) & (ch <= "9") & (exp < 1000) DO
+				exp := exp * 10 + (ORD(ch) - ORD("0"));
+				INC(i); ch := s[i]
+			END;
+			IF negExp THEN exp := -exp END
+		END;
+		exp := exp + e; x := 0; y := 0; n := 0; 
+		WHILE (n < maxDig) & (first <= last) DO
+			IF first # point THEN x := x * 10 + (ORD(s[first]) - ORD("0")); INC(n) END;
+			INC(first)
+		END;
+		WHILE last >= first DO
+			IF last # point THEN y := (y + (ORD(s[last]) - ORD("0"))) / 10 END;
+			DEC(last)
+		END;
+		IF ~dig OR (ch # 0X) THEN res := 2	(* syntax error *)
+		ELSIF exp < -maxExp - maxDig THEN
+			x := 0.0
+		ELSIF exp < -maxExp + maxDig THEN
+			x := (x + y) / Mathe.IntPower(10, n - exp - 2 * maxDig) / factor / factor
+		ELSIF exp < n THEN
+			x := (x + y) / Mathe.IntPower(10, n - exp)
+		ELSIF exp < maxExp THEN
+			x := (x + y) * Mathe.IntPower(10, exp - n)
+		ELSIF exp = maxExp THEN
+			x := (x + y) * (Mathe.IntPower(10, exp - n) / 16);
+			IF x <= MAX(REAL) / 16 THEN x := x * 16
+			ELSE res := 1	(* overflow *)
+			END
+		ELSE res := 1	(* overflow *)
+		END;
+		IF neg THEN x := -x END
+	END StringToReal;
 	
+	PROCEDURE Find* (IN s: ARRAY OF CHAR; IN pat: ARRAY OF CHAR; start: INTEGER; OUT pos: INTEGER);
+		VAR j: INTEGER;
+	BEGIN
+		ASSERT(start >= 0, 20);
+		IF (start = 0) OR (start <= LEN(s$) - LEN(pat$)) THEN
+			(* start = 0 is optimization: need not call Len *)
+			pos := start;
+			WHILE s[pos] # 0X DO j := 0;
+				WHILE (s[pos+j] = pat[j]) & (pat[j] # 0X) DO INC(j) END;
+				IF pat[j] = 0X THEN RETURN END;
+				INC(pos)
+			END
+		END;
+		pos := -1	(* pattern not found *)
+	END Find;
+		
 	PROCEDURE ToLower* (in: ARRAY OF CHAR; OUT out: ARRAY OF CHAR);
 		VAR i, max: INTEGER;
 	BEGIN i := 0; max := LEN(out)-1;