/* * Copyright (c) 2003-2008 The University of Wroclaw. * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the University may not be used to endorse or promote * products derived from this software without specific prior * written permission. * * THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN * NO EVENT SHALL THE UNIVERSITY BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ using Nemerle.Compiler.Parsetree; using Nemerle.Collections; using Nemerle.Utility; namespace Nemerle.Compiler { /** Interface, which will be implemented by class encapsulating macro function. It will allow dynamic execution of macro by compiler itself */ public interface IMacro { GetName () : string; GetNamespace () : string; Run (ctx : Typer, args : list [SyntaxElement]) : PExpr; CallTransform (_ : list [PExpr]) : list [SyntaxElement]; SyntaxExtension () : GrammarElement * (list [SyntaxElement] -> list [SyntaxElement]); IsTailRecursionTransparent : bool { get; } IsInherited : bool { get; } Keywords : list [string] { get; } Usage : MacroUsageAttribute { get; } Location : Location { get; } } enum MacroParm { | Expr | Exprs | Implicit // note that parameter isn't given by user } /// GENERATION OF MACRO CLASSES SECTION public module MacroClasses { /** Generate class implementing interface [MacroRegistry.IMacro], which encapsulates execution of macro. Created methods are: [Run] for running macro, [GetName] for retrieving its name, [GetNamespace] for retrieving macro's definition site (namespace) [SyntaxExtension] for retrieving syntax extension it defines, [CallTransform] for transforming supported call parameters to description taken by [Run] method */ internal GenerateMacroClass (Manager : ManagerClass, decl : TopDeclaration.Macro, ns_node : NamespaceTree.Node) : void { def loc = decl.Location; def header = decl.header; def name = match (header.name) { | Splicable.Name (n) => n.Id | _ => Message.FatalError (loc, "spliced name in macro name is not allowed") }; def synt = decl.synt; def expr = decl.expr; def env = decl.ParsedName.context; def attrs = decl.modifiers; mutable phase = Nemerle.MacroPhase.None; mutable target = Nemerle.MacroTargets (); mutable tail_transparent = false; /// FIXME: we should really operate on typed attributes foreach (x in attrs.custom_attrs) { match (x) { | <[ MacroUsage (..$(ph :: tar :: _)) ]> | <[ $_.MacroUsage (..$(ph :: tar :: _)) ]> => phase = match (ConstantFolder.FoldConstants (env, ph)) { | PExpr.Literal (Literal.Enum (Literal.Integer (x, false, _), ty, _)) when ty.FullName == "Nemerle.MacroPhase" => x :> MacroPhase | _ => Message.FatalError ("invalid value on MacroPhase position: " + ph.ToString ()) } target = match (ConstantFolder.FoldConstants (env, tar)) { | PExpr.Literal (Literal.Enum (Literal.Integer (x, false, _), ty, _)) when ty.FullName == "System.AttributeTargets" => x :> MacroTargets | _ => Message.FatalError ("invalid value on MacroTargets position: " + tar.ToString ()) } | <[ TailRecursionTransparent (true) ]> | <[ $_.TailRecursionTransparent (true) ]> => tail_transparent = true; | _ => () } }; // in case of occurance of special type parameters, we change default type // on which macro can be executed (macros on methods, fields, types) mutable target_type_suff = ""; def set_target_info (atleast, atmost, suff, name) { when (phase == Nemerle.MacroPhase.None) Message.Error (loc, "macro operating on declaration must have stage attribute"); when (atleast > (phase :> int) || atmost < (phase :> int)) Message.Error (loc, "macro from this stage cannot have `" + name + "' parameter"); match (target_type_suff) { | "" => target_type_suff = suff | ":type" => match (suff) { | ":method" | ":field" | ":property" | ":event" | ":param" => target_type_suff = suff | _ => Message.Error (loc, "multiple `TypeBuilder' parameters") } | ":method" => if (suff == ":param") target_type_suff = suff else Message.Error (loc, "after `Method' theres can be only `Parameter', not " + suff) | _ => Message.Error (loc, "parameter `TypeBuilder' must occure before " + suff) } }; // walk through parameters given to macro, extract their names, // note type names, control if they correspond to Nemerle grammar, // handle variable amount of parameters and default values // create code decomposing passed parameters if needed def analyze_params (pars : list [Fun_parm], acc, accs, accmp, defaults : list [Name * PExpr], types : list[string]) : list [PExpr] * list [PExpr] * list [MacroParm] { // build pattern for list from list of patterns def roll (li, bu) { match (li) { | [] => bu | x::xs => roll (xs, <[ $x :: $bu ]>) } }; // build expression for list from list of expressions def roll_expr (li, bu) { match (li) { | [] => bu | (va, d)::xs => roll_expr (xs, <[ { def $(va : name) = $d; $bu } ]>) } }; // handle case of standard (not `params' nor with default value) parameter; // decompose handled types, note them and build pattern matching // parameter's expression def normal_parm (t, va) { match (t) { | <[ _ ]> | <[ expr ]> => (<[ SyntaxElement.Expression ($(va : name)) ]>, "PExpr" :: types, MacroParm.Expr) | <[ parameter ]> => (<[ SyntaxElement.Parameter ($(va : name)) ]>, "parameter" :: types, MacroParm.Expr) | <[ Token ]> => (<[ SyntaxElement.RawToken ($(va : name)) ]>, "Token" :: types, MacroParm.Expr) | <[ string ]> => (<[ SyntaxElement.Expression (PExpr.Literal (Literal.String ($(va : name)))) ]>, "string" :: types, MacroParm.Expr) | <[ int ]> => (<[ SyntaxElement.Expression (PExpr.Literal (Literal.Integer (AsInt = Some ($(va : name))))) ]>, "int" :: types, MacroParm.Expr) | <[ ParsedField ]> => set_target_info (1, 2, ":field", "ParsedField"); (<[ SyntaxElement.ClassMember ((ClassMember.Field) as $(va : name)) ]>, "ParsedField" :: types, MacroParm.Implicit) | <[ ParsedMethod ]> => set_target_info (1, 2, ":method", "ParsedMethod"); (<[ SyntaxElement.ClassMember ((ClassMember.Function) as $(va : name)) ]>, "ParsedMethod" :: types, MacroParm.Implicit) | <[ ParsedProperty ]> => set_target_info (1, 2, ":property", "ParsedProperty"); (<[ SyntaxElement.ClassMember ((ClassMember.Property) as $(va : name)) ]>, "ParsedProperty" :: types, MacroParm.Implicit) | <[ ParsedEvent ]> => set_target_info (1, 2, ":event", "ParsedEvent"); (<[ SyntaxElement.ClassMember ((ClassMember.Event) as $(va : name)) ]>, "ParsedEvent" :: types, MacroParm.Implicit) | <[ ParsedParameter ]> => set_target_info (1, 2, ":param", "ParsedParameter"); (<[ SyntaxElement.Parameter ($(va : name)) ]>, "ParsedParameter" :: types, MacroParm.Implicit) | <[ TypeBuilder ]> => set_target_info (1, 3, ":type", "TypeBuilder"); target_type_suff = ":type"; (<[ SyntaxElement.TypeBuilder ($(va : name)) ]>, "TypeBuilder" :: types, MacroParm.Implicit) | <[ FieldBuilder ]> => set_target_info (3, 3, ":field", "FieldBuilder"); (<[ SyntaxElement.FieldBuilder ($(va : name)) ]>, "FieldBuilder" :: types, MacroParm.Implicit) | <[ MethodBuilder ]> => set_target_info (3, 3, ":method", "MethodBuilder"); (<[ SyntaxElement.MethodBuilder ($(va : name)) ]>, "MethodBuilder" :: types, MacroParm.Implicit) | <[ PropertyBuilder ]> => set_target_info (3, 3, ":property", "PropertyBuilder"); (<[ SyntaxElement.PropertyBuilder ($(va : name)) ]>, "PropertyBuilder" :: types, MacroParm.Implicit) | <[ EventBuilder ]> => set_target_info (3, 3, ":event", "EventBuilder"); (<[ SyntaxElement.EventBuilder ($(va : name)) ]>, "EventBuilder" :: types, MacroParm.Implicit) | <[ ParameterBuilder ]> => set_target_info (3, 3, ":param", "ParameterBuilder"); (<[ SyntaxElement.ParameterBuilder ($(va : name)) ]>, "ParameterBuilder" :: types, MacroParm.Implicit) | <[ uint ]> => (<[ SyntaxElement.Expression (PExpr.Literal (Literal.Integer (AsUInt = Some ($(va : name))))) ]>, "uint" :: types, MacroParm.Expr) | <[ long ]> => (<[ SyntaxElement.Expression (PExpr.Literal (Literal.Integer (AsLong = Some ($(va : name))))) ]>, "long" :: types, MacroParm.Expr) | <[ ulong ]> => (<[ SyntaxElement.Expression (PExpr.Literal (Literal.Integer (AsULong = Some ($(va : name))))) ]>, "ulong" :: types, MacroParm.Expr) | <[ short ]> => (<[ SyntaxElement.Expression (PExpr.Literal (Literal.Integer (AsShort = Some ($(va : name))))) ]>, "short" :: types, MacroParm.Expr) | <[ ushort ]> => (<[ SyntaxElement.Expression (PExpr.Literal (Literal.Integer (AsUShort = Some ($(va : name))))) ]>, "ushort" :: types, MacroParm.Expr) | <[ byte ]> => (<[ SyntaxElement.Expression (PExpr.Literal (Literal.Integer (AsByte = Some ($(va : name))))) ]>, "byte" :: types, MacroParm.Expr) | <[ sbyte ]> => (<[ SyntaxElement.Expression (PExpr.Literal (Literal.Integer (AsSByte = Some ($(va : name))))) ]>, "sbyte" :: types, MacroParm.Expr) | <[ float ]> => (<[ SyntaxElement.Expression (PExpr.Literal (Literal.Float ($(va : name)))) ]>, "float" :: types, MacroParm.Expr) | <[ double ]> => (<[ SyntaxElement.Expression (PExpr.Literal (Literal.Double ($(va : name)))) ]>, "double" :: types, MacroParm.Expr) | <[ decimal ]> => (<[ SyntaxElement.Expression (PExpr.Literal (Literal.Decimal ($(va : name)))) ]>, "decimal" :: types, MacroParm.Expr) | <[ bool ]> => (<[ SyntaxElement.Expression (PExpr.Literal (Literal.Bool ($(va : name)))) ]>, "bool" :: types, MacroParm.Expr) | <[ $(n : name) ]> => Message.FatalError (loc, $"type $(n.Id) not supported for macro parameter") | _ => Message.FatalError (loc, $"complex types are not supported for macro parameters: $t") } }; // create list of match cases (patterns and expressions) containing // cases for default values of parameters, add expressions defining // missed parameters according to those default values def traverse_patterns (pattss, defaults, defsrest, accpat, accexp) { match ((pattss, defaults)) { | ([], _) => (accpat, accexp) | (patts :: xss, []) => traverse_patterns (xss, [], [], <[ [..$(List.Rev (patts))] ]> :: accpat, roll_expr (defsrest, expr) :: accexp) | (patts :: xss, d :: ds) => def newdrest = d :: defsrest; traverse_patterns (xss, ds, newdrest, <[ [..$(List.Rev (patts))] ]> :: accpat, roll_expr (defsrest, expr) :: accexp) } }; def message (types) { def plist = List.Rev (types).ToString (", "); <[ // runtime variable containing parameters of macro def len = List.Length (parms); def types = parms.ToString (", "); Message.FatalError ("macro `" + $(name : string) + "' expects following list of arguments: (" + $(plist : string) + ") got some " + len.ToString () + " parameters [" + types + "]") ]> }; // iterate through parameters match (pars) { | [] => // we have fixed amount of parameters, so there is always // case, which triggers error, handle it def warn = message (types); def (pats, exps) = traverse_patterns (acc :: accs, defaults, [], [ <[ _ ]> ], [warn]); (pats, exps, List.Rev (accmp)) | [ Fun_parm where (name = Splicable.Name (va), ty = t, modifiers = Modifiers where (custom_attrs = [<[ System.ParamArrayAttribute ]>]) ) ] => // variable amount of parameters is handled here def (initpat, initex) = match (acc) { // if there are some elemnts other than out 'va', then this // pattern won't be exchaustive, and we must supply error msg | _ :: _ => def warn = message ("params array" :: types); ([ <[ _ ]> ], [warn]) | _ => ([], []) }; match (t) { | <[ array . [$_] [PExpr] ]> | <[ array . [$_] [expr] ]> => def (pats, exps) = traverse_patterns (accs, defaults, [], roll (acc, <[ exprs ]>) :: initpat, <[ def $(va : name) = array (List.Length (exprs)) : array [PExpr]; mutable i = 0; foreach (e in exprs) { $(va : name)[i] = (e :> SyntaxElement.Expression).body; ++i; } $expr ]> :: initex); (pats, exps, List.Rev (MacroParm.Exprs :: accmp)) | <[ list [PExpr] ]> => def (pats, exps) = traverse_patterns (accs, defaults, [], roll (acc, <[ exprs ]>) :: initpat, <[ def $(va : name) = List.Map (exprs, fun (x : SyntaxElement) { (x :> SyntaxElement.Expression).body }); $expr ]> :: initex); (pats, exps, List.Rev (MacroParm.Exprs :: accmp)) | _ => Message.FatalError (loc, "only array of expr or parm are " "supported in params") } | (Fun_parm where ( name = Splicable.Name (va), ty = t, modifiers = Modifiers where (custom_attrs = [<[ System.ComponentModel.DefaultValueAttribute ($e) ]>]) )) :: xs => // parameter with default value match (normal_parm (t, va)) { | (p, str :: strs, macroparm) => analyze_params (xs, p :: acc, acc :: accs, macroparm :: accmp, (va, e) :: defaults, str + "(opt)" :: strs) } | Fun_parm where (name = Splicable.Name (va), ty = t) :: xs => match (defaults) { | [] => /// [macroparm] is type of parameter supplied by user of macro /// or [MacroParm.Implicit] if it is not given by him, but implicitly /// passed by compiler def (p, str, macroparm) = normal_parm (t, va); analyze_params (xs, p :: acc, accs, macroparm :: accmp, defaults, str) | _ => Message.FatalError (loc, "parameters with default values must not" " be mixed with normal") } | Fun_parm where (name = Splicable.Expression) :: _ => Util.ice ("wrong spliced in macro parameters") | Fun_parm where (name = Splicable.HalfId) :: _ => Util.ice ("completion not supported here") } }; // end analize_parms // creates match cases from pairs of pattern and expression def consolide_cases (pats, exps, acc) { match ((pats, exps)) { | ([], []) => acc | (x :: xs, y :: ys) => consolide_cases (xs, ys, <[ case: $x => $y ]> :: acc) | _ => Util.ice () } }; // store positions and types of all parameters accessed by their names def mapparams (pars : list [Fun_parm], n, map : Map [string, int * PExpr]) { match (pars) { | [] => map | Fun_parm where (name = Splicable.Name (Name where (idl = x)), ty = t) :: xs => when (map.Contains (x)) Message.FatalError (loc, "parameter names cannot repeat"); mapparams (xs, n + 1, map.Add (x, (n, t))) | Fun_parm where (name = Splicable.Expression) :: _ => Util.ice ("wrong Splicable in macro params") | Fun_parm where (name = Splicable.HalfId) :: _ => Util.ice ("completion not supported here") } }; // this also checkes parameters to infer target type of macro def (macro_patts, macro_exprs, macro_parms) = analyze_params (header.parms, [], [], [], [], []); def retname = if (target_type_suff != "" || phase != Nemerle.MacroPhase.None) if (target_type_suff != "" || target == MacroTargets.Assembly) { def phase_suf = if (phase == Nemerle.MacroPhase.BeforeInheritance) ":postscan" else if (phase == Nemerle.MacroPhase.BeforeTypedMembers) ":preadd" else if (phase == Nemerle.MacroPhase.WithTypedMembers) ":postadd" else Message.FatalError (loc, "macro operating on type declaration parts must" " have phase modifier"); def use_suff = match (target) { | MacroTargets.Class => ":type" | MacroTargets.Method => ":method" | MacroTargets.Field => ":field" | MacroTargets.Property => ":property" | MacroTargets.Event => ":event" | MacroTargets.Parameter => ":param" | MacroTargets.Assembly => unless (target_type_suff == "") Message.Error ("invalid parameters specified for assembly macro"); target_type_suff = ":assembly"; ":assembly" | x when x == Nemerle.MacroTargets () => "" | _ => Message.Error ($"invalid macro target: $target"); target_type_suff } unless (use_suff == target_type_suff) Message.Error ($"macro target $target do not match macro parameters"); name + target_type_suff + phase_suf } else Message.FatalError (loc, "macro with phase modifier must operate on type" " declaration parts") else name; // build macro class Util.locate (expr.Location, { attrs.mods |= NemerleAttributes.Macro %| NemerleAttributes.Public %| NemerleAttributes.Sealed; def paramsmap = mapparams (header.parms, 0, Map ()); def (keys, rules, positions) = analyze_syntax (synt, paramsmap); def macro_class_name = header.ParsedName.NewName (convert_to_valid_type_name (retname) + "Macro"); def td = env.Define (<[ decl: ..$attrs class $(macro_class_name : name) : IMacro { static mutable my_usage : MacroUsageAttribute; static keywords : list [string]; static this () { def customs = typeof ($(macro_class_name : name)).GetCustomAttributes (false); foreach (x is MacroUsageAttribute in customs) my_usage = x; keywords = [..$(List.Map (keys, Macros.Lift))]; } public Location : Nemerle.Compiler.Location { get { Location (Location.GetFileIndex ($(decl.Location.File : string)), $(decl.Location.Line : int), $(decl.Location.Column : int)) } } public IsInherited : bool { get { my_usage != null && my_usage.Inherited } } public Keywords : list [string] { get { keywords } } public Usage : MacroUsageAttribute { get { my_usage } } public IsTailRecursionTransparent : bool { get { $(tail_transparent : bool) } } public GetName () : string { $(retname : string) } public Name : string { get { $(retname : string) } } public Namespace : string { get { $(ns_node.GetDisplayName () : string) } } public GetNamespace () : string { $(ns_node.GetDisplayName () : string) } } ]>); td.MarkWithSpecialName (); // count notimplicit parameters mutable count = macro_parms.Length; // create decision tree for transformation of supported call // parameters to our SyntaxElement description def create_transform_tree (parms) { | MacroParm.Expr :: xs => <[ match (trans_p) { | x :: trans_p => trans_res = SyntaxElement.Expression (x) :: trans_res; $(create_transform_tree (xs)) | [] => () } ]> | [MacroParm.Exprs] => <[ def app_expr (l : list [PExpr]) { | x :: xs => trans_res = SyntaxElement.Expression (x) :: trans_res; app_expr (xs) | [] => () }; app_expr (trans_p) ]> | [] => <[ match (trans_p) { | x :: _ => trans_res = SyntaxElement.Expression (x) :: trans_res | [] => () } ]> | MacroParm.Implicit :: xs => --count; create_transform_tree (xs) | _ => Util.ice ("corrupted macro parameters") }; td.Define (<[ decl: public CallTransform (trans_p : list[PExpr]) : list[SyntaxElement] { mutable trans_res = []; $(create_transform_tree (macro_parms)); List.Rev (trans_res); } ]>); def macro_exprs = if (phase == Nemerle.MacroPhase.None) macro_exprs; else macro_exprs.Map ( fun (_) { | PExpr.Sequence (seq) as x => PExpr.Sequence (x.Location, seq + [ <[ () ]> ]) | x => <[ $x; () ]> } ); def macro_cases = List.Rev (consolide_cases (macro_patts, macro_exprs, [])); def run_body = if (phase == Nemerle.MacroPhase.None) <[ match (parms) { ..$macro_cases } ]> else <[ _ = match (parms) { ..$macro_cases }; null ]>; td.Define (<[ decl: public Run ($(Manager.MacrosRegistry.GetImplicitCTXName () : name) : Typer, parms : list[SyntaxElement]) : PExpr { $run_body } ]>); td.Define (<[ decl: public SyntaxExtension () : GrammarElement * (list [SyntaxElement] -> list [SyntaxElement]) { ($(lift_ge (rules)), $(CreatePermutingFunction (positions))) } ]>); td.Compile (); }); } private convert_to_valid_type_name (x : string) : string { def build = System.Text.StringBuilder (x); mutable invalid = false; for (mutable i = 0; i < x.Length; ++i) unless (System.Char.IsLetter (x [i]) || x [i] == '_') if (x [i] == ':') build [i] = '_'; else invalid = true; if (invalid) Util.tmpname ($"operator$(x.GetHashCode())_"); else build.ToString () } // lift grammar element, also propagating Next field private lift_ge (x : GrammarElement) : PExpr { if (x == null) <[ null ]> else { def next = lift_ge (x.Next); match (x) { | GrammarElement.Operator (name) => <[ GrammarElement.Operator ($next, $(name : string)) ]> | GrammarElement.Keyword (name) => <[ GrammarElement.Keyword ($next, $(name : string)) ]> | GrammarElement.Expression => <[ GrammarElement.Expression ($next) ]> | GrammarElement.ExpressionList => <[ GrammarElement.ExpressionList ($next) ]> | GrammarElement.RawToken => <[ GrammarElement.RawToken ($next) ]> | GrammarElement.Parameter => <[ GrammarElement.Parameter ($next) ]> | GrammarElement.Optional (g) => <[ GrammarElement.Optional ($next, $(lift_ge (g))) ]> | GrammarElement.Branch (li) => <[ GrammarElement.Branch ($next, $(Macros.Lift (li, lift_ge))) ]> | GrammarElement.End => Util.ice ("invalid node") } } }; // if syntax extending section of macro exists, analyze all tokens and // permutation of parameters in its definition analyze_syntax (toks : list [PExpr], mutable paramsmap : Map [string, int * PExpr]) : list [string] * GrammarElement * list [int] { mutable keywords = []; mutable positions = []; def analyze_one (tok, acc) { match (tok) { | <[ $(x : string) ]> when LexerBase.HasKeywordChars (x) => keywords = x :: keywords; GrammarElement.Keyword (acc, x) | <[ $(x : string) ]> when LexerBase.IsOperator (x) => GrammarElement.Operator (acc, x) | <[ Optional (..$els) ]> => // we pass null to the inside of Optional, as it will end opt block def inside = List.FoldRight (els, null, analyze_one); match (inside) { | GrammarElement.Optional => Message.FatalError (tok.Location, "nested Optional tokens not allowed in" " syntax definition") | tok => GrammarElement.Optional (acc, tok) } | <[ $(x : dyn) ]> => match (paramsmap.Find (x)) { | Some ((pos, ty)) => paramsmap = paramsmap.Remove (x); def grammar_token = match (ty) { | <[ parameter ]> => GrammarElement.Parameter (acc) | <[ list [PExpr] ]> | <[ array [PExpr] ]> | <[ array [expr] ]> => GrammarElement.ExpressionList (acc) | <[ Token ]> => GrammarElement.RawToken (acc) | _ => GrammarElement.Expression (acc) }; positions = pos :: positions; grammar_token | None => Message.FatalError (tok.Location, "parameters from syntax description doesn't" " match macro's") } | _ => Message.FatalError (tok.Location, "unsupported syntax token") } }; def rule = List.FoldRight (toks, null, analyze_one); (keywords, rule, positions) }; public CreatePermutingFunction (positions : list [int]) : PExpr { // when positions are in increasing order, then it is simply identity def is_identity = List.FoldLeft (positions, -1, fun (now : int, prev) { if (now < prev) int.MaxValue else now }); // for identity we can return much simpler function if (is_identity != int.MaxValue) <[ (Nemerle.Utility.Identity.[list [SyntaxElement], list [SyntaxElement]] () : object) :> list [SyntaxElement] -> list [SyntaxElement] ]> // <[ fun (x) { x } ]> else { def plen = positions.Length; mutable exprs = []; foreach (p in positions) exprs = (if (p == plen - 1) { // take all elements except last [len - m - 1] ones // that is the number of unassigned real parms <[ for (mutable i = $(p : int); i < len; i++) { match (li) { | x :: xs => pararr[i] = x; li = xs; | _ => Util.ice ("not enough elements") } } ]> } else <[ match (li) { | x :: xs => pararr[$(p : int)] = x; li = xs; | _ => Util.ice ("not enough elements") } ]> ) :: exprs; <[ fun (mutable li : list [SyntaxElement]) { def len = li.Length; def pararr = array (len); { ..$(List.Rev (exprs) ) } List.FromArray (pararr) } ]> } } } }