Generating assignments and transforming code inside held forms when generating code

I think, your question is as much about techniques of evaluation control, as it is about code generation. I will show several different methods to achieve the first result you asked for, which would illustrate different approaches and techniques of evaluation control.

Working with unevaluated parts

You can, if you want to, work with parts of your expression, carefully avoiding evaluation leaks. This method is perhaps one of the most difficult and least economical, since it requires a good knowledge of evaluation control, and even then can be tedious and error-prone, if one doesn't stay really focused.

I will first show the solution step by step, and then assemble it into a function. We will start with the lists of variables and values, but first let us give some of the variables some global values, to test that our solution will not capture global bindings:

ClearAll[a, b, c, d];
a = 10;
b = 20;
{{a, b, c, d}, {1, 2, 3, 4}}

(* {{10, 20, c, d}, {1, 2, 3, 4}} *)

The idiom with MapThread that you suggested is a good one, and we will use it. But not with Set directly. We could use a temporary wrapper, and replace it with Set afterwards, but I will pick a different road. Here is what we would like to do:

MapThread[Hold[#1 = #2] &, {{a, b, c, d}, {1, 2, 3, 4}}]

(* {Hold[10 = 1], Hold[20 = 2], Hold[c = 3], Hold[d = 4]} *)

But this doesn't work. The first step in the right direction will be to insert Unevaluated:

MapThread[Hold[#1 = #2] &, Unevaluated@{{a, b, c, d}, {1, 2, 3, 4}}]

(* {Hold[10 = 1], Hold[20 = 2], Hold[c = 3], Hold[d = 4]} *)

This, however, is not good enough. The premature evaluation happens also in Function during the parameter-passing stage, and thus we need this:

step1 = MapThread[
  Function[Null, Hold[#1 = #2], HoldAll], 
  Unevaluated @ {{a, b, c, d}, {1, 2, 3, 4}}
]

(* {Hold[a = 1], Hold[b = 2], Hold[c = 3], Hold[d = 4]} *)

We are good now, but what we need is we need is single Hold around an assignment list, while we have a List of assignments each wrapped in individual Hold. The useful trick here is to use Thread[#, Hold]&, so that:

step2 = Thread[#, Hold] &@step1

(* Hold[{a = 1, b = 2, c = 3, d = 4}] *)

This is closer to what we need, but now we want to wrap Module around the variable / assignment list, and get it into Hold. One of the simplest ways to do this is by using rules, which would be a version of a so-called injector pattern:

step3 = Replace[step2, Hold[a_List] :> Hold[Module[a, someBody[]]]]

(* Hold[Module[{a = 1, b = 2, c = 3, d = 4}, someBody[]]] *)

which is the final result.

As a function, the resulting code would look like this:

ClearAll[genMT];
SetAttributes[genMT, HoldAll];
genMT[vars : {___Symbol}, vals_List] :=
  Composition[
    Replace[Hold[a_List] :> Hold[Module[a, someBody[]]]],
    Thread[#, Hold] &
  ] @ MapThread[
    Function[Null, Hold[#1 = #2], HoldAll],
    Unevaluated @ {vars, vals}
  ]

Where I used an operator form for Replace. So, for example, we have

genMT[{a, b, c, d}, {1, 2, 3, 4}]

(* Hold[Module[{a = 1, b = 2, c = 3, d = 4}, someBody[]]] *)

Note that this method is hard. We had to use several advanced techniques (evaluation control, a trick with Thread, injector pattern) in combination. I have shown this method to illustrate the "brute-force" approach, which is certainly possible, but is not the most economical or elegant one. One reason why this approach is hard is that we don't use rules and pattern-matching to the full extent.

Using holding symbolic containers for expression transformations

There is an alternative way to build an expression we need. I frequently find it more convenient than other methods, since it often gives you more control, and makes it easier to control evaluation.

The method is to replace iteration (where it is necessary) with recursion, and use symbolic containers with Hold* attributes to transform unevaluated expressions into suitable form. For the case at hand, it may look like this:

ClearAll[a, b, c, d, gen];
SetAttributes[gen, HoldAll];
gen[vars : {___Symbol}, vals_List] := gen[{}, vars, vals];
gen[{a___}, {v_, rvars___}, {val_, rvals___}] :=
  gen[{a, Set[v, val]}, {rvars}, {rvals}];
gen[a_List, {}, {}] := Hold[Module[a, someBody[]]]; 

We can test:

a = 1;
b = 2;
gen[{a, b, c, d}, {1, 2, 3, 4}]

(* Hold[Module[{a = 1, b = 2, c = 3, d = 4}, someBody[]]] *)

The way this works is that gen function gradually picks elements from lists of variable names and values and accumulates the assignments built out of them. When the lists are exhausted, we obtain a list of assignments in an unevaluated form, and can then generate the code we need, straightforwardly.

Using Block trick

The method I will describe here is completely different. It is based on the ability of Block to make (almost) any symbol "forget" its definitions temporarily. This may be used to non-trivially change the evaluation order. For the case at hand, it will be one of the most economical methods.

Here is the code:

ClearAll[genB];
SetAttributes[genB, HoldAll];
genB[{vars___Symbol}, vals_List] :=
  Block[{vars, Set, Module, Hold},
    SetAttributes[Module, HoldRest];
    Hold[Module[MapThread[Set, {{vars}, vals}], someBody[]]]
  ]

The way this works is that it temporarily switches off the standard behavior of Set, Module, and Hold, making them just symbolic wrappers during the evaluation of the body of the Block. This is what we need here for code generation. I had to attach a temporary HoldRest to Module inside Block, so that the body of the Module (someBody[]) is kept unevaluated.

We can test:

genB[{a, b, c, d}, {1, 2, 3, 4}]

(* Hold[Module[{a = 1, b = 2, c = 3, d = 4}, someBody[]]] *)

More advanced techniques

One can base more formal, universal and advanced techniques on methods I have described above, by generalizing and automating them to fit one's needs.

For example, some time ago I've developed code generator based on the generalized Block trick used above. The seriously simplified version of this technique I posted here, and with the help of the FrozenCodeEval function defined there, the solution to your problem becomes trivial:

FrozenCodeEval[
  Hold[Module[MapThread[Set, {{a, b, c, d}, {1, 2, 3, 4}}], someBody[]]],
  {MapThread}
]

(* Hold[Module[{a = 1, b = 2, c = 3, d = 4}, someBody[]]] *)

basically, here you just tell FrozenCodeEval, which heads should evaluate (in this case, only MapThread), and all the rest are kept "frozen". This technique I have also illustrated (among some others) in this answer.

Another possible (but IMO somewhat less powerful) technique is to use rules. I have illustrated this technique in this answer.

Yet another technique can be based on generalizing the holding symbolic container approach I described above. One good example of this approach is the LetL macro (nested With replacement), which is described in this answer, and particularly its more complex extension. This method is the one I've preferred recently.

One can also base code generation on introducing several (many) inert heads (like mySet), and replacing them with some "actual" heads (like Set) at the end, after the code has been generated. This was one of your original suggestions, and is certainly also a possibility.

Finally, one may implement a macro system, which would provide macros in a way similar to Lisp. However, that would require introducing read-time, which currently sort-of exists (parsing code to expressions), but can't really be used much. This is possible to do if one implements an alternative code loader, that would parse code to symbolic expression and give the user access to that parsed code before actually evaluating it.

Why I think that Inactive is in general not an answer

This is certainly an opinionated topic, but I personally did not see (almost) any case where Inactive would solve a problem of evaluation control (outside math-related functionality), in a way that would be simpler than other means of evaluation control.

From the viewpoint of evaluation control, the problem of Inactive is that while it inactivates a given head, it does not hold the arguments of that head, so they can freely evaluate. And the effort needed to prevent them from doing so will most of the time invalidate all the benefits of using Inactivate, as compared to Hold, Unevaluated etc.

For example, in our case (taking your code):

Hold[Module[assignments, Print[a, b, c, d]]] //. {
  assignments -> MapThread[Inactive[Set], {{a, b, c, d}, {1, 2, 3, 4}}
]} // Activate

(* Hold[Module[{10 = 1, 20 = 2, c = 3, d = 4}, Print[a, b, c, d]]] *)

shows that the global bindings to a and b were picked up in this method. And avoiding that will make the code no less complex than the first alternative I have shown above.

Summary

There exist several (many) techniques, allowing one to dynamically generate Mathematica code. The ones I have illustrated are based on

  • Direct manipulations with unevaluated parts of expressions
  • Using symbolic holding containers for expression transformations
  • Using Block trick

One can come up with more advanced / general / universal frameworks for code generation. The ones I mentioned are based on

  • Block trick (code "freezing")
  • Symbolic holding containers
  • Repeated rule application to held expressions
  • Inert intermediate (temporary) heads
  • (Read-time) macros

Which one to use depends on the case. For simple cases, some of the simpler techniques may be just enough. If you need to routinely generate code, you may be better off with some heavier but more general and systematic approach.


Since OP mentions Lisp quasiquote mechanism, maybe we can implement something similar in Mathematica.

Disclaimer: I've never written a line of code in any of Lisp dialects.

In Mathematica rules for evaluation of an expression are "attached" to symbols in this expression through various ...Values and Attributes (evaluation of many built-in symbols is implemented in lower level than ...Values but still it's "attached" to the symbol). To prevent evaluation of expression we don't need to hold whole expression, it's enough to "isolate" all symbols inside expression. This "isolation" can be achieved by wrapping symbol with some other symbol for which we know that it will remain unevaluated.

If we take

ClearAll[a, b, c, f, g]
expr = f[a, g[b]][c]

expression and wrap f with some head, let's say quoted:

quoted[f][a, g[b]][c]

we will prevent usage of f's DownValues, SubValues and Attributes, which like e.g. Orderless also can rewrite expression. If we add HoldFirst, HoldAll, or HoldAllComplete attribute to quoted we will prevent usage of f's OwnValues, but to be sure that any of f's UpValues that could match quoted[f] also won't be used we choose HoldAllComplete.

To prevent any evaluation in above expression we can wrap all symbols with quoted:

quotedExpr = quoted[f][quoted[a], quoted[g][quoted[b]]][quoted[c]]

This expression has the same structure as "non-quoted" expression in the sense that at each Part of "quoted" expression is quoted version of the same Part from "non-quoted" expression, for example Part 1 or 0, 2:

expr[[1]]
quotedExpr[[1]]
(* c *)
(* quoted[c] *)

expr[[0, 2]]
quotedExpr[[0, 2]]
(* g[b] *)
(* quoted[g][quoted[b]] *)

If we want some parts of our expression to be evaluated, we can easily mix "quoted" symbols with "non-quoted" ones, which is the main advantage of this approach over wrapping whole expression with single holding wrapper.

Of course manual wrapping of all symbols with quoted would be tedious, so we can define function quote that will do this automatically. Since often we want to quote whole expression except some parts, that we want to evaluate, we can define quasiquote function that quotes every symbol except those inside expression with head unquote.

Since version 10, Mathematica has similar mechanism built-in. We can Inactivate expressions, but, as Leonid mentioned in his answer, it'll inactivate (wrap with Inactive head) only symbols that are heads of expressions. We can overcome this limitation by defining own functions wrapping all symbols with Inactive. Advantage of this approach, over custom quoted symbol, is that Matematica provides IgnoringInactive function which simplifies matching/replacing parts of inactive expressions. But there are few disadvantages. Inactive has HoldFirst and not HoldAllComplete attribute so there is a possibility of evaluation leak through UpValues. It was designed only for heads of expressions and when used for non-heads its formatting is inconsistent. Since inactivation serves slightly different purposes, mixing it with quoting may be a bad idea. Nonetheless implementation based on Inactive is available in second revision of this answer.

Implementation

Core functions

Core of the system is based on following four functions and quoted head:

quote replaces all symbols (except excluded ones) by symbols wrapped with quoted. Expressions, matching pattern given as value of "ExcludedForms" option, are not quoted. It accepts optional second argument used as pattern for expressions that will be excluded in addition to ones matching pattern from option.

quasiquote works like quote, but, by default, doesn't quote expressions with head unquote.

unquote is head used to mark parts, of quasiquote expressions, that shouldn't be quoted.

eval wraps expression with head taken from "Head" option, with default being Identity, and strips quoted wrappers.

ClearAll[quote, quasiquote, unquote, eval, quoted]

SetAttributes[{quote, quasiquote, unquote, quoted}, HoldAllComplete]

Options[quote] = {
    "ExcludedForms" -> 
        List | Rule | RuleDelayed | Hold | HoldComplete | HoldForm | 
        Slot | SlotSequence | Alternatives | Default | Blank | 
        BlankSequence | BlankNullSequence | Except | Optional | Pattern |
        PatternTest | PatternSequence | Repeated | RepeatedNull | 
        Longest | Shortest | Verbatim | HoldPattern | OptionsPattern | 
        IgnoringInactive |
        _quoted | _CompiledFunction | _Experimental`NumericalFunction |
        _InterpolatingFunction | _BSplineFunction | _BezierFunction |
        _ParametricFunction | _NDSolve`StateData |
        _NDSolve`FiniteDifferenceDerivative | _BooleanFunction | _Root |
        _AlgebraicNumber | _DifferenceRoot | _DifferentialRoot | _FittedModel |
        _DataDistribution | _SurvivalModel | _NearestFunction |
        _LinearSolveFunction | _Image | _Image3D | _StateSpaceModel |
        _TransferFunctionModel | _Graphics | _Graphics3D | _GraphicsComplex |
        _Point | _Line | _Polygon | _Directive | _TemporalData | _CellObject |
        _ColorDataFunction | _ColorProfileData | _ByteArray | _CoxModel |
        _EventData | _HypothesisTestData | _LibraryFunction |
        _LiftingFilterData | _NotebookObject | _OptimumFlowData |
        _SeriesData | _StructuredArray | _WeightedData,
    "ExtraRules" -> {}
};
quote[expr_,
    extraExclusion : Except[_?OptionQ] | PatternSequence[],
    opts___?OptionQ
] :=
    Unevaluated[expr] /. Flatten@{
        OptionValue[quote, {opts}, "ExtraRules"],
        excluded :
            extraExclusion | OptionValue[quote, {opts}, "ExcludedForms"] :>
                excluded,
        sym : Except[HoldPattern@Symbol[___], _Symbol] :> quoted[sym]
    }

quasiquote[expr_,
    extraExclusion : Except[_?OptionQ] | PatternSequence[],
    opts___?OptionQ
] :=
    quote[expr, extraExclusion | _unquote, opts]

unquote[expr_] := expr

Options[eval] = {"Head" -> Identity, "Pattern" -> _};
eval[expr_, opts___?OptionQ] :=
    OptionValue[eval, {opts}, "Head"][expr] /. 
        HoldPattern[quoted][x : OptionValue[eval, {opts}, "Pattern"]] :> x

Utilities

Additional functions that simplify matching/replacing parts of quoted expressions and help with evaluation control.

quoteNonPattern is like quasiquote but, additionally, leaves parts of expressions, that have special meaning in pattern matching, non-quoted.

quoteEvaluated first evaluates given expression, then quotes result. It accepts optional second argument that controls how many "evaluation steps" are performed before quoting, this functionality is inspired by Mr.Wizard's step function.

quoted has some formatting defined (quoted symbols have LightGray backgrounds), for Mathematica versions >= 10 we piggyback on formatting of Inactive to get nice formatting for quoted versions of functions like Plus or Set.

ClearAll[quoteNonPattern, quoteEvaluated]

SetAttributes[{quoteNonPattern, quoteEvaluated}, HoldAllComplete]

quoteNonPattern[expr_,
    extraExclusion : Except[_?OptionQ] | PatternSequence[],
    opts___?OptionQ
] :=
    Quiet[
        quasiquote[expr,
            extraExclusion | Alternatives | Except | HoldPattern | 
            IgnoringInactive | Literal | Longest | Optional | 
            OrderlessPatternSequence | PatternSequence | RepeatedNull | 
            Shortest | _Blank | _BlankNullSequence | _BlankSequence |
            _OptionsPattern
            ,
            "ExtraRules" -> {
                OptionValue[quote, {opts}, "ExtraRules"],
                (h : Condition | PatternTest | Repeated)[patt_, rest___] :> 
                    h[quoteNonPattern[patt, extraExclusion, opts], rest],
                Verbatim[Pattern][name_, patt_] :> 
                    Pattern[name, quoteNonPattern[patt, extraExclusion, opts]],
                Verbatim[Verbatim][verb_] :> 
                    Verbatim@quasiquote[verb, extraExclusion, opts]
            },
            opts
        ],
        RuleDelayed::rhs
    ]


quoteEvaluated[expr_,
    (steps_ /; steps === Infinity) | PatternSequence[],
    (extraExclusion_ /; !IntegerQ[extraExclusion] && !OptionQ[extraExclusion]) |
        PatternSequence[],
    opts___?OptionQ
] :=
    quote[#, extraExclusion, opts] &@expr
quoteEvaluated[expr_, 
    steps_ /; steps === 0,
    (extraExclusion_ /; !IntegerQ[extraExclusion] && !OptionQ[extraExclusion]) |
        PatternSequence[], 
    opts___?OptionQ
] :=
    quote[expr, extraExclusion, opts]
quoteEvaluated[expr_,
    steps_ /; IntegerQ[steps] && Positive[steps],
    (extraExclusion_ /; !IntegerQ[extraExclusion] && !OptionQ[extraExclusion]) |
        PatternSequence[], 
    opts___?OptionQ
] :=
    (* Based on: https://mathematica.stackexchange.com/a/1447/14303 *)
    Module[{i = 0, tag},
        Catch[
            quote[#, extraExclusion, opts]& @ TraceScan[
                If[i++ >= steps, Throw[#, tag]]&,
                Unevaluated[expr],
                TraceDepth -> 1
            ],
            tag,
            (* TODO: When TraceScan encounters Evaluate[...] expression, 
               it passes to function, from its first argument,
               HoldForm[HoldForm[Evaluate][...]],
               so we should remove not only external HoldForm,
               but also the one directly wrapping Evaluate,
               but the same expression is passed when TraceScan encounters
               HoldForm[Evaluate][...],
               where we should remove only external HoldForm.
               How can we distinguish these two situations? *)
            First@quote[#1, extraExclusion, opts] &
        ]
    ]


$quotedStyle = {Background -> LightGray};

If[$VersionNumber >= 10,
    ClearAll[inactiveToQuoted];
    SetAttributes[inactiveToQuoted, HoldAllComplete];
    inactiveToQuoted[Inactive[h_][args___]] := quoted[h][args];
    inactiveToQuoted[expr_] := expr;

    quoted /: MakeBoxes[quoted[h_Symbol][args___], StandardForm] :=
        With[{$quotedStyle = $quotedStyle},
            TagBox[
                MakeBoxes[Inactive[h][args], StandardForm] /. {
                    (Tooltip -> tooltip_String /;
                        StringMatchQ[tooltip, "Inactive[*]"]) :>
                            (Tooltip -> "quoted" <> StringDrop[tooltip, 8]),
                    (BaseStyle -> "Inactive") -> (BaseStyle -> $quotedStyle),
                    StyleBox[boxes_, "Inactive"] :>
                        StyleBox[boxes, $quotedStyle]
                },
                inactiveToQuoted
            ]
        ]
 ]
 quoted /: MakeBoxes[quoted[x_Symbol], StandardForm] := 
     TagBox[
         MakeBoxes[x, StandardForm],
         quoted,
         BaseStyle -> $quotedStyle, SyntaxForm -> "Symbol",
         Tooltip -> ToString[quoted[x], InputForm]
     ]

Usage examples

Example of quoted expression, we define function h and variable x to show that their evaluation is properly held:

ClearAll[f, g, h, b, x]
x = 5;
h[x_] := 2 x

quasiquote@{
    1 + 2 + x,
    unquote@{(* this part is unquoted, so it'll be evaluated *)
        3 + 4,
        quasiquote@{(* this part is quoted again so it won't be evaluated *)
            5 + 6,
            unquote[7 + 8] (* and this will evaluate *)
        },
        quote@{(* this won't evaluate *)
            9 + 10,
            (* following will also not evaluate,
               since it's inside quote not quasiquote *)
            unquote[11 + 12]
        }
    },
    # + 1 &[3],
    f[g[x]][h[b]]
}
% // eval
(* {
       1 + 2 + x,
       {
           7,
           {5 + 6, 15},
           {9 + 10, unquote[11 + 12]}
       },
       (#1+1&)[3],
       f[g[x]][h[b]]
   } *)
(* {8, {7, {11, 15}, {19, 23}}, 4, f[g[5]][2 b]} *)

Example of generation of code of Module from OP:

ClearAll[a, b, c, d]
a = 1;
b = 2;
quotedModuleCode =
    quasiquote@Module[
        unquote[MapThread][Set, {{a, b, c, d}, {1, 2, 3, 4}}],
        Print[a, b, c, d]
    ]
eval[%, "Head" -> HoldComplete]
(* Module[{a = 1, b = 2, c = 3, d = 4}, Print[a, b, c, d]] *)
(* HoldComplete[Module[{a = 1, b = 2, c = 3, d = 4}, Print[a, b, c, d]]] *)

Different variant of generation of the same Module code, this time symbols localized by Module and their values are taken from lists assigned to variables. To make things more difficult some of symbols intended for localization have defined values, so ordinary evaluation of variable with their list won't work. To overcome this problem, we quote said variable after only one step of evaluation.

ClearAll[a, b, c, d, symbols, values]
symbols = {a, b, c, d};
values = {1, 2, 3, 4};
a = 1;
b = 2;

symbols
quotedSymbols = quoteEvaluated[symbols, 1]

quote[Module][
    MapThread[quote@Set, {quotedSymbols, values}],
    quote[Print] @@ quotedSymbols
]
(* {1, 2, c, d} *)
(* {a, b, c, d} *)
(* Module[{a = 1, b = 2, c = 3, d = 4}, Print[a, b, c, d]] *)

Note that in this case simple Extraction of OwnValues: quotedSymbols = Extract[OwnValues[symbols], {1, 2}, quote] would also work.

Lookup table example:

symbolMap = quote[<|a -> aLookup, b -> bLookup|>, Association]
quote@If[a > 1, lookupForm[b, 23], lookupForm[a, 24]] /.
    quoteNonPattern@lookupForm[x_, i_] :> quote[Part][symbolMap[x], i]
(* <|a -> aLookup, b -> bLookup|> *)
(* If[a > 1, bLookup[[23]], aLookup[[24]]] *)

"Quoted" code can be easily manipulated and composed:

quotedFDef = quasiquote[
    f[x_] :=
        unquote[quotedModuleCode /. {
            quoteNonPattern[a = _] :> quote[a = x],
            quoteNonPattern@Print[x_, y_, rest__] :> 
                quasiquote@h[
                    unquote[(2 + 5) x],
                    3 10 y,
                    unquote[Sequence @@ {rest}]
                ]
        }]
]
(* f[Pattern[x, _]] := Module[{a = x, b = 2, c = 3, d = 4}, h[7 a, 3*10*b, c, d]] *)

and, when necessary, evaluated:

ClearAll[f]
eval[quotedFDef]
?? f
(* Global`f
   f[x_]:=Module[{a=x,b=2,c=3,d=4},h[7 a,3 10 b,c,d]] *)

f[z]
(* h[7 z, 60, 3, 4] *)

I'm very sure you will find answers to all your questions in very detailed form on this site, since the issues you have were already discussed. Please start reading

  • Metaprogramming in Mathematica
  • Replace inside held expressions

In general, you should look for answers from Leonid, since he did a great deal of work documenting many meta-programming techniques that show you how you can use Mathematica to create Mathematica code.

As for your two questions, let me give you a short head start. I'm giving x and y values, so that you see that the code still works:

x = 1;
y = 2;

One way to create a held Module is

Function[{vars, body}, Hold[Module[vars, body]], {HoldAll}][{x = 5, y = 6}, x + y + 3]

the other one is defining a separate function for this, like your generateAssignments

SetAttributes[createModule, {HoldAll}];
createModule[vars_, body_] := Hold[Module[{vars}, body]]

createModule[{x = 5, y = 6}, x + y + 3]
(* Hold[Module[{{x = 5, y = 6}}, x + y + 3]] *)

Both works find and crucial is that both function hold their arguments which means that the variable definition and the body is not evaluated during the call.

As for your second problem, please search for the Trott-Strzebonski trick for in-place evaluation. That being said, I made a small change to your definition:

useLookupTable[body_, symbolMap_] := 
 body /. lookupForm[a_, idx_] :> 
   With[{eval = symbolMap[a][idx]}, eval /; True]

useLookupTable[
 Hold[If[a > 1, lookupForm[b, 23], lookupForm[a, 24]]], <|
  a -> aLookup, b -> bLookup|>]
(* Hold[If[a > 1, bLookup[23], aLookup[24]]] *)