implemented diagonal in staticexp and ceval

git-svn-id: https://openmodelica.org/svn/OpenModelica/trunk@1307 f25d12d1-65f4-0310-ae8a-bbce733d8d8e
OpenModelica · Oct 11, 2004 · dcf6b67 · dcf6b67
1 parent 0342388
commit dcf6b67
Show file tree

Hide file tree

Showing 2 changed files with 98 additions and 2 deletions.
diff --git a/modeq/ceval.rml b/modeq/ceval.rml
@@ -184,6 +184,10 @@ relation ceval : (Env.Env, Exp.Exp, bool, Interactive.InteractiveSymbolTable opt
 	-----------------------------------------
 	ceval (env,Exp.CALL(Absyn.IDENT("rem"),[exp1, exp2],_,_),impl,st,_) => (v,st) 	
 
+  rule	ceval_builtin_diagonal(env,exp1,impl,st) => (v,st)
+	-----------------------------------------
+	ceval (env,Exp.CALL(Absyn.IDENT("diagonal"),[exp1],_,_),impl,st,_) => (v,st) 	
+
 	(* end luc_pop *)
 
   rule	Print.print_buf "# Can't call functions at compile time\n" &
@@ -1567,6 +1571,82 @@ relation ceval_builtin_integer : (Env.Env, Exp.Exp, bool, Interactive.Interactiv
     ceval_builtin_integer(env,exp,impl,st) => (Values.INTEGER(ri),st)
 
 end
+
+relation ceval_builtin_diagonal : (Env.Env, Exp.Exp, bool, Interactive.InteractiveSymbolTable option) 
+	=> (Values.Value, Interactive.InteractiveSymbolTable option) =
+
+  rule  ceval (env,exp,impl,st,NONE) => (Values.ARRAY(rv2),_) &
+		list_length(rv2) => dimension &
+
+	    ceval_builtin_diagonal2(env,exp,impl,st,dimension,0, [] ) =>
+        retExp &
+
+   	    int_string dimension => dimensionString 
+		--------------------------------------
+		ceval_builtin_diagonal(env,exp,impl,st) => (Values.ARRAY(retExp),st)
+
+
+ rule  print"#-- ceval_builtin_diagonal: Couldn't elaborate ceval_builtin_diagonal()\n" 
+	    ---------------------------------------------------------
+	    ceval_builtin_diagonal (_,_,_,_) => fail
+
+
+end
+
+
+relation ceval_builtin_diagonal2 : (Env.Env, Exp.Exp, bool, Interactive.InteractiveSymbolTable option, int, int,  Values.Value list  ) 
+		=>  Values.Value list =
+
+ rule	Util.list_fill(Values.REAL(0.0),matrixDimension) => zeroList &
+
+		int_add(row,1) => correctElement &
+		ceval (env,Exp.ASUB(s1,correctElement),impl,st,NONE) => (rv2,_) &
+
+		Util.list_replaceat(rv2, row, zeroList) => listWithElement &
+
+		int_add(row,1) => newRow &
+	    ceval_builtin_diagonal2(env,s1,impl,st,matrixDimension,newRow,[Values.ARRAY(listWithElement)] ) => retExp &
+
+	    int_string row => RowString 
+	    --------------------------------------------------
+	    ceval_builtin_diagonal2 (env,s1,impl,st,matrixDimension,row,  [] ) =>  retExp
+
+
+ rule	not matrixDimension = row &
+
+		Util.list_fill(Values.REAL(0.0),matrixDimension) => zeroList &
+
+		int_add(row,1) => correctElement &
+		ceval (env,Exp.ASUB(s1,correctElement),impl,st,NONE) => (rv2,_) &
+
+		Util.list_replaceat(rv2, row, zeroList) => listWithElement &
+
+		int_add(row,1) => newRow &
+		list_append(listIN,[Values.ARRAY(listWithElement)]) => appendedList &
+	    ceval_builtin_diagonal2(env,s1,impl,st,matrixDimension,newRow, appendedList ) => retExp &
+
+	    int_string newRow => RowString 
+	    --------------------------------------------------
+	    ceval_builtin_diagonal2 (env,s1,impl,st,matrixDimension,row,  listIN ) => retExp
+
+
+  rule	matrixDimension = row &
+
+	    int_string row => RowString
+        --------------------------------------------------
+	    ceval_builtin_diagonal2 (env,s1,impl,st,matrixDimension,row, listIN) => listIN
+
+
+
+ rule  print"#-- ceval_builtin_diagonal2: Couldn't elaborate ceval_builtin_diagonal2()\n" &
+ 	    int_string row => RowString &
+	    int_string matrixDimension => matrixDimensionString
+	    ---------------------------------------------------------
+	    ceval_builtin_diagonal2 (_,_,_,_,matrixDimension,row,list) => fail
+
+end
+
+
 (* end luc_pop*)
 
 (* For size(A) *)

diff --git a/modeq/staticexp.rml b/modeq/staticexp.rml
@@ -1453,7 +1453,22 @@ relation elab_builtin_integer : (Env.Env, Absyn.Exp list) => (Exp.Exp, Types.Pro
 
 end
 
+relation elab_builtin_diagonal : (Env.Env, Absyn.Exp list) => (Exp.Exp, Types.Properties)	=
 
+   rule 
+		elab_exp (env,s1,false,NONE) 
+	      => (s1', Types.PROP((Types.T_ARRAY(Types.DIM(SOME(dimension)),_),NONE),c),_)
+          (**print "# integer function not implemented yet REAL\n" **)
+     --------------------------------------
+     elab_builtin_diagonal(env,[s1]) 
+        => (Exp.CALL(Absyn.IDENT("diagonal"),[s1'],false,false),
+            Types.PROP((Types.T_INTEGER([]),NONE),c))
+
+  rule  print"#-- elab_builtin_diagonal: Couldn't elaborate diagonal()\n"
+	    ---------------------------------------------------------
+	    elab_builtin_diagonal (_,_) => fail
+
+end
 
 relation elab_builtin_handler : Ident => ((Env.Env, Absyn.Exp list) 
 					  => (Exp.Exp, Types.Properties)) =
@@ -1478,6 +1493,7 @@ relation elab_builtin_handler : Ident => ((Env.Env, Absyn.Exp list)
   axiom elab_builtin_handler "integer" => elab_builtin_integer
   axiom elab_builtin_handler "mod" => elab_builtin_mod
   axiom elab_builtin_handler "rem" => elab_builtin_rem
+  axiom	elab_builtin_handler "diagonal" => elab_builtin_diagonal
 
 end
 
@@ -3496,8 +3512,8 @@ relation deoverload : ((Exp.Operator * Types.Type list * Types.Type) list,
 		       Absyn.Exp)
 	  => (Exp.Operator, Exp.Exp list, Types.Type) =
 
-  rule	(*Debug.fprint_list("dovl",params,Types.print_type,"\n") & 
-	Debug.fprint("dovl","\n===\n") &*)
+  rule	Debug.fprint_list("dovl",params,Types.print_type,"\n") & 
+	Debug.fprint("dovl","\n===\n") &
 	elab_arglist (params, args) => (args',types') &
 	compute_return_type(op, types', rtype) => rtype'
 	------------------------------------