; GAMA-X - Controlador de Dialogo - 1.0 --- jfc 8/93
#include share.n
#include cdcom.n
#include petrinet.n
#include si.n
#include cdff.n
#include cdset.n
#include cdlist.n
#include cdrel.n
#include cdtup.n
TYPE
CD :: DEFS: GISym -> GIdef
INSTS: InstId -> InstDescr
OUTSM: CHAN
INSM: CHAN
INLX: CHAN
OUTLX: CHAN;
GIdef = DECISION | SYNTH | VALSYNTH | FFSYNTH | SETSYNTH |
LISTSYNTH | RELSYNTH | TUPSYNTH;
DECISION :: GIDescr;
SYNTH :: GIDescr;
VALSYNTH :: GIDescr;
GIDescr :: SYNOMS: GISym-set
TYP: OpcType
EXTERN: GISym-set
SUBGI: GISym-set
VARS: VarId -> VarDecl
CONTEXT: BoolExp
INIT: Code
EVSEQ: CDPetriNet
TRANS: TransId -> TransDescr
EXEC: OpcExecDescr;
FFSYNTH :: DREF: TypeId;
SETSYNTH :: DREF: TypeId;
LISTSYNTH :: DREF: TypeId;
RELSYNTH :: DREF: TypeId;
TUPSYNTH :: DREF: TypeId;
CDPetriNet = PetriNet | PNDescr;
OpcType = NIL | TypeId;
VarDecl = VarUI | VarAPL | VarAPLcopy | VarCTRL;
VarUI :: DREF: TypeId; /* Tb. ARGS */
VarAPL :: TYP: TypeId
VAL: Value;
VarAPLcopy :: TYP: TypeId
APLVAR: OpcVarId;
VarCTRL :: DREF: TypeId;
TransDescr :: COND: BoolExp
ACTION: Code
EXCEP: ExcepDescr-list;
ExcepDescr :: COND: BoolExp
ACTION: Code;
OpcExecDescr = NIL | ExecDescr;
ExecDescr :: OP: STR
ARGS: VarId-list;
InstDescr :: FATHER: OpcInstId
VARS: VarId -> Value
EVSEQ: Conditions
ENABLED: TransId-set
CMDLINE: OpcCmdLineDescr;
Mesg = MesgLxSt | MesgSmSt;
ENDTYPE
; O P E R A C O E S
; Estado: cd: CD
; Master loop -----------------------------------------------------------------
FUNC master((cd)): (cd)
RETURN
let(msg = getlx(), /* ler mensagem */
sfx = domesg(msg) /* tratar mensagem */
)
in if INSTS(cd) != [] then master()
else progn(sendsm(HaltMsg(0)),
quit() /* terminou */
);
; Tratar as Mensagens ---------------------------------------------------------
FUNC domesg(msg: Mesg, (cd)): (cd)
RETURN
if (is-SetValMsg(msg) -> putvalue(VAL(msg), DEST(msg)),
is-CreateMsg(msg) -> creategi(msg),
is-OpenMsg(msg) -> opengi(msg),
is-KillMsg(msg) -> killgi(DEST(msg))
)
otherwise dotransmsg(msg);
; Colocar valor em Instancias de Modelos --------------------------------------
FUNC putvalue(val: Value, instid: InstId, (cd)): (cd)
RETURN
let(defn=DEFS(cd)[SYMB(instid)]
)
in if(is-FFSYNTH(defn) -> putff(val, instid),
is-SETSYNTH(defn) -> putset(val, instid),
is-LISTSYNTH(defn) -> putlist(val, instid),
is-RELSYNTH(defn) -> putrel(val, instid),
is-TUPSYNTH(defn) -> puttup(val, instid)
);
; Criar Instancias ------------------------------------------------------------
FUNC creategi(msg: Mesg, (cd)): (cd)
RETURN
let(def=DEFS(cd)[GI(msg)]
)
in if(type(def) in {'DECISION, 'SYNTH, 'VALSYNTH} -> newgi(GI(msg), DEST(msg)),
is-FFSYNTH(def) -> newff(GI(msg), DEST(msg)),
is-SETSYNTH(def) -> newset(GI(msg), DEST(msg)),
is-LISTSYNTH(def) -> newlist(GI(msg), DEST(msg)),
is-RELSYNTH(def) -> newrel(GI(msg), DEST(msg)),
is-TUPSYNTH(def) -> newtup(GI(msg), DEST(msg))
);
; Criar uma Instancia (nao de modelos)
FUNC newgi(sym: GISym, father: InstId, (cd)): (cd)
STATE
cd <- let(gi = DEFS(cd)[sym],
evseq = EVSEQ(gi)
)
in if is-PetriNet(evseq) then
cd /* PN ja gerada */
else /* gerar PN */
let(cmds = {id | id<-dom(TRANS(gi)): is-CmdId(id)},
newevseq = makepn(evseq, cmds),
newgi = if(is-DECISION(gi) ->
DECISION(SYNOMS(gi), TYP(gi), EXTERN(gi),
SUBGI(gi), VARS(gi), CONTEXT(gi),
INIT(gi), newevseq, TRANS(gi), EXEC(gi)
),
is-SYNTH(gi) ->
SYNTH(SYNOMS(gi), TYP(gi), EXTERN(gi), SUBGI(gi),
VARS(gi), CONTEXT(gi), INIT(gi), newevseq,
TRANS(gi), EXEC(gi)
),
is-VALSYNTH(gi) ->
VALSYNTH(SYNOMS(gi), TYP(gi), EXTERN(gi),
SUBGI(gi), VARS(gi), CONTEXT(gi),
INIT(gi), newevseq, TRANS(gi), EXEC(gi)
)
)
)
in CD(DEFS(cd) + [sym -> newgi], INSTS(cd), OUTSM(cd), INSM(cd),
INLX(cd), OUTLX(cd)
)
RETURN
let(instid = InstId(sym, newninst(1, sym)), /* novo identificador */
inst = createinst(sym, instid, father), /* criar instancia */
defn = DEFS(cd)[sym],
sidefx1 = sendlx(InstMsg(instid)), /* enviar ident ao lx */
sidefx2 = docode(INIT(defn), instid), /* executar INIT */
sidefx3 = showall(VARS(defn), instid), /* enviar vars ao lx */
enabled = {DREF(id)| id<-valideventspn(EVSEQ(defn), EVSEQ(inst), instid)},
sidefx4 = setenable(enabled, instid), /* eventos permitidos */
sidefx5 = setdisable(dom(TRANS(defn))-enabled, instid),
sidefx6 = putenabled(enabled, instid) /* registar permitidos */
)
in sendlx(GoMsg(instid, CMDLINE(inst))); /* fim */
; Calcular numero de instancia
FUNC newninst(ninst: INT, sym: GISym, (cd)): INT
RETURN
if ninst in {INST(id)| id<-dom(INSTS(cd)): SYMB(id)==sym} then
newninst(add(ninst, 1), sym)
else
ninst;
; Criar e registar instancia
FUNC createinst(sym: GISym, instid: InstId, father: EvId, (cd)): InstDescr (cd)
STATE
cd <- let(defn = DEFS(cd)[sym],
vars = [id->defval(VARS(defn)[id], id, instid) |
id<-dom(VARS(defn)) : ~is-VarAPL(VARS(defn)[id])
],
evseq = startpn(EVSEQ(defn), instid),
cmdline = if(EXEC(defn)==NIL) then
NIL
else
CmdLineDescr(OP(EXEC(defn)),
<ArgDef(id, NIL)| id<-ARGS(EXEC(defn))>
),
inst = InstDescr(father, vars, evseq, {}, cmdline)
)
in CD(DEFS(cd), INSTS(cd)+[instid -> inst], OUTSM(cd), INSM(cd),
INLX(cd), OUTLX(cd)
)
RETURN
INSTS(cd)[instid];
; Valores por defeito Built in
FUNC defval(v: VarDecl, id: VarId, instid: InstId, (cd)): Value
RETURN
if is-VarAPLcopy(v) then
VAL(sendgetsm(GetVarMsg(instid, APLVAR(v))))
else
if (DREF(v) == "INT" -> 0,
DREF(v) == "STR" -> "",
DREF(v) == "Bool" -> true
)
otherwise
NIL;
; Mostrar variaveis
FUNC showall(vars: VarId, instid: InstId, (cd)):
RETURN
if vars == [] then NIL
else let(id = choice(dom(vars)),
sidefx = if is-VarUI(vars[id]) then
sendlx(ShowMsg(instid, id, VARS(INSTS(cd)[instid])[id]))
)
in showall(vars\{id}, instid);
; Enviar permitidos
FUNC setenable(trs: TransId-set, instid: InstId, (cd)):
RETURN
if trs == {} then NIL
else let(id = choice(trs),
sidefx = sendlx(EnableMsg(instid, id))
)
in setenable(trs-{id}, instid);
; Enviar nao permitidos
FUNC setdisable(trs: TransId-set, instid: InstId, (cd)):
RETURN
if trs == {} then NIL
else let(id = choice(trs),
sidefx = sendlx(DisableMsg(instid, id))
)
in setdisable(trs-{id}, instid);
; Registar eventos permitidos
FUNC putenabled(en: Transid-set, instid: InstId, (cd)): (cd)
STATE
cd <- let(inst = INSTS(cd)[instid],
newinst = InstDescr(FATHER(inst), VARS(inst), EVSEQ(inst),
en, CMDLINE(inst)
)
)
in CD(DEFS(cd), INSTS(cd) + [instid -> newinst], OUTSM(cd), INSM(cd),
INLX(cd), OUTLX(cd)
);
; Abrir uma Instancia ---------------------------------------------------------
FUNC opengi(msg: OpenMsg, (cd)): (cd)
RETURN
let(sym = SYMB(DEST(msg)),
instid = DEST(msg),
inst = INSTS(cd)[instid],
defn = DEFS(cd)[sym]
)
in if type(defn) in {'DECISON, 'SYNTH, 'VALSYNTH} then
if endpn(EVSEQ(defn), EVSEQ(inst)) then
dostop(instid, true) /* Marcacao Final Atingida */
else
sendlx(GoMsg(instid, CMDLINE(inst)))
else
sendlx(GoMsg(instid, NIL));
; Terminar Instancia
FUNC dostop(instid: InstId, ok: Bool, (cd)):
RETURN
if ok then
let(inst = INSTS(cd)[instid],
defn = DEFS(cd)[SYMB(instid)]
)
in if type(defn) in {'DECISION, 'SYNTH, 'VALSYNTH} then
if CMDLINE(inst) != NIL then /* se tem EXEC */
let(defn = DEFS(cd)[SYMB(instid)],
args = <VALUE(ar)| ar<-ARGS(CMDLINE(inst))>,
res = if TYP(defn) != NIL then
VAL(sendgetsm(CallMsg(instid, OP(CMDLINE(inst)),
args, true
)
)
)
else
let(sidefx = sendsm(CallMsg(instid, OP(CMDLINE(inst)),
args, false
)
)
)
in NIL
)
in sendlx(StopMsg(instid, res))
else
sendlx(StopMsg(instid, NIL))
else
let(res = collectvalue(defn, inst)
)
in sendlx(StopMsg(instid, res))
else
sendlx(AbortMsg(instid))
STATE resetgi(instid); /* para futuras utilizacoes da instancia! */
; Calcular valor de modelos
FUNC collectvalue(defn: GIDef, inst: InstDescr, (cd)): Value
RETURN
if(is-FFSYNTH(defn) -> collectff(inst),
is-SETSYNTH(defn) -> collectset(inst),
is-LISTSYNTH(defn) -> collectlist(inst),
is-RELSYNTH(defn) -> collectrel(inst),
is-TUPSYNTH(defn) -> collecttup(inst)
);
; Fazer reset de uma Instancia
FUNC resetgi(instid: InstId, (cd)): (cd)
RETURN
let(oldinst = INSTS(cd)[instid],
sym = SYMB(instid),
defn = DEFS(cd)[sym]
)
in if type(defn) in {'SYNTH, 'VALSYNTH} then
let(inst = createinst(sym, instid, FATHER(oldinst)),
sidefx2 = docode(INIT(defn), instid),
sidefx3 = showall(VARS(defn), instid),
enabled = {DREF(id)| id<-valideventspn(EVSEQ(defn), EVSEQ(inst), instid)},
sidefx4 = setenable(enabled, instid),
sidefx5 = setdisable(dom(TRANS(defn))-enabled, instid),
sidefx6 = putenabled(enabled, instid)
)
in sendlx(GoMsg(instid, CMDLINE(inst)))
else
sendlx(GoMsg(instid, NIL));
; Eliminar uma instancia ------------------------------------------------------
FUNC killgi(instid: InstId, (cd)): (cd)
STATE
cd <- CD(DEFS(cd), INSTS(cd)\{instid}, OUTSM(cd), INSM(cd), INLX(cd),
OUTLX(cd)
);
; Mensagem de Transicao -------------------------------------------------------
FUNC dotransmsg(msg: MesgLxSt, (cd)): (cd)
RETURN
let(transid = ID(msg),
dest = DEST(msg),
defn = DEFS(cd)[SYMB(dest)],
inst = INSTS(cd)[dest]
)
in if type(defn) in {'DECISION, 'SYNTH, 'VALSYNTH} then
let(oldenab = ENABLED(inst), /* Permissoes anteriores */
newinst = if (is-StartMsg(msg) -> startgi(transid, dest),
is-EndMsg(msg) -> doend(transid, VAL(msg), dest),
is-CancelMsg(msg) -> docancel(transid, dest),
is-CmdMsg(msg) -> startcmd(transid, dest)
),
newenab = {DREF(id)| id<-valideventspn(EVSEQ(defn),
EVSEQ(newinst), dest
)
},
sidefx1 = setenable(newenab-oldenab, dest),
sidefx2 = setdisable(oldenab-newenab, dest),
sidefx3 = putenabled(newenab, dest)
)
in if endpn(EVSEQ(defn), EVSEQ(newinst)) then
dostop(dest, endok(msg))
else
sendlx(GoMsg(dest, CMDLINE(newinst)))
else /* Para modelos */
let(end = if(is-FFSYNTH(defn) -> domsgff(msg),
is-SETSYNTH(defn) -> domsgset(msg),
is-LISTSYNTH(defn) -> domsglist(msg),
is-RELSYNTH(defn) -> domsgrel(msg),
is-TUPSYNTH(defn) -> domsgtup(msg)
)
)
in if end then
dostop(dest, endok(msg))
else
sendlx(GoMsg(dest, NIL));
; Terminou sem ser com Cancel?
FUNC endok(msg: MsgLxSt): Bool
RETURNS
if (is-StartMsg(msg) -> true,
is-EndMsg(msg) -> true,
is-CancelMsg(msg) -> true,
is-CmdMsg(msg) -> if (ID(msg)==CmdId("$Cancel") -> false
)
otherwise true
);
; Mensagem Start --------------------------------------------------------------
FUNC startgi(id: EvId, instid:InstId, (cd)): InstDescr (cd)
STATE
cd <- let (defn = DEFS(cd)[SYMB(instid)],
inst = INSTS(cd)[instid],
newpn = firepn(EVSEQ(defn), EVSEQ(inst), StartEvent(id), instid),
newinst = InstDescr(FATHER(inst), VARS(inst), newpn, ENABLED(inst),
CMDLINE(inst)
)
)
in
CD(DEFS(cd), INSTS(cd)+[instid -> newinst], OUTSM(cd), INSM(cd),
INLX(cd), OUTLX(cd)
)
RETURN
INSTS(cd)[instid];
; Mensagem End ----------------------------------------------------------------
FUNC doend(id: EvId, v:Value, instid: InstId, (cd)): InstDescr (cd)
STATE
cd <- let (sidefx1= if VAR(id) != NIL then alteravar(VAR(id), v, instid),
defn = DEFS(cd)[SYMB(instid)]
)
in if id in dom(TRANS(defn)) then /* se em TRANS */
if dotypedexp(COND(TRANS(defn)[id]), instid, NIL) then
let (sidefx2 = docode(ACTION(TRANS(defn)[id]), instid),
inst = INSTS(cd)[instid],
newpn = firepn(EVSEQ(defn), EVSEQ(inst), EndEvent(id),
instid
),
cmdline = if VAR(id) != NIL then
chngcmdln(VAR(id), v, instid)
else
CMDLINE(inst),
newinst = InstDescr(FATHER(inst), VARS(inst), newpn,
ENABLED(inst), cmdline
)
)
in
CD(DEFS(cd), INSTS(cd)+[instid -> newinst], OUTSM(cd),
INSM(cd), INLX(cd), OUTLX(cd)
)
else /* se nao verifica condicao de TRANS faz Cancel */
let (sidefx2 = doexcep(EXCEP(TRANS(defn)[id]), instid),
inst = INSTS(cd)[instid],
newpn = firepn(EVSEQ(defn), EVSEQ(inst), CancelEvent(id),
instid
),
cmdline = if VAR(id) != NIL then
chngcmdln(VAR(id), v, instid)
else
CMDLINE(inst),
newinst = InstDescr(FATHER(inst), VARS(inst), newpn,
ENABLED(inst), cmdline
)
)
in
CD(DEFS(cd), INSTS(cd)+[instid -> newinst], OUTSM(cd),
INSM(cd), INLX(cd), OUTLX(cd)
)
else /* nao esta em TRANS */
let (inst = INSTS(cd)[instid],
newpn = firepn(EVSEQ(defn), EVSEQ(inst), EndEvent(id), instid),
cmdline = if VAR(id) != NIL then
chngcmdln(VAR(id), v, instid)
else
CMDLINE(inst),
newinst = InstDescr(FATHER(inst), VARS(inst), newpn,
ENABLED(inst), cmdline
)
)
in CD(DEFS(cd), INSTS(cd)+[instid -> newinst], OUTSM(cd),
INSM(cd), INLX(cd), OUTLX(cd)
)
RETURN
INSTS(cd)[instid];
; Actualiza variavel
FUNC alteravar(id: VarId, v:Value, instid: InstId, (cd)): (cd)
STATE
cd <- let (inst = INSTS(cd)[instid],
newvars = VARS(inst)+[id -> v],
newinst = InstDescr(FATHER(inst), newvars, EVSEQ(inst),
ENABLED(inst), CMDLINE(inst)
)
)
in CD(DEFS(cd), INSTS(cd)+[instid -> newinst], OUTSM(cd), INSM(cd),
INLX(cd), OUTLX(cd)
);
; actualiza CMDLN
FUNC chngcmdln(id: VarId, v:Value, instid: InstId, (cd)): PhrDescr
RETURN
if CMDLINE(INSTS(cd)[instid]) != NIL then
let(oldcmd = CMDLINE(INSTS(cd)[instid]),
newparams = putparam(ARGS(oldcmd), id, v)
)
in CmdLineDescr(OP(oldcmd), newparams)
else
NIL;
; Coloca parametro
FUNC putparam(params: ArgDef-list, id: VarId, v: Value): ArgDef-list
RETURN
if params == <> then <>
else
let(h = head(params),
t = tail(params)
)
in if NAME(h) == id then <ArgDef(id, v):t>
else <h:putparam(t, id, v)>;
; Tratamento de Excepcoes
FUNC doexcep(trl: ExcepDescr-list, instid: InstId, (cd)): (cd)
RETURN
if trl == <> then NIL
else let(tr = head(trl)
)
in if dotypedexp(COND(tr), instid, NIL) then
docode(ACTION(tr), instid)
else
doexcep(tl(trl), instid);
; Mensagem Cancel -------------------------------------------------------------
FUNC docancel(id: CmdId, instid: InstId, (cd)): InstDescr (cd)
STATE
cd <- let (defn = DEFS(cd)[SYMB(instid)],
inst = INSTS(cd)[instid],
newpn = firepn(EVSEQ(defn), EVSEQ(inst), CancelEvent(id), instid),
newinst = InstDescr(FATHER(inst), VARS(inst), newpn,
ENABLED(inst), CMDLINE(inst)
)
)
in
CD(DEFS(cd), INSTS(cd)+[instid -> newinst], OUTSM(cd), INSM(cd),
INLX(cd), OUTLX(cd)
)
RETURN
INSTS(cd)[instid];
; Mensagem Cmd ----------------------------------------------------------------
FUNC startcmd(id: CmdId, instid: InstId, (cd)): InstDescr (cd)
STATE
cd <- let (defn = DEFS(cd)[SYMB(instid)]
)
in if dotypedexp(COND(TRANS(defn)[id]), instid, NIL) then
let (sidefx = docode(ACTION(TRANS(defn)[id]), instid),
inst = INSTS(cd)[instid],
newpn = firepn(EVSEQ(defn), EVSEQ(inst), CmdEvent(id), instid),
newinst = InstDescr(FATHER(inst), VARS(inst), newpn,
ENABLED(inst), CMDLINE(inst)
)
)
in
CD(DEFS(cd), INSTS(cd)+[instid -> newinst], OUTSM(cd), INSM(cd),
INLX(cd), OUTLX(cd)
)
else /* se nao verifica condicao */
let (sidefx = doexcep(EXCEP(TRANS(defn)[id]))
)
in cd
RETURN
INSTS(cd)[instid];
; Validar o Contexto de um GI e inicializar Variaveis APL (Petri Nets) --------
FUNC validcontext(sym: GISym, father: InstId, (cd)): Bool (cd)
STATE
cd <- if sym != NIL then
let(defn = DEFS(cd)[sym],
vars = [id -> getvarapl(defn, id) | id<-dom(VARS(defn)) :
is-VarAPL(VARS(defn)[id])
],
gitype = type(defn), /* DECISION, SYNTH, VALSYNTH */
newdef = (eval(gitype))(SYNOMS(defn), TYP(defn), EXTERN(defn),
SUBGI(defn), VARS(defn)+vars,
CONTEXT(defn), INIT(defn), EVSEQ(defn),
TRANS(defn), EXEC(defn)
)
)
in CD(DEFS(cd)+[sym -> newdef], INSTS(cd), OUTSM(cd), INSM(cd),
INLX(cd), OUTLX(cd)
)
else
cd
RETURN
if sym != NIL then
dotypedexp(CONTEXT(DEFS(cd)[sym]), father, sym)
else
true;
; Calcular valor de variavel da aplicacao
FUNC getvarapl(defn: GIDescr, id: VarId, (cd)): VarAPL
RETURN
VarAPL(TYP(VARS(defn)[id]), VAL(sendgetsm(GetVarMsg(0, id))));
; Alterar Valor de Variavel (SI) ----------------------------------------------
FUNC putvar(id: VarId, v: Value, instid: InstId, (cd)): (cd)
STATE
cd <- let(inst = INSTS(cd)[instid],
defn = DEFS(cd)[SYMB(instid)]
)
in if type(defn) in {'DECISION, 'SYNTH, 'VALSYNTH} then
if id in dom(VARS(defn)) then
let(newvars = VARS(inst) + [id -> v],
sidefx = if is-VarUI(VARS(defn)[id]) then
sendlx(ShowMsg(instid, id, v)),
newinst = InstDescr(FATHER(inst), newvars, EVSEQ(inst),
ENABLED(inst), CMDLINE(inst)
)
)
in CD(DEFS(cd), INSTS(cd)+[instid -> newinst], OUTSM(cd),
INSM(cd),INLX(cd), OUTLX(cd)
)
else
let(sidefx = putvar(id, v, FATHER(inst))
)
in cd
else
let(newvars = VARS(inst) + [id -> v],
sidefx = sendlx(ShowMsg(instid, id, v)),
newinst = InstDescr(FATHER(inst), newvars, EVSEQ(inst),
ENABLED(inst), CMDLINE(inst)
)
)
in CD(DEFS(cd), INSTS(cd)+[instid -> newinst], OUTSM(cd),
INSM(cd),INLX(cd), OUTLX(cd)
);
; -----------------------------------------------------------------------------