%{ #define tags(x) 0 #include #include /*------------------------------------------------------------------- ###### # # ## ##### #### ###### ##### # # # # # # # # # # ###### # # # # #### ##### # # # ###### ##### # # ##### # # # # # # # # # # # # # # # #### ###### # # Versao <$Revision$$Date$> -------------------------------------------------------------------*/ int _accao=1; int in_sequence = 0; int cont_alt = 0; int cont_tup = 0; char * idtup() { char s[80]; sprintf(s,"_p%d", cont_tup++); return strdup(s); } char CONTEXTO= 'd'; #include "version" char straux [30], command [50]; char option; int jjDEBUG =1; #include "sexp.h" #include "met.h" void erro(); struct t_tipo { char ti[5]; struct t_tipo *arg1, *arg2, *next; }; typedef struct t_tipo TIPO; typedef struct t_tipo *APTIPO; %} %union {char *str; APTIPO Tipo; struct{ apsexp s1; apsexp s2;} yypar; struct{ aplista par; apsexp sig;} yysig; struct{ aplista par; aplista partyp;} yysiglist; apsexp yysexp; aplista yylista;} %{ /* *** Simbolos Terminais *** */ %} %token SIMB CONSTANTE INTEGER STRING BOOL %token SET LIST TYPE ENDTYPE P4 NIL RELACAO INCLUDE INCLUDEM DEBUGON %token DEBUGOFF QUIT MODEL ENDMODEL FSETA2 INV COMP FPROD FADD %{ /* *** fim de definicao de terminais *** */ %} %{ /* *** prioridades e associatividades: *** */ %} %nonassoc minima %nonassoc ';' %left ',' %nonassoc FUNCAO %nonassoc LAMBDA %nonassoc baixa %nonassoc LET OTHER SETA IF THEN RELBEGIN RELEND PRE ESTADO %nonassoc PERTENCE ELSE RETUR ALL EXIST EXIST1 %nonassoc '>' %left IMPLICA %left AND %left OR %left NOT %nonassoc EQ NEQ LEQ GEQ '<' GT %left STRCAT %left ADD SUB %left MUL DIV %nonassoc NOTIN IN %left UNION %left INTER %left '-' %nonassoc '#' alta %left '^' %left PLUS %left '/' %left '\\' %left '.' %left '[' %left '(' %left COMP %left FSETA LIST SET %right FSETA2 %left FADD %left FPROD %nonassoc CONSF ID IS ':' ORIO QUOTE %right maxima %nonassoc maximam %{ /* *** fim de definicao de prioridades *** */ %} %{ /* *** Simbolos Nao Terminais *** */ %} %type tag %type precond %type deffuncao defobj exp ffexp setexp seqexp letexp ifexp %type boolexp relexp estado /* mensagem*/ retorno seqexp2 %type poscondicao tipo resultado resultado1 all exist exist1 %type exppair def from from2 include op_orio FunctExp inv %type casepair is_exp intexp strexp %type exppairlist explist deflist expcaselist comdef %type explist2 %type fromlist fromlist2 extensao compreensao compreensao2 %type ffcompreensao expFPlist expFAlist %type assinatura %type defTp tuplo rtuplo rtuplo2 %type itemtuplo funcfin relacao lista conjunto %type alternativa2 alternativa simpleType %type segmentoInicial defTipo idTipo %% especificacao : especificacao typesMod | especificacao bloco | especificacao ENDMODEL | especificacao MODEL SIMB { } | ; /*--( Definicao de tipos )-------------------------------------------*/ defTipo : idTipo '=' defTp inv ';' { $$ = funnar("deftype",cons($1, $3)); if($4){ char s[80]; sprintf(s,"inv_%s", atomo($1)); fimdef(_def(mkatconst(s),$4));} } | idTipo P4 defTp inv ';' { $$ = funnar("deftype",cons($1, $3)); if($4){ char s[80]; sprintf(s,"inv_%s", atomo($1)); fimdef(_def(mkatconst(s),$4));} } | error ';' { yyerrok; $$ = mkatconst(";ERROR"); } ; inv : INV '(' SIMB ')' '=' {CONTEXTO='d';} exp {CONTEXTO='t'; $$=lambdaexp(cons(mkatomo($3),nill),$7); } | {$$=NULL;} ; idTipo: SIMB { $$ = mkatomo($1); } ; defTp: simpleType { $$ = (CONTEXTO == 't')?insereEQ($1): $1 ; } | alternativa2 { { char s[80],*s1;; sprintf(s,"_%d", cont_alt++); s1=strdup(s); fimdef(funnar("deftype",cons(mkatconst(s),cons(mkatconst("ALT"),$1 )))); $$ = cons(mkatconst("TUP (tag ANY)"), lista1(mkpair(mkatconst("val"),mkatomo(s1) ))); } } | alternativa { $$ = cons(mkatconst("ALT"),$1 ); } | tuplo { $$ = $1; } ; simpleType : SIMB { $$ = cons(mkatomo($1), nill); } | NIL { $$ = cons(mkatconst("NIL"), nill); } | relacao { $$ = $1; } | funcfin { $$ = $1; } | lista { $$ = $1; } | conjunto { $$ = $1; } | segmentoInicial { $$ = cons($1, nill); } | '(' simpleType ')' { $$ = $2; } ; tuplo : simpleType INTER rtuplo2 { $$ = cons(mkatconst("TUP"), cons(funnar("_p1",$1), $3)); } ; rtuplo2 : simpleType { $$ = cons(funnar("_p2",$1), nill); cont_tup=3; } | rtuplo2 INTER simpleType { $$ = conc($1, cons(mklista(cons(mkatomo(idtup()),$3)), nill)); } ; tuplo : itemtuplo rtuplo { $$ = cons(mkatconst("TUP"), conc($1, $2)); } ; rtuplo: itemtuplo rtuplo { $$ = conc($1, $2); } | { $$ = nill; } ; itemtuplo : SIMB ':' simpleType %prec minima { $$ = cons(mklista(cons(mkatomo($1),$3)), nill); } ; funcfin : simpleType SETA simpleType { $$ = cons(mkatconst("FF"), conc($1,$3)); } ; relacao : simpleType RELACAO simpleType { $$ = cons(mkatconst("REL"), conc($1,$3)); } ; lista : SIMB LIST { $$ = lista2(mkatconst("LIST"), mkatomo($1)); } | '(' simpleType ')' LIST { $$ = cons(mkatconst("LIST"), $2); } | segmentoInicial LIST { $$ = lista2(mkatconst("LIST"), $1); } ; conjunto : SIMB SET { $$ = lista2(mkatconst("SET"), mkatomo($1)); } | '(' simpleType ')' SET { $$ = cons(mkatconst("SET"), $2); } | segmentoInicial SET { $$ = lista2(mkatconst("SET"), $1); } ; segmentoInicial : INTEGER { $$ = mkatconst("INT"); } ; alternativa : '[' simpleType ']' %prec minima { $$ = cons(mkatconst("NIL"), $2); } | simpleType '|' simpleType %prec minima { $$ = conc($1,$3); } | alternativa '|' '[' simpleType ']' %prec minima { $$ = conc($1,cons(mkatconst("NIL"),$4 )); } | alternativa '|' simpleType %prec minima { $$ = conc($1,$3 ); } ; alternativa2 : simpleType PLUS simpleType %prec minima { $$ = conc($1,$3); } | alternativa2 PLUS simpleType %prec minima { $$ = conc($1,$3 ); } ; /*--( Definicao de tipos nos modulos )-------------------------------*/ typesMod : TYPE {CONTEXTO='t'; } defTipo { fimdef($3); } restDefTypesMod ENDTYPE {CONTEXTO='d';} ; restDefTypesMod : defTipo { fimdef($1); } restDefTypesMod | ; /*--( Bloco = (deffuncao+include+teste)* )---------------------------*/ bloco : bloco elemento | elemento ; elemento : exp ';' { fimdef($1); } | include { fimdef($1); } | ESTADO SIMB ':' tipo ';' { fimdef(_def(mkatconst("_state"), _quote(mkatomo($2)))); } | directiva | deffuncao ';' { fimdef($1); } | error ';' {yyerrok;} elemento | QUIT { fimdef(funnar("!",nill)); return(0);} ; /*--( directivas de debug/outras )-----------------------------------*/ directiva : DEBUGON {jjDEBUG = 1;} | DEBUGOFF {jjDEBUG = 0;} ; /*--( Includes )-----------------------------------------------------*/ include : INCLUDE SIMB '.' SIMB { char comando [80]; sprintf(comando,"seca %s.%s %s.met", $2, $4, $2 ); system (comando); sprintf (comando,"\"%s.met\"", $2); $$=fununa("load",mkatconst(comando)); } | INCLUDE STRING { $$=fununa("nload",mkatomo($2)); } | INCLUDE SIMB { char comando [80]; sprintf(comando,"seca %s %s.met",$2,$2 ); system (comando); sprintf (comando,"\"%s.met\"", $2); $$=fununa("load",mkatconst(comando)); } | INCLUDEM STRING { $$=fununa("load",mkatomo($2)); } | INCLUDEM SIMB '.' SIMB { char comando [80]; sprintf (comando,"\"%s.%s\"",$2,$4); $$=fununa("load",mkatconst(comando)); } | INCLUDEM SIMB { char comando [80]; sprintf (comando,"\"%s\"",$2); $$=fununa("load",mkatconst(comando)); } ; /*--( definicao de funcoes )-----------------------------------------*/ deffuncao : SIMB '(' explist ')' '=' exp { $$=deffun($1,$3,$6); } | FUNCAO SIMB assinatura precond /* mensagem */ poscondicao { $$=deffuncao($2,$3.par,$3.sig,$4.s1,$4.s2,$5); } ; poscondicao : estado retorno { $$= poscondicao($1,$2,1); } | retorno estado { $$= poscondicao($1,$2,2); } | retorno { $$= poscondicao(snill,$1,1); } | estado { $$= poscondicao($1,snill,1); } | LET '(' deflist ')' IN poscondicao { $$=funbin("let",mklista($3),$6); } ; retorno : RETUR exp { $$=$2; } ; estado : ESTADO exp { $$=$2; } ; assinatura : '(' explist2 ')' resultado { $$.par=$2.par; $$.sig=mkpair(mklista($2.partyp),$4); } ; resultado : ':' resultado1 { $$=$2; } | { $$=mkatconst("NIL"); } ; resultado1 : resultado1 tipo { $$=$2; } | { $$=mkatconst("NIL"); } ; tipo : defTp { $$=mklista($1); } ; explist2 : SIMB ':' tipo ',' explist2 { $$.par=cons(mkatomo($1),$5.par); $$.partyp=cons($3,$5.partyp); } | SIMB ':' tipo { $$.par=cons(mkatomo($1),nill); $$.partyp=cons($3,nill); } | SIMB ',' explist2 { $$.par=cons(mkatomo($1),$3.par); $$.partyp=cons(mkatconst("ANY"),$3.partyp); } | SIMB { $$.par=cons(mkatomo($1),nill); $$.partyp=cons(mkatconst("ANY"),nill); } | '(' SIMB ')' ',' explist2 { $$.par=$5.par;$$.partyp=$5.partyp; } | '(' SIMB ')' { $$.par=nill;$$.partyp=nill; } | { $$.par=nill;$$.partyp=nill; } ; precond : PRE exp { $$.s1=$2; $$.s2 = snill; } | PRE exp SETA exp { $$.s1=$2;$$.s2=$4; } | { $$.s1=snill;$$.s2=snill; } ; /*--( definicao de variaveis de Estado )-----------------------------*/ defobj : SIMB atrib exp %prec baixa { $$=_def(mkatomo($1),$3); } | SIMB '.' SIMB atrib exp %prec baixa { $$=funtre("tplus",mkatomo($1),mkatomo($3),$5); } ; atrib : PERTENCE ; /*--( Expressoes )---------------------------------------------------*/ exp : SIMB { $$=mkatomo($1); } | '(' exp ')' { $$=$2; } | CONSTANTE { $$=mkatomo($1); } /* | exp exp { #ifdef NYAG $$=mklista(cons($1,$2)); #endif #ifdef PRETTY $$ = ppExpExpList($1,$2); #endif } */ | exp '(' explist ')' %prec '(' { $$=mklista(cons($1,$3)); } | FUNCAO assinatura precond /* mensagem */ poscondicao { $$=lambdaexpfunc($2.par,$3.s1,$3.s2,$4); } | LAMBDA '(' explist ')' '.' exp %prec PERTENCE { $$=lambdaexp($3,$6); } | SIMB '(' explist ')' %prec '(' { $$=mklista(cons(mkatomo($1),$3)); } | QUOTE '(' explist ')' { $$=mklista(cons(mkatconst("quote"),$3)); } | op_orio ORIO '(' exp ',' exp ')' { $$=funtre("reduce",$4,$1,$6); } | NIL { $$=mkatconst("NIL"); } | defobj { $$=$1; } | strexp { $$=$1; } | intexp { $$=$1; } | ffexp { $$=$1; } | relexp { $$=$1; } | seqexp { $$=$1; } | setexp { $$=$1; } | letexp { $$=$1; } | ifexp { $$=$1; } | boolexp { $$=$1; } | exp '\\' exp { $$=_ds($1,$3); } | exp '/' exp { $$=funbin("dr",$1,$3); } | exp '[' exp ']' %prec maxima { $$=_ap($1,$3); } | SIMB '.' SIMB { $$=_ap(mkatomo($1), _quote(mkatomo($3))); } | FunctExp ; strexp : STRING { $$=mkatomo($1); } | exp STRCAT exp { $$=funbin("strcat",$1,$3); } ; op_orio : SIMB { $$=mkatomo($1); } | ADD { $$=mkatconst("add"); } | STRCAT { $$=mkatconst("strcat"); } | MUL { $$=mkatconst("mul"); } | OR { $$=mkatconst("or"); } /* | '^' {$$=mkatconst("append");} */ | PLUS { $$=mkatconst("plus"); } ; /*--( Expressoes Inteiras )----------------------------------------------*/ intexp : INTEGER { $$=mkatomo($1); } | '#' exp { $$=fununa("card",$2); } | exp ADD exp { $$=funbin("add",$1,$3); } | exp SUB exp { $$=funbin("sub",$1,$3); } | exp DIV exp { $$=funbin("div",$1,$3); } | exp MUL exp { $$=funbin("mul",$1,$3); } ; /*--( Expressoes Bool )----------------------------------------------*/ boolexp : exp IN exp { $$=_in($1,$3); } | exp NOTIN exp { $$=_not(_in($1,$3)); } | exp EQ exp { $$=_eq($1,$3); } | exp AND exp { $$=_and($1,$3); } | exp IMPLICA exp { $$=_or(_not($1),$3); } | exp OR exp { $$=_or($1,$3); } | NOT exp { $$=_not($2); } | exp '<' exp { $$=funbin("lt",$1,$3); } | exp GT exp { $$=funbin("gt",$1,$3); } | exp '>' exp { $$=funbin("gt",$1,$3); } | exp LEQ exp { $$=funbin("leq",$1,$3); } | exp GEQ exp { $$=funbin("geq",$1,$3); } | exp NEQ exp { $$=funbin("nequal",$1,$3); } | IS defTp '(' exp ')' { $$=funnar("is",conc($2,cons($4,nill))); } | ALL '(' all ')' { $$=$3; } | EXIST '(' exist ')' { $$=$3; } | EXIST1 '(' exist1 ')' { $$=$3; } | BOOL { $$=mkatomo($1); } ; FunctExp : exp SET { $$= _lambda1( mkatconst("_y_"), _set( mkpair($1, mkatconst("_x_")), _from(mkatconst("_x_"),mkatconst("_y_")))); } | exp LIST { $$= _lambda1( mkatconst("_y_"), _seq( mkpair($1, mkatconst("_x_")), _from(mkatconst("_x_"),mkatconst("_y_")))); } | exp FSETA { $$= _lambda1( mkatconst("_a_"), _ff1( _list2( mkpair( $1,mkatconst("_b_")), _ap(mkatconst("_a_"),mkatconst("_b_"))), _from(mkatconst("_b_"),_dom(mkatconst("_a_"))))); } | FSETA2 exp { $$= _lambda1( mkatconst("_y_"), _ff1( _list2(mkatconst("_x_"), mkpair($2, _ap(mkatconst("_y_"),mkatconst("_x_")))), _from(mkatconst("_x_"),_dom(mkatconst("_y_"))))); } | exp COMP exp { $$= _lambda1( mkatconst("_y_"), mkpair($1,mkpair($3,mkatconst("_y_")))); } | ID exp { $$= _ff1( _list2( mkatconst("_x_"), mkatconst("_x_")), _from(mkatconst("_x_"),$2)); } | CONSF exp { $$= _lambda1( mkatconst("_y_"), $2); } | expFAlist { $$= fununa("fadd",funnar("list",$1)); } | expFPlist { $$= fununa("fprod",funnar("list",$1)); } ; expFAlist : exp FADD exp { $$= cons($1,cons($3,nill)); } | expFAlist FADD exp { $$= conc($1,cons($3,nill)); } ; expFPlist : exp FPROD exp { $$= cons($1,cons($3,nill)); } | expFPlist FPROD exp { $$= conc($1,cons($3,nill)); } ; all : SIMB PERTENCE exp ',' all { $$=funtre("ALL",mkatomo($1),$3,$5); } | SIMB PERTENCE exp ':' exp { $$=funtre("ALL",mkatomo($1),$3,$5); } ; exist : SIMB PERTENCE exp ',' exist { $$=funtre("EXIST",mkatomo($1),$3,$5); } | SIMB PERTENCE exp ':' exp { $$=funtre("EXIST",mkatomo($1),$3,$5); } ; exist1 : SIMB PERTENCE exp ',' exist1 { $$=funtre("EXIST1",mkatomo($1),$3,$5); } | SIMB PERTENCE exp ':' exp { $$=funtre("EXIST1",mkatomo($1),$3,$5); } ; /*--( Set e Seq )----------------------------------------------------*/ setexp : '{' compreensao '}' { $$=funnar("set",$2); } | '{' extensao '}' { $$=funnar("makeset",inverte($2)); } | '{' '}' { $$=funnar("makeset",nill); } | exp INTER exp { $$=funbin("intersection",$1,$3); } | exp UNION exp { $$=funbin("union",$1,$3); } | exp '-' exp { $$=_diff($1,$3); } ; compreensao : exp '|' fromlist { $$=cons($1,$3); } ; compreensao2 : exp '|' fromlist2 { $$=cons($1,$3); } ; extensao : extensao ',' exp { $$=cons($3,$1); } | exp { $$=cons($1,nill); } seqexp2 : compreensao2 { $$=funnar("seq",$1); } | extensao ',' exp '>' { $$=funnar("makeseq",inverte(cons($3,$1))); } | exp '>' { $$=funnar("makeseq",cons($1,nill)); } | '>' { $$=funnar("makeseq",nill); } | exp ':' exp '>' { $$=funbin("cons",$1,$3); } ; seqexp : '<' {in_sequence++ ;} seqexp2 { $$=$3; in_sequence--; } | exp '^' exp { $$=funbin("append",$1,$3); } ; fromlist : from ',' fromlist { $$=cons($1,$3); } | from { $$=cons($1,nill); } ; fromlist2 : from ',' fromlist2 { $$=cons($1,$3); } | from2 { $$=cons($1,nill); } ; from : SIMB PERTENCE exp { $$=_from(mkatomo($1),$3); } | SIMB PERTENCE exp ':' exp { $$=funtre("from",mkatomo($1),$3,$5); } ; from2 : SIMB PERTENCE exp '>' { $$=_from(mkatomo($1),$3); } | SIMB PERTENCE exp ':' exp '>' { $$=funtre("from",mkatomo($1),$3,$5); } ; /*--( Funcoes finitas e relacoes binarias )--------------------------*/ ffexp : '[' ffcompreensao ']' { $$=funnar("ff1",$2); } | '[' exppairlist ']' { $$=funnar("makeff",inverte($2)); } | exp PLUS exp { $$=_plus($1,$3); } ; ffcompreensao : exp SETA exp '|' fromlist { $$=cons(_list2($1,$3),$5); } ; exppairlist : exppairlist ',' exppair { $$=cons($3,$1); } | exppair { $$=cons($1,nill); } | { $$=nill; } ; exppair : exp SETA exp { $$=mkpair($1,$3); } ; relexp : RELBEGIN ffcompreensao RELEND { $$=funnar("rel",$2); } | RELBEGIN exppairlist RELEND { $$=funnar("makerel",inverte($2)); } ; explist : exp ',' explist { $$=cons($1,$3); } | exp { $$=cons($1,nill); } | { $$=nill; } ; /*--( Expressoes condicionais )--------------------------------------*/ letexp : LET '(' deflist ')' IN exp %prec LET { $$=funbin("let",mklista($3),$6); } ; deflist : def ',' deflist { $$=cons($1,$3); } | def { $$=cons($1,nill); } | comdef ',' deflist { $$=conc($1,$3); } | comdef { $$=$1; } ; comdef : '<' SIMB ',' SIMB GTs '=' exp { $$ = lista3(mkpair(mkatconst("_"),$7), mkpair(mkatomo($2),fununa("first",mkatconst("_"))), mkpair(mkatomo($4),fununa("second",mkatconst("_")))); } ; def : SIMB '=' exp { $$=mkpair(mkatomo($1),$3); } | '=' exp { $$=mkpair(mkatconst("__"),$2); } ; ifexp : IF exp THEN exp { $$=funbin("if",$2,$4); } | IF '(' expcaselist { $$=funnar("cond",$3); } | IF exp THEN exp ELSE exp { $$=funtre("if",$2,$4,$6); } ; expcaselist : casepair ',' expcaselist { $$=cons($1,$3); } | casepair ')' { $$=cons($1,nill); } | ELSE SETA exp ')' { $$= cons(mkpair(_true,$3), nill); } | casepair ')' OTHER exp { $$=cons($1, cons(mkpair(_true,$4), nill)); } ; casepair : exp SETA exp { $$=mkpair($1,$3); } | is_exp ; is_exp: exp IS '<' SIMB ':' SIMB GTs SETA exp { $$=mkpair( _and(_not(_null($1)), _is(mkatconst("LIST ANY"),copia($1))), _let(lista2(mkpair(mkatomo($4),_hd(copia($1))), mkpair(mkatomo($6),_tl(copia($1)))), $9)); } | exp IS '<' GTs SETA exp { $$=mkpair(_null($1),$6); } | exp IS '{' SIMB ':' SIMB '}' SETA exp { $$=mkpair(_and(_not(_null($1)), _is(mkatconst("SET ANY"),copia($1))), _let(lista2(mkpair(mkatomo($4),_choice(copia($1))), mkpair(mkatomo($6), _diff(copia($1),_set1(mkatconst($4))))), $9)); } | exp IS '{' '}' SETA exp { $$=mkpair(_null($1),$6); } | exp IS '[' SIMB SETA SIMB ':' SIMB ']' SETA exp { $$=mkpair( _and(_not(_null($1)), _is(mkatconst("FF ANY ANY"),copia($1))), _let(lista3(mkpair(mkatomo($4),_choice(_dom(copia($1)))), mkpair(mkatomo($6),_ap($1,mkatomo(copia($4)))), mkpair(mkatomo($8),_ds($1,_set1(mkatomo($4))))), $11)); } | exp IS '[' ']' SETA exp { $$=mkpair( _null($1), $6); } | exp IS tag ':' SIMB SETA exp { $$=mkpair(_and(_not(_null($1)), /*_and(_is(mkatconst("LIST ANY"),copia($1)),)*/ _eq(_p1(copia($1)),mkatomo($3))), _let(lista1(mkpair(mkatomo($5),_p2(copia($1)))), $7)); } ; GTs : '>' | GT ; tag : INTEGER /*DANGER ?*/ | SIMB ; %% /* ---(Analisador lexico )----------------------------------------------*/ #include #include static int queres_comentarios=1; #include extern jmp_buf xljmpbuf ; #include "lex.yy.c" /* ---(Formata output )-------------------------------------------------*/ #if INTERACTIVE || FUNC #include "iformata.c" #else #include "formata.c" #endif /* ---(Funcoes auxiliares)----------------------------------------------*/ void met(s) char s []; { strcat(strcpy(straux,s),".met"); } char *aspas(s) char *s; {char *aux; aux=(char *) malloc(strlen(s)+3); return(strcat(strcat(strcpy(aux,"\""),s),"\"")); } /* ---(Definicao de Funcoes )-------------------------------------------*/ apsexp poscondicao(estado,expressao,n) int n; apsexp estado, expressao; { apsexp aux; if((estado == snill)&&(expressao != snill)) aux = expressao; else if (estado == snill) {erro("Function without postcondition (or ';' misplaced)"); aux = mkatconst("\"????\"");} else if (expressao == snill) aux = estado; else aux = funbin((n==1)?"progn":"prog1", estado, expressao); return(aux); } apsexp deffuncao(nome,para,assin,pre,exep,post) char *nome; aplista para; apsexp pre, assin, post, exep; {apsexp defassi,deffu; if(jjDEBUG) /* ----(assinatura: )------------------ */ { fimdef( _def(_ops, _plus( _ops, fununa( "makeff", mkpair( _quote(mkatconst(nome)), /* perigoso ?!! */ _quote(assin)))))); /* ----(definicao : )------------------ */ if (pre == snill) deffu=(deffun(nome,para,post)); else { if (exep == snill) exep = funbin( "strcat", mkatconst("\"ERROR (precondition violated) in function \""), mkatomo(aspas(nome))); deffu=(deffun(nome, para, funtre( "if", pre, post, exep))); } } else /* ----(assinatura: )------------------ */ { fimdef( _def( _ops, _plus( _ops, fununa( "makeff", mkpair( _quote(mkatconst(nome)), /* perigoso ?!! */ _quote( mklista( lista3( el1(lista(assin)), el2(lista(assin)), (pre == snill)?_true:pre)))))))); /* ----(definicao : )------------------ */ deffu=(deffun(nome,para,post)); } return(deffu); } apsexp lambdaexp(l,e) aplista l; apsexp e; { return (funbin("lambda", mklista(l), e));} apsexp lambdaexpfunc(para,pre,exep,post) aplista para; apsexp pre, post, exep; {apsexp defassi,deffu; if(jjDEBUG) /* ----(definicao : )------------------ */ { if (pre == snill) deffu=(lambdaexp(para,post)); else { if (exep == snill) exep = mkatconst("\"ERROR (precondition violated) in function \""); deffu=lambdaexp(para,funtre( "if", pre, post, exep)); } } else /* ----(definicao : )------------------ */ deffu=lambdaexp(para,post); return(deffu); } #ifdef __TURBOC__ #define NAOBUF #else #define NAOBUF(f1,f2) setbuf(f1,NULL); setbuf(f2,NULL); fflush(f1); fflush(f2); /* #define NAOBUF setvbuf(yyout,buff,_IOLBF,BUFSIZ) #define NAOBUFi setvbuf(stdin,buff,_IOLBF,BUFSIZ) */ #endif __TURBOC__ /* ---(main )-----------------------------------------------------------*/ FILE *ftags; char fichin[100]; char buff[BUFSIZ]; char buffi[BUFSIZ]; int _ERRO=0; char *FILENAME=""; #ifdef FUNC char * S_GLOBI; char * S_GLOBO; int seca(S,S2) char * S; char * S2; { _ERRO=0; line_read=(char*)NULL; S_GLOBI=S; S_GLOBO=S2; clear_metoobuf(); yyparse(); return(_ERRO); } /* ---(Tratamento de erros em FUNC)-------------------------------------*/ void erro(s) char *s; { _ERRO=1;} void yyerror() {_ERRO=1;} #else /*FUNC*/ extern int neverprompt; main (argc,argv) int argc; char *argv[]; { #ifdef INTERACTIVE int i; char S[200]; #ifdef PIPE neverprompt=1; NAOBUF(stdin,stdout); #endif /*PIPE*/ tags( ftags=fopen("tags.aux","a")); #ifndef PIPE printversion(); printf("camila version %s (%s)\n",cam_version, cam_date); #endif /*PIPE*/ libxminit(0,NULL); /* inicia xmetoo */ sprintf(S,"(load \"%s/.metoorc\")",getenv("HOME")); #ifndef PIPE puts(S+7); #endif /*PIPE*/ libxmevalstr(S); if((argc ==3) && (!strcmp(argv[1],"-n"))) { #ifdef PIPE yyin=fopen(argv[2],"r"); #else /*PIPE*/ freopen(argv[2],"r",stdin); #endif /*PIPE*/ FILENAME = strdup(argv[2]); yyout = stdout; queres_comentarios=0; NAOBUF(yyin,yyout); } else if((argc ==2) && (!strcmp(argv[1],"-n"))) { yyout = stdout; queres_comentarios=0; NAOBUF(stdin,yyout); } else for(i=1; i< argc ; i++) { puts(argv[i]); sprintf(S,"(def _FILENAME \"%s\" ) ",argv[i]); libxmevalstr(S); sprintf(S,"(nload \"%s\" ) ",argv[i]); libxmevalstr(S); } yyparse(); #else /*INTERACTIVE */ if((argc ==3) && (!strcmp(argv[1],"-n"))) { yyin = fopen(argv[2],"r"); FILENAME = strdup(argv[2]); fprintf(stderr,"DEBUG1: %s %s %s\n",argv[0],argv[1], argv[2]); yyout = stdout; queres_comentarios=0; NAOBUF(yyout,yyin); yyparse(); } else if((argc ==2) && (!strcmp(argv[1],"-n"))) { yyin = stdin; FILENAME = strdup(""); fprintf(stderr,"DEBUG2: %s -n\n",argv[0]); yyout = stdout; queres_comentarios=0; NAOBUF(yyout,yyin); yyparse(); } /* tags : seca -t file else if((argc ==3) && (!strcmp(argv[1],"-t"))) { _accao = 2; yyin = fopen(argv[2],"r"); FILENAME = strdup(argv[2]); if(yyin) { ftags=fopen("tags.aux","a"); queres_comentarios=0; strcpy(fichin,argv[2]); yyparse(); } else fprintf(stderr,".can't open file '%s'\n",argv[3]); } */ /* prettyp : seca -p infile outfile */ else if((argc == 4) && (!strcmp(argv[1],"-p"))) { _accao = 3; yyin = fopen(argv[2],"r"); FILENAME = strdup(argv[2]); if(yyin) { yyout = fopen(argv[3],"w+"); yyparse();} else fprintf(stderr,"..can't open file '%s'\n",argv[2]); } /* nyag : seca filein fileout */ else if(argc == 3) { _accao = 1; yyin = fopen(argv[1],"r"); FILENAME = strdup(argv[1]); if(yyin) { yyout = fopen(argv[2],"w+"); yyparse();} else fprintf(stderr,"...can't open file '%s'\n",argv[1]); } /* nyag : seca file */ else if(argc ==2) { _accao = 1; yyin = fopen(argv[1],"r"); FILENAME = strdup(argv[1]); if(yyin) yyparse(); else fprintf(stderr,"....can't open file '%s'\n",argv[1]); } else if(argc == 1) yyparse(); else fprintf(stderr,"Use:\n%s [filein [fileout]]\n -p filein fileout\n -t filein\n",argv[0]); return _ERRO; #endif /*INTERACTIVE */ } /* ---(Tratamento de erros )--------------------------------------------*/ void erro(s) char *s; { _ERRO=1;fprintf(stderr,"%s %d : semantic ERROR: %s\n",FILENAME, yylineno,s);} void yyerror() { _ERRO=1;fprintf(stderr,"%s %d : syntatic ERROR detected in '%s'\n", FILENAME, yylineno,yytext);} #endif /*FUNC */ yywrap() { return (1);} /* ---(Tratamento de tipos )--------------------------------------------*/ #include "secatipo.c" /*---(Gerador de TAGS )------------------------------------------------ */ static char func_name[30]; void gera_tag_pair(nome) char *nome; { printf("invocada - %s\n",nome); } aplista insereEQ(itipo) aplista itipo; { aplista aux = itipo; char *iatomo; if (isatomo(head(itipo))) { iatomo = atomo(head(itipo)); /* se o atomo nao for nenhum dos seguintes: */ if (strcmp(iatomo,"INT") && strcmp(iatomo,"STR") && strcmp(iatomo,"ANY") && strcmp(iatomo, "SYM") ) /* inserir "EQ": */ aux = cons(mkatconst("EQ"), itipo); } return(aux); }