diff options
Diffstat (limited to 'src/interp/br-op2.boot')
-rw-r--r-- | src/interp/br-op2.boot | 144 |
1 files changed, 0 insertions, 144 deletions
diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index dbac1262..bff5beac 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -41,150 +41,6 @@ import br_-op1 -- Operation Description --======================================================================= -displayDomainOp(htPage,which,origin,op,sig,predicate, - doc,index,chooseFn,unexposed?,$generalSearch?) == ------------------------> OBSELETE - $saturn => - displayDomainOp1(htPage,which,origin,op,sig,predicate, - doc,index,chooseFn,unexposed?,$generalSearch?) - $chooseDownCaseOfType : local := true --see dbGetContrivedForm - $whereList : local := nil - $NumberList : local := '(i j k l m n i1 j1 k1 l1 m1 n1 i2 j2 k2 l2 m2 n2 i3 j3 k3 l3 m3 n3 i4 j4 k4 l4 m4 n4 ) - $ElementList: local := '(x y z u v w x1 y1 z1 u1 v1 w1 x2 y2 z2 u2 v2 w2 x3 y3 z3 u3 v3 w3 x4 y4 z4 u4 v4 w4 ) - $FunctionList:local := '(f g h d e F G H) - $DomainList: local := '(D R S E T A B C M N P Q U V W) - exactlyOneOpSig := null index - conform := htpProperty(htPage,'domname) or htpProperty(htPage,'conform) - or origin - if $generalSearch? then $DomainList := rest $DomainList - opform := - which = '"attribute" => - null sig => [op] - [op,sig] - which = '"constructor" => origin - dbGetDisplayFormForOp(op,sig,doc) - htSay('"\newline") - if exactlyOneOpSig then htSay('"\menuitemstyle{}") - else htMakePage [['bcLinks,['"\menuitemstyle{}",'"",chooseFn,which,index]]] - htSay('"\tab{2}") - op := IFCAR opform - args := IFCDR opform - ops := escapeSpecialChars STRINGIMAGE op - n := #sig - do - n = 2 and LASSOC('Nud,PROPLIST op) => htSay(ops,'" {\em ",quickForm2HtString KAR args,'"}") - n = 3 and LASSOC('Led,PROPLIST op) => htSay('"{\em ",quickForm2HtString KAR args,'"} ",ops,'" {\em ",quickForm2HtString KAR KDR args,'"}") - if unexposed? and $includeUnexposed? then - htSayUnexposed() - htSaySaturn '"\unexposed{{\em " - htSaySaturn ops - htSaySaturn '"}" - htSayStandard(ops) - predicate='ASCONST or niladicConstructorFromDB op or member(op,'(0 1)) => 'skip - which = '"attribute" and null args => 'skip - htSay('"(") - if IFCAR args then htSay('"{\em ",quickForm2HtString IFCAR args,'"}") - for x in IFCDR args repeat - htSay('",{\em ",quickForm2HtString x,'"}") - htSay('")") - constring := form2HtString conform - conname := first conform - $conkind : local := htpProperty(htPage,'kind) -- a string e.g. "category" - or STRINGIMAGE getConstructorKindFromDB conname - $conlength : local := #constring - $conform : local := conform - $conargs : local := rest conform - if which = '"operation" then - $signature : local := - MEMQ(conname,$Primitives) => nil - CDAR getConstructorModemapFromDB conname - --RDJ: this next line is necessary until compiler bug is fixed - --that forgets to substitute #variables for t#variables; - --check the signature for SegmentExpansionCategory, e.g. - tvarlist := TAKE(# $conargs,$TriangleVariableList) - $signature := SUBLISLIS($FormalMapVariableList,tvarlist,$signature) - $sig := - which = '"attribute" or which = '"constructor" => sig - $conkind ^= '"package" => sig - symbolsUsed := [x for x in rest conform | IDENTP x] - $DomainList := SETDIFFERENCE($DomainList,symbolsUsed) - getSubstSigIfPossible sig - if member(which,'("operation" "constructor")) then - $displayReturnValue: local := nil - if args then - htSay('"\newline") - htSayStandard '"\tab{2}" - htSay '"{\em Arguments:}" - for a in args for t in rest $sig repeat - htSayIndentRel(15,true) - htSay('"{\em ",form2HtString(a),'"}, ") - htSayValue t - htSayIndentRel(-15,true) - htSay('"\newline ") - if first $sig then - $displayReturnValue := true - htSay('"\newline\tab{2}{\em Returns:}") - htSayIndentRel(15) - htSayValue first $sig - htSayIndentRel(-15) - htSay('"\newline ") - if origin and ($generalSearch? or origin ^= conform) and opOf(origin)^=op then - htSay('"\newline\tab{2}{\em Origin:}") - htSayIndentRel(15) - if not isExposedConstructor opOf origin and $includeUnexposed? then htSayUnexposed() - bcConform(origin,true) - htSayIndentRel(-15) - if not MEMQ(predicate,'(T ASCONST)) then - pred := sublisFormal(KDR conform,predicate) - count := #pred - htSay('"\newline\tab{2}{\em Conditions:}") - for p in displayBreakIntoAnds SUBST($conform,"$",pred) repeat - htSayIndentRel(15,count > 1) - bcPred(p,$conform,true) - htSayIndentRel(-15,count > 1) - htSay('"\newline ") - if $whereList then - count := #$whereList - htSay('"\newline\tab{2}{\em Where:}") - if ASSOC("$",$whereList) then - htSayIndentRel(15,true) - htSayStandard '"{\em \$} is " - htSaySaturn '"{\em \%} is " - htSay - $conkind = '"category" => '"of category " - '"the domain " - bcConform(conform,true,true) - htSayIndentRel(-15,true) - for [d,key,:t] in $whereList | d ^= "$" repeat - htSayIndentRel(15,count > 1) - htSay("{\em ",d,"} is ") - htSayConstructor(key,sublisFormal(KDR conform,t)) - htSayIndentRel(-15,count > 1) - if doc and (doc ^= '"" and (doc isnt [d] or d ^= '"")) then - htSay('"\newline\tab{2}{\em Description:}") - htSayIndentRel(15) - if doc = $charFauxNewline then htSay $charNewline - else - ndoc:= - -- we are confused whether doc is a string or a list of strings - CONSP doc => [SUBSTITUTE($charNewline, $charFauxNewline, i) for i in doc] - SUBSTITUTE($charNewline, $charFauxNewline,doc) - htSay ndoc - htSayIndentRel(-15) - if exactlyOneOpSig and (infoAlist := htpProperty(htPage,'infoAlist)) then - displayInfoOp(htPage,infoAlist,op,sig) - - -htSayIndentRel(n,:options) == ------------------> OBSELETE - flag := IFCAR options - m := ABSVAL n - if flag then m := m + 2 - htSay - n > 0 => - flag => ['"\indent{",STRINGIMAGE m,'"}\tab{-2}"] - ['"\indent{",STRINGIMAGE m,'"}\tab{0}"] - n < 0 => ['"\indent{0}\newline "] htSayConstructor(key,u) == u is ['CATEGORY,kind,:r] => |