Interpreter can handle constructors

git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@6665 8c9fc860-2736-0410-a75d-ab315db34111

source/FoxIntermediateBackend.Mod

@@ -12541,9 +12541,9 @@ TYPE
 					TypeEntry(source, parameter.type);
 					Info(source,"flags");
 					IF parameter.kind = SyntaxTree.VarParameter THEN
-						Set(source, {1});
+						Set(source, {SyntaxTree.FlagParameterVar});
 					ELSIF parameter.kind = SyntaxTree.ConstParameter THEN
-						Set(source,{2});
+						Set(source,{SyntaxTree.FlagParameterConst});
 					ELSE
 						Set(source, {});
 					END;
@@ -12882,6 +12882,7 @@ TYPE
 			PROCEDURE ProcedureArray(source: IntermediateCode.Section; procedure: SyntaxTree.Procedure);
 			VAR pc: LONGINT; size: LONGINT; 
 				segmentedName: Basic.SegmentedName;
+				flags: SET;
 			BEGIN
 				Array(source,pc,"Modules.ProcedureEntry");
 
@@ -12906,6 +12907,15 @@ TYPE
 
 						(* return type entry *)
 						TypeEntry(source, procedure.type(SyntaxTree.ProcedureType).returnType);
+						Info(source, "flags");
+						flags := {};
+						IF procedure.type(SyntaxTree.ProcedureType).isDelegate THEN
+							INCL(flags, SyntaxTree.FlagProcedureDelegate)
+						END;
+						IF procedure.isConstructor THEN
+							INCL(flags, SyntaxTree.FlagProcedureConstructor)
+						END;
+						Set(source, flags);
 
 						INC(size);
 					END;

source/FoxInterpreter.Mod

@@ -647,6 +647,9 @@ TYPE
 			address: ADDRESS;
 			o: ANY;
 			anyValue: InterpreterSymbols.AnyValue;
+			proc: InterpreterSymbols.ProcedureResult;
+			ignore: Result;
+			e: SyntaxTree.Expression;
 		BEGIN
 			position := x.position;
 			p0 := NIL; p1 := NIL; p2 := NIL; 
@@ -655,9 +658,6 @@ TYPE
 			ELSE
 				len := 0
 			END;
-			IF len > 0 THEN p0 := x.parameters.GetExpression(0); t0 := p0.type.resolved END;
-			IF len > 1 THEN p1 := x.parameters.GetExpression(1); t1 := p1.type.resolved END;
-			IF len > 2 THEN p2 := x.parameters.GetExpression(2); t2 := p2.type.resolved END;
 			CASE x.id OF
 			(* ----- NEW -----*)
 			Global.New:
@@ -666,6 +666,18 @@ TYPE
 					address := result.Address();
 					Heaps.NewRec(o, address, FALSE);
 					NEW(anyValue, o);
+					
+					proc := result(InterpreterSymbols.TypeResult).Constructor();
+					IF proc # NIL THEN
+						proc.Pars();
+						proc.PushAddress(o);
+						FOR i := 0 TO x.parameters.Length()-1 DO
+							e := x.parameters.GetExpression(i);
+							IF ~proc.Push(Designate(e)) THEN Error("wrong parameter"); item.object := NIL; RETURN END;
+						END;
+						IF ~proc.Check() THEN Error("non-matching parameter number"); item.object := NIL; RETURN END; 
+						ignore := proc.Evaluate();
+					END;
 					item.object := anyValue;
 				ELSE
 					Error("No Type");
@@ -937,8 +949,11 @@ TYPE
 		BEGIN
 			IF error THEN RETURN FALSE END;
 			Expression(x);
+			IF error THEN RETURN FALSE END;
 			LoadValue();
-			w := item.object(Value);
+			IF item.object # NIL THEN 
+				w := item.object(Value);
+			END;
 			RETURN ~error
 		END GetValue;
 		

source/FoxInterpreterSymbols.Mod

@@ -1,6 +1,6 @@
 MODULE FoxInterpreterSymbols; (** AUTHOR ""; PURPOSE ""; *)
 
-IMPORT Strings, Basic := FoxBasic, StringPool, Streams, Commands, PersistentObjects, Modules, Machine, SYSTEM;
+IMPORT Strings, Basic := FoxBasic, StringPool, Streams, Commands, PersistentObjects, Modules, Machine, SyntaxTree := FoxSyntaxTree, SYSTEM;
 
 CONST
 	TAB = 09X;
@@ -112,6 +112,11 @@ TYPE
 		BEGIN
 			RETURN NIL;
 		END Evaluate;
+		
+		PROCEDURE Constructor*(): ProcedureResult;
+		BEGIN
+			RETURN FindConstructor(SELF, type);
+		END Constructor;
 
 	END TypeResult;
 
@@ -146,7 +151,6 @@ TYPE
 					RETURN field;
 				ELSE 
 					type := FindType(mod.typeInfo, name);
-					TRACE(name, type);
 					IF type # NIL THEN
 						NEW(typeResult, name, type);
 					END;
@@ -371,6 +375,7 @@ TYPE
 			set: SET;
 			var: BOOLEAN;
 			v:Value;
+			a: ADDRESS;
 		BEGIN
 			IF (proc.parameters = NIL) OR (index >= LEN(proc.parameters)) THEN RETURN FALSE END; 
 			type := proc.parameters[index].type;
@@ -442,6 +447,12 @@ TYPE
 						stack.PushSet(set);
 						RETURN TRUE
 					END;
+				|sfTypePointerToRecord:
+					IF v.GetAddress(a) THEN
+						stack.PushA(a);
+						RETURN TRUE
+					END;
+				ELSE TRACE(ORD(type.class)); HALT(100);
 				END;
 			ELSIF type.subclass = sfTypeOpenArray THEN
 				CASE type.class OF
@@ -682,6 +693,26 @@ TYPE
 		RETURN NIL; 
 	END FindInType;
 	
+	PROCEDURE FindConstructor(scope: Result; type: ADDRESS): ProcedureResult;
+	VAR tag: ADDRESS; typeInfo: Modules.TypeDesc; i, num: LONGINT; 
+			proc: ProcedureResult; f: FieldResult;	
+	BEGIN
+		FOR i := 15 TO 0 BY -1 DO
+			SYSTEM.GET(type-(2+i)*SIZEOF(ADDRESS), tag); 
+			IF tag # NIL THEN
+				SYSTEM.GET(tag-SIZEOF(ADDRESS), typeInfo); 
+				FOR num := 0 TO LEN(typeInfo.procedures)-1 DO
+					IF SyntaxTree.FlagProcedureConstructor IN typeInfo.procedures[num].flags THEN
+						NEW(proc, scope, typeInfo.procedures[num].name^, typeInfo.procedures[num]);
+						proc.address := typeInfo.procedures[num].address;
+						RETURN proc
+					END;
+				END;
+			END;
+		END;
+		RETURN NIL; 
+	END FindConstructor;
+	
 TYPE
 	Value*= OBJECT(Result)
 

source/FoxSyntaxTree.Mod

@@ -54,6 +54,13 @@ CONST
 	ArrayIndex* = 0;
 	SetElement* = 1;
 	CaseGuard* = 2;
+	
+	(* reflection flags *)
+	FlagProcedureDelegate*=0;
+	FlagProcedureConstructor*=1;
+	
+	FlagParameterVar*=1;
+	FlagParameterConst*=2;
 
 TYPE
 	SourceCode*= Scanner.StringType;

source/Generic.Modules.Mod

@@ -83,6 +83,7 @@ TYPE
 		variables*: FieldEntries;
 		procedures*: ProcedureEntries;
 		returnType*: EntryType;
+		flags*: SET;
 	END;
 
 	TypeDesc* = POINTER TO RECORD 

source/InterpreterShell.Mod

@@ -838,6 +838,7 @@ TYPE
 					context.out.Ln;
 					context.out.String(">");
 					context.out.Update;
+					IF interpreter.error THEN interpreter.Reset END;
 					WHILE parser.Optional(Scanner.Escape) OR parser.Optional(Scanner.Semicolon) DO 
 						(*TRACE(parser.Token());*)
 					END;
@@ -964,6 +965,6 @@ TYPE
 
 END InterpreterShell.
 
-SystemTools.Free WMInterpreterShell InterpreterShell FoxInterpreter FoxInterpreterSymbols ~
+SystemTools.Free WMInterpreterShell InterpreterShell FoxInterpreter FoxInterpreterSymbols Test ~
 
 WMInterpreterShell.Open ~