% $Id: REPTk.oz,v 1.7 2009/10/21 02:56:25 leavens Exp leavens $ % Interactive test interface for the Reducer, built Using Oz's QTk system, % based on an example by Peter van Roy. % % BUGS: this gives some Tk error ("Expected type: tickle") % when you press the Run Reductions button % % AUTHOR: Gary T. Leavens \insert 'Desugar.oz' \insert 'ReducerPrinting.oz' \insert 'Unparse.oz' local [OzFrontend QTk] = {Module.link ['OzFrontend.ozf' 'x-oz://system/wp/QTk.ozf']} StdParseFile = OzFrontend.parseFile StdParseVirtualString = OzFrontend.parseVirtualString fun {GetSwitch SName} % ENSURES: Return false for all switches (a default value) false end fun {ParseFile FileName Reporter} % ENSURES: Result is an AST for the file named FileName (or parseError) {StdParseFile FileName Reporter GetSwitch {NewDictionary}} end fun {ParseVS VS Reporter} % ENSURES: Result is an AST for the virtual string VS (or parseError) {StdParseVirtualString VS Reporter GetSwitch {NewDictionary}} end fun {PositionMsg pos(FileName Line Column)} % ENSURES: Result is a virtual string describing an error position case FileName of '' then '' else 'File "'#FileName#'", ' end #'line '#{Value.toVirtualString Line 2 2} #', character '#{Value.toVirtualString Column 2 2} end In ParseDisplay Out proc {Reporter error(coord:Coord kind:_ msg:Message)} % ENSURES: Output shows the message {Out set({PositionMsg Coord}#': '#Message)} end ShowParse = true D=td(tdrubberframe(glue:nswe lr(glue:we button(glue:we bg:green text:"Run Reductions" action: proc {$} PT = {ParseVS {In get($)} Reporter} in if PT \= parseError then local DPT = {Desugar PT} _#InitConfig|Reds = {ReductionsFor DPT} RedsVS = {StringForConfig InitConfig} # {FoldR Reds fun {$ RN#Config Rest} "\n"#Arrow#{By RN} #"\n"#SpacingBeforeConfig #{StringForConfig Config} #Rest end ""} in if ShowParse then {ParseDisplay set({Value.toVirtualString DPT 20 20})} end {Out set(RedsVS)} end end end) button(glue:we text:"Quit" bg:red action:toplevel#close)) lr(glue:nswe label(text:"Statement") text(handle:In glue:nswe)) if ShowParse then lr(glue:we label(text:"Desugared AST") text(handle:ParseDisplay glue:nswe tdscrollbar:true)) else lr(empty) end lr(glue:nswe label(text:"Reductions") text(handle:Out glue:nswe tdscrollbar:true))) ) W={QTk.build D} in {W show(wait:true)} end