;-----------------------------------------------------------------------
; Modulo de Input Output
;
; 1. Leitura de STR e INT
;     lerstr : prompt -> string nao vazia e incluindo
;     lerint : prompt -> inteiro
;     lerany : prompt -> any      (* str entre "",inteiros, Sexp *)
;     lersetstr : prompt -> set of STR (* terminar com "." *)
;     lerset : prompt -> set of ANY    (* terminar com "." *)
;     lerfixdomff : ANY-set -> ffanyany
;
; 2. PrettyPrint 
;     pp   - Prettyprint 
;     fpp - Fast PrettyPrint
;
; 3. Escolha interactiva de um elemento dum SET, LIST, FF:
;     pickone : (ANY-set | ANY-list | ANY-> ANY) -> ANY
;     ppickone : (ANY-set | ANY-list | ANY-> ANY) x prompt -> ANY
;     pickmany : (ANY-set | ANY-list | ANY-> ANY) -> ANY-set
;
; 4. Menu que associa opcoes a expressoes, menus, funcoes ou valores
;    Inteiros
;          menu: tmenu -> ANY   (resultado duma funcao, resultado do
;                                calculo de uma expressao, Inteiro ou
;                                resultado da exec. dum menu )
;          run : tmenu ->       (executa menu ate' escolher opcao 0)
;
;TYPE
;   tmenu :: titger : STR                /*     titulo do menu     */
;            opcoes_list : opcoes-list;  /*     lista das opcoes   */
;   opcoes :: titopc : STR               /*     tilulo da opcao    */
;             accao_op : taccao;  
;   taccao =  tmenu | SYM |INT | _exp;
;   _exp = ANY;
;ENDTYPE
;
;Exemplo de menu: 
;M <- tmenu("Menu geral",            /* accao = calculo de expressao */
;           <opcoes("conteudo deste menu",'(pp(M))),
;            opcoes("invocacao deste menu",'(menu(M)))>);
;            
;-----------------------------------------------------------------------


( def lerstr lambda
  ( str )
  ( progn
    ( ppn str )
    ( let
      (
        ( a
          ( fgets )
        )
      )
      ( if
        ( equal a "\n" )
        ( _l
          ( fgets )
        )
        ( _l a )
      )
    )
  )
)
;---------------------

( def _l lambda
  ( y )
  ( let
    (
      ( z
        ( strlen y )
      )
    )
    ( substr y 1
      ( sub z 1 )
    )
  )
)
;---------------------


( def lerint lambda
  ( str )
  ( progn
    ( ppn str )
    ( let
      (
        ( a
          ( read )
        )
      )
      ( if
        ( equal
          ( type a ) 'INT
        ) a
        ( lerint str )
      )
    )
  )
)
;---------------------

( def lersetstr lambda
  ( str )
  ( progn
    ( ppn str )
    ( let
      (
        ( a
          ( lerstr "?- " )
        )
      )
      ( if
        ( equal a "." )
        ( makeset )
        ( union
          ( makeset a )
          ( lersetstr " " )
        )
      )
    )
  )
)
;---------------------
(def FIM '.)

( def lerset lambda
  ( str )
  ( progn
    ( ppn str )
    ( let
      (
        ( a
          ( read )
        )
      )
      ( if
        ( equal a FIM )
        ( makeset )
        ( union
          ( makeset a )
          ( lerset "? " )
        )
      )
    )
  )
)
;---------------------


( def pickone lambda
  ( m1 )
  ( let
    (
      ( m
        ( cond
          (
            ( equal 'SET
              ( type m1 )
            )
            ( seq x
              ( from x m1 )
            )
          )
          (
            ( equal 'LIST
              ( type m1 )
            ) m1
          )
          (
            ( equal 'FF
              ( type m1 )
            )
            ( seq
              ( makeff
                ( x
                  ( ap m1 x )
                )
              )
              ( from x
                ( dom m1 )
              )
            )
          )
        )
      )
      ( a1
        ( progn
          ( princ "\n--------------------------------------------------\n\t" )
          ( set
            ( princ x " "
              ( el x m ) "\n\t"
            )
            ( from x
              ( inds m )
            )
          )
          ( def _b
            ( leropcao "\nqual destes ? " )
          )
          ( while
            ( or
              ( gt _b
                ( length m )
              )
              ( lt _b 0 )
            )
            ( def _b
              ( leropcao "qual destes ? " )
            )
          )
          ( princ "\n--------------------------------------------------\n" )
        )
      )
    )
    ( if
      ( equal _b 0 ) NIL
      ( el _b m )
    )
  )
)
;---------------------


( def pickmany lambda
  ( m1 )
  ( let
    (
      ( m
        ( cond
          (
            ( equal 'SET
              ( type m1 )
            )
            ( seq x
              ( from x m1 )
            )
          )
          (
            ( equal 'LIST
              ( type m1 )
            ) m1
          )
          (
            ( equal 'FF
              ( type m1 )
            )
            ( seq
              ( makeff
                ( x
                  ( ap m1 x )
                )
              )
              ( from x
                ( dom m1 )
              )
            )
          )
        )
      )
      ( a1
        ( progn
          ( princ "\n--------------------------------------------------\n\t" )
          ( set
            ( princ x " "
              ( el x m ) "\n\t"
            )
            ( from x
              ( inds m )
            )
          )
        )
      )
    )
    ( set
      ( el b m )
      ( from b
        ( lerset "\nquais destes (. para terminar)\n ? " )
      )
    )
  )
)
;---------------------


( def ppickone lambda
  ( m1 s )
  ( let
    (
      ( m
        ( cond
          (
            ( equal 'SET
              ( type m1 )
            )
            ( seq x
              ( from x m1 )
            )
          )
          (
            ( equal 'LIST
              ( type m1 )
            ) m1
          )
          (
            ( equal 'FF
              ( type m1 )
            )
            ( seq
              ( makeff
                ( x
                  ( ap m1 x )
                )
              )
              ( from x
                ( dom m1 )
              )
            )
          )
        )
      )
      ( a1
        ( progn
          ( princ "\n--------------------------------------------------\n\t" )
          ( set
            ( princ x " "
              ( el x m ) "\n\t"
            )
            ( from x
              ( inds m )
            )
          )
          ( def _b
            ( leropcao
              ( strcat "\n" s )
            )
          )
          ( while
            ( or
              ( gt _b
                ( length m )
              )
              ( lt _b 0 )
            )
            ( def _b
              ( leropcao
                ( strcat "\n" s )
              )
            )
          )
          ( princ "\n--------------------------------------------------\n" )
        )
      )
    )
    ( if
      ( equal _b 0 ) NIL
      ( el _b m )
    )
  )
)
;---------------------

( def lerany lambda
  ( p )
  ( progn
    ( ppn p )
    ( read )
  )
)
;---------------------


( def lerfixdomff lambda
  ( e )
  ( ff1
    ( list x
      ( lerany x )
    )
    ( from x e )
  )
)
;---------------------
;---------------------------------------------------------------------
; PrettyPrint - pp
;---------------------------------------------------------------------
;    pp(valor) = do(  princ(" "),
;                     if valor == nil then
;                       fputs("{} ")
;                     else
;                       pprint1(valor, 1,0), princ("\n") );
;

( def fpp lambda
  ( valor )
  ( nwrite stdout valor )
)
;---------------------
;
;    ppn(valor) = do(  princ(" "),
;                     if valor == nil then
;                       fputs("{} ")
;                     else
;                      pprint1(valor, 1,0));
;    pprint1(valor,i,ml) =
;    if valor == nil then 
;       fputs(" {} ")
;     else 
;       let (tipo = type(valor))
;       in if (tipo in {'INT, 'STR, 'SYM} -> pvalor(valor),
;              tipo == 'FF                -> pff(valor, i,ml),
;              tipo == 'REL               -> prel(valor, i,ml),
;              tipo == 'SET               -> pset(valor, i,ml),
;              tipo == 'LIST              -> plist(valor, i,ml),
;              tipo == 'ALT               -> palt(valor, i,ml),
;              tipo == 'FUN               -> pfunc(valor, i,ml)
;             )
;           otherwise
;             let (tipoex = gettype(tipo))
;             in if hd(tipoex) == 'EQ  then
;                   peq(valor, tipo, i,ml)
;                 else          
;                   ptup(tipo, valor, tl(tipoex), i,ml);
;
;    /* --- */
;
;    pvalor(valor) = princ(valor," ");
;
;    /* --- */
;
;    pff(valor,i,ml) =
;    do( if(ml == 1) then indent(i),
;        fputs("[ "),
;        let (y = choice(dom(valor)),
;             valor_ = dom(valor)-{y},
;             i2 = add(2,i))
;        in do( pprint1(y, i2, 0),
;               fputs("-> "),
;               pprint1(valor[y], i2, 0),
;               { do( indent(i2),
;                     pprint1(x, i2,1),
;                     fputs("-> "),
;                     pprint1(valor[x], i2, 0)) 
;               | x <- valor_ }
;             ),
;        fputs("]")
;      );
;
;     /* --- */
;    pfunc(valor,i,ml) =
;   do( if(ml == 1) then indent(i),
;        fputs("func ("),
;        foreach(x,hd(valor),pvalor(x)),
;        fputs(")="),
;        pexp(hd(tl(valor)),i.+1,1)
;     );
;
;    /* --- */
;    pexp(valor,i,ml) = plist(valor,i,ml);
;    /* --- */
;
;    prel(valor,i,ml) =
;    do(    if(ml == 1) then indent(i),
;           fputs("[ "),
;           let (y = choice(valor),
;                j = add(i,2),
;                valor_ = valor-[*hd(y) -> hd(tl(y))*]
;               )
;           in do( pprint1(first(y), j,0),
;                     fputs("<-> "),
;                     pprint1(second(y), j,0),
;                     { do( indent(j),
;                           pprint1(first(x), j,1),
;                           fputs("<-> "),
;                           pprint1(second(x), j,0)) 
;                     | x <- valor_
;                     }
;                ),
;           fputs("]")
;         );
;
;    /* --- */
;
;    pset(valor,i,ml) = 
;    do   (if (ml == 1) then indent(i), 
;          fputs("{ "),
;          let(p=choice(valor),
;              j=add(i,2),
;              r=valor - {p} )
;          in do( pprint1(p,j,0),
;                 { pprint1(x, j, 1) | x <- r }),
;          fputs("}")
;         );
;
;    /* --- */
;
;    plist(valor,i,ml) = 
;    do   (if (ml == 1) then indent(i), 
;          fputs("< "),
;          let(p=hd(valor),
;              j=add(i,2),
;              r=tail(valor))
;          in do( pprint1(p,j,0),
;                 { pprint1(x, j, 1) | x <- r }),
;          fputs(">")
;         );
;
;    /* --- */
;
;    peq(nome,valor,i,ml) =
;    do( fputs("("),
;           fputs(nome),
;           fputs(")"),
;           let (len = add(strlen(nome), 2))
;           in pprint1(ignlab(valor), add(lin, i),0)
;         );
;
;    /* --- */
;
;    ptup(nome,valor,tipo,i,ml) =
;    do(
;           if(ml == 1) then indent(i),
;           fputs("[ "),
;           let( len = add( 2, i),
;                k = choice(elems(inds(tipo))),
;                inds_ = elems(inds(tipo))-{k},
;                selec = first(nth(k, tipo)),
;                len_ = add(add(strlen(symstr(selec)), 2), len))
;           in  do( fputs(symstr(selec)),
;                   fputs(": "),
;                   pprint1((eval(selec))(valor), len_,0),
;                   { let (selector = first(nth(j, tipo)),
;                          len1 = add(add(strlen(symstr(selector)), 2), len)
;                         )
;                     in do( indent(len),
;                            fputs(symstr(selector)),
;                            fputs(": "),
;                            pprint1((eval(selector))(valor), len1,0)) 
;                   | j <- inds_ }
;                 ),
;           fputs("] ")
;       );
;
;    /* --- */
;
;    indent(i) = let (s = inseg(i))
;                in fputs(strcat("\n", strcat-orio("",
;                                <" "|y <- s : (y <= i)>)));
;
;                            
; pp(<1,2,3,{2,4},[ 1-> 3]>);
; pp(obs);
; pp(M);
;          pickone 
;          menu
;          run 

( def leropcao lambda
  ( x )
  ( let
    (
      ( a
        ( lerstr x )
      )
    )
    ( if
      ( equal a "\e\n" ) 0
      ( atoi a )
    )
  )
)
;---------------------

( deftype tmenu TUP
  ( titger STR )
  ( opcoes_list LIST opcoes )
)
;---------------------

( deftype opcoes TUP
  ( titopc STR )
  ( accao_op taccao )
)
;---------------------

( deftype taccao ALT tmenu SYM INT _exp )
;---------------------

( deftype _exp ANY )
;---------------------


( def menu lambda
  ( m )
  ( let
    (
      ( m1
        ( opcoes_list m )
      )
      ( a1
        ( progn
          ( princ "\n--------------------------------------------------" )
          ( princ "\n\t"
            ( titger m ) "\n\n\t"
          )
          ( set
            ( princ x " "
              ( titopc
                ( el x m1 )
              ) "\n\t"
            )
            ( from x
              ( inds m1 )
            )
          )
          ( def _b
            ( leropcao "\nqual a opcao? " )
          )
          ( while
            ( or
              ( gt _b
                ( length m1 )
              )
              ( lt _b 0 )
            )
            ( def _b
              ( leropcao "qual a opcao? " )
            )
          )
          ( princ "\n--------------------------------------------------\n" )
        )
      )
      ( acc
        ( if
          ( nequal 0 _b )
          ( accao_op
            ( el _b m1 )
          ) _b
        )
      )
    )
    ( cond
      (
        ( equal 'SYM
          ( type acc )
        )
        (
          ( eval acc )
        )
      )
      (
        ( is tmenu acc )
        ( menu acc )
      )
      (
        ( equal 'LIST
          ( type acc )
        )
        ( eval acc )
      )
      (
        ( equal 'INT
          ( type acc )
        ) acc
      )
      ( true acc )
    )
  )
)
;---------------------
;FUNC run (m:tmenu)
;STATE let(x=menu(m))
;       in if (x == 0) then NIL
;          else do( pp(x),run(m));
; dada a necessidade de eficiencia desta funcao, foi reescrita de modo 
;  mais imperativo...


( def run lambda
  ( m )
  ( while
    ( let
      (
        ( x
          ( menu m )
        )
      )
      ( if
        ( nequal x 0 )
        ( progn
          ( pp x ) true
        ) false
      )
    )
  )
)
;---------------------
;M <- tmenu("Menu geral",
;           <opcoes("conteudo deste menu",'(pp(M))),
;            opcoes("invocacao deste menu",'(menu(M)))>);
;            
;pptmenu(x,i)= do(fputs("\nTitulogeral: "), pp(titger(x)),
;                  fputs("\nOpcoes:\n"), pp(opcoes_list(x)));
;
;ppopcoes(x,i)= do(fputs("\ttiulo: "), pp(titopc(x)),
;                   fputs("\n\taccao: "), pp(accao_op(x)),
;                   fputs("\n"), NIL);
;