raytransfer/OptimizeExpressionToC.m at main · ABHModels/raytransfer · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
(* ::Package:: *)

BeginPackage[ "OptimizeExpressionToC`"]

OptimizeExpressionToC::usage = "Generates optimized version of expression in C";

ExtractTags::usage = "";
ClearTagText::usage = "";
TagExistQ::usage = "";
AppendToTag::usage = "";

Begin[ "Private`"]

OptimizeExpressionToC[expr_List] :=
	Module[ {optimizedExpr, mainExpr, n, m, defs, output},
		optimizedExpr = Experimental`OptimizeExpression[expr];
		If[ ToString@optimizedExpr[[1, 0]] == "Block",
		    {n = Length[optimizedExpr[[1, 1]]];
		     mainExpr = optimizedExpr[[1, 2, n + 1]];},
		    {n = 0;
		     mainExpr = Flatten@{optimizedExpr[[1]]};}
		];
		m = Length[mainExpr];

		defs  =
		Table[ "double " <>
			       ToString@CForm@optimizedExpr[[1, 2, i, 1]]  <>
			       " = " <>
			       ToString@CForm@optimizedExpr[[1, 2, i, 2]] <>
     			       ";",
    		       {i, 1, n}];

		output =

		       MapIndexed[ "out("<>StringJoin@Riffle[ToString/@(#2-1),""]<>") = " <> ToString@CForm@#1 <>";" &,
					 mainExpr, {ArrayDepth[mainExpr]}];

		StringReplace[Join[defs,output], "Compile_$" -> "t"]
	];

End[]


ExtractTags[string_String] :=
	Module[ {regex, extractTag},
		regex = RegularExpression["\\n([^\\n]*)// (\\[|</?)([^\\]\\n]*)(\\]|>)[^\\n]*\\n"];

		extractTag[bounds_] := Module[{substring, indentation, tagType, tag},
					      substring = StringTake[string, bounds];
					      {{indentation, tagType, tag}} =
					      StringCases[substring, regex -> {"$1", "$2", "$3"}];
					      Association["indentation" -> indentation,
							  "tagType" -> tagType,
							  "tag" -> tag , "start" -> bounds[[1]] + 1,
							  "end" -> bounds[[2]]]
				       ];

		extractTag[#] & /@ StringPosition[string, regex]
	];

TagExistQ[string_String, tag_String] := AnyTrue[ExtractTags[string], #[["tag"]]==tag &];

ClearTagText[string_String, tag_String] :=
	Module[{tags, startTag, endTag, x},
	       tags = ExtractTags[string];
	       startTag = FirstCase[tags, x_ /; x[["tag"]] == tag  && x[["tagType"]] == "<"];
	       endTag = FirstCase[tags, x_ /; x[["tag"]] == tag  && x[["tagType"]] == "</"];

	       StringTake[string, {1, startTag[["end"]]}] <>
			 StringTake[string, {endTag[["start"]], StringLength[string]}]
	]

AppendToTag[string_String,  tag_String, linesToAppend_List] :=
	Module[{tags, startTag, indent, x},
	       tags = ExtractTags[string];
	       startTag = FirstCase[tags, x_ /; x[["tag"]] == tag  && x[["tagType"]] == "<"];
	       indent = startTag[["indentation"]];

	       StringTake[string, {1, startTag[["end"]]}] <>
			 StringRiffle[ linesToAppend, {indent, "\n" <> indent, "\n"}] <>
			 StringTake[ string, {startTag[["end"]] + 1, StringLength[string]}]
	];

AppendToTag[string_String,  tag_String, stringToAppend_String] :=
	AppendToTag[string, tag, StringSplit[stringToAppend,"\n"]];


EndPackage[]