#include io.cam
#include seq.cam
#include str.cam
#include txt.cam

TYPE

; the Repository

    Db  = IdComp -> MComp;

    MComp = Comp | RComp;

    Comp :: F: IdCompIfAny
            St: STR -> Sets
            A: Actions;
    IdCompIfAny = [IdComp];

    RComp :: F: IdComp
             St: STR -> STR
             A: STR -> STR;
    Actions = IdAccao -> Func;
    Func :: I: Sets-list
            O: Sets-list;


; SETS sublanguage

    Sets = Var | Pow | List | Ffun | Times | Plus | Cons;
    Cons :: N: STR;
    Var  :: V: STR;
    Pow  :: E: Sets;
    List :: A: Sets;
    Ffun :: D: Sets R: Sets;
    Times:: A: Sets B: Sets;
    Plus :: A: Sets B: Sets;

; end of SETS sublanguage

    IdComp  = STR;
    IdAccao = STR;


ENDTYPE

FUNC TAXDUMP(i:NAT):VOID
RETURN let (a={ k | k <- dom(db): ~is-NIL(F(db[k])) },
            b=(*->F)(db/a))
       in ioTxt2File("_tmp0",tax2txt(llg2tax(b),0,i));

;------------- aux -----------------------

flat(p) = < p1(p), p1(p2(p)), p2(p2(p)) >;

FUNC listByIndex(f:A->B,l:A-list): ABlist
RETURN < <a,f[a]> | a <- l: a in dom(f) >;

FUNC STRsetSort(s:STR-set):STR-list
RETURN if s=={} then <>
       else let(a=strMIN(s))
            in < a > ^ STRsetSort(s-{a});

addSep2StrList(l,s) = 
       if l==<> then <>
                else < head(l) > ^ CONC(< < s , x > | x <- tail(l) > ); 

; --- Taxonomies with no multiple inheritance modelled by left linear graphs
; cf llg.ca0

FUNC llg2tax(g:LLGraph):Tax
RETURN llg2taxAux(g,{a | a <- ran(g)-dom(g)});

FUNC llg2taxAux(g:LLGraph,S:Classes):Tax
RETURN [ a -> llg2taxAux(g, { b | b<-dom(g): g[b]==a }) | a <- S ];

FUNC tax2txt(t:Tax,a:NAT,b:NAT):txt
RETURN let (c= CONC(< < < strFill(" ", a.*b),k > > ^ tax2txt(t[k], a .+ 1, b)
                    | k <- dom(t) >))
       in txtFlat(txtAddNL(c));

;-----------------------------------------

FUNC SetsSubst(e:Sets,s:STR->Sets):Sets
RETURN if is-Cons(e) then e
       else if is-Var(e)
               then let (v=V(e))
                    in (if v in dom(s) then s[v] else e)
       else if is-Pow(e) then Pow(SetsSubst(E(e),s))
       else if is-List(e) then List(SetsSubst(A(e),s))
       else if is-Ffun(e) then Ffun(SetsSubst(D(e),s),SetsSubst(R(e),s))
       else if is-Times(e) then Times(SetsSubst(A(e),s),SetsSubst(B(e),s))
       else                    Plus(SetsSubst(A(e),s),SetsSubst(B(e),s));

FUNC Sets2STR(e:Sets):STR
RETURN if is-Cons(e) then N(e)
       else if is-Var(e)  then V(e)
       else if is-Pow(e)  then strcat(Sets2STRaux(E(e)),"-set")
       else if is-List(e) then strcat(Sets2STRaux(A(e)),"-seq")
       else if is-Ffun(e) then strcat(Sets2STRaux(D(e)),"->",
                                         Sets2STR(R(e)))
       else if is-Times(e) then strcat(Sets2STRaux(A(e)),"*",
                                          Sets2STRaux(B(e)))
       else                     strcat(Sets2STRaux(A(e)),"+",
                                          Sets2STRaux(B(e)));

FUNC Sets2STRaux(e:Sets):STR
RETURN if is-Cons(e) then N(e)
       else if is-Var(e) then V(e)
       else strcat("(",Sets2STR(e),")");


FUNC ActionsSubst(f:Actions,s:STR->Sets):Actions
RETURN [  k -> let (x=f[k],
                    i=I(x),
                    o=O(x),
                    ii=<SetsSubst(e,s)|e<-i>,
                    oo=<SetsSubst(e,s)|e<-o>)
               in Func(ii,oo)
           | k <- dom(f) ];

FUNC Comp2SEXP(i:Comp,db:Db):SEXP
RETURN if i in dom(db)
       then let (x=db[i],
                 a=if is-Comp(x) then AcInherit(i,[],db)
                   else let (y=AcInherit(F(x),A(x),db),
                             f=lambda(d).SetsSubst(d,(*->Var)(St(x))))
                        in [ a -> let (i=I(y[a]),
                                       o=O(y[a]))
                                  in Func(f-seq(i),f-seq(o)) | a <- dom(y) ],
                 b= [ n -> let (x=a[n],
                                i=< Sets2STR(s) | s <- I(x) >,
                                o=< Sets2STR(s) | s <- O(x) >,
                                ii=strCAT(addSep2StrList(i," , ")),
                                oo=strCAT(addSep2StrList(o," , ")),
                                s= < ii,oo >)
                           in s
                    | n <- dom(a)],
                 c= STRsetSort(dom(b)),
                 d= length(c),
                 e= seqSubl(c,1,d./2),
                 f= seqSubl(c,d./2.+1,d./2.+1),
                 g=listByIndex(b,e),
                 h=listByIndex(b,f),
                 j=< flat(x) | x <- g >,
                 k=< flat(x) | x <- h >)
            in ["@Name"->i,
                "@State"->Sets2STR(StInherit(i,db)),
                "@LActions"-> j,
                "@RActions"-> k
                ]
       else [];

FUNC INIT():SYM
STATE
db <- [
         "RSC"  -> Comp(NIL,[],
                        [
                          "RD" -> Func(<>,<Var("A")>),
                          "WR" -> Func(<Var("A")>,<>),
                          "NOP" -> Func(<>,<>),
                          "EQL" -> Func(<Var("A")>,<Cons("BOOL")>)
                        ]),
         "FSET" -> Comp("RSC",["A"->Pow(Var("A"))],
                        [
                          "INIT" -> Func(<>,<>),
                          "INS" -> Func(<Var("A")>,<>),
                          "REM" -> Func(<Var("A")>,<>),
                          "GET" -> Func(<>,<Var("A")>),
                          "EMPTY" -> Func(<>,<Cons("BOOL")>),
                          "TEST" -> Func(<Var("A")>,<Cons("BOOL")>)
                        ]),
         "FFUN" -> Comp("RSC",["A"->Ffun(Var("A"),Var("B"))],
                        [
                          "INIT" -> Func(<>,<>),
                          "INS" -> Func(<Var("A"),Var("B")>,<>),
                          "REM" -> Func(<Var("A")>,<>),
                          "EMPTY" -> Func(<>,<Cons("BOOL")>),
                          "FIND" -> Func(<Var("A")>,<Var("B")>)
                        ]),
         "MSET" -> Comp("FFUN",["B"->Cons("NAT")],
                        [
                          "MUL" -> Func(<Cons("NAT")>,<>),
                          "DIF" -> Func(<Ffun(Var("A"),Cons("NAT"))>,<>),
                          "ADD" -> Func(<Ffun(Var("A"),Cons("NAT"))>,<>)
                        ]),
         "BREL" -> Comp("FSET",["A"->Times(Var("A"),Var("B"))],
                        [
                          "REMR" -> Func(<Var("A")>,<>),
                          "REML" -> Func(<Var("B")>,<>),
                          "SELR" -> Func(<Var("A")>,<Pow(Var("B"))>),
                          "SELL" -> Func(<Var("B")>,<Pow(Var("A"))>)
                        ]),
;        "XBREL" -> Comp("BREL",["B"->Pow(Var("B"))],
;                       [
;                         "MERGE" -> Func(<>,<Pow(Times(Var("A"),Var("B")))>)
;                       ]),
         "FFSET" -> Comp("FSET",["A"->Ffun(Var("A"),Var("B"))],
                        [
                          "HIST" -> Func(<Var("B")>,<Ffun(Var("B"),Cons("NAT"))>),
                          "REN"  -> Func(<Ffun(Var("A"),Var("A"))>,<>),
                          "JOIN" -> Func(<Pow(Ffun(Var("A"),Var("B")))>,<>)
                        ]),
         "ORDER" -> Comp("BREL",["B"->Var("A")],
                        [
                            "RCLOSE" -> Func(<>,<>),
                            "SCLOSE" -> Func(<>,<>),
                            "TCLOSE" -> Func(<>,<>)
                        ]),
         "QSET" -> Comp("FSET",["A"->Pow(Var("A"))],
                        [
                            "INIT" -> Func(<Pow(Var("A"))>,<>),
                            "EQU" ->  Func(<Var("A"),Var("A")>,<>),
                            "ETEST" ->  Func(<Var("A"),Var("A")>,<Cons("BOOL")>),
                            "CLASS" -> Func(<Var("A")>,<Pow(Var("A"))>)
                        ]),
         "SEQ" -> Comp("RSC",["A"->List(Var("A"))],
                        [
                          "INIT" -> Func(<>,<>),
                          "EMPTY" -> Func(<>,<Cons("BOOL")>)
                        ]),
;        "POLY" -> Comp("RSC",["A"->Plus(Var("A"),Var("B"))],
;                       [
;                         "INIT" -> Func(<>,<>)
;                       ]),
         "FLIST" -> Comp("SEQ",["A"->List(Var("A"))],
                        [
                          "CONS" -> Func(<Var("A")>,<>),
                          "HEAD" -> Func(<>,<Var("A")>),
                          "TAIL" -> Func(<Var("A")>,<>),
                          "GET" -> Func(<>,<Var("A")>)
                        ]),
         "STACK" -> Comp("SEQ",[],
                        [
                          "PUSH" -> Func(<Var("A")>,<>),
                          "TOP"  -> Func(<>,<Var("A")>),
                          "POP" -> Func(<>,<Var("A")>)
                        ]),
         "QUEUE" -> Comp("SEQ",[],
                        [
                          "ENQ" -> Func(<Var("A")>,<>),
                          "FRONT"  -> Func(<>,<Var("A")>),
                          "DEQ" -> Func(<>,<Var("A")>)
                        ]),
         "TEXT"  -> Comp("FLIST",["A"->List(Var("A"))],
                        [
                          "INS" -> Func(<Var("A"),Cons("NAT"),Cons("NAT")>,<>),
                          "DEL" -> Func(<Cons("NAT"),Cons("NAT")>,<Var("A")>),
                          "READ"-> Func(<Cons("NAT"),Cons("NAT")>,<Var("A")>)
                        ]),
;        "STOCK" -> Comp("MSET",[],
;                       [
;                         "STKIN"  -> Func(<Ffun(Var("A"),Cons("NAT"))>,<>),
;                         "STKOUT" -> Func(<Ffun(Var("A"),Cons("NAT"))>,<>),
;                         "SHOW"   -> Func(<Pow(Var("A"))>,
;                                          <Ffun(Var("A"),Cons("NAT0"))>),
;                         "DIFF"   -> Func(<Ffun(Var("A"),Cons("NAT"))>,
;                                          <Ffun(Var("A"),Cons("NAT"))>)
;                       ]),
         "FAMILY" -> Comp("FFUN",["B"->Pow(Var("B"))],
                        [
                          "JOIN" -> Func(<Var("A"),Var("B")>,<>),
                          "LEAVE" -> Func(<Var("A"),Var("B")>,<>)
                        ]),
;        "HTABLE" -> Comp("FAMILY",["A"->Cons("NAT")],
;                       [
;                         "HINS" -> Func(<Var("B")>,<>),
;                         "HREM" -> Func(<Var("B")>,<>),
;                         "HGET" -> Func(<>,<Var("B")>),
;                         "HIDX" -> Func(<Var("B")>,<Cons("NAT")>),
;                         "REHASH" -> Func(<>,<>)
;                       ]),
         "PQUEUE" -> Comp("FFUN",["B"->List(Var("B"))],
                        [
                          "ENQ" -> Func(<Var("A"),Var("B")>,<>),
                          "FRONT"  -> Func(<>,<Var("B")>),
                          "DEQ" -> Func(<>,<Var("B")>)
                        ]),
         "PQUEUEMK" -> Comp("PQUEUE",["A"->Times(Var("A1"),Var("A2"))],
                        [
                        ]),
         "QFUN"   -> Comp("FFUN",["B"->Ffun(Var("B"),Var("C"))],
                        [
                          "INS" -> Func(<Var("A"),Var("B"),Var("C")>,<>),
                          "DEL" -> Func(<Var("A"),Var("B")>,<>),
                          "FIND" -> Func(<Var("A"),Var("B")>,<>)
                        ]),
         "FDEP" -> Comp("FFUN",["B"->Times(Var("B"),Var("C"))],
                        [
                          "SELL"   -> Func(<Var("A")>,<Var("B")>),
                          "SELR"   -> Func(<Var("A")>,<Var("C")>),
                          "INS"    -> Func(<Var("A"),Var("B"),Var("C")>,<>)
                        ]),
         "FDMO" -> Comp("FDEP",["B"->Pow(Var("B"))],
                        [
                          "ADDONL" -> Func(<Var("A"),Pow(Var("B"))>,<>),
                          "NEW"    -> Func(<Var("A"),Pow(Var("B")),Var("C")>,<>)
                        ]),
         "FDMONAT" -> Comp("FDMO",["C"->Cons("NAT")],
                        [
                          "ADDONR"    -> Func(<Var("A"),Cons("NAT")>,<>),
                          "SUBONR"    -> Func(<Var("A"),Cons("NAT")>,<>),
                          "SELONR"    -> Func(<Cons("NAT")>,<Pow(Var("B"))>)
                        ]),
         "BAMS" ->RComp("FDMONAT",["A"-> "AccId",
                                "B"-> "AccHolder",
                                "C" -> "Amount"],
                        [
                          "NEW"       -> "OpenAccount",
                          "ADDONL"    -> "AddAccHolders",
                          "ADDONR"    -> "Credit",
                          "SUBONR"    -> "Withdraw",
                          "SELONR"  -> "GoodCostumers"
                        ])
     ];

FUNC StInherit(i:IdComp,db:Db):Sets
RETURN if i in dom(db)
       then let (c=db[i],
                 a=F(c),
                 s=if is-Comp(c) then St(c) else (*->Var)(St(c)))
            in if is-NIL(a) then Var("A")
                            else SetsSubst(StInherit(a,db),s)
       else Var("A");

FUNC AcInherit(i:IdComp,r:IdAccao->IdAccao,db:Db):Actions
RETURN let (x=
       if i in dom(db)
       then let (c=db[i],
                 a=F(c),
                 s=St(c))
            in A(c) + if is-NIL(a)
                      then []
                      else let (f=AcInherit(a,[],db))
                           in ActionsSubst(f,s)
       else [])
       in Rename(r,x);

FUNC Comp2TeX(i:IdCom,db:Db):TeX
RETURN if i in dom(db)
       then let (m=strlen(i).+2,
                 a=AcInherit(i,[],db),
                 b=dom(a),
                 c=card(b),
                 d=div(c,2),
                 e=index([x->x|x<-b]),
                 f=seqSubl(e,1,d),
                 g=seqSubl(e,d.+1,c.-d),
                 h=d.*2.+10,
                 k= < let (x=nth(i,f),
_=princ(i,x))
                      in TeXCmd(if O(a[x]) == <>
                                then "newrpin" else "newrpout",
                                <0,i.*2,x>) | i <- inseq(length(f)) >,
                 l= < let (x=nth(i,g))
                      in TeXCmd(if O(a[x]) == <>
                                then "newrpin" else "newrpout",
                                <m,i.*2,x>) | i <- inseq(length(g)) >
                )
            in < TeXCmd("begin",<"interface",i,m,h>) > ^
                   k ^ l ^
               < TeXCmd("end",<"interface">) >
       else <>;

FUNC DUMP():VOID
RETURN
let (f = lambda(k,db).
         let (x=db[k],
              p=F(x),
              s=StInherit(k,db),
              a=A(x),
              l= < 
                   if is-NIL(p) then "" else < "#include ", p ++ ".cam" >, < >,
                   <"; Creation date: "> ^ ioReadPipe("date",""), < >,
                   < "STATE st: ",  Sets2STR(s) >,
                   < "  INV i(st);" >, < >
                 > ^
                 < let (g=lambda(i).chr(96.+i),
                        i=I(a[k]),
                        o=O(a[k]),
                        j=(g->*)(seq2ff(i)),
                        m=seqAddSep(<"st">^<k|k<-dom(j)>,","),
                        p=seq2ff(o)
                       )
                   in  txtAddNL(
                       <
                         < "FUNC ", k, "(",
                                       seqAddSep(
                                       <
                                         < s , ": ", Sets2STR(j[s]) >
                                       | s <- dom(j)
                                       >,", "),
                                       "): ",
                                       (if (o==<>) then "VOID"
                                                   else Sets2STR(hd(o)))
                         >,
                         < "PRE    p(" , m , ")" >,
                         < "STATE  st <- f(" , m , ")" >,
                         < "RETURN g(" , m , ");" >
                       >)
                | k <- dom(a) >)
         in txtFlat(txtAddNL(l)))
in foreach(k,< x | x <- dom(db): is-Comp(db[x]) >,
             ioTxt2File("/tmp/" ++ k ++ ".cam",f(k,db)));

FUNC MComp2Comp(x:MComp):Comp
RETURN if is-Comp(x) then x
       else let (c=C(x),
                 s=St(x),
                 a=A(x))
            in if c in dom(db)
               then (let (d=MComp2Comp(db[c]))
                     in Comp(F(d),(*->Var)(s), let (b=A(d))
                                               in []))
               else db["RSC"];


Rename(r,t)=  t \ dom(r) + [ r[a] -> t[a] | a <- dom(r) * dom(t) ];