133 lines
4.9 KiB
Mathematica
133 lines
4.9 KiB
Mathematica
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
; ;
|
||
|
|
; Copyright 2010 Fidelity Information Services, Inc ;
|
||
|
|
; ;
|
||
|
|
; This source code contains the intellectual property ;
|
||
|
|
; of its copyright holder(s), and is made available ;
|
||
|
|
; under a license. If you do not know the terms of ;
|
||
|
|
; the license, please stop and do not read further. ;
|
||
|
|
; ;
|
||
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
|
map: ;create maps for put and show, names for get and show
|
||
|
|
PUTMAKE
|
||
|
|
k lexnams n t1
|
||
|
|
d SHOWMAKE
|
||
|
|
s s1=$ztr($zj("",SIZEOF("mident"))," ",$zch(255)),t1=$ztr($zj("",SIZEOF("mident"))," ",$zch(0))
|
||
|
|
f s s2=s1,s1=$o(map(s1),-1),map(s2_$ze(t1,$zl(s2)+1,SIZEOF("mident")))=map(s1) q:s1="$" k map(s1)
|
||
|
|
s map("#)"_$ze(t1,3,SIZEOF("mident")))=map("#)"),map("%"_$ze(t1,2,SIZEOF("mident")))=map("$")
|
||
|
|
f s2="#","#)","$" k map(s2)
|
||
|
|
q
|
||
|
|
;----------------------------------------------------------------------------------------------------------------------------------
|
||
|
|
SHOWMAKE
|
||
|
|
n lexnams s s=""
|
||
|
|
f s s=$o(nams(s)) q:'$zl(s) d lexins(s)
|
||
|
|
s map("$")=nams("*"),map("#")=nams("#")
|
||
|
|
s i=1
|
||
|
|
f s i=$o(lexnams(i)) q:'$zl(i) d showstar(i)
|
||
|
|
s s=""
|
||
|
|
f s s=$o(lexnams(0,s),-1) q:'$zl(s) d pointins(s,lexnams(0,s))
|
||
|
|
s s1=$o(map(""),-1)
|
||
|
|
f s s2=s1,s1=$o(map(s1),-1) q:s2="$" i map(s1)=map(s2) k map(s2)
|
||
|
|
q
|
||
|
|
;----------------------------------------------------------------------------------------------------------------------------------
|
||
|
|
SHOWNAM
|
||
|
|
n lexnams,t1,map
|
||
|
|
d SHOWMAKE
|
||
|
|
s s1=$ztr($zj("",SIZEOF("mident"))," ",$zch(255)),t1=$ztr($zj("",SIZEOF("mident"))," ",$zch(0))
|
||
|
|
f s s2=s1,s1=$o(map(s1),-1),map(s2)=map(s1) q:s1="$" k map(s1)
|
||
|
|
k map("#") i '$$MAP2NAM(.map) zm gdeerr("GDECHECK")\2*2
|
||
|
|
q
|
||
|
|
;----------------------------------------------------------------------------------------------------------------------------------
|
||
|
|
MAP2NAM(list)
|
||
|
|
n ar,l,s,x,xl,xn,xp,xt,xv
|
||
|
|
s x=$o(list("")) q:x'="#)" 0
|
||
|
|
s x=$o(list(x))
|
||
|
|
i x="%" s list("$")=list("%") k list("%")
|
||
|
|
e q:x'="$" 0
|
||
|
|
s s=$ztr($zj("",SIZEOF("mident"))," ",$zch(255)),x=$o(list(""),-1) q:x'=s 0
|
||
|
|
k ar,nams s nams=0,ar(0,s)="",x=$o(list(x),-1)
|
||
|
|
i x'="$",list(x)'=list(s) s xp="z" f q:xp="" s xn=xp_"*",(nams(xn),ar(1,xn))="",xp=$$lexprev(xp)
|
||
|
|
f q:x="$" d s x=$o(list(x),-1)
|
||
|
|
. i $d(list(x_")")) q
|
||
|
|
. s xl=$zl(x)
|
||
|
|
. i $ze(x,xl)=")" s xn=$ze(x,1,xl-1),(nams(xn))="" q
|
||
|
|
. i xl+1'<SIZEOF("mident") s (ar(SIZEOF("mident")+1,x),nams(x))="" q
|
||
|
|
. s xp=x,(ip,in)=0,star=$s(xl<(SIZEOF("mident")-1):"*",1:"")
|
||
|
|
. f s xp=$$lexprev(xp),l=$zl(xp) q:'l s ip=ip+1 q:l=xl&$d(list(xp))
|
||
|
|
. i ip'=1 s xn=x f s xn=$$lexnext(xn),l=$zl(xn) q:'l s in=in+1 q:l'>xl&($d(list(xn))!$d(list(xn_")")))
|
||
|
|
. i ip,ip'>in!($zl($ztr(x,"z"))&(xl+1=SIZEOF("mident")!'in)) do
|
||
|
|
. . s xp=x f ip=1:1:ip s xp=$$lexprev(xp),xn=xp_star,(nams(xn),ar(xl,xn))=""
|
||
|
|
. e s:'in&'$zl($ztr(x,"z")) in=1 s xn=x f in=1:1:in d q:$d(nams(xn))!$d(list(xn_")"))
|
||
|
|
. . s xp=xn_star,(nams(xp),ar($zl(xn),xp))="",xn=$$lexnext(xn)
|
||
|
|
s x="",ok=1
|
||
|
|
f xl=1:1:SIZEOF("mident") d q:'ok
|
||
|
|
. f s x=$o(ar(xl,x)) q:x="" d q:'ok
|
||
|
|
. . s xt=$o(list(x))
|
||
|
|
. . i '$zl(xt) s ok=0 q
|
||
|
|
. . s xv=list(xt)
|
||
|
|
. . i '$zl(xv) s ok=0 q
|
||
|
|
. . s xn=$$lexnext($ze(x,1,xl))
|
||
|
|
. . f l=xl-1:-1:0 d chkprojection q:$zl(xp)
|
||
|
|
i 'ok q 0
|
||
|
|
f s x=$o(nams(x)) q:x="" s xn=$o(list(x)),nams(x)=list(xn),nams=nams+1
|
||
|
|
s xl=SIZEOF("mident")+1,x=$o(ar(xl,""))
|
||
|
|
i $zl(x) f s xt=$o(ar(xl,x)) s xv=nams(x),xn=$$lexnext(x) d q:""=xt s x=xt
|
||
|
|
. f l=xl-3:-1:0 d chkprojection q:$zl(xp)
|
||
|
|
. i $zl(xt),xt'=xn,$d(nams(x)) f s nams(xn)=nams(x),nams=nams+1,xn=$$lexnext(xn) q:xt']xn
|
||
|
|
s nams("#")=list("#)"),nams("*")=list("$"),nams=nams+2
|
||
|
|
q 1
|
||
|
|
;----------------------------------------------------------------------------------------------------------------------------------
|
||
|
|
lexins:(s)
|
||
|
|
n x,l
|
||
|
|
i s["*" s l=$zl(s),x=$ze(s,1,l),lexnams(l,x)=nams(s)
|
||
|
|
e s lexnams(0,s)=nams(s)
|
||
|
|
q
|
||
|
|
showstar:(i)
|
||
|
|
s j=""
|
||
|
|
f s j=$o(lexnams(i,j),-1) q:'$zl(j) d starins($ze(j,1,$zl(j)-1),lexnams(i,j))
|
||
|
|
q
|
||
|
|
starins:(s,reg)
|
||
|
|
n next
|
||
|
|
s next=$$lexnext(s)
|
||
|
|
i $zl(next),'$d(map(next)) s map(next)=map($o(map(next),-1))
|
||
|
|
s map(s)=reg
|
||
|
|
q
|
||
|
|
pointins:(s,reg)
|
||
|
|
n next
|
||
|
|
s next=$$alphnext(s)
|
||
|
|
i $zl(next),'$d(map(next)) s map(next)=map($o(map(next),-1))
|
||
|
|
s map(s)=reg
|
||
|
|
q
|
||
|
|
alphnext:(s)
|
||
|
|
i $zl(s)=MAXNAMLN q $$lexnext(s)
|
||
|
|
e q s_")"
|
||
|
|
;
|
||
|
|
lexnext:(s)
|
||
|
|
n len,last,succ
|
||
|
|
s len=$zl(s),last=$ze(s,len)
|
||
|
|
i last="z" f s len=len-1,last=$ze(s,len) q:last'="z"!'len
|
||
|
|
i 'len q ""
|
||
|
|
s s=$ze(s,1,len-1),succ=$zch($za(last)+1)
|
||
|
|
i succ?1AN q s_succ
|
||
|
|
i "A"]succ q s_"A"
|
||
|
|
i "a"]succ q s_"a"
|
||
|
|
q ""
|
||
|
|
lexprev:(s)
|
||
|
|
n len,last,prio
|
||
|
|
s len=$zl(s),last=$ze(s,len)
|
||
|
|
s s=$ze(s,1,len-1),prio=$zch($za(last)-1)
|
||
|
|
i prio?1AN q s_prio
|
||
|
|
i prio]"Z" q s_"Z"
|
||
|
|
i prio]"9" q:len=1 "%" q s_"9"
|
||
|
|
q ""
|
||
|
|
chkprojection: ; assumes l,x,xt,xv and may change ok & xp
|
||
|
|
n xr,xs
|
||
|
|
s (xp,xs)=$ze(x,1,l)
|
||
|
|
f s xp=$o(ar(l,xp)) s xr=$s('$zl(xp):"",'l:"$",$ze(xp,1,l)'=xs:xt,1:$o(list(xp))) i xs']xr!'$zl(xr)!'l q
|
||
|
|
s:'$zl(xr) xp="" q:'$zl(xp)
|
||
|
|
i xt=xr&(xl>1) s xp=" " q
|
||
|
|
s xp=list(xr)
|
||
|
|
i '$zl(xp) s ok=0 q
|
||
|
|
i xv=xp k nams(x)
|
||
|
|
q
|