summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.hgignore3
-rw-r--r--Makefile4
-rw-r--r--src/compiler.sig36
-rw-r--r--src/compiler.sml64
-rw-r--r--src/errormsg.sig14
-rw-r--r--src/errormsg.sml57
-rw-r--r--src/laconic.sml20
-rw-r--r--src/laconic_print.sig36
-rw-r--r--src/laconic_print.sml147
-rw-r--r--src/lacweb.grm126
-rw-r--r--src/lacweb.lex124
-rw-r--r--src/main.mlton.sml3
-rw-r--r--src/print.sig54
-rw-r--r--src/print.sml92
-rw-r--r--src/sources12
-rw-r--r--tests/stuff.lac10
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]