adamc@1: (* Copyright (c) 2008, Adam Chlipala adamc@1: * All rights reserved. adamc@1: * adamc@1: * Redistribution and use in source and binary forms, with or without adamc@1: * modification, are permitted provided that the following conditions are met: adamc@1: * adamc@1: * - Redistributions of source code must retain the above copyright notice, adamc@1: * this list of conditions and the following disclaimer. adamc@1: * - Redistributions in binary form must reproduce the above copyright notice, adamc@1: * this list of conditions and the following disclaimer in the documentation adamc@1: * and/or other materials provided with the distribution. adamc@1: * - The names of contributors may not be used to endorse or promote products adamc@1: * derived from this software without specific prior written permission. adamc@1: * adamc@1: * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" adamc@1: * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE adamc@1: * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE adamc@1: * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE adamc@1: * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR adamc@1: * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF adamc@1: * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS adamc@1: * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN adamc@1: * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) adamc@1: * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE adamc@1: * POSSIBILITY OF SUCH DAMAGE. adamc@1: *) adamc@1: adamc@1: (* Laconic/Web language parser *) adamc@1: adamc@1: structure Compiler :> COMPILER = struct adamc@1: adamc@1: structure LacwebLrVals = LacwebLrValsFn(structure Token = LrParser.Token) adamc@1: structure Lex = LacwebLexFn(structure Tokens = LacwebLrVals.Tokens) adamc@1: structure LacwebP = Join(structure ParserData = LacwebLrVals.ParserData adamc@1: structure Lex = Lex adamc@1: structure LrParser = LrParser) adamc@1: adamc@1: (* The main parsing routine *) adamc@1: fun parse filename = adamc@1: let adamc@1: val () = (ErrorMsg.resetErrors (); adamc@1: ErrorMsg.resetPositioning filename) adamc@1: val file = TextIO.openIn filename adamc@1: fun get _ = TextIO.input file adamc@1: fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s adamc@1: val lexer = LrParser.Stream.streamify (Lex.makeLexer get) adamc@1: val (absyn, _) = LacwebP.parse (30, lexer, parseerror, ()) adamc@1: in adamc@1: TextIO.closeIn file; adamc@5: if ErrorMsg.anyErrors () then adamc@5: NONE adamc@5: else adamc@5: SOME absyn adamc@1: end adamc@1: handle LrParser.ParseError => NONE adamc@1: adamc@5: fun elaborate env filename = adamc@5: case parse filename of adamc@5: NONE => NONE adamc@5: | SOME file => adamc@5: let adamc@5: val out = Elaborate.elabFile env file adamc@5: in adamc@5: if ErrorMsg.anyErrors () then adamc@5: NONE adamc@5: else adamc@5: SOME out adamc@5: end adamc@16: adamc@16: fun corify eenv cenv filename = adamc@16: case elaborate eenv filename of adamc@16: NONE => NONE adamc@31: | SOME (file, _) => adamc@25: if ErrorMsg.anyErrors () then adamc@25: NONE adamc@25: else adamc@25: SOME (Corify.corify file) adamc@5: adamc@20: fun reduce eenv cenv filename = adamc@20: case corify eenv cenv filename of adamc@20: NONE => NONE adamc@25: | SOME file => adamc@25: if ErrorMsg.anyErrors () then adamc@25: NONE adamc@25: else adamc@25: SOME (Reduce.reduce (Shake.shake file)) adamc@20: adamc@23: fun shake eenv cenv filename = adamc@23: case reduce eenv cenv filename of adamc@23: NONE => NONE adamc@25: | SOME file => adamc@25: if ErrorMsg.anyErrors () then adamc@25: NONE adamc@25: else adamc@25: SOME (Shake.shake file) adamc@25: adamc@25: fun monoize eenv cenv filename = adamc@25: case shake eenv cenv filename of adamc@25: NONE => NONE adamc@25: | SOME file => adamc@25: if ErrorMsg.anyErrors () then adamc@25: NONE adamc@25: else adamc@25: SOME (Monoize.monoize cenv file) adamc@23: adamc@26: fun cloconv eenv cenv filename = adamc@26: case monoize eenv cenv filename of adamc@26: NONE => NONE adamc@26: | SOME file => adamc@26: if ErrorMsg.anyErrors () then adamc@26: NONE adamc@26: else adamc@26: SOME (Cloconv.cloconv file) adamc@26: adamc@29: fun cjrize eenv cenv filename = adamc@29: case cloconv eenv cenv filename of adamc@29: NONE => NONE adamc@29: | SOME file => adamc@29: if ErrorMsg.anyErrors () then adamc@29: NONE adamc@29: else adamc@29: SOME (Cjrize.cjrize file) adamc@29: adamc@1: fun testParse filename = adamc@1: case parse filename of adamc@5: NONE => print "Failed\n" adamc@1: | SOME file => adamc@5: (Print.print (SourcePrint.p_file file); adamc@5: print "\n") adamc@5: adamc@5: fun testElaborate filename = adamc@14: (case elaborate ElabEnv.basis filename of adamc@5: NONE => print "Failed\n" adamc@31: | SOME (file, _) => adamc@14: (Print.print (ElabPrint.p_file ElabEnv.basis file); adamc@5: print "\n")) adamc@5: handle ElabEnv.UnboundNamed n => adamc@5: print ("Unbound named " ^ Int.toString n ^ "\n") adamc@1: adamc@16: fun testCorify filename = adamc@16: (case corify ElabEnv.basis CoreEnv.basis filename of adamc@16: NONE => print "Failed\n" adamc@16: | SOME file => adamc@16: (Print.print (CorePrint.p_file CoreEnv.basis file); adamc@16: print "\n")) adamc@16: handle CoreEnv.UnboundNamed n => adamc@16: print ("Unbound named " ^ Int.toString n ^ "\n") adamc@16: adamc@20: fun testReduce filename = adamc@20: (case reduce ElabEnv.basis CoreEnv.basis filename of adamc@20: NONE => print "Failed\n" adamc@20: | SOME file => adamc@20: (Print.print (CorePrint.p_file CoreEnv.basis file); adamc@20: print "\n")) adamc@20: handle CoreEnv.UnboundNamed n => adamc@20: print ("Unbound named " ^ Int.toString n ^ "\n") adamc@20: adamc@23: fun testShake filename = adamc@23: (case shake ElabEnv.basis CoreEnv.basis filename of adamc@23: NONE => print "Failed\n" adamc@23: | SOME file => adamc@23: (Print.print (CorePrint.p_file CoreEnv.basis file); adamc@23: print "\n")) adamc@23: handle CoreEnv.UnboundNamed n => adamc@23: print ("Unbound named " ^ Int.toString n ^ "\n") adamc@23: adamc@25: fun testMonoize filename = adamc@25: (case monoize ElabEnv.basis CoreEnv.basis filename of adamc@25: NONE => print "Failed\n" adamc@25: | SOME file => adamc@25: (Print.print (MonoPrint.p_file MonoEnv.basis file); adamc@25: print "\n")) adamc@25: handle MonoEnv.UnboundNamed n => adamc@25: print ("Unbound named " ^ Int.toString n ^ "\n") adamc@25: adamc@26: fun testCloconv filename = adamc@26: (case cloconv ElabEnv.basis CoreEnv.basis filename of adamc@26: NONE => print "Failed\n" adamc@26: | SOME file => adamc@26: (Print.print (FlatPrint.p_file FlatEnv.basis file); adamc@26: print "\n")) adamc@26: handle FlatEnv.UnboundNamed n => adamc@26: print ("Unbound named " ^ Int.toString n ^ "\n") adamc@26: adamc@29: fun testCjrize filename = adamc@29: (case cjrize ElabEnv.basis CoreEnv.basis filename of adamc@29: NONE => print "Failed\n" adamc@29: | SOME file => adamc@29: (Print.print (CjrPrint.p_file CjrEnv.basis file); adamc@29: print "\n")) adamc@29: handle CjrEnv.UnboundNamed n => adamc@29: print ("Unbound named " ^ Int.toString n ^ "\n") adamc@29: adamc@29: fun compile filename = adamc@29: case cjrize ElabEnv.basis CoreEnv.basis filename of adamc@29: NONE => () adamc@29: | SOME file => adamc@29: let adamc@29: val outf = TextIO.openOut "/tmp/lacweb.c" adamc@29: val s = TextIOPP.openOut {dst = outf, wid = 80} adamc@29: in adamc@29: Print.fprint s (CjrPrint.p_file CjrEnv.basis file); adamc@29: TextIO.closeOut outf adamc@29: end adamc@29: adamc@1: end