share/macro/contrl.mac

   1 /*-*-MACSYMA-*-*/
   2
   3 eval_when([translate,batch,demo],
   4           if get('sharem,'version)=false then load(autolo))$
   5
   6 herald_package(contrl)$
   7
   8 /* cond and caseq */
   9
  10 eval_when([translate,batch,demo,loadfile],
  11
  12 cond([pair_sequence])::=
  13  if pair_sequence=[] then buildq([],false)
  14  else
  15   block([pred:pop(pair_sequence),
  16          form:if pair_sequence=[] then error("odd number of cond args")
  17               else pop(pair_sequence)],
  18     if pred=true then buildq([form],form)
  19     else buildq([pred,form,pair_sequence],
  20             if pred then form else cond(splice(pair_sequence))))
  21 )$
  22
  23 caseq(exp,[pairs])::=
  24  block([predt,statement],
  25   cond(not atom(exp),
  26        buildq([g:?gentemp(),exp,pairs],block([g:exp],caseq(g,splice(pairs)))),
  27
  28        pairs=[],buildq([],false),
  29
  30        (predt:pop(pairs),if listp(predt) and length(predt)=1 then predt:predt[1],pairs=[]),
  31        error("odd number of caseq case args"),
  32
  33        true,
  34        (statement:pop(pairs),
  35         if member(predt,'[otherwise,true]) then buildq([statement,exp],statement)
  36         else
  37            buildq([condition:if listp(predt) then
  38                                 buildq([exp,predt],member(exp,'predt))
  39                              else buildq([exp,predt],exp='predt),
  40                    statement,exp,pairs],
  41               if condition then statement
  42               else caseq(exp,splice(pairs))))))$