From dca24e575234607464f4f4a3ed1d8c55bcb27730 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Thu, 12 Aug 2004 04:28:37 +0000 Subject: [PATCH] Updated for SML/NJ 110.46+ --- BUILDING | 14 +++++++++++--- src/.cvsignore | 1 + src/common.sml | 8 ++++---- src/compiler.sml | 4 ++-- src/config.sml | 4 ++-- src/lib/.cvsignore | 1 + src/mlt.sml | 32 +++++++++++++++++--------------- 7 files changed, 38 insertions(+), 26 deletions(-) diff --git a/BUILDING b/BUILDING index 919e906..acdc51b 100644 --- a/BUILDING +++ b/BUILDING @@ -2,9 +2,17 @@ System requirements =================== -Compiling the mlt tool requires a "working version" of SML/NJ. I've -tested it with 110.42. You'll need to get the SML/NJ source code -package and modify some of the included .cm files to make a few +Compiling the mlt tool requires a "working version" of SML/NJ. It's +best to use version 110.46 or later. You may have problems with any +version whatsoever, though, since this stuff uses some SML/NJ compiler +internals, and they may change often. + +If you're using a pre-110.46 version, you'll need to, at a minimum, +get the SML/NJ source, make the following patches, and build it. Of +course, there are no promises that everything will then work with that +particular version. (Especially problematic are the changes in the +Basis library spec that aren't backwards compatible.) The patch +involves modifying some of the included .cm files to make a few additional internal structures visible. The necessary changes to make are described below, with paths given relative to your base SML/NJ directory. The lines listed for each file should be added right before diff --git a/src/.cvsignore b/src/.cvsignore index 30087d6..ac72ffc 100644 --- a/src/.cvsignore +++ b/src/.cvsignore @@ -1,3 +1,4 @@ +.cm CM *.x86-linux *.grm.* diff --git a/src/common.sml b/src/common.sml index b9e8920..0180b78 100644 --- a/src/common.sml +++ b/src/common.sml @@ -107,8 +107,8 @@ struct fun copy () = (case TextIO.inputLine inf of - "" => () - | line => (TextIO.output (outf, line); + NONE => () + | SOME line => (TextIO.output (outf, line); copy ())) in copy (); @@ -129,8 +129,8 @@ struct val inf = TextIO.openIn fname fun read acc = (case TextIO.inputLine inf of - "" => String.concat (rev acc) - | line => read (line::acc)) + NONE => String.concat (rev acc) + | SOME line => read (line::acc)) in read [] before TextIO.closeIn inf diff --git a/src/compiler.sml b/src/compiler.sml index 6e31f5a..aa4db33 100644 --- a/src/compiler.sml +++ b/src/compiler.sml @@ -112,8 +112,8 @@ struct fun loop (smls, mlts) = (case Posix.FileSys.readdir dir of - "" => (smls, mlts) - | fname => + NONE => (smls, mlts) + | SOME fname => (case getExt fname of "mlt" => loop (smls, (path ^ "/" ^ fname) :: mlts) | ("sml"|"sig") => diff --git a/src/config.sml b/src/config.sml index 691f714..45253ac 100644 --- a/src/config.sml +++ b/src/config.sml @@ -62,8 +62,8 @@ struct fun read (fields as {inPath, outPath, pubPath, lib, compiler, cm, sml, printFn, beforeT, afterT, exnT}) = (case TextIO.inputLine inf of - "" => CONFIG fields - | line => + NONE => CONFIG fields + | SOME line => (case String.tokens Char.isSpace line of [] => read fields | ["in", inPath] => read {inPath = expandPath inPath, outPath = outPath, pubPath = pubPath, diff --git a/src/lib/.cvsignore b/src/lib/.cvsignore index cc5f76e..a2a33e4 100644 --- a/src/lib/.cvsignore +++ b/src/lib/.cvsignore @@ -1 +1,2 @@ +.cm CM diff --git a/src/mlt.sml b/src/mlt.sml index b853295..099cae3 100644 --- a/src/mlt.sml +++ b/src/mlt.sml @@ -34,8 +34,8 @@ struct val errorTy = Types.WILDCARDty - val ppstream = PrettyPrint.mk_ppstream {consumer = TextIO.print, flush = fn () => TextIO.flushOut TextIO.stdOut, - linewidth = 80} + (*val ppstream = PrettyPrint.mk_ppstream {consumer = TextIO.print, flush = fn () => TextIO.flushOut TextIO.stdOut, + linewidth = 80}*) datatype unify = ExpUn of exp @@ -83,6 +83,8 @@ struct (case StaticEnv.look (env, Symbol.varSymbol v) of Bindings.CONbind (Types.DATACON {typ, ...}) => #1 (TypesUtil.instantiatePoly typ) | _ => raise Fail "Unexpected binding in lookVal") + + fun lookCon (env, v, pos) = (lookCon' (env, v)) handle ModuleUtil.Unbound _ => (error (SOME pos, "Unbound constructor " ^ v); errorTy) @@ -129,21 +131,21 @@ struct Unify.unifyTy (t1, t2) (*end*) handle Unify.Unify msg => - (PrettyPrint.begin_block ppstream PrettyPrint.CONSISTENT 0; - PrettyPrint.add_string ppstream "Error unifying"; - PrettyPrint.add_break ppstream (1, 0); - PrettyPrint.begin_block ppstream PrettyPrint.CONSISTENT 5; + ((*PrettyPrint.openBox ppstream (PrettyPrint.Abs 0); + PrettyPrint.string ppstream "Error unifying"; + PrettyPrint.newline ppstream; + PrettyPrint.openBox ppstream (PrettyPrint.Abs 5); PPType.ppType env ppstream t1; - PrettyPrint.end_block ppstream; - PrettyPrint.add_break ppstream (1, 0); - PrettyPrint.add_string ppstream "and"; - PrettyPrint.add_break ppstream (1, 0); - PrettyPrint.begin_block ppstream PrettyPrint.CONSISTENT 5; + PrettyPrint.closeBox ppstream; + PrettyPrint.newline ppstream; + PrettyPrint.string ppstream "and"; + PrettyPrint.newline ppstream; + PrettyPrint.openBox ppstream (PrettyPrint.Abs 5); PPType.ppType env ppstream t2; - PrettyPrint.end_block ppstream; - PrettyPrint.end_block ppstream; - PrettyPrint.add_break ppstream (1, 0); - PrettyPrint.flush_ppstream ppstream; + PrettyPrint.closeBox ppstream; + PrettyPrint.closeBox ppstream; + PrettyPrint.newline ppstream; + PrettyPrint.flushStream ppstream;*) error (SOME pos, Unify.failMessage msg ^ " for " ^ (case e of ExpUn e => Tree.expString e | PatUn p => ""))) -- 2.20.1