/*----- * group: Macro programming * purpose: Populate a macro array (N macro variables) from a delimited list of items. This macro uses rx* function, which have some problems with macro quoting tokens. */ %macro split ( array , items , bounding = Q , delim = %str( ) , scope = RESOLVE , lets = , locals = ); %* Richard A. DeVenezia %* 20041230 - Revised as [split], add bounding %* 20031119 - Revised as [array], add scope, lets and locals %* 19931109 - Initial coding as [makelist] %* %* Create a macro array from a delimited list of items %* %* This macro relies on SAS rx* functions to handle quoted items. %* However, there are some problems with how the rx* system handles macro quoting tokens. Thus not ready for primetime. %* %* value is %* ---------------------------------------------------------------- %* array - macro array name, prefix of numbered macro variables that %* will contain the item values %* items - original list of items, separated by sep %* bounding - characters an item can be bounded by for the cases when an item contains %* the delimiter, %* Q: single or double quote %* P: parenthesis () %* C: curly braces {} %* B: brackets [] %* A: angle brackets <> %* delim - character delimiting each item in items %* scope - scope of macro array variables. %* GLOBAL, INHERIT, RESOLVE %* GLOBAL - avoid if possible %* INHERIT - the invoker _must_ ensure the variables %* <&array>_size <&array>_1 ... <&array>_n exist %* prior to invoking %array. %* Why? because a macro is not allowed to create a macro variable %* in a local scope above its own. %* (It may however, access any macro variables in scope above itself) %* If this macro implicitly 'creates' a macro variable, it will %* be destroyed when the macro ends, and thus will not be available %* to invoker. %* RESOLVE - macro var named in lets will receive a quoted macro %* statement which is a series of %lets. The invoker is responsible %* for unquoting the statement to get macro vars in its scope. %* lets - name of macro var existing in invokers scope. %* upon return, the invoker should unquote the value %* to cause the macro array variables to be assigned. %* locals - name of macro var existing in invokers scope. %* upon return, the invoker should resolve this variable in a %* %local statement to ensure the variables in the lets variable %* will not accidently overwrite an existing macro variable in scope %* higher than invoker. (See examples at bottom) %*; %if (&array. =) %then %do; %put ERROR: array name is missing; %goto EndMacro; %end; %let bounding = %upcase(&bounding); %if 0 = %index (|Q|P|C|B|A| ||, |&bounding.|) %then %do; %put ERROR: bounding = &bounding is unknown, use Q, P, C, B, A or blank; %goto EndMacro; %end; %let scope = %upcase(&scope); %if 0 = %index (|GLOBAL|INHERIT|RESOLVE|, |&scope.|) %then %do; %put ERROR: scope = &scope is unknown, use GLOBAL, INHERIT or RESOLVE; %goto EndMacro; %end; %if (&scope = RESOLVE) and (&lets = ) %then %do; %put ERROR: scope=&scope requires an lets=; %goto EndMacro; %end; %let lets = %upcase(&lets); %if (&scope = RESOLVE) and (&lets = LETS) %then %do; %put ERROR: lets= can not be LETS, try lets=_let; %goto EndMacro; %end; %let locals = %upcase(&locals); %if (&locals=LOCALS) %then %do; %put ERROR: locals= can not be LOCALS, try locals=_local; %goto EndMacro; %end; %local pQ pP pC pB pA; %let pQ = $Q; %let pP = $(1); %let pC = ${1}; %let pB = $[1]; %let pA = $<1>; %local rxB1 rxB2 rxD; %* parse patterns that will locate bounded items; %if (&bounding eq ) %then %do; %let rxB1 = 0; %let rxB2 = 0; %end; %else %do; %let rxB1 = %sysfunc ( rxParse ( &&p&bounding "&delim." ) ) ; %let rxB2 = %sysfunc ( rxParse ( &&p&bounding @0 ) ) ; %end; %* parse pattern that will locate unbounded items; %let rxD = %sysfunc ( rxParse ( ^"&delim."+ "&delim." ) ); %local items_length item_position item_length item item_count new_start; %let item_count = 0; %if (&scope = GLOBAL) %then %global &array._size; %if (&scope = RESOLVE) %then %let &lets = ; %if (&locals ^= ) %then %let &locals = &array._size; %let items = %superq (items); %do %while (1); %put |&items.|; %let item_position = 0; %let item_length = 0; %let items_length = %length (&items); %* check if next item is bounded ; %if &rxB1 %then %do; %syscall rxSubstr (rxB1, items, item_position, item_length); %if &item_position = 1 %then %do; %* next item is bounded and followed by the delimiter; %let item = %qsubstr (&items, &item_position, &item_length-1); %if &items_length = &item_length %then %let items = ; %else %do; %let new_start = &item_position + &item_length; %put new_start=&new_start; %let items = %qsubstr (&items, &new_start); %end; %goto assign; %end; %syscall rxSubstr (rxB2, items, item_position, item_length); %if &item_position = 1 %then %do; %* final item is bounded and is items; %let item = &items; %let items = ; %goto assign; %end; %end; %* locate next item; %syscall rxSubstr (rxD, items, item_position, item_length); %if &item_position = 0 %then %do; %* delimiter not found; %let item = &items; %let items = ; %end; %else %if &item_length = 1 %then %do; %* delimiter found, but no item prior to it; %let item = ; %if &items_length = &item_length %then %let items = ; %else %do; %let new_start = &item_position + &item_length; %put new_start=&new_start; %let items = %qsubstr (&items, &item_position+&item_length); %end; %end; %else %do; %* delimiter found, and an item is prior to it; %let item = %qsubstr (&items, &item_position, &item_length-1); %if &items_length = &item_length %then %let items = ; %else %do; %let new_start = &item_position + &item_length; %put new_start=&new_start; %let items = %qsubstr (&items, &item_position+&item_length); %end; %end; %assign: %let item_count = %eval(&item_count + 1); %put &item_count.: &item_position &item_length |&item.|; %if &scope = GLOBAL %then %global &array.&item_count; %if (&scope = GLOBAL) or (&scope = INHERIT) %then %let &array.&item_count = &item; %else %let &lets = %nrquote(&&&lets)%nrstr(%let )&array.&item_count=&item%str(;); %if (&locals ^= ) %then %let &locals = &&&locals &array&item_count; %if %length (&items) = 0 %then %goto EndScan; %end; %EndScan: %if (&scope = GLOBAL) or (&scope = INHERIT) %then %let &array._size = &item_count; %else %let &lets = %nrquote(&&&lets)%nrstr(%let )&array._size=&item_count%str(;); %syscall rxfree(rxB1); %syscall rxfree(rxB2); %syscall rxfree(rxD); %EndMacro: %mend; /**html *

Sample code

*/ /**/ %split (bob, a b c d e, scope=GLOBAL) data _null_; do i = 1 to &bob_size; name = "BOB"||put(i,3.-L); value = symget (name); put i= name= value=; end; run; %* mis-application of INHERIT %* macro vars that will be the macro array should exist in invokers scope %* prior to using %split; %* In a fresh session, x1 to x5 and x_size do not exist in %* invoking scope (open code -aka- global) prior to invocation; %split (x, a b c d e, scope=INHERIT) %put &x_size; %* mis-application of INHERIT; %* dangerous because only y1, y3 and y_size are available as GLOBAL, %* and y2, y4 and y5 are not; %let y_size=; %let y1=; %let y3=; %split (y, a b c d e, scope=INHERIT) %put &y_size; %put &y1; %put &y2; %put &y3; %put &y4; %put &y5; %* mis-application of RESOLVE, init should exist prior to invocation; %split (z, a b c d e, scope=RESOLVE, lets=init); %put &init; %* proper application of RESOLVE, init exists prior to invocation; %let init=; %split (z, a b c d e, scope=RESOLVE, lets=init); %put &init; %unquote(&init) %put &z_size; %put &z1; %put &z2; %put &z3; %put &z4; %put &z5; %* proper application of RESOLVE, _let and _local exist prior to invocation; %macro foo; %local _let _local array; %let array=xyz; %split (&array, a b c d e, scope=RESOLVE, lets=_let, locals=_local); options symbolgen; %local &_local; %unquote (&_let) options nosymbolgen; %do i = 1 %to &&&array._size; %put &array&i=&&&array.&i; %end; %mend; %foo options nosymbolgen; /**/ /* %split (path, "A|B"|A|B|C|D|E, scope=GLOBAL, delim=|) */ %split (path, "C:\Program Files" "C:\Foo Bar" foo bar blah 'C:\Bar Foo', scope=GLOBAL) data _null_; do i = 1 to &path_size; name = "PATH"||put(i,3.-L); value = symget (name); put name= value=; end; run; %split (path, "C:\Program Files" "C:\Foo Bar" foo bar blah 'C:\Bar Foo', scope=GLOBAL, bounding=) options nosymbolgen; /**/