Skip to content

Instantly share code, notes, and snippets.

@mzp

mzp/annot.patch

Created May 6, 2012 22:47
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save mzp/2624870 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save mzp/2624870 to your computer and use it in GitHub Desktop.
Download ZIP
SMLSharp spotter
Raw
annot.patch
diff --git a/depend.mk b/depend.mk
index dec0a30..9f29e21 100644
--- a/depend.mk
+++ b/depend.mk
@@ -5440,11 +5440,11 @@ src/compiler/main/main/RunLoop.o: src/compiler/main/main/RunLoop.sml \
src/compiler/toplevel2/main/TOP.sig \
src/compiler/toplevel2/main/TopData.ppg.smi \
src/compiler/toplevel2/main/NameEvalEnvUtils.smi \
- src/compiler/toplevel2/main/Top.smi src/ffi/main/DynamicLink.smi \
- src/ffi/main/Pointer.smi src/ffi.smi src/sql/main/PGSQL.smi \
- src/sql/main/SQLBACKEND.sig src/sql/main/PGSQLBackend.smi \
- src/sql/main/Backend.smi src/sql/main/SQLPrim.smi \
- src/compiler/main/main/RunLoop.smi \
+ src/compiler/toplevel2/main/Annot.smi src/compiler/toplevel2/main/Top.smi \
+ src/ffi/main/DynamicLink.smi src/ffi/main/Pointer.smi src/ffi.smi \
+ src/sql/main/PGSQL.smi src/sql/main/SQLBACKEND.sig \
+ src/sql/main/PGSQLBackend.smi src/sql/main/Backend.smi \
+ src/sql/main/SQLPrim.smi src/compiler/main/main/RunLoop.smi \
$(SMLSHARP_DEP)
src/compiler/main/main/SMLofNJ.o: src/compiler/main/main/SMLofNJ.sml \
src/compiler/main/main/SMLofNJ.smi \
@@ -5704,12 +5704,13 @@ src/compiler/main/main/SimpleMain.o: src/compiler/main/main/SimpleMain.sml \
src/compiler/toplevel2/main/TOP.sig \
src/compiler/toplevel2/main/TopData.ppg.smi \
src/compiler/toplevel2/main/NameEvalEnvUtils.smi \
- src/compiler/toplevel2/main/Top.smi src/compiler/main/main/GetOpt.smi \
- src/compiler/main/main/SMLofNJ.smi src/ffi/main/DynamicLink.smi \
- src/ffi/main/Pointer.smi src/ffi.smi src/sql/main/PGSQL.smi \
- src/sql/main/SQLBACKEND.sig src/sql/main/PGSQLBackend.smi \
- src/sql/main/Backend.smi src/sql/main/SQLPrim.smi \
- src/compiler/main/main/RunLoop.smi src/compiler/main/main/ExecutablePath.smi \
+ src/compiler/toplevel2/main/Annot.smi src/compiler/toplevel2/main/Top.smi \
+ src/compiler/main/main/GetOpt.smi src/compiler/main/main/SMLofNJ.smi \
+ src/ffi/main/DynamicLink.smi src/ffi/main/Pointer.smi src/ffi.smi \
+ src/sql/main/PGSQL.smi src/sql/main/SQLBACKEND.sig \
+ src/sql/main/PGSQLBackend.smi src/sql/main/Backend.smi \
+ src/sql/main/SQLPrim.smi src/compiler/main/main/RunLoop.smi \
+ src/compiler/main/main/ExecutablePath.smi \
src/compiler/main/main/SimpleMain.smi \
$(SMLSHARP_DEP)
src/compiler/matchcompilation/main/MatchCompiler.o: \
@@ -6262,12 +6263,13 @@ src/compiler/minismlsharp.o: src/compiler/minismlsharp.sml \
src/compiler/toplevel2/main/TOP.sig \
src/compiler/toplevel2/main/TopData.ppg.smi \
src/compiler/toplevel2/main/NameEvalEnvUtils.smi \
- src/compiler/toplevel2/main/Top.smi src/compiler/main/main/GetOpt.smi \
- src/compiler/main/main/SMLofNJ.smi src/ffi/main/DynamicLink.smi \
- src/ffi/main/Pointer.smi src/ffi.smi src/sql/main/PGSQL.smi \
- src/sql/main/SQLBACKEND.sig src/sql/main/PGSQLBackend.smi \
- src/sql/main/Backend.smi src/sql/main/SQLPrim.smi \
- src/compiler/main/main/RunLoop.smi src/compiler/main/main/ExecutablePath.smi \
+ src/compiler/toplevel2/main/Annot.smi src/compiler/toplevel2/main/Top.smi \
+ src/compiler/main/main/GetOpt.smi src/compiler/main/main/SMLofNJ.smi \
+ src/ffi/main/DynamicLink.smi src/ffi/main/Pointer.smi src/ffi.smi \
+ src/sql/main/PGSQL.smi src/sql/main/SQLBACKEND.sig \
+ src/sql/main/PGSQLBackend.smi src/sql/main/Backend.smi \
+ src/sql/main/SQLPrim.smi src/compiler/main/main/RunLoop.smi \
+ src/compiler/main/main/ExecutablePath.smi \
src/compiler/main/main/SimpleMain.smi src/compiler/minismlsharp.smi \
$(SMLSHARP_DEP)
src/compiler/multiplevaluecalc/main/MultipleValueCalc.ppg.sml: src/compiler/multiplevaluecalc/main/MultipleValueCalc.ppg $(SMLFORMAT_DEP)
@@ -12165,9 +12167,9 @@ src/compiler/smlsharp.o: src/compiler/smlsharp.sml src/basis/main/GENERAL.sig \
src/compiler/toplevel2/main/TOP.sig \
src/compiler/toplevel2/main/TopData.ppg.smi \
src/compiler/toplevel2/main/NameEvalEnvUtils.smi \
- src/compiler/toplevel2/main/Top.smi src/compiler/main/main/GetOpt.smi \
- src/compiler/main/main/SMLofNJ.smi src/compiler/main/main/RunLoop.smi \
- src/compiler/main/main/ExecutablePath.smi \
+ src/compiler/toplevel2/main/Annot.smi src/compiler/toplevel2/main/Top.smi \
+ src/compiler/main/main/GetOpt.smi src/compiler/main/main/SMLofNJ.smi \
+ src/compiler/main/main/RunLoop.smi src/compiler/main/main/ExecutablePath.smi \
src/compiler/main/main/SimpleMain.smi src/compiler/smlsharp.smi \
$(SMLSHARP_DEP)
src/compiler/sqlcompilation/main/SQLCompilation.o: \
@@ -13213,6 +13215,96 @@ src/compiler/toolchain/main/TempFile.o: \
src/compiler/toolchain/main/CoreUtils.smi \
src/compiler/toolchain/main/TempFile.smi \
$(SMLSHARP_DEP)
+src/compiler/toplevel2/main/Annot.o: src/compiler/toplevel2/main/Annot.sml \
+ src/basis/main/GENERAL.sig src/basis/main/General.smi \
+ src/basis/main/OPTION.sig src/basis/main/Option.smi src/basis/main/LIST.sig \
+ src/basis/main/List.smi src/basis/main/Array.smi src/basis/main/Vector.smi \
+ src/basis/main/VectorSlice.smi src/basis/main/STRING_CVT.sig \
+ src/basis/main/StringCvt.smi src/basis/main/SMLSharpScanChar.smi \
+ src/basis/main/CHAR.sig src/basis/main/Char.smi \
+ src/basis/main/MONO_ARRAY.sig src/basis/main/MONO_VECTOR.sig \
+ src/basis/main/MONO_ARRAY_SLICE.sig src/basis/main/MONO_VECTOR_SLICE.sig \
+ src/basis/main/STRING.sig src/basis/main/SUBSTRING.sig \
+ src/basis/main/Word8Vector.smi src/basis/main/Word8VectorSlice.smi \
+ src/basis/main/BOOL.sig src/basis/main/Bool.smi src/basis/main/IO.sig \
+ src/basis/main/IO.smi src/basis/main/SMLSharpRuntime.smi \
+ src/basis/main/StringBase.smi src/basis/main/CharVector.smi \
+ src/basis/main/CharVectorSlice.smi src/basis/main/String.smi \
+ src/basis/main/IntInf.smi src/basis/main/Int.smi \
+ src/basis/main/IEEE_REAL.sig src/basis/main/IEEEReal.smi \
+ src/basis/main/RealClass.smi src/basis/main/Substring.smi \
+ src/basis/main/MATH.sig src/basis/main/Real.smi src/basis/main/Real32.smi \
+ src/basis/main/TIME.sig src/basis/main/Time.smi src/basis/main/Word.smi \
+ src/basis/main/Word8Array.smi src/basis/main/Byte.smi \
+ src/basis/main/SMLSharpOSFileSys.smi src/smlnj/Basis/NJ/cleanup.sig \
+ src/smlnj/Basis/NJ/cleanup.smi src/basis/main/OS_PROCESS.sig \
+ src/basis/main/SMLSharpOSProcess.smi src/basis/main/OS_PATH.sig \
+ src/smlnj/Basis/OS/os-path-fn.smi src/smlnj/Basis/Unix/os-path.smi \
+ src/smlnj/Basis/Unix/os-filesys.smi src/basis/main/LIST_PAIR.sig \
+ src/basis/main/ListPair.smi src/basis/main/OS_IO.sig \
+ src/smlnj/Basis/Unix/os-io.smi src/basis/main/OS_FILE_SYS.sig \
+ src/basis/main/OS.sig src/basis/main/OS.smi src/basis/main/PRIM_IO.sig \
+ src/basis/main/CharArray.smi src/smlnj/Basis/IO/prim-io-text.smi \
+ src/smlnj/Basis/IO/clean-io.smi src/smlnj/Basis/IO/os-prim-io.sig \
+ src/basis/main/Word8.smi src/smlnj/Basis/IO/prim-io-bin.smi \
+ src/smlnj/Basis/Posix/posix-io.smi \
+ src/smlnj/Basis/Unix/posix-text-prim-io.smi src/smlnj/Basis/IO/text-io.smi \
+ src/basis/main/STREAM_IO.sig src/basis/main/TEXT_STREAM_IO.sig \
+ src/basis/main/TEXT_IO.sig src/basis/main/TextIO.smi \
+ src/smlnj/Basis/Unix/posix-bin-prim-io.smi src/smlnj/Basis/IO/bin-io.smi \
+ src/basis/main/IMPERATIVE_IO.sig src/basis/main/BIN_IO.sig \
+ src/basis/main/BinIO.smi src/basis/main/TEXT.sig src/basis/main/Text.smi \
+ src/basis/main/COMMAND_LINE.sig src/basis/main/CommandLine.smi \
+ src/basis/main/ArraySlice.smi src/basis/main/TIMER.sig \
+ src/smlnj/Basis/internal-timer.smi src/basis/main/Timer.smi \
+ src/basis/main/DATE.sig src/basis/main/Date.smi src/basis/main/ARRAY.sig \
+ src/basis/main/ARRAY_SLICE.sig src/basis/main/BYTE.sig \
+ src/basis/main/INTEGER.sig src/basis/main/INT_INF.sig \
+ src/basis/main/REAL.sig src/basis/main/VECTOR.sig \
+ src/basis/main/VECTOR_SLICE.sig src/basis/main/WORD.sig \
+ src/basis/main/binary-op.smi src/basis.smi \
+ src/smlnj-lib/Util/parser-comb-sig.sml src/smlnj-lib/Util/parser-comb.smi \
+ src/smlformat/formatlib/main/FORMAT_EXPRESSION.sig \
+ src/smlformat/formatlib/main/FormatExpressionTypes.smi \
+ src/smlformat/formatlib/main/FormatExpression.smi \
+ src/smlformat/formatlib/main/PrinterParameter.smi \
+ src/smlformat/formatlib/main/AssocResolver.smi \
+ src/smlformat/formatlib/main/PreProcessedExpression.smi \
+ src/smlformat/formatlib/main/PrettyPrinter.smi \
+ src/smlformat/formatlib/main/PRINTER_PARAMETER.sig \
+ src/smlformat/formatlib/main/Truncator.smi \
+ src/smlformat/formatlib/main/PreProcessor.smi \
+ src/smlformat/formatlib/main/BASIC_FORMATTERS.sig \
+ src/smlformat/formatlib/main/BasicFormatters.smi \
+ src/smlformat/formatlib/main/SMLFORMAT.sig \
+ src/smlformat/formatlib/main/SMLFormat.smi src/smlformat-lib.smi \
+ src/compiler/control/main/LOC.sig src/compiler/control/main/Loc.ppg.smi \
+ src/smlnj-lib/Util/lib-base-sig.sml src/smlnj-lib/Util/lib-base.smi \
+ src/smlnj-lib/Util/ord-key-sig.sml src/smlnj-lib/Util/ord-map-sig.sml \
+ src/smlnj-lib/Util/binary-map-fn.smi \
+ src/compiler-utils/env/main/LabelOrd.smi \
+ src/compiler-utils/env/main/LabelEnv.smi \
+ src/compiler/builtin/main/BuiltinPrimitive.ppg.smi \
+ src/smlnj-lib/Util/ord-set-sig.sml src/smlnj-lib/Util/binary-set-fn.smi \
+ src/compiler-utils/env/main/SOrd.smi src/compiler-utils/env/main/SSet.smi \
+ src/compiler-utils/env/main/ENV.sig src/compiler-utils/env/main/SEnv.smi \
+ src/compiler-utils/env/main/IEnv.smi \
+ src/compiler/control/main/Control.ppg.smi \
+ src/compiler/util/main/BigInt_IntInf.smi \
+ src/compiler/util/main/SmlppgUtil.ppg.smi \
+ src/compiler-utils/env/main/IOrd.smi src/compiler-utils/env/main/ISet.smi \
+ src/compiler/name/main/LOCAL_ID.sig src/compiler/name/main/LocalID.smi \
+ src/compiler/util/main/ListSorter.smi src/compiler/util/main/TermFormat.smi \
+ src/compiler/builtin/main/BuiltinType.ppg.smi \
+ src/compiler/absyn/main/AbsynSQL.ppg.smi src/compiler/absyn/main/ABSYN.sig \
+ src/compiler/absyn/main/Absyn.ppg.smi \
+ src/compiler/types/main/OPrimInstMap.smi \
+ src/compiler/types/main/Types.ppg.smi src/compiler/util/main/gensym.smi \
+ src/compiler/patterncalc/main/PatternCalc.ppg.smi \
+ src/compiler/types/main/tvarMap.smi src/compiler/types/main/IDCalc.ppg.smi \
+ src/compiler/typedcalc/main/TypedCalc.ppg.smi \
+ src/compiler/toplevel2/main/Annot.smi \
+ $(SMLSHARP_DEP)
src/compiler/toplevel2/main/NameEvalEnvUtils.o: \
src/compiler/toplevel2/main/NameEvalEnvUtils.sml src/basis/main/GENERAL.sig \
src/basis/main/General.smi src/basis/main/OPTION.sig \
@@ -13585,7 +13677,7 @@ src/compiler/toplevel2/main/Top.o: src/compiler/toplevel2/main/Top.sml \
src/compiler/toplevel2/main/TOP.sig \
src/compiler/toplevel2/main/TopData.ppg.smi \
src/compiler/toplevel2/main/NameEvalEnvUtils.smi \
- src/compiler/toplevel2/main/Top.smi \
+ src/compiler/toplevel2/main/Annot.smi src/compiler/toplevel2/main/Top.smi \
$(SMLSHARP_DEP)
src/compiler/toplevel2/main/TopData.ppg.sml: src/compiler/toplevel2/main/TopData.ppg $(SMLFORMAT_DEP)
src/compiler/toplevel2/main/TopData.ppg.o: \
@@ -20545,13 +20637,12 @@ src/runtime/exn.o: src/runtime/exn.c src/runtime/smlsharp.h src/runtime/object.h
src/runtime/init.o: src/runtime/init.c src/runtime/smlsharp.h src/runtime/objspace.h \
src/runtime/control.h src/runtime/heap.h
src/runtime/object.o: src/runtime/object.c src/runtime/smlsharp.h \
- src/runtime/intinf.h src/runtime/object.h \
- src/runtime/objspace.h src/runtime/heap.h
+ src/runtime/intinf.h src/runtime/object.h src/runtime/objspace.h \
+ src/runtime/heap.h
src/runtime/objspace.o: src/runtime/objspace.c src/runtime/smlsharp.h \
src/runtime/object.h src/runtime/control.h src/runtime/objspace.h \
src/runtime/splay.h
src/runtime/obstack.o: src/runtime/obstack.c src/runtime/smlsharp.h
src/runtime/prim.o: src/runtime/prim.c config.h src/runtime/smlsharp.h \
- src/runtime/intinf.h src/runtime/object.h \
- src/runtime/prim.h
+ src/runtime/intinf.h src/runtime/object.h src/runtime/prim.h
src/runtime/splay.o: src/runtime/splay.c src/runtime/smlsharp.h src/runtime/splay.h
diff --git a/files.mk b/files.mk
index ca1e4c9..d94a3a1 100644
--- a/files.mk
+++ b/files.mk
@@ -1062,6 +1062,7 @@ src/ffi/main/DynamicLink.o \
src/compiler/main/main/SMLofNJ.o \
src/compiler/main/main/GetOpt.o \
src/compiler/toplevel2/main/Top.o \
+src/compiler/toplevel2/main/Annot.o \
src/compiler/toplevel2/main/NameEvalEnvUtils.o \
src/compiler/toplevel2/main/TopData.ppg.o \
src/compiler/rtl/main/X86AsmGen.o \
@@ -1338,6 +1339,7 @@ src/ffi/main/DynamicLink.sml \
src/compiler/main/main/SMLofNJ.sml \
src/compiler/main/main/GetOpt.sml \
src/compiler/toplevel2/main/Top.sml \
+src/compiler/toplevel2/main/Annot.sml \
src/compiler/toplevel2/main/NameEvalEnvUtils.sml \
src/compiler/toplevel2/main/TopData.ppg.sml \
src/compiler/toplevel2/main/TOP.sig \
@@ -1693,6 +1695,7 @@ src/compiler/main/main/RunLoop.o \
src/compiler/main/main/SMLofNJ.o \
src/compiler/main/main/GetOpt.o \
src/compiler/toplevel2/main/Top.o \
+src/compiler/toplevel2/main/Annot.o \
src/compiler/toplevel2/main/NameEvalEnvUtils.o \
src/compiler/toplevel2/main/TopData.ppg.o \
src/compiler/rtl/main/X86AsmGen.o \
@@ -1970,6 +1973,7 @@ src/compiler/main/main/RunLoop.sml \
src/compiler/main/main/SMLofNJ.sml \
src/compiler/main/main/GetOpt.sml \
src/compiler/toplevel2/main/Top.sml \
+src/compiler/toplevel2/main/Annot.sml \
src/compiler/toplevel2/main/NameEvalEnvUtils.sml \
src/compiler/toplevel2/main/TopData.ppg.sml \
src/compiler/toplevel2/main/TOP.sig \
@@ -3193,6 +3197,8 @@ src/compiler/toolchain/main/Filename.o \
src/compiler/toolchain/main/Filename.smi \
src/compiler/toolchain/main/TempFile.o \
src/compiler/toolchain/main/TempFile.smi \
+src/compiler/toplevel2/main/Annot.o \
+src/compiler/toplevel2/main/Annot.smi \
src/compiler/toplevel2/main/NameEvalEnvUtils.o \
src/compiler/toplevel2/main/NameEvalEnvUtils.smi \
src/compiler/toplevel2/main/TOP.sig \
@@ -3585,6 +3591,7 @@ src/compiler/toolchain/main/BinUtils.o \
src/compiler/toolchain/main/CoreUtils.o \
src/compiler/toolchain/main/Filename.o \
src/compiler/toolchain/main/TempFile.o \
+src/compiler/toplevel2/main/Annot.o \
src/compiler/toplevel2/main/NameEvalEnvUtils.o \
src/compiler/toplevel2/main/Top.o \
src/compiler/toplevel2/main/TopData.ppg.o \
diff --git a/src/compiler/control/main/Control.ppg b/src/compiler/control/main/Control.ppg
index 591a978..66686e5 100644
--- a/src/compiler/control/main/Control.ppg
+++ b/src/compiler/control/main/Control.ppg
@@ -320,6 +320,8 @@ struct
* file. *)
val skipShebang = ref true
+ val annot = ref false
+
(****************************************)
(* MEMO: procedure to generate switches list.
@@ -428,7 +430,8 @@ struct
("VMHeapSize", IntSwitch VMHeapSize),
("VMStackSize", IntSwitch VMStackSize),
("withoutLink", BoolSwitch withoutLink),
- ("insertCheckGC", BoolSwitch insertCheckGC)
+ ("insertCheckGC", BoolSwitch insertCheckGC),
+ ("annot", BoolSwitch annot)
]
(****************************************)
diff --git a/src/compiler/control/main/Control.ppg.smi b/src/compiler/control/main/Control.ppg.smi
index 75f1230..f7b96ea 100644
--- a/src/compiler/control/main/Control.ppg.smi
+++ b/src/compiler/control/main/Control.ppg.smi
@@ -141,6 +141,7 @@ struct
val secondLinePrompt : string ref
val skipShebang : bool ref
val newRBU : bool ref
+ val annot : bool ref
val switchTable : switchTable
val switchToString : switch -> string
val interpretControlOption : string * switch * string -> unit
diff --git a/src/compiler/toplevel2/main/Annot.smi b/src/compiler/toplevel2/main/Annot.smi
new file mode 100644
index 0000000..46e9c19
--- /dev/null
+++ b/src/compiler/toplevel2/main/Annot.smi
@@ -0,0 +1,10 @@
+_require "../../../basis.smi"
+_require "../../control/main/Loc.ppg.smi"
+_require "../../typedcalc/main/TypedCalc.ppg.smi"
+_require "../../types/main/Types.ppg.smi"
+_require "../../../compiler-utils/env/main/LabelEnv.smi"
+
+structure Annot =
+struct
+ val dump : string -> TypedCalc.tpdecl list -> unit
+end
diff --git a/src/compiler/toplevel2/main/Annot.sml b/src/compiler/toplevel2/main/Annot.sml
new file mode 100644
index 0000000..9252b7f
--- /dev/null
+++ b/src/compiler/toplevel2/main/Annot.sml
@@ -0,0 +1,179 @@
+
+structure Annot =
+struct
+ local open TypedCalc in
+
+ fun output stream str =
+ (TextIO.outputSubstr (stream, (Substring.full str));
+ TextIO.outputSubstr (stream, (Substring.full "\n")))
+
+ fun sexp (from, to) ty =
+ "(" ^
+ "\"" ^ (Loc.fileNameOfPos from) ^ "\" " ^
+ "(" ^ (Int.toString (Loc.lineOfPos from)) ^ " " ^ (Int.toString (Loc.colOfPos from)) ^ ")" ^
+ " " ^
+ "(" ^ (Int.toString (Loc.lineOfPos to)) ^ " " ^ (Int.toString (Loc.colOfPos to)) ^ ")" ^
+ " " ^ "\"" ^ Types.tyToString ty ^ "\"" ^
+ ")"
+
+ fun annot stream loc ty =
+ output stream (sexp loc ty)
+
+ fun fromIdstatus idstatus =
+ case idstatus of
+ RECFUNID (info,_) =>
+ #ty info
+ | VARID info =>
+ #ty info
+
+ fun outputExpr stream (e : tpexp) =
+ case e of
+ TPAPPM {funTy, loc, funExp, argExpList, ...} =>
+ (annot stream loc funTy;
+ outputExpr stream funExp;
+ List.app (outputExpr stream) argExpList)
+ | TPCASEM {ruleBodyTy, loc, expList, ruleList, ...} =>
+ (annot stream loc ruleBodyTy;
+ List.app (outputExpr stream) expList;
+ List.app (fn x => outputExpr stream (#body x)) ruleList)
+ | TPCAST (exp, ty, loc) =>
+ (annot stream loc ty;
+ outputExpr stream exp)
+ | TPCONSTANT {loc, ty, ...} =>
+ annot stream loc ty
+ | TPDATACONSTRUCT {loc, con, argExpOpt, ...} =>
+ (annot stream loc (#ty con);
+ case argExpOpt of
+ SOME x =>
+ outputExpr stream x
+ | NONE =>
+ ())
+ | TPERROR =>
+ ()
+ | TPEXNCONSTRUCT {argExpOpt, exn,loc, ...} =>
+ (case exn of
+ EXEXN i =>
+ annot stream loc (#ty i)
+ | EXN i =>
+ annot stream loc (#ty i);
+ case argExpOpt of
+ SOME x =>
+ outputExpr stream x
+ | NONE =>
+ ())
+ | TPEXN_CONSTRUCTOR {exnInfo, loc} =>
+ annot stream loc (#ty exnInfo)
+ | TPEXEXN_CONSTRUCTOR {exExnInfo, loc} =>
+ annot stream loc (#ty exExnInfo)
+ | TPEXVAR (info, loc) =>
+ annot stream loc (#ty info)
+ | TPFFIIMPORT {loc, ptrExp:tpexp, stubTy:Types.ty,...} =>
+ (annot stream loc stubTy;
+ outputExpr stream ptrExp)
+ | TPFNM {bodyExp, bodyTy, loc, ...} =>
+ (annot stream loc bodyTy;
+ outputExpr stream bodyExp)
+ | TPGLOBALSYMBOL {loc, ty, ...} =>
+ annot stream loc ty
+ | TPHANDLE {exnVar, exp, handler, loc} =>
+ (annot stream loc (#ty exnVar);
+ outputExpr stream exp;
+ outputExpr stream handler)
+ | TPLET {body, decls, loc, tys} =>
+ (List.app (outputExpr stream) body;
+ List.app (outputDecl stream) decls
+ )
+ | TPMODIFY {elementExp , loc, recordExp, recordTy, ...} =>
+ (annot stream loc recordTy;
+ outputExpr stream elementExp;
+ outputExpr stream recordExp)
+ | TPMONOLET { binds, bodyExp, loc} =>
+ (List.app (fn (_,exp) =>
+ outputExpr stream exp) binds;
+ outputExpr stream bodyExp)
+ | TPOPRIMAPPLY {argExp, loc, oprimOp, ...} =>
+ (annot stream loc (#ty oprimOp);
+ outputExpr stream argExp)
+ | TPPOLY {exp, expTyWithoutTAbs, loc, ...} =>
+ (annot stream loc expTyWithoutTAbs;
+ outputExpr stream exp)
+ | TPPOLYFNM {bodyExp, bodyTy, loc, ...} =>
+ (annot stream loc bodyTy;
+ outputExpr stream bodyExp)
+ | TPPRIMAPPLY {argExp,loc, primOp, ...} =>
+ (annot stream loc (#ty primOp);
+ outputExpr stream argExp)
+ | TPRAISE {exp, loc, ty} =>
+ (annot stream loc ty;
+ outputExpr stream exp)
+ | TPRECFUNVAR {loc, var,...} =>
+ annot stream loc (#ty var)
+ | TPRECORD {loc, recordTy, fields} =>
+ (annot stream loc recordTy;
+ LabelEnv.app (outputExpr stream) fields)
+ | TPSELECT {exp, loc, resultTy,...} =>
+ (annot stream loc resultTy;
+ outputExpr stream exp)
+ | TPSEQ {expList, ...} =>
+ List.app (outputExpr stream) expList
+ | TPSIZEOF (ty, loc) =>
+ annot stream loc ty
+ | TPSQLSERVER {loc, resultTy, server, ...} =>
+ (annot stream loc resultTy;
+ List.app (fn (_, exp) => outputExpr stream exp) server)
+ | TPTAPP {exp, ...} =>
+ outputExpr stream exp
+ | TPVAR (info, loc) =>
+ annot stream loc (#ty info)
+
+ and outputDecl stream decl =
+ case decl of
+ TPEXD (xs, loc) =>
+ List.app (fn x => annot stream (#loc x) (#ty (#exnInfo x))) xs
+ | TPEXNTAGD ({exnInfo, varInfo}, loc) =>
+ annot stream loc (#ty varInfo)
+ | TPEXPORTEXN (exnInfo, loc) =>
+ annot stream loc (#ty exnInfo)
+ | TPEXPORTVAR (x, loc) =>
+ annot stream loc (fromIdstatus x)
+ | TPEXTERNEXN ({ty, ...},loc) =>
+ annot stream loc ty
+ | TPEXTERNVAR ({ty, ...}, loc) =>
+ annot stream loc ty
+ | TPFUNDECL (xs, loc) =>
+ List.app (fn x =>
+ (annot stream loc (#ty (#funVarInfo x));
+ (List.app (fn rule =>
+ outputExpr stream (#body rule))
+ (#ruleList x))))
+ xs
+ | TPPOLYFUNDECL (_, xs, loc) =>
+ List.app (fn x => (
+ annot stream loc (#ty (#funVarInfo x));
+ (List.app (fn rule =>
+ outputExpr stream (#body rule))
+ (#ruleList x)))) xs
+ | TPVAL (xs, loc) =>
+ List.app (fn (info,exp) =>
+ (annot stream loc (#ty info);
+ outputExpr stream exp)) xs
+ | TPVALPOLYREC (_, xs, loc) =>
+ List.app (fn x =>
+ (annot stream loc (#ty (#var x));
+ outputExpr stream (#exp x))
+ ) xs
+ | TPVALREC (xs, loc) =>
+ List.app (fn x =>
+ (annot stream loc (#ty (#var x));
+ outputExpr stream (#exp x))
+ ) xs
+
+ fun dump name decls =
+ let
+ val stream = TextIO.openOut name
+ in
+ List.app (outputDecl stream) decls;
+ TextIO.closeOut stream
+ end
+ end
+end
diff --git a/src/compiler/toplevel2/main/Top.smi b/src/compiler/toplevel2/main/Top.smi
index 98928c7..02a2dd3 100644
--- a/src/compiler/toplevel2/main/Top.smi
+++ b/src/compiler/toplevel2/main/Top.smi
@@ -69,6 +69,7 @@ _require "../../../config/main/Config.smi"
_require "TOP.sig"
_require "TopData.ppg.smi"
_require "NameEvalEnvUtils.smi"
+_require "Annot.smi"
structure Top =
struct
diff --git a/src/compiler/toplevel2/main/Top.sml b/src/compiler/toplevel2/main/Top.sml
index 0a14521..f2cdd1c 100644
--- a/src/compiler/toplevel2/main/Top.sml
+++ b/src/compiler/toplevel2/main/Top.sml
@@ -748,6 +748,16 @@ struct
val (typeinfVarE, tpcalc) =
doTypeInference idcalc handle exn => raise exn
+ val _ =
+ case baseName of
+ SOME x =>
+ if ! Control.annot then
+ Annot.dump (Filename.toString (Filename.replaceSuffix "annot" x)) tpcalc
+ else
+ ()
+ | NONE =>
+ ()
+
val nameevalTopEnv =
if !Control.interactiveMode
then NameEvalEnvUtils.mergeTypeEnv (nameevalTopEnv, typeinfVarE)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment