-- specification of a language-based editor for -- the programming language "Example_Variante" -- abstract syntax begindata Example_Data data Program = PROG Identifier DeclList StmtList data DeclList = DECLLISTSINGLE Decl | DECLLISTPAIR Decl DeclList data Decl = DECLARATION Identifier TypExp data TypExp = EMPTYTYPEXP | INTTYPEXP | BOOLTYPEXP data Identifier = IDENTIFIERNULL | IDENTIFIER String data StmtList = STMTLISTSINGLE Stmt | STMTLISTPAIR Stmt StmtList data Stmt = EMPTYSTMT | ASSIGN Identifier Exp | WHILE Exp Stmt data Exp = EMPTYEXP | INTCONST Int | BOOLCONST Bool | ID Identifier | EQUAL Exp Exp | ADD Exp Exp enddata -- attribution beginmag Example_SynInh_Mag input Example_Data root PROG inh env :: a -> Identifier -> TypExp where a from {StmtList,Stmt,Exp} syn typ :: a -> TypExp where a from {Exp} syn decl_as :: a -> Identifier -> TypExp where a from {DeclList, Decl} inh multivar :: a -> Identifier -> Bool where a from {DeclList, Decl} -- information of multiple declarednes syn varenv :: a -> Identifier -> Int where a from {DeclList, Decl} -- number of declaration of an identifier t@(PROG t1 t2 t3) in env t3 y = decl_as t2 y multivar t2 y = (ifthenelse (y==IDENTIFIERNULL) False ((varenv t2 y) >1)) t@(DECLLISTPAIR t1 t2) in decl_as t y = look (decl_as t1 y) (decl_as t2 y) varenv t y = (varenv t1 y) + (varenv t2 y) multivar t2 y = multivar t y multivar t1 y = multivar t y t@(DECLLISTSINGLE t1) in varenv t y = varenv t1 y decl_as t y = decl_as t1 y multivar t1 y = multivar t y t@(DECLARATION t1 t2) in decl_as t y = getType y t1 t2 varenv t y = (ifthenelse (y==t1) 1 0) t@(STMTLISTPAIR t1 t2) in env t1 y = env t y env t2 y = env t y t@(STMTLISTSINGLE t1) in env t1 y = env t y t@(ASSIGN t1 t2) in env t2 y = env t y t@(WHILE t1 t2) in env t1 y = env t y env t2 y = env t y typ (EMPTYEXP) = EMPTYTYPEXP typ (INTCONST t1) = INTTYPEXP typ (BOOLCONST t1) = BOOLTYPEXP t@(EQUAL t1 t2) in env t1 y = env t y env t2 y = env t y typ t = BOOLTYPEXP t@(ADD t1 t2) in env t1 y = env t y env t2 y = env t y typ t = INTTYPEXP t@(ID t1) in typ t = env t t1 endmag -- display format beginmag Example_Unparse_Mag input Example_Data root PROG unparse up :: a -> String where a from {Program,DeclList,Decl,TypExp,Identifier,StmtList,Stmt,Exp} up (PROG t1 t2 t3) = "program " ++ (up t1) ++ ";\n" ++ "var" ++ "\t\n" ++ (up t2) ++ "\b\n" ++ "begin" ++ "\t\n" ++ (up t3) ++ "\b\n" ++ "end." t@(DECLLISTSINGLE t1) in up t = (up t1) t@(DECLLISTPAIR t1 t2) in up t = (up t1) ++ ";\n" ++ (up t2) t@(DECLARATION t1 t2) in up t = (up t1) ++ (check "{Multiple Declaration}" (not (multivar t t1))) ++ " : " ++ (up t2) up EMPTYTYPEXP = "" up INTTYPEXP = "integer" up BOOLTYPEXP = "boolean" up IDENTIFIERNULL = "" up (IDENTIFIER t1) = (show t1) up (STMTLISTSINGLE t1) = (up t1) up (STMTLISTPAIR t1 t2) = (up t1) ++ ";\n" ++ (up t2) up EMPTYSTMT = "" up (WHILE t1 t2) = "while " ++ (up t1) ++ (check " { Boolean Expression needed } " (compatible (typ t1) BOOLTYPEXP)) ++ " do" ++ "\t\n" ++ (up t2) ++ "\b" t@(ASSIGN t1 t2) in up t = (up t1) ++ (check " {Not declared } " ((t1 == IDENTIFIERNULL) || ((env t t1) /= EMPTYTYPEXP))) ++ " := " ++ (up t2) ++ (check " Incomatible Types in := } " (compatible (env t t1) (typ t2))) t@(ID t1) in up t = (up t1) ++ (check " {Not declared } " ((t1 == IDENTIFIERNULL) || ((env t t1) /= EMPTYTYPEXP))) up (EQUAL t1 t2) = "(" ++ (up t1) ++ " == " ++ (check " Incomatible Types in == } " (compatible (typ t1) (typ t2))) ++ (up t2) ++ ")" up (ADD t1 t2) = "(" ++ (up t1) ++ (check " Int Expression needed } " (compatible (typ t1) INTTYPEXP)) ++ " + " ++ (check " Int Expression needed } " (compatible (typ t2) INTTYPEXP)) ++ (up t2) ++ ")" up EMPTYEXP = "" up (INTCONST t1) = (show t1) up (BOOLCONST t1) = (show t1) endmag -- structural transformations beginmag Example_Transform_Mag input Example_Data root PROG transform trans :: a -> TransSelection -> a where a from {DeclList,TypExp,Identifier,StmtList,Stmt,Exp} t@(DECLLISTSINGLE t1) in trans t Ins_decl_after = DECLLISTPAIR t1 (DECLLISTSINGLE (DECLARATION IDENTIFIERNULL EMPTYTYPEXP)) t@(DECLLISTPAIR t1 t2) in trans t Cut_first = t2 trans t Cut_rest = DECLLISTSINGLE t1 t@EMPTYTYPEXP in trans t Ins_integer = INTTYPEXP trans t Ins_boolean = BOOLTYPEXP trans INTTYPEXP Cut = EMPTYTYPEXP trans BOOLTYPEXP Cut = EMPTYTYPEXP trans (IDENTIFIER t1) Cut = IDENTIFIERNULL t@(STMTLISTSINGLE t1) in trans t Ins_stmt_before = STMTLISTPAIR EMPTYSTMT t trans t Ins_stmt_after = STMTLISTPAIR t1 (STMTLISTSINGLE EMPTYSTMT) t@(STMTLISTPAIR t1 t2) in trans t Cut_first = t2 trans t Cut_rest = STMTLISTSINGLE t1 trans t Ins_stmt_before = STMTLISTPAIR EMPTYSTMT t trans t Flip_first_pair = flip_stmts t t@EMPTYSTMT in trans t Ins_assign = ASSIGN IDENTIFIERNULL EMPTYEXP trans t Ins_while = WHILE EMPTYEXP EMPTYSTMT t@(ASSIGN t1 t2) in trans t Cut = EMPTYSTMT t@(WHILE t1 t2) in trans t Cut = EMPTYSTMT t@EMPTYEXP in trans t Ins_true = BOOLCONST True trans t Ins_false = BOOLCONST False trans t Ins_id = ID IDENTIFIERNULL trans t Ins_equal = EQUAL EMPTYEXP EMPTYEXP trans t Ins_add = ADD EMPTYEXP EMPTYEXP trans (INTCONST t1) Cut = EMPTYEXP trans (BOOLCONST t1) Cut = EMPTYEXP trans (ID t1) Cut = EMPTYEXP trans (EQUAL t1 t2) Cut = EMPTYEXP trans (ADD t1 t2) Cut = EMPTYEXP endmag -- transform commands data TransSelection = Ins_decl_after | Ins_stmt_before | Ins_stmt_after | Flip_first_pair | Ins_integer | Ins_boolean | Ins_assign | Ins_while | Ins_true | Ins_false | Ins_id | Ins_equal | Ins_add | Cut | Cut_first | Cut_rest deriving (Show,Eq,Read) -- token definitions beginlex Example_Input token Whitespace = [\ \t\n] token IntT = "integer" token BoolT = "boolean" token ColonT = ':' token AssignT = ":=" token WhileT = "while" token DoT = "do" token OParenT = '(' token CParenT = ')' token EqualT = "==" token PlusT = '+' token TrueT = "True" token FalseT = "False" token IntegerT Int = '0' | [1-9] [0-9]* token IdentifierT String = [a-zA-Z] [0-9a-zA-Z_]* endlex -- parsing definitions beginparse Example_Input parse P_Identifier :: Identifier | IdentifierT = IDENTIFIER $1 parse P_TypExp :: TypExp | IntT = INTTYPEXP | BoolT = BOOLTYPEXP parse P_Decl :: Decl | P_Identifier ColonT P_TypExp = DECLARATION $1 $3 parse P_Stmt :: Stmt | P_Identifier AssignT P_Exp = ASSIGN $1 $3 | WhileT P_Exp DoT P_Stmt = WHILE $2 $4 parse P_OpenExp :: Exp | P_CompactExp EqualT P_CompactExp = EQUAL $1 $3 | P_CompactExp PlusT P_CompactExp = ADD $1 $3 parse P_CompactExp :: Exp | P_Identifier = ID $1 | IntegerT = INTCONST $1 | TrueT = BOOLCONST True | FalseT = BOOLCONST False | OParenT P_OpenExp CParenT = $2 parse P_Exp :: Exp | P_OpenExp = $1 | P_CompactExp = $1 endparse -- input determinization begininput Example_Input input PROG.1 @ Identifier as P_Identifier via complete_name input Identifier as P_Identifier input EMPTYSTMT @ Stmt as P_Stmt input TypExp as P_TypExp input Decl as P_Decl input Exp as P_Exp endinput -- auxilary functions check :: String -> Bool -> String check message condition = if condition then "" else message look :: TypExp -> TypExp -> TypExp -- returns the first type if it is specified, otherwise the second look EMPTYTYPEXP type2 = type2 look type1 _ = type1 getType :: Identifier -> Identifier -> TypExp -> TypExp -- gets the type of an specified identifier (first argument) -- which is given by the third argument -- if both given identifier are equal getType id1 id2 typ = if ((id1 /= IDENTIFIERNULL) && (id1==id2)) then typ else EMPTYTYPEXP compatible :: TypExp -> TypExp -> Bool compatible t1 t2 = (t1 == EMPTYTYPEXP) || (t2 == EMPTYTYPEXP) || (t1 == t2) flip_stmts :: StmtList -> StmtList flip_stmts (STMTLISTPAIR first (STMTLISTSINGLE second)) = (STMTLISTPAIR second (STMTLISTSINGLE first)) flip_stmts (STMTLISTPAIR first (STMTLISTPAIR second rest)) = (STMTLISTPAIR second (STMTLISTPAIR first rest)) ifthenelse :: Bool -> a -> a -> a ifthenelse b s1 s2 = if b then s1 else s2 complete_name :: Identifier -> Identifier complete_name (IDENTIFIER t1) = (IDENTIFIER ("*** " ++ t1 ++ " ***"))