Initial parsing and pretty-printing

16 files changed, 796 insertions, 6 deletions

diff --git a/.hgignore b/.hgignore
index 361098b6..deca79d3 100644
--- a/.hgignore
+++ b/.hgignore
@@ -8,3 +8,6 @@ bin/*
 
 src/lacweb.cm
 src/lacweb.mlb
+
+*.lex.*
+*.grm.*
diff --git a/Makefile b/Makefile
index 1705c222..9bfcd95c 100644
--- a/Makefile
+++ b/Makefile
@@ -37,5 +37,7 @@ ifdef DEBUG
 	MLTON += -const 'Exn.keepHistory true'
 endif
 
-bin/lacweb: src/lacweb.mlb src/*.sig src/*.sml
+bin/lacweb: src/lacweb.mlb src/*.sig src/*.sml \
+		src/lacweb.mlton.lex.sml \
+		src/lacweb.mlton.grm.sig src/lacweb.mlton.grm.sml
 	$(MLTON) -output $@ src/lacweb.mlb
diff --git a/src/compiler.sig b/src/compiler.sig
new file mode 100644
index 00000000..92c4d679
--- /dev/null
+++ b/src/compiler.sig
@@ -0,0 +1,36 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Laconic/Web main compiler interface *)
+
+signature COMPILER = sig
+
+    val parse : string -> Laconic.file option
+
+    val testParse : string -> unit
+
+end
diff --git a/src/compiler.sml b/src/compiler.sml
new file mode 100644
index 00000000..2463528b
--- /dev/null
+++ b/src/compiler.sml
@@ -0,0 +1,64 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Laconic/Web language parser *)
+
+structure Compiler :> COMPILER = struct 
+
+structure LacwebLrVals = LacwebLrValsFn(structure Token = LrParser.Token)
+structure Lex = LacwebLexFn(structure Tokens = LacwebLrVals.Tokens)
+structure LacwebP = Join(structure ParserData = LacwebLrVals.ParserData
+                         structure Lex = Lex
+                         structure LrParser = LrParser)
+
+(* The main parsing routine *)
+fun parse filename =
+    let
+        val () = (ErrorMsg.resetErrors ();
+                  ErrorMsg.resetPositioning filename)
+	val file = TextIO.openIn filename
+	fun get _ = TextIO.input file
+	fun parseerror (s, p1, p2) = ErrorMsg.errorAt' (p1, p2) s
+	val lexer = LrParser.Stream.streamify (Lex.makeLexer get)
+	val (absyn, _) = LacwebP.parse (30, lexer, parseerror, ())
+    in
+        TextIO.closeIn file;
+        SOME absyn
+    end
+    handle LrParser.ParseError => NONE
+
+fun testParse filename =
+    case parse filename of
+        NONE => print "Parse error\n"
+      | SOME file =>
+        if ErrorMsg.anyErrors () then
+            print "Recoverable parse error\n"
+        else
+            (Print.print (LaconicPrint.p_file file);
+             print "\n")
+
+end
diff --git a/src/errormsg.sig b/src/errormsg.sig
index 0716a3df..24bc8205 100644
--- a/src/errormsg.sig
+++ b/src/errormsg.sig
@@ -36,4 +36,18 @@ signature ERROR_MSG = sig
 
     type 'a located = 'a * span
 
+    val posToString : pos -> string
+    val spanToString : span -> string
+
+    val resetPositioning : string -> unit
+    val newline : int -> unit
+    val lastLineStart : unit -> int
+    val posOf : int -> pos
+    val spanOf : int * int -> span
+
+    val resetErrors : unit -> unit
+    val anyErrors : unit -> bool
+    val error : string -> unit
+    val errorAt : span -> string -> unit
+    val errorAt' : int * int -> string -> unit
 end
diff --git a/src/errormsg.sml b/src/errormsg.sml
index 9f41fff3..0f5b9b61 100644
--- a/src/errormsg.sml
+++ b/src/errormsg.sml
@@ -36,4 +36,61 @@ type span = {file : string,
 
 type 'a located = 'a * span
 
+
+fun posToString {line, char} =
+    String.concat [Int.toString line, ":", Int.toString char]
+
+fun spanToString {file, first, last} =
+    String.concat [file, ":", posToString first, "-", posToString last]
+
+
+val file = ref ""
+val numLines = ref 1
+val lines : int list ref = ref []
+
+fun resetPositioning fname = (file := fname;
+                              numLines := 1;
+                              lines := [])
+
+fun newline pos = (numLines := !numLines + 1;
+                   lines := pos :: !lines)
+
+fun lastLineStart () =
+    case !lines of
+        [] => 0
+      | n :: _ => n+1
+
+fun posOf n =
+    let
+        fun search lineNum lines =
+            case lines of
+                [] => {line = 1,
+                       char = n}
+              | bound :: rest =>
+                if n > bound then
+                    {line = lineNum,
+                     char = n - bound - 1}
+                else
+                    search (lineNum - 1) rest
+    in
+        search (!numLines) (!lines)
+    end
+
+fun spanOf (pos1, pos2) = {file = !file,
+                           first = posOf pos1,
+                           last = posOf pos2}
+
+
+val errors = ref false
+
+fun resetErrors () = errors := false
+fun anyErrors () = !errors
+fun error s = (TextIO.output (TextIO.stdErr, s);
+               TextIO.output1 (TextIO.stdErr, #"\n");
+               errors := true)
+fun errorAt span s = (TextIO.output (TextIO.stdErr, spanToString span);
+                      TextIO.output1 (TextIO.stdErr, #" ");
+                      error s)
+fun errorAt' span s = errorAt (spanOf span) s
+
 end
diff --git a/src/laconic.sml b/src/laconic.sml
index eacc7ebc..02770a75 100644
--- a/src/laconic.sml
+++ b/src/laconic.sml
@@ -37,23 +37,33 @@ datatype kind' =
 
 withtype kind = kind' located
 
+datatype explicitness =
+         Explicit
+       | Implicit
+
 datatype con' =
          CAnnot of con * kind
 
        | TFun of con * con
-       | TCFun of bool * string option * kind * con
+       | TCFun of explicitness * string * kind * con
        | TRecord of con
 
-       | CFvar of string
-       | CBvar of int
+       | CVar of string
        | CApp of con * con
-       | CAbs of string * kind * con
+       | CAbs of explicitness * string * kind * con
 
        | CName of string
 
-       | CRecord of (string * con) list
+       | CRecord of (con * con) list
        | CConcat of con * con
 
 withtype con = con' located
 
+datatype decl' =
+         DCon of string * kind option * con
+
+withtype decl = decl' located
+
+type file = decl list
+
 end
diff --git a/src/laconic_print.sig b/src/laconic_print.sig
new file mode 100644
index 00000000..079b420e
--- /dev/null
+++ b/src/laconic_print.sig
@@ -0,0 +1,36 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing Laconic/Web *)
+
+signature LACONIC_PRINT = sig
+    val p_kind : Laconic.kind Print.printer
+    val p_explicitness : Laconic.explicitness Print.printer
+    val p_con : Laconic.con Print.printer
+    val p_decl : Laconic.decl Print.printer
+    val p_file : Laconic.file Print.printer
+end
diff --git a/src/laconic_print.sml b/src/laconic_print.sml
new file mode 100644
index 00000000..9b18dcba
--- /dev/null
+++ b/src/laconic_print.sml
@@ -0,0 +1,147 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing Laconic/Web *)
+
+structure LaconicPrint :> LACONIC_PRINT = struct
+
+open Print.PD
+open Print
+
+open Laconic
+
+fun p_kind' par (k, _) =
+    case k of
+        KType => string "Type"
+      | KArrow (k1, k2) => parenIf par (box [p_kind' true k1,
+                                             space,
+                                             string "->",
+                                             space,
+                                             p_kind k2])
+      | KName => string "Name"
+      | KRecord k => box [string "{", p_kind k, string "}"]
+
+and p_kind k = p_kind' false k
+
+fun p_explicitness e =
+    case e of
+        Explicit => string "::"
+      | Implicit => string ":::"
+
+fun p_con' par (c, _) =
+    case c of
+        CAnnot (c, k) => box [string "(",
+                              p_con c,
+                              space,
+                              string "::",
+                              space,
+                              p_kind k,
+                              string ")"]
+
+      | TFun (t1, t2) => parenIf par (box [p_con' true t1,
+                                           space,
+                                           string "->",
+                                           space,
+                                           p_con t2])
+      | TCFun (e, x, k, c) => parenIf par (box [string x,
+                                                space,
+                                                p_explicitness e,
+                                                space,
+                                                p_kind k,
+                                                space,
+                                                string "->",
+                                                space,
+                                                p_con c])
+      | TRecord (CRecord xcs, _) => box [string "{",
+                                         p_list (fn (x, c) =>
+                                                    box [p_con x,
+                                                         space,
+                                                         string ":",
+                                                         space,
+                                                         p_con c]) xcs,
+                                         string "}"]
+      | TRecord c => box [string "$",
+                          p_con' true c]
+
+      | CVar s => string s
+      | CApp (c1, c2) => parenIf par (box [p_con c1,
+                                           space,
+                                           p_con' true c2])
+      | CAbs (e, x, k, c) => parenIf par (box [string "fn",
+                                               space,
+                                               string x,
+                                               space,
+                                               p_explicitness e,
+                                               space,
+                                               p_kind k,
+                                               space,
+                                               string "=>",
+                                               space,
+                                               p_con c])
+
+      | CName s => box [string "#", string s]
+
+      | CRecord xcs => box [string "[",
+                            p_list (fn (x, c) =>
+                                       box [p_con x,
+                                            space,
+                                            string "=",
+                                            space,
+                                            p_con c]) xcs,
+                            string "]"]
+      | CConcat (c1, c2) => parenIf par (box [p_con' true c1,
+                                              space,
+                                              string "++",
+                                              space,
+                                              p_con c2])
+        
+and p_con c = p_con' false c
+
+fun p_decl ((d, _) : decl) =
+    case d of
+        DCon (x, NONE, c) => box [string "con",
+                                  space,
+                                  string x,
+                                  space,
+                                  string "=",
+                                  space,
+                                  p_con c]
+      | DCon (x, SOME k, c) => box [string "con",
+                                    space,
+                                    string x,
+                                    space,
+                                    string "::",
+                                    space,
+                                    p_kind k,
+                                    space,
+                                    string "=",
+                                    space,
+                                    p_con c]
+
+val p_file = p_list_sep newline p_decl
+
+end
diff --git a/src/lacweb.grm b/src/lacweb.grm
new file mode 100644
index 00000000..2f9150fa
--- /dev/null
+++ b/src/lacweb.grm
@@ -0,0 +1,126 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Grammar for Laconic/Web programs *)
+
+open Laconic
+
+val s = ErrorMsg.spanOf
+
+%%
+%header (functor LacwebLrValsFn(structure Token : TOKEN))
+
+%term 
+   EOF
+ | SYMBOL of string | CSYMBOL of string
+ | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE
+ | EQ | COMMA | COLON | DCOLON | TCOLON | DOT | HASH
+ | CON | TYPE | NAME
+ | ARROW | LARROW | DARROW
+ | FN | PLUSPLUS | DOLLAR
+
+%nonterm 
+   file of decl list
+ | decls of decl list
+ | decl of decl
+
+ | kind of kind
+ | kcolon of explicitness
+
+ | cexp of con
+ | capps of con
+ | cterm of con
+ | ident of con
+ | rcon of (con * con) list
+ | rcone of (con * con) list
+
+%verbose                                (* print summary of errors *)
+%pos int                                (* positions *)
+%start file
+%pure
+%eop EOF
+%noshift EOF
+
+%name Lacweb
+
+%nonassoc DARROW
+%nonassoc COLON
+%right COMMA
+%right ARROW LARROW
+%right PLUSPLUS
+%nonassoc DOLLAR
+%left DOT
+
+%%
+
+file   : decls                          (decls)
+
+decls  :                                ([])
+       | decl decls                     (decl :: decls)
+
+decl   : CON SYMBOL EQ cexp             (DCon (SYMBOL, NONE, cexp), s (CONleft, cexpright))
+       | CON SYMBOL DCOLON kind EQ cexp (DCon (SYMBOL, SOME kind, cexp), s (CONleft, cexpright))
+
+kind   : TYPE                           (KType, s (TYPEleft, TYPEright))
+       | NAME                           (KName, s (NAMEleft, NAMEright))
+       | LBRACE kind RBRACE             (KRecord kind, s (LBRACEleft, RBRACEright))
+       | kind ARROW kind                (KArrow (kind1, kind2), s (kind1left, kind2right))
+       | LPAREN kind RPAREN             (#1 kind, s (LPARENleft, RPARENright))
+
+capps  : cterm                          (cterm)
+       | capps cterm                    (CApp (capps, cterm), s (cappsleft, ctermright))
+
+cexp   : capps                          (capps)
+       | cexp ARROW cexp                (TFun (cexp1, cexp2), s (cexp1left, cexp2right))
+       | SYMBOL kcolon kind ARROW cexp (TCFun (kcolon, SYMBOL, kind, cexp), s (SYMBOLleft, cexpright))
+
+       | cexp PLUSPLUS cexp             (CConcat (cexp1, cexp2), s (cexp1left, cexp1right))
+
+       | FN SYMBOL kcolon kind DARROW cexp (CAbs (kcolon, SYMBOL, kind, cexp), s (FNleft, cexpright))
+
+kcolon : DCOLON                         (Explicit)
+       | TCOLON                         (Implicit)
+
+cterm  : LPAREN cexp RPAREN             (#1 cexp, s (LPARENleft, RPARENright))
+       | LBRACK rcon RBRACK             (CRecord rcon, s (LBRACKleft, RBRACKright))
+       | LBRACE rcone RBRACE            (TRecord (CRecord rcone, s (LBRACEleft, RBRACEright)),
+					 s (LBRACEleft, RBRACEright))
+       | DOLLAR cterm                   (TRecord cterm, s (DOLLARleft, ctermright))
+       | HASH CSYMBOL                   (CName CSYMBOL, s (HASHleft, CSYMBOLright))
+
+       | SYMBOL                         (CVar SYMBOL, s (SYMBOLleft, SYMBOLright))
+
+rcon   :                                ([])
+       | ident EQ cexp                  ([(ident, cexp)])
+       | ident EQ cexp COMMA rcon       ((ident, cexp) :: rcon)
+
+rcone  :                                ([])
+       | ident COLON cexp               ([(ident, cexp)])
+       | ident COLON cexp COMMA rcone   ((ident, cexp) :: rcone)
+
+ident  : CSYMBOL                        (CName CSYMBOL, s (CSYMBOLleft, CSYMBOLright))
+       | SYMBOL                         (CVar SYMBOL, s (SYMBOLleft, SYMBOLright))
diff --git a/src/lacweb.lex b/src/lacweb.lex
new file mode 100644
index 00000000..bc5d3af4
--- /dev/null
+++ b/src/lacweb.lex
@@ -0,0 +1,124 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Lexing info for Laconic/Web programs *)
+
+type pos = int
+type svalue = Tokens.svalue
+type ('a,'b) token = ('a,'b) Tokens.token
+type lexresult = (svalue,pos) Tokens.token
+
+local
+  val commentLevel = ref 0
+  val commentPos = ref 0
+in
+  fun enterComment pos =
+      (if !commentLevel = 0 then
+           commentPos := pos
+       else
+           ();
+       commentLevel := !commentLevel + 1)
+    
+  fun exitComment () =
+      (ignore (commentLevel := !commentLevel - 1);
+       !commentLevel = 0)
+
+  fun eof () = 
+    let 
+      val pos = ErrorMsg.lastLineStart ()
+    in
+      if !commentLevel > 0 then
+          ErrorMsg.errorAt' (!commentPos, !commentPos) "Unterminated comment"
+      else
+          ();
+      Tokens.EOF (pos, pos) 
+    end
+end
+
+%%
+%header (functor LacwebLexFn(structure Tokens : Lacweb_TOKENS));
+%full
+%s COMMENT;
+
+id = [a-z_][A-Za-z0-9_]*;
+cid = [A-Z][A-Za-z0-9_]*;
+ws = [\ \t\012];
+
+%%
+
+<INITIAL> \n          => (ErrorMsg.newline yypos;
+                          continue ());
+<COMMENT> \n          => (ErrorMsg.newline yypos;
+                          continue ());
+
+<INITIAL> {ws}+       => (lex ());
+
+<INITIAL> "(*"        => (YYBEGIN COMMENT;
+                          enterComment yypos;
+                          continue ());
+<INITIAL> "*)"        => (ErrorMsg.errorAt' (yypos, yypos) "Unbalanced comments";
+			  continue ());
+
+<COMMENT> "(*"        => (enterComment yypos;
+                          continue ());
+<COMMENT> "*)"        => (if exitComment () then YYBEGIN INITIAL else ();
+			  continue ());
+
+<INITIAL> "("         => (Tokens.LPAREN (yypos, yypos + size yytext));
+<INITIAL> ")"         => (Tokens.RPAREN (yypos, yypos + size yytext));
+<INITIAL> "["         => (Tokens.LBRACK (yypos, yypos + size yytext));
+<INITIAL> "]"         => (Tokens.RBRACK (yypos, yypos + size yytext));
+<INITIAL> "{"         => (Tokens.LBRACE (yypos, yypos + size yytext));
+<INITIAL> "}"         => (Tokens.RBRACE (yypos, yypos + size yytext));
+
+<INITIAL> "->"        => (Tokens.ARROW (yypos, yypos + size yytext));
+<INITIAL> "=>"        => (Tokens.DARROW (yypos, yypos + size yytext));
+<INITIAL> "++"        => (Tokens.PLUSPLUS (yypos, yypos + size yytext));
+
+<INITIAL> "="         => (Tokens.EQ (yypos, yypos + size yytext));
+<INITIAL> ","         => (Tokens.COMMA (yypos, yypos + size yytext));
+<INITIAL> ":::"       => (Tokens.TCOLON (yypos, yypos + size yytext));
+<INITIAL> "::"        => (Tokens.DCOLON (yypos, yypos + size yytext));
+<INITIAL> ":"         => (Tokens.COLON (yypos, yypos + size yytext));
+<INITIAL> "."         => (Tokens.DOT (yypos, yypos + size yytext));
+<INITIAL> "$"         => (Tokens.DOLLAR (yypos, yypos + size yytext));
+<INITIAL> "#"         => (Tokens.HASH (yypos, yypos + size yytext));
+
+<INITIAL> "con"       => (Tokens.CON (yypos, yypos + size yytext));
+<INITIAL> "fn"        => (Tokens.FN (yypos, yypos + size yytext));
+
+<INITIAL> "Type"      => (Tokens.TYPE (yypos, yypos + size yytext));
+<INITIAL> "Name"      => (Tokens.NAME (yypos, yypos + size yytext));
+
+<INITIAL> {id}        => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext));
+<INITIAL> {cid}       => (Tokens.CSYMBOL (yytext, yypos, yypos + size yytext));
+
+<COMMENT> .           => (continue());
+
+<INITIAL> .           => (ErrorMsg.errorAt' (yypos, yypos)
+                                            ("illegal character: \"" ^ yytext ^ "\"");
+                          continue ());
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index 833f8c11..ac9c24d6 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -25,3 +25,6 @@
  * POSSIBILITY OF SUCH DAMAGE.
  *)
 
+val () = case CommandLine.arguments () of
+             [filename] => Compiler.testParse filename
+           | _ => print "Bad arguments"
diff --git a/src/print.sig b/src/print.sig
new file mode 100644
index 00000000..5bf3fcd8
--- /dev/null
+++ b/src/print.sig
@@ -0,0 +1,54 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing *)
+
+signature PRINT = sig
+    structure PD : PP_DESC
+                       where type PPS.token = string
+
+    type 'a printer = 'a -> PD.pp_desc
+
+    val box : PD.pp_desc list -> PD.pp_desc
+    val parenIf : bool -> PD.pp_desc -> PD.pp_desc
+    val space : PD.pp_desc
+
+    val p_list_sep : PD.pp_desc -> 'a printer -> 'a list printer
+    val p_list : 'a printer -> 'a list printer
+
+    val fprint : PD.PPS.stream -> PD.pp_desc -> unit
+    val print : PD.pp_desc -> unit
+    val eprint : PD.pp_desc -> unit
+
+    val fpreface : PD.PPS.stream -> string * PD.pp_desc -> unit
+    val preface : string * PD.pp_desc -> unit
+    val epreface : string * PD.pp_desc -> unit
+
+    val fprefaces : PD.PPS.stream -> (string * PD.pp_desc) list -> unit
+    val prefaces : (string * PD.pp_desc) list -> unit
+    val eprefaces : (string * PD.pp_desc) list -> unit
+end
diff --git a/src/print.sml b/src/print.sml
new file mode 100644
index 00000000..6d9019d2
--- /dev/null
+++ b/src/print.sml
@@ -0,0 +1,92 @@
+(* Copyright (c) 2008, Adam Chlipala
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * - Redistributions of source code must retain the above copyright notice,
+ *   this list of conditions and the following disclaimer.
+ * - Redistributions in binary form must reproduce the above copyright notice,
+ *   this list of conditions and the following disclaimer in the documentation
+ *   and/or other materials provided with the distribution.
+ * - The names of contributors may not be used to endorse or promote products
+ *   derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+(* Pretty-printing Laconic/Web *)
+
+structure Print :> PRINT = struct
+
+structure SM = TextIOPP
+structure PD = PPDescFn(SM)
+
+type 'a printer = 'a -> PD.pp_desc
+
+fun box ds = PD.hovBox (PD.PPS.Rel 1, ds)
+fun parenIf b d =
+    if b then
+        box [PD.string "(", d, PD.string ")"]
+    else
+        d
+val space = PD.space 1
+
+val out = SM.openOut {dst = TextIO.stdOut, wid = 70}
+val err = SM.openOut {dst = TextIO.stdErr, wid = 70}
+
+fun p_list_sep sep f ls =
+    case ls of
+        [] => PD.string ""
+      | [x] => f x
+      | x :: rest =>
+        let
+            val tokens = foldr (fn (x, tokens) =>
+                                   sep :: f x :: tokens)
+                               [] rest
+        in
+            box (f x :: tokens)
+        end
+fun p_list f = p_list_sep (box [PD.string ",", space]) f
+
+fun fprint f d = (PD.description (f, d);
+                  PD.PPS.flushStream f)
+val print = fprint out
+val eprint = fprint err
+
+fun fpreface f (s, d) =
+    fprint f (PD.hovBox (PD.PPS.Rel 0,
+		         [PD.string s, PD.space 1, d]))
+
+val preface = fpreface out
+val epreface = fpreface err
+
+fun fprefaces f ls =
+    let
+        val len = foldl (fn ((s, _), best) =>
+                            Int.max (size s, best)) 0 ls
+    in
+        app (fn (s, d) =>
+                let
+                    val s = CharVector.tabulate (len - size s,
+                                                 fn _ => #" ")
+                            ^ s ^ ": "
+                in
+                    fpreface f (s, d)
+                end) ls
+    end
+
+val prefaces = fprefaces out
+val eprefaces = fprefaces err
+
+end
diff --git a/src/sources b/src/sources
index f4bd55b0..0329092a 100644
--- a/src/sources
+++ b/src/sources
@@ -2,3 +2,15 @@ errormsg.sig
 errormsg.sml
 
 laconic.sml
+
+lacweb.grm
+lacweb.lex
+
+print.sig
+print.sml
+
+laconic_print.sig
+laconic_print.sml
+
+compiler.sig
+compiler.sml
diff --git a/tests/stuff.lac b/tests/stuff.lac
new file mode 100644
index 00000000..076698ce
--- /dev/null
+++ b/tests/stuff.lac
@@ -0,0 +1,10 @@
+con c1 = t :: Type -> t
+con c2 :: Type = t :: Type -> t
+con c3 = fn t :: Type => c1
+con c4 = c3 c1
+con c5 = (fn t :: Type => c1) c1
+
+con name = #MyName
+
+con c6 = {A : c1, name : c2}
+con c7 = [A = c1, name = c2]