├── .cvsignore ├── .gitignore ├── .hgignore ├── COPYING ├── README ├── basisstubs ├── .cvsignore ├── LOAD ├── README ├── basislib.pm ├── current │ ├── .gitignore │ ├── ARRAY-sig.sml │ ├── Array.sml │ ├── BIT_FLAGS.sml │ ├── BOOL-sig.sml │ ├── BYTE-sig.sml │ ├── BitFlags.sml │ ├── Bool.sml │ ├── Byte.sml │ ├── CHAR-sig.sml │ ├── COMMAND_LINE.sml │ ├── CharVector.sml │ ├── CommandLine.sml │ ├── DATE-sig.sml │ ├── Date.sml │ ├── GENERAL-sig.sml │ ├── General.sml │ ├── INTEGER.sml │ ├── IO-sig.sml │ ├── LIST-sig.sml │ ├── LIST_PAIR.sml │ ├── List.sml │ ├── ListPair.sml │ ├── MATH-sig.sml │ ├── MONO_ARRAY.sml │ ├── MONO_ARRAY_SLICE.sml │ ├── MONO_VECTOR.sml │ ├── MONO_VECTOR_SLICE.sml │ ├── Math.sml │ ├── OPTION-sig.sml │ ├── OS-sig.sml │ ├── OS_FILE_SYS.sml │ ├── OS_IO.sml │ ├── OS_PATH.sml │ ├── OS_PROCESS.sml │ ├── Option.sml │ ├── POSIX.sml │ ├── Path.sml │ ├── REAL-sig.sml │ ├── Real.sml │ ├── SML90-sig.sml │ ├── STRING-sig.sml │ ├── STRING_CVT.sml │ ├── STR_BASE.sml │ ├── SUBSTRING-sig.sml │ ├── Sml90.sml │ ├── StringCvt.sml │ ├── TIME-sig.sml │ ├── TIMER-sig.sml │ ├── Time.sml │ ├── Timer.sml │ ├── VECTOR-sig.sml │ ├── Vector.sml │ ├── WORD-sig.sml │ ├── from-mlton │ │ ├── IEEE-real.sig │ │ ├── IEEE-real.sml │ │ ├── array-slice.sig │ │ ├── array2.sig │ │ ├── array2.sml │ │ ├── int-inf.sig │ │ ├── int-inf.sml │ │ ├── io │ │ │ ├── bin-io.sig │ │ │ ├── bin-prim-io.sml │ │ │ ├── imperative-io.fun │ │ │ ├── imperative-io.sig │ │ │ ├── prim-io.fun │ │ │ ├── prim-io.sig │ │ │ ├── stream-io.fun │ │ │ ├── stream-io.sig │ │ │ ├── text-io.sig │ │ │ ├── text-prim-io.sml │ │ │ └── text-stream-io.sig │ │ ├── mono-array2.fun │ │ ├── mono-array2.sig │ │ ├── net │ │ │ ├── generic-sock.sig │ │ │ ├── generic-sock.sml │ │ │ ├── inet-sock.sig │ │ │ ├── inet-sock.sml │ │ │ ├── net-host-db.sig │ │ │ ├── net-host-db.sml │ │ │ ├── net-prot-db.sig │ │ │ ├── net-prot-db.sml │ │ │ ├── net-serv-db.sig │ │ │ ├── net-serv-db.sml │ │ │ ├── net.sig │ │ │ ├── net.sml │ │ │ ├── socket.sig │ │ │ ├── socket.sml │ │ │ ├── unix-sock.sig │ │ │ └── unix-sock.sml │ │ ├── pack-real.sig │ │ ├── pack-word.sig │ │ ├── pack-word.sml │ │ ├── text.sig │ │ ├── text.sml │ │ ├── unix.sig │ │ ├── unix.sml │ │ └── vector-slice.sig │ ├── useme │ └── windows.sml ├── kit.script ├── missing.txt └── sigs │ ├── ARRAY.sml │ ├── BIN_IO.sml │ ├── BOOL.sml │ ├── BYTE.sml │ ├── CHAR.sml │ ├── COMMAND_LINE.sml │ ├── DATE.sml │ ├── GENERAL.sml │ ├── INTEGER.sml │ ├── IO.sml │ ├── LIST.sml │ ├── LIST_PAIR.sml │ ├── LIST_SORT.sml │ ├── MATH.sml │ ├── MONO_ARRAY.sml │ ├── MONO_VECTOR.sml │ ├── OPTION.sml │ ├── OS.sml │ ├── OS_FILE_SYS.sml │ ├── OS_PATH.sml │ ├── OS_PROCESS.sml │ ├── RANDOM.sml │ ├── REAL.sml │ ├── SML90.sml │ ├── STRING.sml │ ├── STRING_CVT.sml │ ├── STR_BASE.sml │ ├── SUBSTRING.sml │ ├── TEXT_IO.sml │ ├── TIME.sml │ ├── TIMER.sml │ ├── VECTOR.sml │ ├── WORD.sml │ ├── mkstructstub.awk │ ├── useme │ └── useme2 ├── bin ├── .heap │ └── README └── README ├── emacs └── sml-refinements.el ├── lib ├── basis │ ├── .gitignore │ ├── basis.mlb │ └── pervasive.mlb ├── mlyacc-lib │ ├── base.sig │ ├── join.sml │ ├── lrtable.sml │ ├── ml-yacc-lib.cm │ ├── mlyacc-lib.mlb │ ├── parser1.sml │ ├── parser2.sml │ └── stream.sml ├── refined-basis │ ├── basis.mlb │ ├── bool.sml │ ├── list.sml │ └── option.sml └── smlnj-lib │ ├── PP │ └── pp-lib.mlb │ └── Util │ ├── BinaryMapFn.sml │ ├── BinarySetFn.sml │ ├── GET_OPT.sml │ ├── HASH_TABLE.sml │ ├── HashString.sml │ ├── ORD_KEY.sml │ ├── ORD_MAP.sml │ ├── ORD_SET.sml │ ├── SYMBOL.sml │ └── smlnj-lib.mlb ├── mlb-path-map ├── src ├── .cvsignore ├── Cidre │ ├── BINARYMAP-sig.sml │ ├── Binarymap.sml │ ├── CONFIGURATION-sig.sml │ ├── Cidre.sml │ ├── Configuration.sml │ ├── ENVIRONMENT-sig.sml │ ├── Environment.sml │ ├── InfixLib.sml │ ├── MLB_FILESYS.sml │ ├── MLB_PROJECT.sml │ ├── MlbFileSys.sml │ ├── MlbProject.sml │ ├── MlbUtil.sml │ ├── cidre.cm │ ├── environment.mlb │ └── test.mlb ├── Common │ ├── .cvsignore │ ├── BASIC_IO.sml │ ├── BASIS-sig.sml │ ├── BITS │ │ ├── .cvsignore │ │ ├── ElabTopdec+.sml │ │ ├── Elaboration+.sml │ │ ├── Elaboration+Ref.sml │ │ ├── ModuleEnvironments-no-refinements.sml │ │ ├── ModuleEnvironments.sml+ │ │ ├── RefDec.sml- │ │ ├── RefinedEnvironments-expC-helper.sml │ │ ├── RefinedEnvironments-expandConj-via-intersectRC.sml │ │ ├── RefinedEnvironments-home-performance-tests.sml │ │ ├── RefinedEnvironments-memo-true-with-assumptions.sml │ │ ├── RefinedEnvironments-simpler-slower-expandConj.sml │ │ ├── RefinedEnvironments-uwa-changes.sml │ │ ├── RefinedEnvironments.sml+ │ │ ├── SemiPermFinMap.sml │ │ └── infer_pat.sml │ ├── BasicIO.sml │ ├── Basis.sml │ ├── COMP-sig.sml │ ├── CRASH-sig.sml │ ├── CoerceRefInfo.sml │ ├── Comp.sml │ ├── Crash.sml │ ├── DEC_GRAMMAR.sml │ ├── DFInfo.sml │ ├── DF_INFO.sml │ ├── DIGRAPH-sig.sml │ ├── DecGrammar.sml │ ├── DiGraph.sml │ ├── ELABDEC-sig.sml │ ├── ELABTOPDEC-sig.sml │ ├── ELAB_INFO.sml │ ├── ENVIRONMENTS-sig.sml │ ├── ERROR_CODE.sml │ ├── ERROR_INFO.sml │ ├── ERROR_TRAVERSE.sml │ ├── E_OR_R_INFO.sml │ ├── ElabDec.sml │ ├── ElabInfo.sml │ ├── ElabTopdec.sml │ ├── Elaboration.sml │ ├── Environments.sml │ ├── EqFinMap.sml │ ├── EqSetList.sml │ ├── ErrorInfo.sml │ ├── ErrorTraverse.sml │ ├── Execution.sml │ ├── FINMAP-sig.sml │ ├── FINMAPEQ-sig.sml │ ├── FLAGS-sig.sml │ ├── FUNID-sig.sml │ ├── FinMap.sml │ ├── FinMapEq.sml │ ├── Flags.sml │ ├── FunId.sml │ ├── HashTable.sml │ ├── Heap.sml │ ├── IDENT-sig.sml │ ├── INFIXBASIS-sig.sml │ ├── IOStreams.sml │ ├── IO_STREAMS.sml │ ├── Ident.sml │ ├── InfixBasis.sml │ ├── IntDiGraph.sml │ ├── IntFinMap.sml │ ├── IntFinMapPT.sml │ ├── IntSet.sml │ ├── KIT_MONO_SET.sml │ ├── KitCompiler.sml │ ├── KitOnKit.sml │ ├── LAB-sig.sml │ ├── LIST_HACKS.sml │ ├── LIST_SORT.sml │ ├── Lab.sml │ ├── ListHacks.sml │ ├── ListSort.sml │ ├── ListTable.sml │ ├── MAP_DEC_INFO.sml │ ├── MODULE_ENVIRONMENTS.sml │ ├── MODULE_STATOBJECT.sml │ ├── MONO_FINMAP.sml │ ├── MapDecInfo.sml │ ├── ModuleEnvironments.sml │ ├── ModuleStatObject.sml │ ├── NatSet.sml │ ├── ORDSET.sml │ ├── OVERLOADING_INFO.sml │ ├── OrderFinMap.sml │ ├── OrderSet.sml │ ├── OverloadingInfo.sml │ ├── PARSE_ELAB.sml │ ├── PARSE_INFO.sml │ ├── PRETTYPRINT-sig.sml │ ├── ParseInfo.sml │ ├── PrettyPrint.sml │ ├── QUASI_ENV.sml │ ├── QuasiEnv.sml │ ├── QuasiMap.sml │ ├── QuasiSet.sml │ ├── REFDEC-sig.sml │ ├── REFINED_ENVIRONMENTS.sml │ ├── REFINE_ERROR_INFO.sml │ ├── REFINE_ERROR_TRAVERSE.sml │ ├── REFOBJECT-sig.sml │ ├── REFTOPDEC-sig.sml │ ├── REF_INFO.sml │ ├── REPORT-sig.sml │ ├── RedBlackTree.sml │ ├── RefDec.sml │ ├── RefInfo.sml │ ├── RefObject.sml │ ├── RefTopdec.sml │ ├── RefineCheck.sml │ ├── RefineErrorInfo.sml │ ├── RefineErrorTraverse.sml │ ├── RefineInfo.sml │ ├── RefinedEnvironments.sml │ ├── Report.sml │ ├── SCON-sig.sml │ ├── SCon.sml │ ├── SIGID-sig.sml │ ├── SMLofNJOnKit.sml │ ├── SORTCON-sig.sml │ ├── SORTED_FINMAP.sml │ ├── SORTNAME-sig.sml │ ├── SORTVAR-sig.sml │ ├── SORT_INFO.sml │ ├── SOURCE_INFO.sml │ ├── STATOBJECT-sig.sml │ ├── STRID-sig.sml │ ├── SigId.sml │ ├── SortCon.sml │ ├── SortInfo.sml │ ├── SortName.sml │ ├── SortVar.sml │ ├── SortedFinMap.sml │ ├── SourceInfo.sml │ ├── StatObject.sml │ ├── StrId.sml │ ├── TIMESTAMP-sig.sml │ ├── TOPDEC_GRAMMAR.sml │ ├── TOP_LEVEL_REPORT.sml │ ├── TYCON-sig.sml │ ├── TYNAME-sig.sml │ ├── TYPE_INFO.sml │ ├── TYVAR-sig.sml │ ├── Timestamp.sml │ ├── Timing.sml │ ├── TopLevelReport.sml │ ├── TopdecGrammar.sml │ ├── TyCon.sml │ ├── TyGoals.sml │ ├── TyName.sml │ ├── TyVar.sml │ ├── TypeInfo.sml │ ├── common.cm │ ├── common.pm │ ├── hash-table-twelf.sml │ ├── smlnj-lib.cm │ └── smlnj-lib │ │ └── Util │ │ ├── README │ │ ├── TODO │ │ ├── array-qsort-fn.sml │ │ ├── array-qsort.sml │ │ ├── array-sort-sig.sml │ │ ├── array2-sig.sml │ │ ├── array2.sml │ │ ├── atom-binary-map.sml │ │ ├── atom-binary-set.sml │ │ ├── atom-map.sml │ │ ├── atom-redblack-map.sml │ │ ├── atom-redblack-set.sml │ │ ├── atom-set.sml │ │ ├── atom-sig.sml │ │ ├── atom-table.sml │ │ ├── atom.sml │ │ ├── binary-map-fn.sml │ │ ├── binary-set-fn.sml │ │ ├── bit-array-sig.sml │ │ ├── bit-array.sml │ │ ├── bit-vector-sig.sml │ │ ├── bit-vector.sml │ │ ├── bsearch-fn.sml │ │ ├── char-map-sig.sml │ │ ├── char-map.sml │ │ ├── dynamic-array-fn.sml │ │ ├── dynamic-array-sig.sml │ │ ├── dynamic-array.sml │ │ ├── fifo-sig.sml │ │ ├── fifo.sml │ │ ├── fmt-fields.sml │ │ ├── format-sig.sml │ │ ├── format.sml │ │ ├── getopt-sig.sml │ │ ├── getopt.sml │ │ ├── graph-scc-sig.sml │ │ ├── graph-scc.sml │ │ ├── hash-key-sig.sml │ │ ├── hash-string.sml │ │ ├── hash-table-fn.sml │ │ ├── hash-table-rep.sml │ │ ├── hash-table-sig.sml │ │ ├── hash-table.sml │ │ ├── hash2-table-fn.sml │ │ ├── int-binary-map.sml │ │ ├── int-binary-set.sml │ │ ├── int-hash-table.sml │ │ ├── int-inf-sig.sml │ │ ├── int-inf.sml │ │ ├── int-list-map.sml │ │ ├── int-list-set.sml │ │ ├── int-redblack-map.sml │ │ ├── int-redblack-set.sml │ │ ├── io-util-sig.sml │ │ ├── io-util.sml │ │ ├── iterate-sig.sml │ │ ├── iterate.sml │ │ ├── keyword-fn.sml │ │ ├── lib-base-sig.sml │ │ ├── lib-base.sml │ │ ├── list-format-sig.sml │ │ ├── list-format.sml │ │ ├── list-map-fn.sml │ │ ├── list-mergesort.sml │ │ ├── list-set-fn.sml │ │ ├── list-xprod-sig.sml │ │ ├── list-xprod.sml │ │ ├── listsort-sig.sml │ │ ├── load │ │ ├── mono-array-fn.sml │ │ ├── mono-array-sort-sig.sml │ │ ├── mono-dynamic-array-sig.sml │ │ ├── mono-hash-table-sig.sml │ │ ├── mono-hash2-table-sig.sml │ │ ├── ord-key-sig.sml │ │ ├── ord-map-sig.sml │ │ ├── ord-set-sig.sml │ │ ├── parser-comb-sig.sml │ │ ├── parser-comb.sml │ │ ├── path-util-sig.sml │ │ ├── path-util.sml │ │ ├── plist-sig.sml │ │ ├── plist.sml │ │ ├── queue-sig.sml │ │ ├── queue.sml │ │ ├── rand-sig.sml │ │ ├── rand.sml │ │ ├── random-sig.sml │ │ ├── random.sml │ │ ├── real-format.sml │ │ ├── redblack-map-fn.sml │ │ ├── redblack-set-fn.sml │ │ ├── scan-sig.sml │ │ ├── scan.sml │ │ ├── simple-uref.sml │ │ ├── smlnj-lib.cm │ │ ├── splay-map-fn.sml │ │ ├── splay-set-fn.sml │ │ ├── splaytree-sig.sml │ │ ├── splaytree.sml │ │ ├── time-limit.sml │ │ ├── uref-sig.sml │ │ ├── uref.sml │ │ ├── word-hash-table.sml │ │ ├── word-redblack-map.sml │ │ └── word-redblack-set.sml ├── Edlib │ ├── .cvsignore │ ├── EDLIB_GENERAL.sml │ ├── EQ_SET.sml │ ├── Edlib.sml │ ├── EdlibGeneral.sml │ ├── EqSet.sml │ ├── LIST-sig.sml │ ├── LIST_PAIR.sml │ ├── LIST_SORT.sml │ ├── List.sml │ ├── ListPair.sml │ ├── ListSort.sml │ ├── ORDERING.sml │ ├── SET-sig.sml │ ├── Set.sml │ ├── edlib.cm │ └── edlib.pm ├── Manager │ ├── .cvsignore │ ├── ELAB_REPOSITORY.sml │ ├── ElabRepository.sml │ ├── FREE_IDS.sml │ ├── FreeIds.sml │ ├── INT_MODULES.sml │ ├── IntModules.sml │ ├── MANAGER-sig.sml │ ├── MANAGER_OBJECTS.sml │ ├── Manager.sml │ ├── ManagerObjects.sml │ ├── NAME-sig.sml │ ├── Name.sml │ ├── OPACITY_ELIM.sml │ ├── OpacityElim.sml │ ├── OpacityEnv.sml │ ├── PARSE_ELAB.sml │ └── ParseElab.sml ├── Parsing │ ├── .cvsignore │ ├── GRAMMAR_UTILS.sml │ ├── GrammarUtils.sml │ ├── HOOKS.sml │ ├── INFIXING-sig.sml │ ├── INFIX_STACK.sml │ ├── InfixStack.sml │ ├── Infixing.sml │ ├── LEX_BASICS.sml │ ├── LEX_UTILS.sml │ ├── LexBasics.sml │ ├── LexUtils.sml │ ├── MyBase.sml │ ├── PARSE-sig.sml │ ├── Parse.sml │ ├── Topdec.grm │ ├── Topdec.grm.sig │ ├── Topdec.grm.sml │ ├── Topdec.lex │ ├── Topdec.lex.sml │ └── parsing.cm ├── cm2mlb │ ├── MLton-LICENSE │ ├── Makefile │ ├── cm2mlb-map │ ├── cm2mlb.cm │ ├── cm2mlb.sml │ └── gen-mlb.sml ├── mkusefile.out ├── sources.cm └── sources.pm ├── test-examples ├── bugs │ ├── all-datatype-tyvars-generalised.sml │ ├── cant-specify-manifest-opaque-refinements.sml │ ├── opaque-refinements-of-datasorts-not-caught.sml │ ├── opaque-sig-mixed-defs-crashs.sml │ ├── opaque-sorts-clobber-variances.sml │ ├── robs-pattern-bug-min.sml │ ├── robs-pattern-bug.sml │ └── sigs-cant-specify-type-constr-variance.sml ├── fixed-bugs │ ├── README │ ├── abstract-lattice-wrong.sml │ ├── abstract-sort.sml │ ├── constructor-sorts.sml │ ├── crash-printing-functor-result-simplified.sml │ ├── crash-printing-functor-result.sml │ ├── datasort-qualified-constructors-wrong.sml │ ├── datasort-qualified-constructors.sml │ ├── datatype-in-functor-parameter-wrong-sortname.sml │ ├── datatype-names-missing-functor.sml │ ├── elabtopdec-bug.sml │ ├── field-swap-bug.sml │ ├── functor-where-bug.sml │ ├── ignored-wrong-in-all-covariant.sml │ ├── intersection-allowed-in-types.sml │ ├── map-conjunction-instance-fails.sml │ ├── no-lattice-printed.sml │ ├── opaque-refinements-generate-types.sml │ ├── parameter-unions-unsound.sml │ ├── qualified-top-level.sml │ ├── realiser-combines-datatypes.sml │ ├── sig-datatype-replication-crashes.sml │ ├── sort-printing.sml │ ├── top-level-val-sort-specs-propagate-to-other-files.sml │ ├── top-level-val-sort-specs-propagate-to-other-files2.sml │ ├── transparent-sig.sml │ ├── transparent-sig2.sml │ ├── tygoals-not-erased-in-refdec.sml │ ├── tyvarbug.sml │ ├── tyvars-error-not-reported-crashes.sml │ ├── tyvars-wrong.sml │ ├── underscore-patterns-not-considered-empty.sml │ ├── variances-are-matched-with-transparent.sml │ ├── variances-not-improved.sml │ ├── variances-not-improved2.sml │ ├── variances-not-matched.sml │ └── where.sml ├── fixed-performance-bugs │ ├── long-lists.sml │ ├── long-lists2.sml │ ├── ref-instance.sml │ ├── tarjan-break-up.sml │ ├── tarjan-expand-conj.sml │ ├── tarjan-expand-conj2.sml │ ├── tarjan-expand-xduce.q │ ├── tarjan-sig.sml │ ├── tarjan.cduce │ ├── tarjan.sml │ └── tarjan2.sml ├── fp-examples │ ├── minml-heap.sml │ ├── norm.sml │ ├── pairs.sml │ └── reg.sml ├── illustrative-examples │ ├── README │ ├── abstract-lattice-large.sml │ ├── abstract-lattice-linear.sml │ ├── abstract-lattice-redundant.sml │ ├── abstract-lattice.sml │ ├── backtracking.sml │ ├── constructor-intersections.sml │ ├── constructor-sorts.sml │ ├── datasort-extrusion.sml │ ├── datasort-no-extrusion-let.sml │ ├── distr-via-datasort.sml │ ├── exception-matching.sml │ ├── first-warnings.sml │ ├── functor-list.sml │ ├── functor-monomorphic-list.sml │ ├── ignored-allowed-in-all-covariant.sml │ ├── improved-inv-princ.sml │ ├── improved-inv-princ2.sml │ ├── interesting-functor.sml │ ├── intersection-printing.sml │ ├── intersection-realisation.sml │ ├── large-lattice-nat.sml │ ├── large-lattice-tree.sml │ ├── large-lattice.sml │ ├── lattice-consistency-correct.sml │ ├── lattice-consistency.sml │ ├── mono-list.sml │ ├── multiple-bindings.sml │ ├── no-case-analysis.cduce │ ├── no-need-for-datasort-replication.sml │ ├── non-covariant-opt.sml │ ├── parameter-unions.sml │ ├── poly-recursion-allowed.sml │ ├── poly-recursion-allowed2.sml │ ├── poly-recursion-allowed3.sml │ ├── polypattern-subtraction.sml │ ├── promote-sort-to-type.sml │ ├── ref-pat-multiple.sml │ ├── ref-pat-subtract.sml │ ├── ref-pat.sml │ ├── slow-exp-instances.sml │ ├── slow-pattern-instances.sml │ ├── slow-pattern-instances2.sml │ ├── unsound-ref.sml │ └── without-improved-inv-princ.sml ├── language-constructs │ ├── assume.sml │ ├── comma-valspec.sml │ ├── datasort-qualified-constructors.sml │ ├── datasort-spec-error.sml │ ├── datasort-spec.sml │ ├── datatype-replication.sml │ ├── functor-test-with-error.sml │ ├── functor-test.sml │ ├── pattern-sort-bound.sml │ ├── poly-test.sml │ ├── record-sorts.sml │ ├── sharing-test.sml │ ├── sig-datatype-replication.sml │ ├── sig-match.sml │ ├── sigdatatype.sml │ ├── sigpoly.sml │ ├── sigsort-sub.sml │ ├── sigtest.sml │ ├── sort-scheme-explicit-instantiators.sml │ ├── struct-assume.sml │ ├── structure-sharing-test.sml │ ├── subsort-spec.sml │ └── wheretype.sml ├── large-examples │ ├── .cvsignore │ ├── okasaki-rbt.sml │ ├── parse-all-datasorts.sml │ ├── parse-all-needs-sorts-for-error.sml │ ├── parse-all-with-sorts-for-error.sml │ ├── parsing │ │ ├── README │ │ ├── intsyn-datasorts.sml │ │ ├── intsyn.sml │ │ ├── parse-lexer.sml │ │ ├── parse-lib.sml │ │ ├── parse-stream.sml │ │ ├── parse-term.sml │ │ ├── start-of-parse-all.sml │ │ └── start2-of-parse-all.sml │ ├── red-black-datasorts.sml │ ├── red-black-needs-add-unions.sml │ ├── red-black-no-sig.sml │ ├── red-black-okasaki.sml │ ├── red-black-small-balanced.sml │ ├── red-black-transparent.sml │ ├── red-black.CDuce │ ├── red-black.sml │ ├── syntaxeditor.sml │ ├── tarjan-stacks.sml │ └── twelf-parsing │ │ ├── .cvsignore │ │ ├── intsyn.sig │ │ ├── lexer.sig │ │ ├── names.sig │ │ ├── parse-term.fun │ │ ├── parse-term.sig │ │ ├── parsing.sig │ │ ├── paths.sig │ │ ├── recon-term.sig │ │ ├── sortcheck-usefile.sml │ │ └── stream.sml ├── lisp-monotype │ ├── lisp-monotype-new-default.sml │ └── lisp-monotype.sml ├── old-examples │ └── small.sml ├── performance-bugs │ └── RefinedEnvironments-with-tarjan-datasorts.sml ├── possible-extensions │ └── tygoals-from-sigs.sml ├── possible-improvements │ ├── instantiators-annotation.sml │ ├── opaque-all-covariant-unsound.sml │ └── sig-datatype-replication-shadowing.sml ├── robs-DictTable.sml ├── robs-lex-error.sml ├── small │ └── accept-both-yi.sml └── thesis-examples │ ├── bitstring-most-sig-first.sml │ ├── bitstring-most-sig-first2.sml │ ├── bitstring.sml │ ├── intro-ref-unsound.sml │ ├── layered-patterns.sml │ ├── monotype-misc.sml │ ├── polymorphic-recursion.sml │ ├── sharing.sml │ ├── sig-matching-struct.sml │ ├── sig.sml │ └── struct.sml └── useme.sml /.cvsignore: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /src/*/.cm 2 | /src/drml-ext.cm 3 | *~ 4 | /bin/sml-cidre 5 | /bin/sml-cidre.bat 6 | /bin/.heap/* -------------------------------------------------------------------------------- /.hgignore: -------------------------------------------------------------------------------- 1 | syntax: glob 2 | 3 | .cm/* -------------------------------------------------------------------------------- /basisstubs/.cvsignore: -------------------------------------------------------------------------------- 1 | 2 | BITS 3 | PM *.log run 4 | no-assume-all 5 | orig-no-stubs 6 | pre-structs 7 | structs- 8 | structs-from-old-no-eqtype 9 | structs-from-old-script 10 | structs-merged 11 | structs-with-fns 12 | structs2-no-fns 13 | structs4-with-spaces-for-type 14 | structs5-with-fns-before-edits 15 | -------------------------------------------------------------------------------- /basisstubs/README: -------------------------------------------------------------------------------- 1 | 2 | This directory contains "stub" code for the SML Standard Basis, with 3 | the correct types and sorts. 4 | -------------------------------------------------------------------------------- /basisstubs/basislib.pm: -------------------------------------------------------------------------------- 1 | (* Initial allows for other modules to be discharged at link time *) 2 | local Initial.sml 3 | in 4 | 5 | (* General: *) 6 | GENERAL.sml General.sml OPTION.sml Option.sml 7 | 8 | (* Lists: *) 9 | LIST.sml List.sml LIST_PAIR.sml ListPair.sml LIST_SORT.sml 10 | ListSort.sml 11 | 12 | (* Arrays and Vectors: *) 13 | local wordtables.sml 14 | in VECTOR.sml Vector.sml ARRAY.sml Array.sml 15 | end 16 | 17 | 18 | MONO_VECTOR.sml MONO_ARRAY.sml ByteVector.sml ByteArray.sml 19 | 20 | (* Text: *) 21 | STRING_CVT.sml StringCvt.sml 22 | 23 | local STR_BASE.sml StrBase.sml 24 | in Char.sml String.sml CHAR.sml STRING.sml SUBSTRING.sml Substring.sml 25 | end 26 | 27 | BOOL.sml 28 | Bool.sml 29 | 30 | (* Integers: *) 31 | Word.sml Word8.sml WORD.sml BYTE.sml Byte.sml Int.sml INTEGER.sml 32 | 33 | (* Reals: *) 34 | MATH.sml Math.sml REAL.sml Real.sml 35 | 36 | (* IO: *) 37 | IO.sml TEXT_IO.sml TextIO.sml BIN_IO.sml BinIO.sml 38 | 39 | (* System: *) 40 | TIME.sml Time.sml OS_PATH.sml Path.sml OS_FILE_SYS.sml FileSys.sml 41 | OS_PROCESS.sml Process.sml OS.sml COMMAND_LINE.sml CommandLine.sml 42 | DATE.sml Date.sml TIMER.sml Timer.sml 43 | 44 | (* Misc: *) 45 | RANDOM.sml Random.sml SML90.sml 46 | 47 | end (*Initial*) 48 | 49 | 50 | 51 | 52 | -------------------------------------------------------------------------------- /basisstubs/current/.gitignore: -------------------------------------------------------------------------------- 1 | 2 | *.sml~ -------------------------------------------------------------------------------- /basisstubs/current/ARRAY-sig.sml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rowandavies/sml-cidre/dbd797af94eb38603d5613561b2edf8d1270e3f9/basisstubs/current/ARRAY-sig.sml -------------------------------------------------------------------------------- /basisstubs/current/Array.sml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rowandavies/sml-cidre/dbd797af94eb38603d5613561b2edf8d1270e3f9/basisstubs/current/Array.sml -------------------------------------------------------------------------------- /basisstubs/current/BOOL-sig.sml: -------------------------------------------------------------------------------- 1 | (*BOOL.sml*) 2 | 3 | signature BOOL = sig 4 | type bool = bool 5 | val not : bool -> bool 6 | val fromString : string -> bool option 7 | val scan : (char, 'a) StringCvt.reader 8 | -> (bool, 'a) StringCvt.reader 9 | val toString : bool -> string 10 | end; (*signature BOOL*) 11 | 12 | (* 13 | [not b] is the logical negation of b. 14 | 15 | [toString b] returns the string "false" or "true" according as b is 16 | false or true. 17 | 18 | [fromString s] scans a boolean b from the string s, after possible 19 | initial whitespace (blanks, tabs, newlines). Returns (SOME b) if s 20 | has a prefix which is either "false" or "true"; the value b is the 21 | corresponding truth value; otherwise NONE is returned. 22 | 23 | [scan getc src] scans a boolean b from the stream src, using the 24 | stream accessor getc. In case of success, returns SOME(b, rst) 25 | where b is the scanned boolean value and rst is the remainder of 26 | the stream; otherwise returns NONE. 27 | *) 28 | -------------------------------------------------------------------------------- /basisstubs/current/BitFlags.sml: -------------------------------------------------------------------------------- 1 | 2 | functor BitFlags(F : sig 3 | val all : SysWord.word 4 | end) = 5 | struct 6 | type flags = SysWord.word 7 | fun toWord x = x 8 | fun fromWord x = SysWord.andb(x, F.all) 9 | fun flags x = List.foldl SysWord.orb 0wx0 x 10 | fun intersect x = List.foldl SysWord.andb F.all x 11 | fun clear (f1,f2) = SysWord.andb (SysWord.notb f1,f2) 12 | fun allSet (f1,f2) = SysWord.andb (f1,f2) = f1 13 | fun anySet (f1,f2) = SysWord.andb (f1,f2) <> 0wx0 14 | end 15 | -------------------------------------------------------------------------------- /basisstubs/current/Bool.sml: -------------------------------------------------------------------------------- 1 | (*BOOL.sml*) 2 | 3 | structure Bool:BOOL = struct(*[ assumesig BOOL ]*) 4 | end; (*signature BOOL*) 5 | 6 | (* 7 | [not b] is the logical negation of b. 8 | 9 | [toString b] returns the string "false" or "true" according as b is 10 | false or true. 11 | 12 | [fromString s] scans a boolean b from the string s, after possible 13 | initial whitespace (blanks, tabs, newlines). Returns (SOME b) if s 14 | has a prefix which is either "false" or "true"; the value b is the 15 | corresponding truth value; otherwise NONE is returned. 16 | 17 | [scan getc src] scans a boolean b from the stream src, using the 18 | stream accessor getc. In case of success, returns SOME(b, rst) 19 | where b is the scanned boolean value and rst is the remainder of 20 | the stream; otherwise returns NONE. 21 | *) 22 | -------------------------------------------------------------------------------- /basisstubs/current/COMMAND_LINE.sml: -------------------------------------------------------------------------------- 1 | (* CommandLine -- SML Basis Library *) 2 | 3 | signature COMMAND_LINE = 4 | sig 5 | val name : unit -> string 6 | val arguments : unit -> string list 7 | end 8 | 9 | (* 10 | [name ()] returns the name used to start the current process. 11 | 12 | [arguments ()] returns the command line arguments of the current process. 13 | Hence List.nth(arguments (), 0) is the first argument. 14 | *) 15 | -------------------------------------------------------------------------------- /basisstubs/current/CommandLine.sml: -------------------------------------------------------------------------------- 1 | (* CommandLine -- SML Basis Library *) 2 | 3 | structure CommandLine:COMMAND_LINE = 4 | struct(*[ assumesig COMMAND_LINE ]*) 5 | val name : unit -> string = fn _ => raise Match 6 | val arguments : unit -> string list = fn _ => raise Match 7 | end 8 | 9 | (* 10 | [name ()] returns the name used to start the current process. 11 | 12 | [arguments ()] returns the command line arguments of the current process. 13 | Hence List.nth(arguments (), 0) is the first argument. 14 | *) 15 | -------------------------------------------------------------------------------- /basisstubs/current/OS-sig.sml: -------------------------------------------------------------------------------- 1 | 2 | signature OS = 3 | sig 4 | type syserror 5 | 6 | exception SysErr of string * syserror option 7 | 8 | val errorMsg : syserror -> string 9 | val errorName : syserror -> string 10 | val syserror : string -> syserror option 11 | 12 | structure FileSys : OS_FILE_SYS 13 | structure Path : OS_PATH 14 | structure Process : OS_PROCESS 15 | structure IO : OS_IO 16 | end 17 | 18 | (* Various functions for interacting with the operating system. 19 | 20 | [errorMsg err] returns a string explaining the error message system 21 | error code err, as found in a SysErr exception. The precise form 22 | of the strings are operating system dependent. 23 | *) 24 | structure OS:OS = 25 | struct(*[ assumesig OS ]*) 26 | end 27 | 28 | -------------------------------------------------------------------------------- /basisstubs/current/OS_IO.sml: -------------------------------------------------------------------------------- 1 | signature OS_IO = 2 | sig 3 | eqtype iodesc 4 | val hash : iodesc -> word 5 | val compare : iodesc * iodesc -> order 6 | eqtype iodesc_kind 7 | val kind : iodesc -> iodesc_kind 8 | structure Kind : sig 9 | val file : iodesc_kind 10 | val dir : iodesc_kind 11 | val symlink : iodesc_kind 12 | val tty : iodesc_kind 13 | val pipe : iodesc_kind 14 | val socket : iodesc_kind 15 | val device : iodesc_kind 16 | end 17 | eqtype poll_desc 18 | type poll_info 19 | val pollDesc : iodesc -> poll_desc option 20 | val pollToIODesc : poll_desc -> iodesc 21 | exception Poll 22 | val pollIn : poll_desc -> poll_desc 23 | val pollOut : poll_desc -> poll_desc 24 | val pollPri : poll_desc -> poll_desc 25 | val poll : poll_desc list * Time.time option -> poll_info list 26 | val isIn : poll_info -> bool 27 | val isOut : poll_info -> bool 28 | val isPri : poll_info -> bool 29 | val infoToPollDesc : poll_info -> poll_desc 30 | end 31 | -------------------------------------------------------------------------------- /basisstubs/current/Timer.sml: -------------------------------------------------------------------------------- 1 | (* Timer -- SML Basis Library *) 2 | 3 | structure Timer:TIMER = 4 | struct(*[ assumesig TIMER ]*) 5 | end 6 | 7 | (* A [cpu_timer] measures the CPU time consumed. 8 | 9 | A [real_timer] measures the real time that has passed. 10 | 11 | [startCPUTimer ()] returns a cpu_timer started at the moment of 12 | the call. 13 | 14 | [totalCPUTimer ()] returns a cpu_timer started at the moment the 15 | library was loaded. 16 | 17 | [checkCPUTimer tmr] returns {usr, sys, gc} where usr is the amount 18 | of user CPU time consumed since tmr was started, gc is the amount 19 | of user CPU time spent on garbage collection, and sys is the 20 | amount of system CPU time consumed since tmr was started. Note 21 | that gc time is included in the usr time. Under MS DOS, usr time 22 | and gc time are measured in real time. 23 | 24 | [startRealTimer ()] returns a real_timer started at the moment of 25 | the call. 26 | 27 | [totalRealTimer ()] returns a real_timer started at the moment the 28 | library was loaded. 29 | 30 | [checkRealTimer tmr] returns the amount of real time that has passed 31 | since tmr was started. 32 | *) 33 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/IEEE-real.sig: -------------------------------------------------------------------------------- 1 | signature IEEE_REAL = 2 | sig 3 | exception Unordered 4 | 5 | datatype real_order = LESS | EQUAL | GREATER | UNORDERED 6 | 7 | datatype float_class = 8 | NAN 9 | | INF 10 | | ZERO 11 | | NORMAL 12 | | SUBNORMAL 13 | 14 | datatype rounding_mode = 15 | TO_NEAREST 16 | | TO_NEGINF 17 | | TO_POSINF 18 | | TO_ZERO 19 | 20 | type decimal_approx = {class: float_class, 21 | digits: int list, 22 | exp: int, 23 | sign: bool} 24 | 25 | val fromString: string -> decimal_approx option 26 | val getRoundingMode: unit -> rounding_mode 27 | val scan: (char, 'a) StringCvt.reader 28 | -> (decimal_approx, 'a) StringCvt.reader 29 | val setRoundingMode: rounding_mode -> unit 30 | val toString: decimal_approx -> string 31 | end 32 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/IEEE-real.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * Copyright (C) 1997-2000 NEC Research Institute. 4 | * 5 | * MLton is released under a BSD-style license. 6 | * See the file MLton-LICENSE for details. 7 | *) 8 | 9 | structure IEEEReal = struct (*[ assumesig IEEE_REAL ]*) end 10 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/array2.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * Copyright (C) 1997-2000 NEC Research Institute. 4 | * 5 | * MLton is released under a BSD-style license. 6 | * See the file MLton-LICENSE for details. 7 | *) 8 | 9 | structure Array2 = struct (*[ assumesig ARRAY2 ]*) end 10 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/int-inf.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * Copyright (C) 1997-2000 NEC Research Institute. 4 | * 5 | * MLton is released under a BSD-style license. 6 | * See the file MLton-LICENSE for details. 7 | *) 8 | 9 | structure IntInf = struct (*[ assumesig INT_INF ]*) end 10 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/io/bin-prim-io.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | structure BinPrimIO = 9 | struct (*[ assumesig PRIM_IO 10 | where type array = Word8Array.array 11 | where type vector = Word8Vector.vector 12 | where type elem = Word8.word 13 | where type pos = Position.int ]*) 14 | end 15 | 16 | (* = PrimIO (structure Vector = Word8Vector 17 | structure VectorSlice = Word8VectorSlice 18 | structure Array = Word8Array 19 | structure ArraySlice = Word8ArraySlice 20 | type pos = Position.int 21 | val compare = Position.compare 22 | val someElem = 0wx0: Word8.word) *) 23 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/io/imperative-io.fun: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2002-2007 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | signature IMPERATIVE_IO_ARG = 9 | sig 10 | structure Array: MONO_ARRAY 11 | (* structure ArraySlice: MONO_ARRAY_SLICE *) 12 | structure StreamIO: STREAM_IO 13 | structure Vector: MONO_VECTOR 14 | (* structure VectorSlice: MONO_VECTOR_SLICE *) 15 | (* sharing type Array.array = ArraySlice.array *) 16 | sharing type 17 | Array.elem 18 | (* = ArraySlice.elem *) 19 | = StreamIO.elem 20 | = Vector.elem 21 | (* = VectorSlice.elem *) 22 | sharing type 23 | Array.vector 24 | (* = ArraySlice.vector *) 25 | = Vector.vector 26 | (* = VectorSlice.vector *) 27 | (* sharing type ArraySlice.vector_slice = VectorSlice.slice *) 28 | end 29 | 30 | functor ImperativeIO (S: IMPERATIVE_IO_ARG) = struct (*[ assumesig IMPERATIVE_IO ]*) end 31 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/io/prim-io.fun: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2002-2006 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | signature PRIM_IO_ARG = 9 | sig 10 | structure Vector: MONO_VECTOR 11 | structure VectorSlice: MONO_VECTOR_SLICE 12 | structure Array: MONO_ARRAY 13 | structure ArraySlice: MONO_ARRAY_SLICE 14 | sharing type Vector.elem = VectorSlice.elem 15 | = Array.elem = ArraySlice.elem 16 | sharing type Vector.vector = VectorSlice.vector 17 | = Array.vector = ArraySlice.vector 18 | sharing type VectorSlice.slice = ArraySlice.vector_slice 19 | sharing type Array.array = ArraySlice.array 20 | 21 | val someElem: Vector.elem 22 | 23 | eqtype pos 24 | val compare: pos * pos -> order 25 | end 26 | 27 | functor PrimIO (S: PRIM_IO_ARG): PRIM_IO = 28 | struct (*[ assumesig PRIM_IO ]*) end 29 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/io/stream-io.fun: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2002-2006 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | signature STREAM_IO_ARG = 9 | sig 10 | structure Array: MONO_ARRAY 11 | structure ArraySlice: MONO_ARRAY_SLICE 12 | structure PrimIO: PRIM_IO 13 | structure Vector: MONO_VECTOR 14 | structure VectorSlice: MONO_VECTOR_SLICE 15 | sharing type PrimIO.elem = Vector.elem = VectorSlice.elem = Array.elem 16 | = ArraySlice.elem 17 | sharing type PrimIO.vector = Vector.vector = VectorSlice.vector 18 | = Array.vector = ArraySlice.vector 19 | sharing type PrimIO.vector_slice = VectorSlice.slice 20 | = ArraySlice.vector_slice 21 | sharing type PrimIO.array = Array.array = ArraySlice.array 22 | sharing type PrimIO.array_slice = ArraySlice.slice 23 | 24 | val someElem: PrimIO.elem 25 | end 26 | 27 | functor StreamIO (S: STREAM_IO_ARG): STREAM_IO = struct (*[ assumesig STREAM_IO ]*) end 28 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/io/text-prim-io.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2002-2005 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | structure TextPrimIO = 9 | struct (*[ assumesig PRIM_IO 10 | where type array = CharArray.array 11 | where type vector = CharVector.vector 12 | where type elem = Char.char ]*) 13 | end 14 | 15 | (* = 16 | PrimIO (structure Vector = CharVector 17 | structure VectorSlice = CharVectorSlice 18 | structure Array = CharArray 19 | structure ArraySlice = CharArraySlice 20 | type pos = Position.int 21 | val compare = Position.compare 22 | val someElem = #"\000": Char.char) 23 | *) 24 | 25 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/io/text-stream-io.sig: -------------------------------------------------------------------------------- 1 | signature TEXT_STREAM_IO = 2 | sig 3 | include STREAM_IO 4 | where type elem = Char.char 5 | where type vector = CharVector.vector 6 | 7 | val inputLine: instream -> (string * instream) option 8 | val outputSubstr: outstream * substring -> unit 9 | end 10 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/mono-array2.fun: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * Copyright (C) 1997-2000 NEC Research Institute. 4 | * 5 | * MLton is released under a BSD-style license. 6 | * See the file MLton-LICENSE for details. 7 | *) 8 | 9 | functor MonoArray2 (eqtype elem 10 | structure V: MONO_VECTOR 11 | where type elem = elem 12 | and type vector = elem Vector.vector): MONO_ARRAY2 = 13 | struct 14 | (*[ assumesig MONO_ARRAY2 ]*) 15 | end 16 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/generic-sock.sig: -------------------------------------------------------------------------------- 1 | signature GENERIC_SOCK = 2 | sig 3 | val socket: Socket.AF.addr_family * Socket.SOCK.sock_type -> 4 | ('af, 'sock_type) Socket.sock 5 | val socketPair: Socket.AF.addr_family * Socket.SOCK.sock_type -> 6 | ('af, 'sock_type) Socket.sock * ('af, 'sock_type) Socket.sock 7 | val socket': Socket.AF.addr_family * Socket.SOCK.sock_type * int -> 8 | ('af, 'sock_type) Socket.sock 9 | val socketPair': Socket.AF.addr_family * Socket.SOCK.sock_type * int -> 10 | ('af, 'sock_type) Socket.sock * ('af, 'sock_type) Socket.sock 11 | end 12 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/generic-sock.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2002-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | structure GenericSock = struct (*[ assumesig GENERIC_SOCK ]*) end 9 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/inet-sock.sig: -------------------------------------------------------------------------------- 1 | signature INET_SOCK = 2 | sig 3 | type inet 4 | type 'sock_type sock = (inet, 'sock_type) Socket.sock 5 | type dgram_sock = Socket.dgram sock 6 | type sock_addr = inet Socket.sock_addr 7 | type 'mode stream_sock = 'mode Socket.stream sock 8 | val inetAF: Socket.AF.addr_family 9 | val toAddr: NetHostDB.in_addr * int -> sock_addr 10 | val fromAddr: sock_addr -> NetHostDB.in_addr * int 11 | val any: int -> sock_addr 12 | structure UDP: 13 | sig 14 | val socket: unit -> dgram_sock 15 | val socket': int -> dgram_sock 16 | end 17 | structure TCP: 18 | sig 19 | val socket: unit -> 'mode stream_sock 20 | val socket': int -> 'mode stream_sock 21 | val getNODELAY: 'mode stream_sock -> bool 22 | val setNODELAY: 'mode stream_sock * bool -> unit 23 | end 24 | end 25 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/inet-sock.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2002-2008 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | structure INetSock = struct (*[ assumesig INET_SOCK ]*) end 9 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/net-host-db.sig: -------------------------------------------------------------------------------- 1 | signature NET_HOST_DB = 2 | sig 3 | eqtype addr_family 4 | type entry 5 | eqtype in_addr 6 | 7 | val addr: entry -> in_addr 8 | val addrType: entry -> addr_family 9 | val addrs: entry -> in_addr list 10 | val aliases: entry -> string list 11 | val fromString: string -> in_addr option 12 | val getByAddr: in_addr -> entry option 13 | val getByName: string -> entry option 14 | val getHostName: unit -> string 15 | val name: entry -> string 16 | val scan: (char, 'a) StringCvt.reader -> (in_addr, 'a) StringCvt.reader 17 | val toString: in_addr -> string 18 | end 19 | 20 | signature NET_HOST_DB_EXTRA = 21 | sig 22 | include NET_HOST_DB 23 | type pre_in_addr 24 | 25 | val any: unit -> in_addr 26 | val inAddrToWord8Vector: in_addr -> Word8.word vector 27 | val newInAddr: unit -> pre_in_addr * (unit -> in_addr) 28 | val preInAddrToWord8Array: pre_in_addr -> Word8.word array 29 | end 30 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/net-host-db.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2002-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | structure NetHostDB = struct (*[ assumesig NET_HOST_DB_EXTRA ]*) end 9 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/net-prot-db.sig: -------------------------------------------------------------------------------- 1 | signature NET_PROT_DB = 2 | sig 3 | type entry 4 | val name: entry -> string 5 | val aliases: entry -> string list 6 | val protocol: entry -> int 7 | val getByName: string -> entry option 8 | val getByNumber: int -> entry option 9 | end 10 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/net-prot-db.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2002-2006 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | structure NetProtDB = struct (*[ assumesig NET_PROT_DB ]*) end 9 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/net-serv-db.sig: -------------------------------------------------------------------------------- 1 | signature NET_SERV_DB = 2 | sig 3 | type entry 4 | val name: entry -> string 5 | val aliases: entry -> string list 6 | val port: entry -> int 7 | val protocol: entry -> string 8 | val getByName: string * string option -> entry option 9 | val getByPort: int * string option -> entry option 10 | end 11 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/net-serv-db.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2002-2006 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | structure NetServDB = struct (*[ assumesig NET_SERV_DB ]*) end 9 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/net.sig: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2002-2008 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | signature NET = 9 | sig 10 | structure AddrFamily : ABS_REP_EQ where type Rep.t = C_Int.t 11 | structure Sock : ABS_REP where type Rep.t = C_Sock.t 12 | structure SockType : ABS_REP_EQ where type Rep.t = C_Sock.t 13 | 14 | structure Word16 : 15 | sig 16 | val hton: Word16.word -> Word16.word 17 | val ntoh: Word16.word -> Word16.word 18 | end 19 | structure C_Int : 20 | sig 21 | val hton: C_Int.t -> C_Int.t 22 | val ntoh: C_Int.t -> C_Int.t 23 | end 24 | end 25 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/net.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2002-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | structure Net = struct (*[ assumesig NET ]*) end 9 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/socket.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2002-2008 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | structure Socket = struct (*[ assumesig SOCKET ]*) end 9 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/unix-sock.sig: -------------------------------------------------------------------------------- 1 | signature UNIX_SOCK = 2 | sig 3 | type unix 4 | type 'sock_type sock = (unix, 'sock_type) Socket.sock 5 | type 'mode stream_sock = 'mode Socket.stream sock 6 | type dgram_sock = Socket.dgram sock 7 | type sock_addr = unix Socket.sock_addr 8 | val unixAF: Socket.AF.addr_family 9 | val toAddr: string -> sock_addr 10 | val fromAddr: sock_addr -> string 11 | structure Strm : 12 | sig 13 | val socket: unit -> 'mode stream_sock 14 | val socketPair: unit -> 'mode stream_sock * 'mode stream_sock 15 | end 16 | structure DGrm : 17 | sig 18 | val socket: unit -> dgram_sock 19 | val socketPair: unit -> dgram_sock * dgram_sock 20 | end 21 | end 22 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/net/unix-sock.sml: -------------------------------------------------------------------------------- 1 | 2 | structure UnixSock = struct (*[ assumesig UNIX_SOCK ]*) end 3 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/pack-real.sig: -------------------------------------------------------------------------------- 1 | signature PACK_REAL = 2 | sig 3 | type real 4 | 5 | val bytesPerElem: int 6 | val isBigEndian: bool 7 | val toBytes: real -> Word8Vector.vector 8 | val fromBytes: Word8Vector.vector -> real 9 | val subVec: Word8Vector.vector * int -> real 10 | val subArr: Word8Array.array * int -> real 11 | val update: Word8Array.array * int * real -> unit 12 | end 13 | 14 | 15 | local structure s = struct 16 | (*[ assumesig sig 17 | structure PackRealBig : PACK_REAL (* OPTIONAL *) 18 | where type real = Real.real 19 | structure PackRealLittle : PACK_REAL (* OPTIONAL *) 20 | where type real = Real.real 21 | 22 | structure PackReal32Big : PACK_REAL (* OPTIONAL *) 23 | where type real = Real32.real 24 | structure PackReal32Little : PACK_REAL (* OPTIONAL *) 25 | where type real = Real32.real 26 | 27 | structure PackReal64Big : PACK_REAL (* OPTIONAL *) 28 | where type real = Real64.real 29 | structure PackReal64Little : PACK_REAL (* OPTIONAL *) 30 | where type real = Real64.real 31 | 32 | (* MLton has more, but it looks like SML/NJ may not define any PackReal* at all ?? *) 33 | 34 | end ]*) 35 | end 36 | 37 | in open s 38 | end 39 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/pack-word.sig: -------------------------------------------------------------------------------- 1 | signature PACK_WORD = 2 | sig 3 | val bytesPerElem: int 4 | val isBigEndian: bool 5 | val subArr: Word8Array.array * int -> LargeWord.word 6 | val subArrX: Word8Array.array * int -> LargeWord.word 7 | val subVec: Word8Vector.vector * int -> LargeWord.word 8 | val subVecX: Word8Vector.vector * int -> LargeWord.word 9 | val update: Word8Array.array * int * LargeWord.word -> unit 10 | end 11 | 12 | signature PACK_WORD_EXTRA = 13 | sig 14 | include PACK_WORD 15 | val unsafeSubArr: Word8Array.array * int -> LargeWord.word 16 | val unsafeSubArrX: Word8Array.array * int -> LargeWord.word 17 | val unsafeSubVec: Word8Vector.vector * int -> LargeWord.word 18 | val unsafeSubVecX: Word8Vector.vector * int -> LargeWord.word 19 | val unsafeUpdate: Word8Array.array * int * LargeWord.word -> unit 20 | end 21 | 22 | 23 | 24 | local structure s = 25 | struct (*[ assumesig sig 26 | structure PackWord32Big: PACK_WORD_EXTRA 27 | structure PackWord32Little: PACK_WORD_EXTRA 28 | structure PackWord32Host: PACK_WORD_EXTRA 29 | 30 | structure PackWord64Big: PACK_WORD_EXTRA 31 | structure PackWord64Little: PACK_WORD_EXTRA 32 | structure PackWord64Host: PACK_WORD_EXTRA 33 | end ]*) end 34 | 35 | in open s 36 | end 37 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/text.sig: -------------------------------------------------------------------------------- 1 | signature TEXT = 2 | sig 3 | structure Char: CHAR 4 | structure CharArray: MONO_ARRAY 5 | structure CharArraySlice: MONO_ARRAY_SLICE 6 | structure CharVector: MONO_VECTOR 7 | structure CharVectorSlice: MONO_VECTOR_SLICE 8 | structure String: STRING 9 | structure Substring: SUBSTRING 10 | sharing type Char.char 11 | = CharArray.elem 12 | = CharArraySlice.elem 13 | = CharVector.elem 14 | = CharVectorSlice.elem 15 | = String.char 16 | = Substring.char 17 | sharing type Char.string 18 | = CharArraySlice.vector 19 | = CharVector.vector 20 | = CharArray.vector 21 | = CharVectorSlice.vector 22 | = String.string 23 | = Substring.string 24 | sharing type CharArray.array = CharArraySlice.array 25 | sharing type CharVectorSlice.slice = CharArraySlice.vector_slice 26 | end 27 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/text.sml: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2002-2007 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | structure Text: TEXT = 9 | struct 10 | structure Char = Char 11 | structure CharArray = CharArray 12 | structure CharArraySlice = CharArraySlice 13 | structure CharVector = CharVector 14 | structure CharVectorSlice = CharVectorSlice 15 | structure String = String 16 | structure Substring = Substring 17 | end 18 | 19 | (* Optional 20 | structure WideText: TEXT = 21 | struct 22 | structure Char = WideChar 23 | structure CharArray = WideCharArray 24 | structure CharArraySlice = WideCharArraySlice 25 | structure CharVector = WideCharVector 26 | structure CharVectorSlice = WideCharVectorSlice 27 | structure String = WideString 28 | structure Substring = WideSubstring 29 | end 30 | *) 31 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/unix.sig: -------------------------------------------------------------------------------- 1 | signature UNIX = 2 | sig 3 | type ('a, 'b) proc 4 | type signal 5 | datatype exit_status = 6 | W_EXITED 7 | | W_EXITSTATUS of Word8.word 8 | | W_SIGNALED of signal 9 | | W_STOPPED of signal 10 | 11 | val binInstreamOf: (BinIO.instream, 'a) proc -> BinIO.instream 12 | val binOutstreamOf: ('a, BinIO.outstream) proc -> BinIO.outstream 13 | val execute: string * string list -> ('a, 'b) proc 14 | val executeInEnv: string * string list * string list -> ('a, 'b) proc 15 | val exit: Word8.word -> 'a 16 | val fromStatus: OS.Process.status -> exit_status 17 | val kill: ('a, 'b) proc * signal -> unit 18 | val reap: ('a, 'b) proc -> OS.Process.status 19 | val streamsOf: ((TextIO.instream, TextIO.outstream) proc 20 | -> TextIO.instream * TextIO.outstream) 21 | val textInstreamOf: (TextIO.instream, 'a) proc -> TextIO.instream 22 | val textOutstreamOf: ('a, TextIO.outstream) proc -> TextIO.outstream 23 | end 24 | -------------------------------------------------------------------------------- /basisstubs/current/from-mlton/unix.sml: -------------------------------------------------------------------------------- 1 | 2 | structure Unix = struct (*[ assumesig UNIX ]*) end 3 | 4 | -------------------------------------------------------------------------------- /basisstubs/missing.txt: -------------------------------------------------------------------------------- 1 | Array2 X 2 | ArraySlice X 3 | GeneralSock X 4 | IEEEReal X 5 | ImperativeIO X 6 | INetSock X 7 | IntInf X 8 | MONO_ARRAY2 X 9 | NetHostDB X 10 | NetProtDB X 11 | NetServDB X 12 | PrimIO functor X 13 | Socket X 14 | StreamIO X 15 | Text ??? 16 | TEXT_STREAM_IO signature X 17 | Unix X 18 | UnixSock X 19 | VectorSlice (?) X 20 | Windows X 21 | 22 | General (close enough, revisit) 23 | 24 | PackReal C ??????? 25 | PackWord C ??????? 26 | 27 | Path, FileSys - remove from top level (?) 28 | 29 | -------------------------------------------------------------------------------- /basisstubs/sigs/ARRAY.sml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rowandavies/sml-cidre/dbd797af94eb38603d5613561b2edf8d1270e3f9/basisstubs/sigs/ARRAY.sml -------------------------------------------------------------------------------- /basisstubs/sigs/BOOL.sml: -------------------------------------------------------------------------------- 1 | (*BOOL.sml*) 2 | 3 | signature BOOL = sig 4 | eqtype bool 5 | val not : bool -> bool 6 | val fromString : string -> bool option 7 | val scan : (char, 'a) StringCvt.reader -> 'a -> (bool * 'a) option 8 | val toString : bool -> string 9 | end; (*signature BOOL*) 10 | 11 | (* 12 | [not b] is the logical negation of b. 13 | 14 | [toString b] returns the string "false" or "true" according as b is 15 | false or true. 16 | 17 | [fromString s] scans a boolean b from the string s, after possible 18 | initial whitespace (blanks, tabs, newlines). Returns (SOME b) if s 19 | has a prefix which is either "false" or "true"; the value b is the 20 | corresponding truth value; otherwise NONE is returned. 21 | 22 | [scan getc src] scans a boolean b from the stream src, using the 23 | stream accessor getc. In case of success, returns SOME(b, rst) 24 | where b is the scanned boolean value and rst is the remainder of 25 | the stream; otherwise returns NONE. 26 | *) 27 | -------------------------------------------------------------------------------- /basisstubs/sigs/COMMAND_LINE.sml: -------------------------------------------------------------------------------- 1 | (* CommandLine -- SML Basis Library *) 2 | 3 | signature COMMAND_LINE = 4 | sig 5 | val name : unit -> string 6 | val arguments : unit -> string list 7 | end 8 | 9 | (* 10 | [name ()] returns the name used to start the current process. 11 | 12 | [arguments ()] returns the command line arguments of the current process. 13 | Hence List.nth(arguments (), 0) is the first argument. 14 | *) 15 | -------------------------------------------------------------------------------- /basisstubs/sigs/LIST_SORT.sml: -------------------------------------------------------------------------------- 1 | signature LIST_SORT = 2 | sig 3 | 4 | val sort : ('a * 'a -> order) -> 'a list -> 'a list 5 | val sorted : ('a * 'a -> order) -> 'a list -> bool 6 | 7 | (* 8 | [sort ordr xs] sorts the list xs in nondecreasing order, using the 9 | given ordering. Uses Richard O'Keefe's smooth applicative merge 10 | sort. 11 | 12 | [sorted ordr xs] checks that the list xs is sorted in nondecreasing 13 | order, in the given ordering. 14 | *) 15 | 16 | end -------------------------------------------------------------------------------- /basisstubs/sigs/OS.sml: -------------------------------------------------------------------------------- 1 | 2 | signature OS = 3 | sig 4 | type syserror 5 | 6 | exception SysErr of string * syserror option 7 | 8 | val errorMsg : syserror -> string 9 | 10 | structure FileSys : OS_FILE_SYS 11 | structure Path : OS_PATH 12 | structure Process : OS_PROCESS 13 | end 14 | 15 | (* Various functions for interacting with the operating system. 16 | 17 | [errorMsg err] returns a string explaining the error message system 18 | error code err, as found in a SysErr exception. The precise form 19 | of the strings are operating system dependent. 20 | *) 21 | structure OS:OS = 22 | struct 23 | type syserror = unit 24 | 25 | exception SysErr of string * syserror option 26 | 27 | val errorMsg : syserror -> string = fn _ => raise Match 28 | 29 | structure FileSys : OS_FILE_SYS = FileSys 30 | structure Path : OS_PATH = Path 31 | structure Process : OS_PROCESS = Process 32 | end 33 | 34 | (* 35 | structure OS : OS = 36 | struct 37 | type syserror = OS.syserror 38 | exception SysErr = OS.SysErr 39 | fun errorMsg (err : int) : string = OS.errorMsg err 40 | 41 | structure FileSys = FileSys 42 | structure Path = Path 43 | structure Process = Process 44 | end 45 | 46 | *) -------------------------------------------------------------------------------- /basisstubs/sigs/RANDOM.sml: -------------------------------------------------------------------------------- 1 | (* Random -- Random number generator -- 1995-04-23 *) 2 | 3 | signature RANDOM = 4 | sig 5 | type generator 6 | 7 | val newgenseed : real -> generator 8 | val newgen : unit -> generator 9 | val random : generator -> real 10 | val randomlist : int * generator -> real list 11 | val range : int * int -> generator -> int 12 | val rangelist : int * int -> int * generator -> int list 13 | end 14 | 15 | (* Type generator is the abstract type of random number generators, 16 | producing uniformly distributed pseudo-random numbers. 17 | 18 | [newgenseed seed] returns a random number generator with the given seed. 19 | 20 | [newgen ()] returns a random number generator, taking the seed from 21 | the system clock. 22 | 23 | [random gen] returns a random number in the interval [0..1). 24 | 25 | [randomlist (n, gen)] returns a list of n random numbers in the 26 | interval [0,1). 27 | 28 | [range (min, max) gen] returns an integral random number in the 29 | range [min, max). Raises Fail if min > max. 30 | 31 | [rangelist (min, max) (n, gen)] returns a list of n integral random 32 | numbers in the range [min, max). Raises Fail if min > max. 33 | *) 34 | -------------------------------------------------------------------------------- /basisstubs/sigs/STR_BASE.sml: -------------------------------------------------------------------------------- 1 | (* Strbase -- internal auxiliaries for String and Substring 2 | 1995-04-13, 1995-11-06 *) 3 | 4 | signature STR_BASE = 5 | sig 6 | type substring = string * int * int 7 | 8 | val dropl : (char -> bool) -> substring -> substring 9 | val dropr : (char -> bool) -> substring -> substring 10 | val takel : (char -> bool) -> substring -> substring 11 | val taker : (char -> bool) -> substring -> substring 12 | val splitl : (char -> bool) -> substring -> substring * substring 13 | val splitr : (char -> bool) -> substring -> substring * substring 14 | 15 | val translate : (char -> string) -> substring -> string 16 | 17 | val tokens : (char -> bool) -> substring -> substring list 18 | val fields : (char -> bool) -> substring -> substring list 19 | 20 | val foldl : (char * 'a -> 'a) -> 'a -> substring -> 'a 21 | val fromMLescape : ('a -> (char * 'a) option) -> ('a -> (char * 'a) option) 22 | val toMLescape : char -> string 23 | val fromCescape : ('a -> (char * 'a) option) -> ('a -> (char * 'a) option) 24 | val toCescape : char -> string 25 | val fromCString : string -> string option 26 | 27 | val explode : string -> char list 28 | end 29 | 30 | -------------------------------------------------------------------------------- /basisstubs/sigs/mkstructstub.awk: -------------------------------------------------------------------------------- 1 | { 2 | printf("cp %s ", $1); 3 | split($1,words,"_"); 4 | for (i in words) { 5 | w = words[i]; 6 | w = substr(w, 0, 1) tolower(substr(w, 2)); 7 | printf("%s", w); 8 | } 9 | printf("\n") 10 | } 11 | -------------------------------------------------------------------------------- /basisstubs/sigs/useme: -------------------------------------------------------------------------------- 1 | R.refine_file "ARRAY.sml"; 2 | R.refine_file "BIN_IO.sml"; 3 | R.refine_file "BOOL.sml"; 4 | R.refine_file "BYTE.sml"; 5 | R.refine_file "CHAR.sml"; 6 | R.refine_file "COMMAND_LINE.sml"; 7 | R.refine_file "DATE.sml"; 8 | R.refine_file "GENERAL.sml"; 9 | R.refine_file "INTEGER.sml"; 10 | R.refine_file "IO.sml"; 11 | R.refine_file "LIST.sml"; 12 | R.refine_file "LIST_PAIR.sml"; 13 | R.refine_file "LIST_SORT.sml"; 14 | R.refine_file "MATH.sml"; 15 | R.refine_file "MONO_ARRAY.sml"; 16 | R.refine_file "MONO_VECTOR.sml"; 17 | R.refine_file "OPTION.sml"; 18 | R.refine_file "OS.sml"; 19 | R.refine_file "OS_FILE_SYS.sml"; 20 | R.refine_file "OS_PATH.sml"; 21 | R.refine_file "OS_PROCESS.sml"; 22 | R.refine_file "RANDOM.sml"; 23 | R.refine_file "REAL.sml"; 24 | R.refine_file "SML90.sml"; 25 | R.refine_file "STRING.sml"; 26 | R.refine_file "STRING_CVT.sml"; 27 | R.refine_file "STR_BASE.sml"; 28 | R.refine_file "SUBSTRING.sml"; 29 | R.refine_file "TEXT_IO.sml"; 30 | R.refine_file "TIME.sml"; 31 | R.refine_file "TIMER.sml"; 32 | R.refine_file "VECTOR.sml"; 33 | R.refine_file "WORD.sml"; 34 | -------------------------------------------------------------------------------- /bin/.heap/README: -------------------------------------------------------------------------------- 1 | This file ensures this directory is created. 2 | 3 | The heap images for each os-arch will be written here. 4 | -------------------------------------------------------------------------------- /bin/README: -------------------------------------------------------------------------------- 1 | Executables and heaps are put here. This README ensures that the directory exists. -------------------------------------------------------------------------------- /lib/basis/.gitignore: -------------------------------------------------------------------------------- 1 | 2 | *.mlb~ -------------------------------------------------------------------------------- /lib/basis/pervasive.mlb: -------------------------------------------------------------------------------- 1 | (* For now, there's nothing here - the Standard Basis is always included, and that always includes the pervasives. *) 2 | -------------------------------------------------------------------------------- /lib/mlyacc-lib/ml-yacc-lib.cm: -------------------------------------------------------------------------------- 1 | (* sources file for ML-Yacc library *) 2 | 3 | Library 4 | 5 | signature STREAM 6 | signature LR_TABLE 7 | signature TOKEN 8 | signature LR_PARSER 9 | signature LEXER 10 | signature ARG_LEXER 11 | signature PARSER_DATA 12 | signature PARSER 13 | signature ARG_PARSER 14 | functor Join 15 | functor JoinWithArg 16 | structure LrTable 17 | structure Stream 18 | structure LrParser 19 | 20 | is 21 | 22 | #if defined(NEW_CM) 23 | $/basis.cm 24 | #endif 25 | 26 | base.sig 27 | join.sml 28 | lrtable.sml 29 | stream.sml 30 | parser2.sml (* error correcting version *) 31 | -------------------------------------------------------------------------------- /lib/mlyacc-lib/mlyacc-lib.mlb: -------------------------------------------------------------------------------- 1 | (* Copyright (C) 2004-2005 Henry Cejtin, Matthew Fluet, Suresh 2 | * Jagannathan, and Stephen Weeks. 3 | * 4 | * MLton is released under a BSD-style license. 5 | * See the file MLton-LICENSE for details. 6 | *) 7 | 8 | ann 9 | "sequenceNonUnit warn" 10 | "nonexhaustiveMatch warn" "redundantMatch warn" 11 | "warnUnused false" "forceUsed" 12 | in 13 | local 14 | $(SML_LIB)/basis/basis.mlb 15 | base.sig 16 | join.sml 17 | lrtable.sml 18 | stream.sml 19 | parser2.sml (* error correcting version *) 20 | in 21 | signature STREAM 22 | signature LR_TABLE 23 | signature TOKEN 24 | signature LR_PARSER 25 | signature LEXER 26 | signature ARG_LEXER 27 | signature PARSER_DATA 28 | signature PARSER 29 | signature ARG_PARSER 30 | functor Join 31 | functor JoinWithArg 32 | structure LrTable 33 | structure Stream 34 | structure LrParser 35 | end 36 | end 37 | -------------------------------------------------------------------------------- /lib/mlyacc-lib/stream.sml: -------------------------------------------------------------------------------- 1 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *) 2 | 3 | (* Stream: a structure implementing a lazy stream. The signature STREAM 4 | is found in base.sig *) 5 | 6 | structure Stream :> STREAM = 7 | struct 8 | datatype 'a str = EVAL of 'a * 'a str ref | UNEVAL of (unit->'a) 9 | 10 | type 'a stream = 'a str ref 11 | 12 | fun get(ref(EVAL t)) = t 13 | | get(s as ref(UNEVAL f)) = 14 | let val t = (f(), ref(UNEVAL f)) in s := EVAL t; t end 15 | 16 | fun streamify f = ref(UNEVAL f) 17 | fun cons(a,s) = ref(EVAL(a,s)) 18 | 19 | end; 20 | -------------------------------------------------------------------------------- /lib/refined-basis/basis.mlb: -------------------------------------------------------------------------------- 1 | bool.sml 2 | option.sml 3 | list.sml 4 | -------------------------------------------------------------------------------- /lib/refined-basis/bool.sml: -------------------------------------------------------------------------------- 1 | (*[ datasort true = true ]*) 2 | (*[ datasort false = false ]*) 3 | -------------------------------------------------------------------------------- /lib/refined-basis/list.sml: -------------------------------------------------------------------------------- 1 | (*[ datasort 'a conslist = :: of 'a * 'a list ]*) 2 | 3 | structure List = struct 4 | 5 | open List 6 | 7 | (*[ val map: ('a -> 'b) -> 'a conslist -> 'b conslist 8 | & ('a -> 'b) -> 'a list -> 'b list ]*) 9 | fun map f [] = [] 10 | | map f (x :: xs) = f x :: map f xs 11 | 12 | (*[ val getItem: 'a conslist -> ('a * 'a list) some 13 | & 'a list -> ('a * 'a list) option ]*) 14 | fun getItem [] = NONE 15 | | getItem (x :: xs) = SOME (x, xs) 16 | 17 | (*[ val revAppend: 'a list * 'a conslist -> 'a conslist 18 | & 'a conslist * 'a list -> 'a conslist 19 | & 'a list * 'a list -> 'a list ]*) 20 | fun revAppend ([], ys) = ys 21 | | revAppend (x :: xs, ys) = revAppend (xs, x :: ys) 22 | 23 | (*[ val rev: 'a conslist -> 'a conslist 24 | & 'a list -> 'a list ]*) 25 | fun rev xs = revAppend (xs, []) 26 | 27 | (*[ val @ : 'a list * 'a list -> 'a list 28 | & 'a conslist * 'a list -> 'a conslist 29 | & 'a list * 'a conslist -> 'a conslist ]*) 30 | 31 | val @ = (fn ([], ys) => ys 32 | | (x :: xs, ys) => x :: (xs @ ys)) 33 | 34 | end 35 | 36 | val map = List.map 37 | 38 | val @ = List.@ 39 | -------------------------------------------------------------------------------- /lib/refined-basis/option.sml: -------------------------------------------------------------------------------- 1 | (*[ datasort 'a none = NONE ]*) 2 | (*[ datasort 'a some = SOME of 'a ]*) 3 | 4 | -------------------------------------------------------------------------------- /lib/smlnj-lib/PP/pp-lib.mlb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rowandavies/sml-cidre/dbd797af94eb38603d5613561b2edf8d1270e3f9/lib/smlnj-lib/PP/pp-lib.mlb -------------------------------------------------------------------------------- /lib/smlnj-lib/Util/BinaryMapFn.sml: -------------------------------------------------------------------------------- 1 | functor BinaryMapFn (Key:ORD_KEY) = struct (*[ assumesig ORD_MAP where type Key.ord_key=Key.ord_key ]*) end 2 | -------------------------------------------------------------------------------- /lib/smlnj-lib/Util/BinarySetFn.sml: -------------------------------------------------------------------------------- 1 | functor BinarySetFn (Key:ORD_KEY) = 2 | struct (*[ assumesig ORD_SET where type Key.ord_key = Key.ord_key ]*) end 3 | -------------------------------------------------------------------------------- /lib/smlnj-lib/Util/GET_OPT.sml: -------------------------------------------------------------------------------- 1 | signature GET_OPT = 2 | sig 3 | datatype 'a arg_order 4 | = Permute | RequireOrder | ReturnInOrder of string -> 'a 5 | datatype 'a arg_descr 6 | = NoArg of unit -> 'a 7 | | OptArg of (string option -> 'a) * string 8 | | ReqArg of (string -> 'a) * string 9 | type 'a opt_descr = 10 | {desc:'a arg_descr, help:string, long:string list, short:string} 11 | val usageInfo : {header:string, options:'a opt_descr list} -> string 12 | val getOpt : {argOrder:'a arg_order, errFn:string -> unit, 13 | options:'a opt_descr list} 14 | -> string list -> 'a list * string list 15 | end 16 | 17 | structure GetOpt = struct (*[ assumesig GET_OPT ]*) end 18 | -------------------------------------------------------------------------------- /lib/smlnj-lib/Util/HashString.sml: -------------------------------------------------------------------------------- 1 | structure HashString = struct 2 | (*[ assumesig 3 | sig 4 | val hashString : string -> word 5 | val hashSubstring : substring -> word 6 | end 7 | ]*) 8 | end 9 | -------------------------------------------------------------------------------- /lib/smlnj-lib/Util/ORD_KEY.sml: -------------------------------------------------------------------------------- 1 | signature ORD_KEY = sig 2 | type ord_key 3 | val compare : (ord_key * ord_key) -> order 4 | end 5 | -------------------------------------------------------------------------------- /lib/smlnj-lib/Util/ORD_SET.sml: -------------------------------------------------------------------------------- 1 | signature ORD_SET = sig 2 | structure Key : ORD_KEY 3 | type item = Key.ord_key 4 | type set 5 | val empty : set 6 | val singleton : item -> set 7 | val add : (set * item) -> set 8 | val add' : (item * set) -> set 9 | val addList : (set * item list) -> set 10 | val delete : (set * item) -> set 11 | val member : (set * item) -> bool 12 | val isEmpty : set -> bool 13 | val equal : (set * set) -> bool 14 | val compare : (set * set) -> order 15 | val isSubset : (set * set) -> bool 16 | val numItems : set -> int 17 | val listItems : set -> item list 18 | val union : (set * set) -> set 19 | val intersection : (set * set) -> set 20 | val difference : (set * set) -> set 21 | val map : (item -> item) -> set -> set 22 | val app : (item -> unit) -> set -> unit 23 | val foldl : ((item * 'b) -> 'b) -> 'b -> set -> 'b 24 | val foldr : ((item * 'b) -> 'b) -> 'b -> set -> 'b 25 | val filter : (item -> bool) -> set -> set 26 | val exists : (item -> bool) -> set -> bool 27 | val find : (item -> bool) -> set -> item option 28 | end 29 | -------------------------------------------------------------------------------- /lib/smlnj-lib/Util/smlnj-lib.mlb: -------------------------------------------------------------------------------- 1 | SYMBOL.sml 2 | HASH_TABLE.sml 3 | ORD_KEY.sml 4 | ORD_MAP.sml 5 | BinaryMapFn.sml 6 | ORD_SET.sml 7 | BinarySetFn.sml 8 | HashString.sml 9 | GET_OPT.sml 10 | -------------------------------------------------------------------------------- /mlb-path-map: -------------------------------------------------------------------------------- 1 | OBJPTR_REP rep32 2 | HEADER_WORD word32 3 | SEQINDEX_INT int32 4 | DEFAULT_INT int32 5 | DEFAULT_WORD word32 6 | DEFAULT_CHAR char8 7 | DEFAULT_WIDECHAR widechar16 8 | -------------------------------------------------------------------------------- /src/.cvsignore: -------------------------------------------------------------------------------- 1 | .config PM 2 | abcd 3 | errors.log 4 | usefileCM.sml 5 | -------------------------------------------------------------------------------- /src/Cidre/CONFIGURATION-sig.sml: -------------------------------------------------------------------------------- 1 | signature CONFIGURATION = 2 | sig 3 | val etcdir : string 4 | end 5 | -------------------------------------------------------------------------------- /src/Cidre/Configuration.sml: -------------------------------------------------------------------------------- 1 | structure Configuration :> CONFIGURATION = 2 | struct 3 | val etcdir = "/etc" (* A wild guess - Rowan *) 4 | end 5 | -------------------------------------------------------------------------------- /src/Cidre/ENVIRONMENT-sig.sml: -------------------------------------------------------------------------------- 1 | signature ENVIRONMENT = 2 | sig 3 | val getEnvVal : string -> string option 4 | end 5 | -------------------------------------------------------------------------------- /src/Cidre/InfixLib.sml: -------------------------------------------------------------------------------- 1 | (* Handy top level defintions from http://mlton.org/InfixingOperators *) 2 | structure InfixingLib = struct 3 | 4 | infix 3 <\ fun x <\ f = fn y => f (x, y) (* Left section *) 5 | infix 3 \> fun f \> y = f y (* Left application *) 6 | infixr 3 /> fun f /> y = fn x => f (x, y) (* Right section *) 7 | infixr 3 | val op>| = op (* Right pipe *) 14 | 15 | end 16 | -------------------------------------------------------------------------------- /src/Cidre/MLB_FILESYS.sml: -------------------------------------------------------------------------------- 1 | signature MLB_FILESYS = 2 | sig 3 | eqtype unique 4 | val fromFile : string -> string 5 | val change_dir : string -> {cd_old : unit -> unit, file : string} 6 | val getCurrentDir : unit -> string 7 | val cmp : unique * unique -> order 8 | val unique : bool -> string -> unique 9 | end 10 | 11 | (* 12 | 13 | unique b file 14 | 15 | get a unique id on the file file. If b then follow links instead of getting the 16 | unique id of the link. The id is the pair dev_t * ino_t from the stat of the 17 | file. 18 | 19 | *) 20 | -------------------------------------------------------------------------------- /src/Cidre/MlbUtil.sml: -------------------------------------------------------------------------------- 1 | structure MlbUtil :> 2 | sig 3 | val vchat0 : (unit -> bool) -> string -> unit 4 | val quot : string -> string 5 | val warn : string -> unit 6 | val error : string -> 'a 7 | val errors : string list -> 'a 8 | val pp_list : string -> string list -> string 9 | end = 10 | struct 11 | fun pp_list sep nil = "" 12 | | pp_list sep [x] = x 13 | | pp_list sep (x::xs) = x ^ sep ^ pp_list sep xs 14 | 15 | fun quot s = "'" ^ s ^ "'" 16 | 17 | fun warn (s : string) = print ("Warning: " ^ s ^ ".\n") 18 | 19 | local 20 | fun err s = print ("\nError: " ^ s ^ ".\n\n"); 21 | in 22 | fun error (s : string) = (err s; raise Fail "error") 23 | fun errors (ss:string list) = 24 | (app err ss; raise Fail "error") 25 | end 26 | 27 | fun vchat0 (verbose:unit -> bool) s = 28 | if verbose() then print (" ++ " ^ s ^ "\n") 29 | else () 30 | 31 | fun system verbose cmd : unit = 32 | (vchat0 verbose ("Executing command: " ^ cmd) ; 33 | let 34 | val status = OS.Process.system cmd 35 | handle _ => error ("Command failed: " ^ quot cmd) 36 | in if status = OS.Process.failure then 37 | error ("Command failed: " ^ quot cmd) 38 | else () 39 | end 40 | ) 41 | end 42 | 43 | -------------------------------------------------------------------------------- /src/Cidre/cidre.cm: -------------------------------------------------------------------------------- 1 | Group 2 | is 3 | $/basis.cm 4 | 5 | $smlnj/cm.cm 6 | 7 | 8 | BINARYMAP-sig.sml 9 | Binarymap.sml 10 | 11 | ENVIRONMENT-sig.sml 12 | Environment.sml 13 | CONFIGURATION-sig.sml 14 | Configuration.sml 15 | MLB_FILESYS.sml 16 | MlbFileSys.sml 17 | MlbUtil.sml 18 | MLB_PROJECT.sml 19 | MlbProject.sml 20 | 21 | ../sources.cm 22 | 23 | ../cm2mlb/cm2mlb.cm 24 | 25 | (* ../Common/RefineCheck.sml *) 26 | 27 | InfixLib.sml 28 | Cidre.sml 29 | -------------------------------------------------------------------------------- /src/Cidre/environment.mlb: -------------------------------------------------------------------------------- 1 | local 2 | (* $(SML_LIB)/basis/basis.mlb 3 | ../../../basis/kitlib.mlb *) 4 | in 5 | BINARYMAP-sig.sml 6 | BinaryMap.sml 7 | 8 | CONFIGURATION-sig.sml Configuration.sml 9 | ENVIRONMENT-sig.sml Environment.sml 10 | end 11 | -------------------------------------------------------------------------------- /src/Cidre/test.mlb: -------------------------------------------------------------------------------- 1 | local 2 | $(SML_LIB)/basis/basis.mlb 3 | (* basis KitLib = bas ../../../basis/kitlib.mlb end *) 4 | basis Environment = bas environment.mlb end 5 | basis FileSys = bas MLB_FILESYS.sml MlbFileSys.sml end 6 | basis Util = bas MlbUtil.sml end 7 | in 8 | local 9 | open Environment FileSys 10 | in 11 | MLB_PROJECT.sml 12 | local open (* KitLib *) Util Environment 13 | in MlbProject.sml 14 | end 15 | (* ULFILE-sig.sml 16 | UlFile.sml *) 17 | end 18 | (* MLB_PLUGIN.sml 19 | local open (* KitLib *) Util 20 | in MlbMake.sml 21 | end 22 | *) 23 | end 24 | -------------------------------------------------------------------------------- /src/Common/.cvsignore: -------------------------------------------------------------------------------- 1 | CM PM 2 | Elaboration.sml+ 3 | Elaboration.sml- 4 | Elaboration.sml-- 5 | RefDec+.sml 6 | tynames-in-refexp.sml 7 | RefinedEnvironments.sml+ 8 | SemiPermFinMap.sml -------------------------------------------------------------------------------- /src/Common/BASIC_IO.sml: -------------------------------------------------------------------------------- 1 | (*$BASIC_IO*) 2 | signature BASIC_IO = 3 | sig 4 | val dot: unit -> unit 5 | val print: string -> unit 6 | val println: string -> unit 7 | val print': TextIO.outstream -> string -> unit 8 | val println': TextIO.outstream -> string -> unit 9 | 10 | val withSpace: ('a -> unit) -> ('a -> unit) 11 | val withNewline: ('a -> unit) -> ('a -> unit) 12 | 13 | val withDot: ('a -> 'b) -> 'a -> 'b 14 | 15 | val open_in: string -> TextIO.instream 16 | val input: TextIO.instream * int -> string 17 | val close_in: TextIO.instream -> unit 18 | end; 19 | -------------------------------------------------------------------------------- /src/Common/BASIS-sig.sml: -------------------------------------------------------------------------------- 1 | 2 | signature BASIS = 3 | sig 4 | 5 | structure TyName : TYNAME 6 | 7 | type ElabEnv 8 | 9 | type longstrid 10 | 11 | type Basis and InfixBasis and ElabBasis 12 | structure Basis : 13 | sig 14 | val empty : Basis 15 | val mk : InfixBasis * ElabBasis -> Basis 16 | val un : Basis -> InfixBasis * ElabBasis 17 | val plus : Basis * Basis -> Basis 18 | val layout : Basis -> StringTree 19 | 20 | val agree : longstrid list * Basis * (Basis * TyName.Set.Set) -> bool 21 | val enrich : Basis * (Basis * TyName.Set.Set) -> bool 22 | 23 | val initial : Basis 24 | end 25 | 26 | type name 27 | 28 | end -------------------------------------------------------------------------------- /src/Common/BITS/.cvsignore: -------------------------------------------------------------------------------- 1 | Copy\ of\ RefinedEnvironments.sml -------------------------------------------------------------------------------- /src/Common/BITS/ModuleEnvironments-no-refinements.sml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rowandavies/sml-cidre/dbd797af94eb38603d5613561b2edf8d1270e3f9/src/Common/BITS/ModuleEnvironments-no-refinements.sml -------------------------------------------------------------------------------- /src/Common/BITS/ModuleEnvironments.sml+: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rowandavies/sml-cidre/dbd797af94eb38603d5613561b2edf8d1270e3f9/src/Common/BITS/ModuleEnvironments.sml+ -------------------------------------------------------------------------------- /src/Common/BITS/RefinedEnvironments-simpler-slower-expandConj.sml: -------------------------------------------------------------------------------- 1 | 2 | fun expandConj (_, []) = Crash.impossible "RefinedEnvironment.expandConj(1)" 3 | | expandConj (con, sortname::sortnames) = 4 | case lookupR (R, sortname) 5 | of NONE => Crash.impossible "RefinedEnvironments.expandConj(2)" 6 | | SOME RC => 7 | (case lookupRC (RC, con) 8 | of NONE => [] (* con absent from datasort body. *) 9 | of NONE => [] 10 | | SOME NONE => (* con present and has no argument. *) 11 | (case sortnames of [] => [NONE] 12 | | _ => expandConj (con, sortnames)) 13 | | SOME (SOME sortfcn_list) => (* con present with argument. *) 14 | case sortnames of [] => map SOME sortfcn_list 15 | | _ => 16 | let val expanded_sortnames = expandConj (con, sortnames) 17 | val conj_sfcn = RO.conjSortFcn conjSN 18 | fun conj_exp_sns sf' = map (fn SOME sf => SOME (conj_sfcn (sf, sf'))) 19 | expanded_sortnames 20 | in 21 | ListHacks.flatten (map conj_exp_sns sortfcn_list) 22 | end) 23 | 24 | -------------------------------------------------------------------------------- /src/Common/CRASH-sig.sml: -------------------------------------------------------------------------------- 1 | (*$CRASH*) 2 | 3 | (* CRASH signature: used for internal consistency errors and so on. *) 4 | signature CRASH = 5 | sig 6 | val assert: (string * bool) -> unit 7 | val impossible: string -> 'a 8 | val unimplemented: string -> 'a 9 | 10 | exception CRASH (* So we can catch it and reenter 11 | at top-level. *) 12 | end; 13 | -------------------------------------------------------------------------------- /src/Common/CoerceRefInfo.sml: -------------------------------------------------------------------------------- 1 | (* Coerce RefInfo so that functor ErrorTraverse can be applied to it. 2 | 3 | - Rowan 6jul01 *) 4 | 5 | functor CoerceRefInfo(RefInfo : REF_INFO) 6 | : E_OR_R_INFO where type ElabInfo = RefInfo.RefInfo 7 | and type ErrorInfo.ErrorInfo = RefInfo.RefineErrorInfo.ErrorInfo 8 | and type ErrorInfo.Report = RefInfo.RefineErrorInfo.Report 9 | and type ErrorInfo.ErrorCode.ErrorCode = 10 | RefInfo.RefineErrorInfo.ErrorCode.ErrorCode 11 | and type StringTree = RefInfo.StringTree 12 | = struct 13 | type ElabInfo = RefInfo.RefInfo 14 | structure ErrorInfo = RefInfo.RefineErrorInfo 15 | type ErrorInfo = RefInfo.RefineErrorInfo.ErrorInfo 16 | type StringTree = RefInfo.StringTree 17 | val report_SourceInfo = RefInfo.report_SourceInfo 18 | val to_ErrorInfo = RefInfo.to_RefineErrorInfo 19 | end 20 | -------------------------------------------------------------------------------- /src/Common/Crash.sml: -------------------------------------------------------------------------------- 1 | 2 | functor Crash(structure BasicIO: BASIC_IO): CRASH = 3 | struct 4 | exception CRASH 5 | 6 | fun impossible msg = 7 | let 8 | val msg = "Impossible: " ^ msg 9 | in 10 | BasicIO.println msg; 11 | raise CRASH 12 | end 13 | 14 | fun assert(msg, condition) = 15 | if condition then () 16 | else 17 | let 18 | val msg = "Assert fails: " ^ msg 19 | in 20 | BasicIO.println msg; 21 | raise CRASH 22 | end 23 | 24 | fun unimplemented msg = 25 | let 26 | val msg = "Unimplemented: " ^ msg 27 | in 28 | BasicIO.println msg; 29 | raise CRASH 30 | end 31 | end; 32 | -------------------------------------------------------------------------------- /src/Common/DEC_GRAMMAR.sml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rowandavies/sml-cidre/dbd797af94eb38603d5613561b2edf8d1270e3f9/src/Common/DEC_GRAMMAR.sml -------------------------------------------------------------------------------- /src/Common/DFInfo.sml: -------------------------------------------------------------------------------- 1 | (* Derived form information *) 2 | 3 | (*$DFInfo: PRETTYPRINT INFIX_BASIS DF_INFO*) 4 | 5 | functor DFInfo (structure PrettyPrint : PRETTYPRINT 6 | structure InfixBasis : INFIX_BASIS) : DF_INFO = 7 | struct 8 | type InfixBasis = InfixBasis.Basis 9 | datatype DFInfo = UNITEXP_df | TUPLE_df | CASE_df | IF_df | ORELSE_df 10 | | FUN_df | VALIT_df | INFIX_df | INFIX_BASIS of InfixBasis 11 | 12 | fun string UNITEXP_df = "UNITEXP" 13 | | string TUPLE_df = "TUPLE" 14 | | string CASE_df = "CASE" 15 | | string IF_df = "IF_df" 16 | | string ORELSE_df = "ORELSE_df" 17 | | string FUN_df = "FUN_df" 18 | | string VALIT_df = "VALIT_df" 19 | | string INFIX_df = "INFIX_df" 20 | | string (INFIX_BASIS _) = "INFIX_BASIS" 21 | val layout = StringTree.LEAF o string 22 | end; 23 | -------------------------------------------------------------------------------- /src/Common/DF_INFO.sml: -------------------------------------------------------------------------------- 1 | (*DFInfo is a part of the ParseInfo. It gives derived form 2 | information. See PARSE_INFO for an overview of the different 3 | kinds of info.*) 4 | 5 | (* It also makes it possible to save an infix basis in a functor 6 | * binding node. This is to support reelaboration of functor bodies. 7 | *) 8 | 9 | (*$DF_INFO *) 10 | 11 | signature DF_INFO = 12 | sig 13 | type InfixBasis 14 | datatype DFInfo = UNITEXP_df | TUPLE_df | CASE_df | IF_df | ORELSE_df 15 | | FUN_df | VALIT_df | INFIX_df | INFIX_BASIS of InfixBasis 16 | 17 | val string : DFInfo -> string 18 | val layout : DFInfo -> StringTree.t 19 | end; 20 | -------------------------------------------------------------------------------- /src/Common/DecGrammar.sml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rowandavies/sml-cidre/dbd797af94eb38603d5613561b2edf8d1270e3f9/src/Common/DecGrammar.sml -------------------------------------------------------------------------------- /src/Common/ELABDEC-sig.sml: -------------------------------------------------------------------------------- 1 | (* Elaborate a Core Language Declaration, dec *) 2 | 3 | (*$ELABDEC*) 4 | 5 | signature ELABDEC = 6 | sig 7 | type Context and Env and Type and TyName 8 | eqtype id 9 | 10 | type PreElabDec and PostElabDec 11 | type PreElabTy and PostElabTy 12 | 13 | val found_error : bool ref (* set each time an error is found *) 14 | 15 | val elab_dec : Context * PreElabDec -> TyName list * Env * PostElabDec 16 | and elab_ty : Context * PreElabTy -> Type option * PostElabTy 17 | and elab_srt : Context * PreElabTy -> Type option * PostElabTy 18 | 19 | (* elab_ty returns `NONE' if an error occurred when elborating the 20 | * type expression. The reason we do things this way is that 21 | * errors are dealt with in two different ways depending on the 22 | * construct the type expression is part of. *) 23 | 24 | type PreElabDatBind and PostElabDatBind and TyEnv 25 | 26 | val datasort_TE : Context * PreElabDatBind -> TyEnv 27 | val elab_datbind_s : Context * PreElabDatBind -> PostElabDatBind 28 | 29 | end; 30 | -------------------------------------------------------------------------------- /src/Common/ELABTOPDEC-sig.sml: -------------------------------------------------------------------------------- 1 | (* Elaborate a topdec *) 2 | 3 | (*$ELABTOPDEC*) 4 | signature ELABTOPDEC = 5 | sig 6 | type StaticBasis 7 | 8 | type PreElabTopdec and PostElabTopdec 9 | 10 | type prjid = string 11 | 12 | val elab_topdec: prjid * StaticBasis * PreElabTopdec -> StaticBasis * PostElabTopdec 13 | 14 | (* type StringTree *) 15 | val layoutStaticBasis: StaticBasis -> StringTree.t 16 | end; 17 | -------------------------------------------------------------------------------- /src/Common/ERROR_CODE.sml: -------------------------------------------------------------------------------- 1 | (*$ERROR_CODE*) 2 | signature ERROR_CODE = (* Support for error testing. *) 3 | sig 4 | type ErrorCode and ErrorInfo 5 | val from_ErrorInfo : ErrorInfo -> ErrorCode 6 | val error_code_parse : ErrorCode 7 | val pr : ErrorCode -> string 8 | end 9 | -------------------------------------------------------------------------------- /src/Common/ERROR_TRAVERSE.sml: -------------------------------------------------------------------------------- 1 | (*$ERROR_TRAVERSE: ERROR_CODE*) 2 | signature ERROR_TRAVERSE = 3 | sig 4 | structure ErrorCode : ERROR_CODE 5 | 6 | type topdec 7 | type Report 8 | 9 | datatype result = SUCCESS 10 | | FAILURE of Report * ErrorCode.ErrorCode list 11 | 12 | val traverse: topdec -> result 13 | end; 14 | -------------------------------------------------------------------------------- /src/Common/E_OR_R_INFO.sml: -------------------------------------------------------------------------------- 1 | (* A minimal signature matched by both ElabInfo and (coerced) RefInfo for use 2 | by ErrorTraverse. *) 3 | 4 | signature E_OR_R_INFO = 5 | sig 6 | (*type supplied by this module:*) 7 | type ElabInfo 8 | 9 | structure ErrorInfo : sig 10 | type ErrorInfo 11 | type Report 12 | val report : ErrorInfo -> Report 13 | structure ErrorCode : ERROR_CODE 14 | sharing type ErrorCode.ErrorInfo = ErrorInfo 15 | end 16 | 17 | type ErrorInfo = ErrorInfo.ErrorInfo 18 | type StringTree 19 | val report_SourceInfo : ElabInfo -> ErrorInfo.Report 20 | val to_ErrorInfo : ElabInfo -> ErrorInfo option 21 | end; 22 | -------------------------------------------------------------------------------- /src/Common/FUNID-sig.sml: -------------------------------------------------------------------------------- 1 | (* Functor identifiers - Definition v3 page 10 *) 2 | 3 | (*$FUNID*) 4 | 5 | signature FUNID = 6 | sig 7 | eqtype funid 8 | 9 | val mk_FunId: string -> funid (* NEW PARSER *) 10 | and pr_FunId: funid -> string 11 | 12 | val < : funid * funid -> bool (* Used for top-level printout *) 13 | end; 14 | -------------------------------------------------------------------------------- /src/Common/FunId.sml: -------------------------------------------------------------------------------- 1 | (* Functor identifiers - Definition v3 page 10 *) 2 | 3 | (*$FunId: FUNID*) 4 | functor FunId(): FUNID = 5 | struct 6 | datatype funid = FUNID of string 7 | 8 | val mk_FunId = FUNID 9 | fun pr_FunId(FUNID str) = str 10 | 11 | val op < = fn (FUNID str1, FUNID str2) => str1 < str2 12 | end; 13 | -------------------------------------------------------------------------------- /src/Common/INFIXBASIS-sig.sml: -------------------------------------------------------------------------------- 1 | (*$INFIX_BASIS*) 2 | signature INFIX_BASIS = 3 | sig 4 | eqtype id 5 | type Basis 6 | 7 | val emptyB: Basis 8 | 9 | datatype InfixEntry = NONFIX | INFIX of int | INFIXR of int 10 | 11 | val new: id list * InfixEntry -> Basis 12 | val lookup: Basis -> id -> InfixEntry 13 | 14 | val compose: Basis * Basis -> Basis 15 | val eq: Basis * Basis -> bool 16 | 17 | type Report 18 | val reportBasis: Basis -> Report 19 | 20 | (* type StringTree *) 21 | val layoutBasis: Basis -> StringTree.t 22 | end; 23 | -------------------------------------------------------------------------------- /src/Common/IO_STREAMS.sml: -------------------------------------------------------------------------------- 1 | (* This is runtime stuff: I/O streams. We represent streams as numbers, and 2 | let the prelude abstract them into the I/O stream type. Input and output 3 | streams are distinct (i.e. they might use the same numbers); 0 means 4 | both std_in and std_out. *) 5 | 6 | (*$IO_STREAMS*) 7 | signature IO_STREAMS = 8 | sig 9 | (* A set of current streams (rather than having implicit state in the 10 | package, although that's unavoidable because of the "real" I/O 11 | streams open in the host package. *) 12 | 13 | type Streams 14 | val initialStreams: Streams 15 | 16 | (* Create and register a new stream - note the failure function: *) 17 | 18 | val openIn: Streams -> (string * (unit -> 'a)) -> int * Streams 19 | val openOut: Streams -> (string * (unit -> 'a)) -> int * Streams 20 | 21 | (* Get the "real" stream associated with a stream number; needed for 22 | reading, writing, and closing. . *) 23 | 24 | val inputStream: Streams -> int -> instream 25 | val outputStream: Streams -> int -> outstream 26 | end; 27 | -------------------------------------------------------------------------------- /src/Common/KitOnKit.sml: -------------------------------------------------------------------------------- 1 | val _ = K.kitexe(CommandLine.name(),CommandLine.arguments()) -------------------------------------------------------------------------------- /src/Common/LAB-sig.sml: -------------------------------------------------------------------------------- 1 | (* Labels - Definition v3 page 4 *) 2 | 3 | (*$LAB*) 4 | signature LAB = 5 | sig 6 | eqtype lab 7 | 8 | val mk_IdentLab: string -> lab 9 | val mk_IntegerLab: int -> lab (* NEW PARSER *) 10 | 11 | val < : lab * lab -> bool 12 | val is_LabN: lab * int -> bool (* Needed when examining records 13 | for tupleness. *) 14 | 15 | val pr_Lab: lab -> string 16 | end; 17 | -------------------------------------------------------------------------------- /src/Common/LIST_HACKS.sml: -------------------------------------------------------------------------------- 1 | (*$LIST_HACKS*) 2 | (* LIST_HACKS provides operations to treat lists as sets. This is temporary, 3 | since the elaboration phases haven't been ported to use the SML Library's 4 | sets yet. *) 5 | 6 | signature LIST_HACKS = 7 | sig 8 | val union: ''a list * ''a list -> ''a list 9 | val unionEq: ('a * 'a -> bool) -> 'a list * 'a list -> 'a list 10 | val intersect: ''a list * ''a list -> ''a list 11 | val minus: ''a list * ''a list -> ''a list 12 | val eqSet: ''a list * ''a list -> bool 13 | val reverse: 'a list -> 'a list 14 | (* add an element to a list of maximal elements wrt a partial order *) 15 | val addMax: ('a * 'a -> bool) -> 'a * 'a list -> 'a list 16 | val flatten: 'a list list -> 'a list 17 | val foldl': ('a * 'a -> 'a) -> 'a list -> 'a 18 | val foldr': ('a * 'a -> 'a) -> 'a list -> 'a 19 | val stringSep: string -> string -> string -> ('a -> string) -> 'a list -> string 20 | end; 21 | -------------------------------------------------------------------------------- /src/Common/LIST_SORT.sml: -------------------------------------------------------------------------------- 1 | (*$LIST_SORT*) 2 | signature LIST_SORT = 3 | sig 4 | val sort : ('a * 'a -> bool) -> 'a list -> 'a list 5 | 6 | (* sort lt l sorts l according to the ordering lt *) 7 | end; -------------------------------------------------------------------------------- /src/Common/Lab.sml: -------------------------------------------------------------------------------- 1 | (* Labels - Definition v3 page 4 *) 2 | 3 | functor Lab(): LAB = 4 | struct 5 | 6 | datatype lab = LAB of string 7 | 8 | (* Ordering of labels requires a rethink, because we have to be careful 9 | when printing tuple types and values. `Lab.<' should behave correctly 10 | for numeric labels (2 < 10) and still give an unambiguous ordering 11 | for others (a2 > a10). We'd also better be convinced that the 12 | ordering is transitive, or things could start going horribly wrong. *) 13 | 14 | val op < = fn (LAB str1, LAB str2) => 15 | (case (Int.fromString str1, Int.fromString str2) 16 | of (SOME i1, SOME i2) => i1 < i2 17 | | _ => str1 < str2) 18 | handle _ => str1 < str2 (* fromString may raise Overflow *) 19 | 20 | fun is_LabN(LAB str, i) = 21 | (case Int.fromString str 22 | of SOME i' => (i = i') 23 | | _ => false) 24 | handle _ => false 25 | 26 | fun pr_Lab(LAB str) = str 27 | 28 | val mk_IdentLab = LAB 29 | val mk_IntegerLab = LAB o Int.toString 30 | end; 31 | -------------------------------------------------------------------------------- /src/Common/ListSort.sml: -------------------------------------------------------------------------------- 1 | (*$ListSort: LIST_SORT*) 2 | functor ListSort(): LIST_SORT = 3 | struct 4 | (* val sort : ('a * 'a -> bool) -> 'a list -> 'a list*) 5 | (* sort lt l sorts l according to the ordering lt *) 6 | 7 | (* We use top-down merge sort from Paulson *) 8 | 9 | exception Take and Drop 10 | 11 | fun take(xs, 0) = [] 12 | | take(x::xs, n) = x :: take(xs, n-1) 13 | | take _ = raise Take 14 | 15 | fun drop(xs, 0) = xs 16 | | drop(x::xs, n) = drop(xs, n-1) 17 | | drop _ = raise Drop 18 | 19 | fun sort lt = 20 | let fun merge([], ys) = ys 21 | | merge(xs, []) = xs 22 | | merge(l1 as x::xs, l2 as y::ys) = 23 | if lt(x,y) then x::merge(xs, l2) 24 | else y::merge(l1,ys) 25 | fun tmergesort[] = [] 26 | | tmergesort[x] = [x] 27 | | tmergesort xs = 28 | let val k = List.size xs div 2 29 | in merge(tmergesort(take(xs, k)), 30 | tmergesort(drop(xs, k))) 31 | end 32 | in 33 | tmergesort 34 | end; 35 | end; -------------------------------------------------------------------------------- /src/Common/MAP_DEC_INFO.sml: -------------------------------------------------------------------------------- 1 | 2 | signature MAP_DEC_INFO = 3 | sig 4 | structure IG : DEC_GRAMMAR 5 | structure OG : DEC_GRAMMAR 6 | where type lab = IG.lab 7 | where type scon = IG.scon 8 | where type strid = IG.strid 9 | where type longid = IG.longid 10 | where type id = IG.id 11 | where type tyvar = IG.tyvar 12 | where type TyVar.Variance = IG.TyVar.Variance 13 | where type tycon = IG.tycon 14 | where type longtycon = IG.longtycon 15 | where type longstrid = IG.longstrid 16 | val map_dec_info : (IG.info -> OG.info) -> IG.dec -> OG.dec 17 | val map_ty_info : (IG.info -> OG.info) -> IG.ty -> OG.ty 18 | val map_datbind_info : (IG.info -> OG.info) -> IG.datbind -> OG.datbind 19 | end 20 | -------------------------------------------------------------------------------- /src/Common/ModuleEnvironments.sml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rowandavies/sml-cidre/dbd797af94eb38603d5613561b2edf8d1270e3f9/src/Common/ModuleEnvironments.sml -------------------------------------------------------------------------------- /src/Common/ModuleStatObject.sml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rowandavies/sml-cidre/dbd797af94eb38603d5613561b2edf8d1270e3f9/src/Common/ModuleStatObject.sml -------------------------------------------------------------------------------- /src/Common/ORDSET.sml: -------------------------------------------------------------------------------- 1 | (*$ORDSET*) 2 | signature ORDSET = 3 | sig 4 | type item 5 | val lt: item * item -> bool 6 | 7 | type StringTree 8 | val show: item-> StringTree 9 | end 10 | -------------------------------------------------------------------------------- /src/Common/OVERLOADING_INFO.sml: -------------------------------------------------------------------------------- 1 | (*OverloadingInfo is part of the ElabInfo. See ELAB_INFO for an 2 | overview of the different kinds of info.*) 3 | 4 | signature OVERLOADING_INFO = 5 | sig 6 | type TyVar 7 | type RecType 8 | 9 | datatype OverloadingInfo = 10 | UNRESOLVED_IDENT of TyVar 11 | | UNRESOLVED_DOTDOTDOT of RecType 12 | | RESOLVED_INT 13 | | RESOLVED_REAL 14 | | RESOLVED_STRING 15 | | RESOLVED_CHAR 16 | | RESOLVED_WORD8 17 | | RESOLVED_WORD 18 | 19 | val string : OverloadingInfo -> string 20 | val layout : OverloadingInfo -> StringTree.t 21 | end; 22 | -------------------------------------------------------------------------------- /src/Common/OverloadingInfo.sml: -------------------------------------------------------------------------------- 1 | (* Overloading information *) 2 | 3 | functor OverloadingInfo (structure StatObject : STATOBJECT 4 | structure PrettyPrint : PRETTYPRINT 5 | ) : OVERLOADING_INFO = 6 | struct 7 | type RecType = StatObject.RecType 8 | type TyVar = StatObject.TyVar 9 | 10 | datatype OverloadingInfo = 11 | UNRESOLVED_IDENT of TyVar 12 | | UNRESOLVED_DOTDOTDOT of RecType 13 | | RESOLVED_INT 14 | | RESOLVED_REAL 15 | | RESOLVED_STRING 16 | | RESOLVED_CHAR 17 | | RESOLVED_WORD8 18 | | RESOLVED_WORD 19 | 20 | fun string (UNRESOLVED_IDENT tyvars) = "UNRESOLVED_IDENT" 21 | | string (UNRESOLVED_DOTDOTDOT tau) = "UNRESOLVED_DOTDOTDOT" 22 | | string RESOLVED_INT = "RESOLVED_INT" 23 | | string RESOLVED_REAL = "RESOLVED_REAL" 24 | | string RESOLVED_STRING = "RESOLVED_STRING" 25 | | string RESOLVED_CHAR = "RESOLVED_CHAR" 26 | | string RESOLVED_WORD8 = "RESOLVED_WORD8" 27 | | string RESOLVED_WORD = "RESOLVED_WORD" 28 | 29 | val layout = StringTree.LEAF o string 30 | 31 | end; 32 | -------------------------------------------------------------------------------- /src/Common/PARSE_ELAB.sml: -------------------------------------------------------------------------------- 1 | (*$PARSE_ELAB: ERROR_CODE*) 2 | 3 | signature PARSE_ELAB = 4 | sig 5 | structure ErrorCode : ERROR_CODE 6 | 7 | type Report and InfixBasis and ElabBasis and topdec 8 | 9 | type prjid = string 10 | 11 | datatype Result = SUCCESS of {report: Report, infB: InfixBasis, 12 | elabB: ElabBasis, topdec: topdec} 13 | | FAILURE of Report * ErrorCode.ErrorCode list 14 | 15 | val parse_elab : {infB: InfixBasis, elabB: ElabBasis, 16 | prjid: prjid, file: string} -> Result 17 | 18 | end -------------------------------------------------------------------------------- /src/Common/QUASI_ENV.sml: -------------------------------------------------------------------------------- 1 | (* Environment with a persistent part to be used accross program units 2 | * ('a map) and a combined persistent/non-persistent (hashing) map to 3 | * be used locally for each program unit ('a qmap). 4 | *) 5 | 6 | signature QUASI_ENV = 7 | sig 8 | 9 | structure Env : MONO_FINMAP 10 | 11 | type '_a qmap (* combined map *) 12 | type 'a map sharing type Env.map = map (* persistent map *) 13 | 14 | type dom sharing type Env.dom = dom 15 | 16 | val mk : int -> '_a map -> '_a qmap 17 | val lookup : '_a qmap -> dom -> '_a option 18 | val update : dom * '_a * '_a qmap -> unit 19 | 20 | val Fold : (((int * '_b) * 'a) -> 'a) -> 'a -> '_b qmap -> 'a 21 | 22 | val combine: 'a map * 'a qmap -> 'a qmap 23 | 24 | val layout : {start:string,finish:string,eq:string,sep:string} -> 25 | (int -> StringTree.t) -> ('_a -> StringTree.t) -> '_a qmap -> StringTree.t 26 | end 27 | 28 | -------------------------------------------------------------------------------- /src/Common/REFDEC-sig.sml: -------------------------------------------------------------------------------- 1 | (*$REFDEC*) 2 | 3 | signature REFDEC = 4 | sig 5 | structure Comp : COMP 6 | 7 | type 'a Comp = bool -> 'a * Comp.Error list 8 | 9 | type Context 10 | and TyNameEnv 11 | and Env 12 | and Sort 13 | 14 | type PostElabDec 15 | type PostElabTy 16 | type PostElabDatBind 17 | 18 | val howMuchIsTooMuch : int ref 19 | 20 | val ref_dec : Context * PostElabDec -> (TyNameEnv * Env) Comp 21 | val ref_ty_covar : Context * PostElabTy -> Sort Comp 22 | 23 | val ref_datsortbind_complete : Context * PostElabDatBind -> (TyNameEnv * Env) Comp 24 | end; 25 | -------------------------------------------------------------------------------- /src/Common/REFINE_ERROR_INFO.sml: -------------------------------------------------------------------------------- 1 | (* RefineError information, including source-info *) 2 | 3 | (* 4 | $File: Common/REFINE_ERROR_INFO.sml $ 5 | $Date: 2002/02/05 15:02:49 $ 6 | $Revision: 1.6 $ 7 | $Locker: $ 8 | *) 9 | 10 | (*$REFINE_ERROR_INFO*) 11 | 12 | signature REFINE_ERROR_INFO = 13 | sig 14 | type Sort and SortScheme and Type and longsortcon and longid 15 | and SourceInfo 16 | type Report 17 | 18 | datatype ErrorInfo = 19 | LOOKUP_LONGCON of longid 20 | | LOOKUP_LONGSORTCON of longsortcon 21 | | SORTING of Sort 22 | | NOT_SUBSORT of Sort * Sort 23 | | CANT_APPLY of Sort 24 | | REDEX 25 | | INCOMPATIBLE of SortScheme * SortScheme 26 | | WRONG_TYPE of Sort * Type 27 | | SHADOWED of longsortcon 28 | | VARIANCE 29 | | WRONG_ARITY of {expected: int, actual: int} 30 | | NOT_COVARIANT 31 | | MULTIPLE_BINDINGS 32 | | NOT_UNIQUE 33 | | SHARING_REFINEMENTS_DIFFER 34 | 35 | (* warnings *) 36 | | UNMATCHED of Sort 37 | | TOO_MUCH 38 | 39 | type Error = SourceInfo * ErrorInfo 40 | 41 | val report: Error -> Report 42 | end; 43 | -------------------------------------------------------------------------------- /src/Common/REFINE_ERROR_TRAVERSE.sml: -------------------------------------------------------------------------------- 1 | (*$REFINE_ERROR_TRAVERSE*) 2 | signature REFINE_ERROR_TRAVERSE = 3 | sig 4 | type topdec 5 | type Report 6 | 7 | datatype result = SUCCESS 8 | | FAILURE of Report 9 | 10 | val traverse: topdec -> result 11 | end; 12 | -------------------------------------------------------------------------------- /src/Common/REFTOPDEC-sig.sml: -------------------------------------------------------------------------------- 1 | (*$REFTOPDEC*) 2 | 3 | signature REFTOPDEC = 4 | sig 5 | structure Comp : COMP 6 | 7 | type Basis 8 | type PostElabTopdec 9 | 10 | val ref_topdec: Basis * PostElabTopdec -> Basis Comp.Comp 11 | 12 | end; 13 | -------------------------------------------------------------------------------- /src/Common/REPORT-sig.sml: -------------------------------------------------------------------------------- 1 | (* Reporting of errors, binding, and so on. Tidier than the stuff 2 | generated by the pretty-printer. *) 3 | 4 | signature REPORT = 5 | sig 6 | type Report (* Some lines of text for the user. *) 7 | val null: Report (* Nothing to report. *) 8 | val line: string -> Report (* One line of text. *) 9 | val // : Report * Report -> Report 10 | val flatten: Report list -> Report 11 | val indent: int * Report -> Report 12 | val adjust: int * Report -> Report 13 | val decorate: string * Report -> Report 14 | (*decorate s report = indent report in a flashy way 15 | which puts a s in front of the first line and indents 16 | the rest. If there are no lines in report, return s 17 | as the report.*) 18 | val print: Report -> unit (* Output on std_out *) 19 | val print' : Report -> TextIO.outstream -> unit (* Output on outstream *) 20 | end; 21 | -------------------------------------------------------------------------------- /src/Common/RefineInfo.sml: -------------------------------------------------------------------------------- 1 | functor RefineInfo (structure ParseInfo : PARSE_INFO 2 | structure ErrorInfo : ERROR_INFO 3 | sharing type ErrorInfo.Report = ParseInfo.SourceInfo.Report 4 | structure RefineErrorInfo : REFINE_ERROR_INFO 5 | structure TypeInfo : TYPE_INFO 6 | structure SortInfo: SORT_INFO 7 | structure OverloadingInfo : OVERLOADING_INFO 8 | structure PrettyPrint : PRETTYPRINT 9 | sharing type ParseInfo.StringTree = TypeInfo.StringTree 10 | = OverloadingInfo.StringTree = PrettyPrint.StringTree 11 | = SortInfo.StringTree 12 | structure Crash : CRASH 13 | ) : ELAB_INFO = 14 | -------------------------------------------------------------------------------- /src/Common/SCON-sig.sml: -------------------------------------------------------------------------------- 1 | (* special constants - Definition v3 page 3 *) 2 | 3 | (* I'd like two views of SCON, one with the datatype hidden, but that seems 4 | to cause Poly/ML problems with the local/sharing/open stuff. *) 5 | 6 | signature SCON = 7 | sig 8 | datatype scon = INTEGER of int 9 | | WORD of int 10 | | STRING of string 11 | | CHAR of int 12 | | REAL of string 13 | 14 | val eq : scon * scon -> bool 15 | val lt : scon * scon -> bool 16 | 17 | val pr_scon: scon -> string 18 | end; 19 | -------------------------------------------------------------------------------- /src/Common/SCon.sml: -------------------------------------------------------------------------------- 1 | (* special constants - Definition v3 page 3 *) 2 | 3 | functor SCon(): SCON = 4 | struct 5 | 6 | datatype scon = INTEGER of int | STRING of string | REAL of string 7 | | WORD of int | CHAR of int 8 | 9 | (*INTEGER < STRING < REAL < WORD < CHAR:*) 10 | fun ord (INTEGER _) = 0 11 | | ord (STRING _) = 1 12 | | ord (REAL _) = 2 13 | | ord (WORD _) = 3 14 | | ord (CHAR _) = 4 15 | fun lt (INTEGER i1, INTEGER i2) = i1 < i2 16 | | lt (STRING s1, STRING s2) = s1 < s2 17 | | lt (REAL r1, REAL r2) = r1 < r2 18 | | lt (WORD i1, WORD i2) = i1 < i2 19 | | lt (CHAR i1, CHAR i2) = i1 < i2 20 | | lt (scon1, scon2) = ord scon1 < ord scon2 21 | 22 | fun pr_scon(INTEGER i) = Int.toString i 23 | | pr_scon(WORD i) = Int.toString i 24 | | pr_scon(STRING s) = "\"" ^ String.toString s ^ "\"" 25 | | pr_scon(CHAR i) = "#\"" ^ str(chr i) ^ "\"" 26 | | pr_scon(REAL r) = r 27 | 28 | fun eq (INTEGER i1, INTEGER i2) = i1 = i2 29 | | eq (WORD w1, WORD w2) = w1 = w2 30 | | eq (STRING s1, STRING s2) = s1 = s2 31 | | eq (CHAR c1, CHAR c2) = c1 = c2 32 | | eq (REAL r1, REAL r2) = (r1 = r2) 33 | | eq _ = false 34 | 35 | end; 36 | -------------------------------------------------------------------------------- /src/Common/SIGID-sig.sml: -------------------------------------------------------------------------------- 1 | (* Signature identifiers - Definition v3 page 10 *) 2 | 3 | (*$SIGID*) 4 | signature SIGID = 5 | sig 6 | eqtype sigid 7 | 8 | val mk_SigId: string -> sigid (* NEW PARSER *) 9 | and pr_SigId : sigid -> string 10 | 11 | val < : sigid * sigid -> bool (* Used for top-level printout *) 12 | end; 13 | -------------------------------------------------------------------------------- /src/Common/SMLofNJOnKit.sml: -------------------------------------------------------------------------------- 1 | structure SMLofNJ = 2 | struct 3 | structure SysInfo = 4 | struct 5 | fun getHostArch() = "HPPA" 6 | fun getOSName() = "HPUX" 7 | end 8 | fun exportFn(kitbinkit_path,kitexe) = print "SMLofNJ.exportFn not implemented" 9 | end -------------------------------------------------------------------------------- /src/Common/SORTCON-sig.sml: -------------------------------------------------------------------------------- 1 | (* sort constructors *) 2 | 3 | (* 4 | $File: Common/SORTCON.sml $ 5 | $Date: 2004/09/17 22:35:51 $ 6 | $Revision: 1.1 $ 7 | $Locker: $ 8 | *) 9 | 10 | (*$SORTCON*) 11 | signature SORTCON = 12 | sig 13 | eqtype tycon 14 | eqtype longtycon 15 | eqtype strid 16 | 17 | eqtype sortcon 18 | eqtype longsortcon 19 | 20 | val mk_SortCon: string -> sortcon 21 | val mk_TypeSortCon: tycon -> sortcon 22 | 23 | val mk_LongSortCon: string list -> longsortcon 24 | val mk_TypeLongSortCon: longtycon -> longsortcon 25 | 26 | val implode_LongSortCon : strid list * sortcon -> longsortcon 27 | and explode_LongSortCon : longsortcon -> strid list * sortcon 28 | 29 | val sortcon_INT : sortcon 30 | and sortcon_REAL : sortcon 31 | and sortcon_STRING : sortcon 32 | and sortcon_EXN : sortcon 33 | and sortcon_REF : sortcon 34 | and sortcon_BOOL : sortcon 35 | and sortcon_LIST : sortcon 36 | and sortcon_INSTREAM : sortcon 37 | and sortcon_OUTSTREAM : sortcon 38 | and sortcon_UNIT : sortcon 39 | 40 | val pr_SortCon : sortcon -> string 41 | val pr_LongSortCon : longsortcon -> string 42 | 43 | val < : sortcon * sortcon -> bool (* Needed to order 44 | top-level printout. *) 45 | end; 46 | -------------------------------------------------------------------------------- /src/Common/SORTVAR-sig.sml: -------------------------------------------------------------------------------- 1 | (* sort variables *) 2 | (* NOT USED: in RML/Kit3, TYVAR is used instead *) 3 | 4 | 5 | (*$SORTVAR*) 6 | signature SORTVAR = 7 | sig 8 | eqtype SyntaxSortVar 9 | datatype Variance = COVARIANT | CONTRAVARIANT | IGNORED | MIXED 10 | 11 | val mk_SortVar: string -> SyntaxSortVar (* NEW PARSER *) 12 | and pr_sortvar: SyntaxSortVar -> string 13 | 14 | val variance : SyntaxSortVar -> Variance 15 | val variancePrefix : Variance -> string 16 | 17 | val covariant : Variance -> bool 18 | val contravariant : Variance -> bool 19 | 20 | val join_variance : Variance * Variance -> Variance 21 | 22 | end; 23 | -------------------------------------------------------------------------------- /src/Common/SOURCE_INFO.sml: -------------------------------------------------------------------------------- 1 | (*SourceInfo is a part of the ParseInfo. See PARSE_INFO for an 2 | overview of the different kinds of info.*) 3 | 4 | (*$SOURCE_INFO*) 5 | 6 | signature SOURCE_INFO = 7 | sig 8 | (*type supplied by this module:*) 9 | type SourceInfo 10 | 11 | (*types imported from other modules:*) 12 | type pos (*from LexBasics, I think*) 13 | type Report 14 | 15 | val from_positions : pos -> pos -> SourceInfo 16 | val to_positions : SourceInfo -> pos * pos 17 | 18 | val report : SourceInfo -> Report 19 | val layout : SourceInfo -> StringTree.t 20 | end; 21 | -------------------------------------------------------------------------------- /src/Common/STATOBJECT-sig.sml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rowandavies/sml-cidre/dbd797af94eb38603d5613561b2edf8d1270e3f9/src/Common/STATOBJECT-sig.sml -------------------------------------------------------------------------------- /src/Common/STRID-sig.sml: -------------------------------------------------------------------------------- 1 | (* Structure identifiers *) 2 | 3 | signature STRID = 4 | sig 5 | eqtype strid 6 | eqtype longstrid 7 | 8 | val mk_StrId: string -> strid (* NEW PARSER *) 9 | val mk_LongStrId: string list -> longstrid (* NEW PARSER *) 10 | val inventStrId: unit -> strid (* NEW PARSER *) 11 | val longStrIdOfStrId: strid -> longstrid (* NEW PARSER *) 12 | 13 | val invented_StrId : strid -> bool 14 | 15 | val implode_longstrid : strid list * strid -> longstrid 16 | and explode_longstrid : longstrid -> strid list * strid 17 | (* MEMO: elsewhere we use the 18 | name `decompose' for this kind 19 | of thing. *) 20 | 21 | val pr_StrId: strid -> string 22 | val pr_LongStrId: longstrid -> string 23 | 24 | (* Needed for top-level printing: *) 25 | val < : strid * strid -> bool 26 | end; 27 | -------------------------------------------------------------------------------- /src/Common/SigId.sml: -------------------------------------------------------------------------------- 1 | (* Signature identifiers - Definition v3 page 10 *) 2 | 3 | (*$SigId: SIGID*) 4 | functor SigId(): SIGID = 5 | struct 6 | datatype sigid = SIGID of string 7 | 8 | val mk_SigId = SIGID 9 | fun pr_SigId(SIGID str) = str 10 | 11 | val op < = fn (SIGID str1, SIGID str2) => str1 < str2 12 | end; 13 | -------------------------------------------------------------------------------- /src/Common/SourceInfo.sml: -------------------------------------------------------------------------------- 1 | (*$SourceInfo: LEX_BASICS PRETTYPRINT CRASH SOURCE_INFO*) 2 | 3 | functor SourceInfo (structure LexBasics : LEX_BASICS 4 | structure PrettyPrint : PRETTYPRINT 5 | structure Crash: CRASH 6 | ) : SOURCE_INFO = 7 | struct 8 | type pos = LexBasics.pos 9 | type Report = LexBasics.Report 10 | 11 | datatype SourceInfo = POSinfo of {left : pos, right : pos} 12 | 13 | fun from_positions left right = POSinfo {left=left, right=right} 14 | fun to_positions (POSinfo {left, right}) = (left, right) 15 | 16 | fun report (POSinfo {left, right}) = 17 | LexBasics.reportPosition {left=left, right=right} 18 | 19 | fun layout (POSinfo {left, right}) = 20 | StringTree.NODE {start="SourceInfo(", finish=")", indent=0, 21 | childsep=StringTree.RIGHT ", ", 22 | children=[LexBasics.layoutPos left, 23 | LexBasics.layoutPos right]} 24 | end; 25 | -------------------------------------------------------------------------------- /src/Common/TIMESTAMP-sig.sml: -------------------------------------------------------------------------------- 1 | (*$TIMESTAMP*) 2 | signature TIMESTAMP = 3 | sig 4 | eqtype stamp 5 | val new: unit -> stamp 6 | val stamp2int : stamp -> int (* an injective mapping from stamps to integers *) 7 | val print: stamp -> string 8 | end; 9 | -------------------------------------------------------------------------------- /src/Common/TOP_LEVEL_REPORT.sml: -------------------------------------------------------------------------------- 1 | (* Top-level reporting: ties static and dynamic basis together, generates 2 | a report of bindings. *) 3 | 4 | (*$TOP_LEVEL_REPORT*) 5 | signature TOP_LEVEL_REPORT = 6 | sig 7 | type InfixBasis and ElabBasis 8 | type Report 9 | 10 | val report: {infB: InfixBasis, elabB: ElabBasis, bindings: bool} -> Report 11 | end; 12 | -------------------------------------------------------------------------------- /src/Common/TYCON-sig.sml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/rowandavies/sml-cidre/dbd797af94eb38603d5613561b2edf8d1270e3f9/src/Common/TYCON-sig.sml -------------------------------------------------------------------------------- /src/Common/TYVAR-sig.sml: -------------------------------------------------------------------------------- 1 | (* type variables - Definition v3 page 4 *) 2 | 3 | (*$TYVAR*) 4 | signature TYVAR = 5 | sig 6 | eqtype SyntaxTyVar 7 | 8 | val mk_TyVar: string -> SyntaxTyVar (* NEW PARSER *) 9 | and pr_tyvar: SyntaxTyVar -> string 10 | 11 | val isEquality: SyntaxTyVar -> bool 12 | 13 | datatype Variance = COVARIANT | CONTRAVARIANT | IGNORED | MIXED 14 | 15 | val variance : SyntaxTyVar -> Variance 16 | val variancePrefix : Variance -> string 17 | 18 | val covariant : Variance -> bool 19 | val contravariant : Variance -> bool 20 | 21 | val join_variance : Variance * Variance -> Variance 22 | 23 | end; 24 | -------------------------------------------------------------------------------- /src/Common/Timestamp.sml: -------------------------------------------------------------------------------- 1 | (*$Timestamp: TIMESTAMP*) 2 | functor Timestamp(): TIMESTAMP = 3 | struct 4 | type stamp = int 5 | 6 | val r = ref 0 7 | fun new() = (r := !r + 1; !r) 8 | 9 | fun stamp2int i = i 10 | 11 | fun print i = (*"$" ^*) Int.toString i 12 | end; 13 | -------------------------------------------------------------------------------- /src/Common/TyGoals.sml: -------------------------------------------------------------------------------- 1 | (* NOT USED CURRENTLY - rowan 25jul01 *) 2 | 3 | functor TyGoals(structure DecGrammar: DEC_GRAMMAR 4 | 5 | structure Ident: IDENT 6 | sharing type Ident.longid = DecGrammar.longid 7 | sharing type Ident.id = DecGrammar.id 8 | 9 | structure PP: PRETTYPRINT 10 | sharing type PP.StringTree = DecGrammar.StringTree 11 | 12 | structure FinMap: FINMAP 13 | sharing type FinMap.StringTree = PP.StringTree 14 | 15 | ) : TYGOALS = 16 | struct 17 | 18 | type id = Ident.id 19 | type ty = DecGrammar.ty 20 | 21 | datatype TyGoals = TYGOALS of (id, ty) FinMap.map 22 | 23 | val empty : TyGoals = TYGOALS FinMap.empty 24 | val singleton : id * ty -> TyGoals = TYGOALS o FinMap.singleton 25 | fun add (id, ty, TYGOALS s) = TYGOALS(FinMap.add(id, ty, s)) 26 | fun plus (TYGOALS s, TYGOALS s') : TyGoals = 27 | TYGOALS(FinMap.plus(s, s')) 28 | fun lookup (TYGOALS map) (id : id) : ty option = 29 | FinMap.lookup map id 30 | 31 | fun layout (TYGOALS m) = 32 | FinMap.layoutMap {start="", finish="",sep=", ", eq=" : "} 33 | (PP.LEAF o Ident.pr_id) DecGrammar.layoutTy m 34 | 35 | end 36 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib.cm: -------------------------------------------------------------------------------- 1 | (* Alias smlnj-lib/Util/smlnj-lib.cm *) 2 | 3 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/README: -------------------------------------------------------------------------------- 1 | This is the utility library of the SML/NJ Library. The services provided 2 | can be grouped as follows: 3 | 4 | - Data structures 5 | - Hash tables 6 | - Finite maps of ordered keys 7 | - Finite sets of ordered elements 8 | - Queues 9 | - Arrays 10 | 11 | - Searching and sorting 12 | 13 | - String conversions 14 | 15 | - Some miscellaneous utility modules. 16 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/TODO: -------------------------------------------------------------------------------- 1 | Improve implementation of unionWith/intersectWith in BinaryMapFn, IntBinaryMap, 2 | and SplayMapFn. 3 | 4 | New iterator module 5 | 6 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/array-sort-sig.sml: -------------------------------------------------------------------------------- 1 | (* array-sort-sig.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | * Signature for in-place sorting of polymorphic arrays 6 | * 7 | *) 8 | 9 | signature ARRAY_SORT = 10 | sig 11 | 12 | type 'a array 13 | 14 | val sort : ('a * 'a -> order) -> 'a array -> unit 15 | val sorted : ('a * 'a -> order) -> 'a array -> bool 16 | 17 | end (* ARRAY_SORT *) 18 | 19 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/array2-sig.sml: -------------------------------------------------------------------------------- 1 | (* array2-sig.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | * Two-dimensional arrays. 6 | *) 7 | 8 | signature ARRAY2 = 9 | sig 10 | type 'a array2 11 | 12 | val array : (int * int * 'a) -> 'a array2 13 | (* array(n,m,x) creates an n*m array initialized to x. 14 | * Raises Size, if m or n is < 0. 15 | *) 16 | val tabulate : (int * int * ((int * int) -> 'a)) -> 'a array2 17 | (* tabulate(n,m,f) creates an n*m array, where the (i,j) element 18 | * is initialized to f(i,j). Raises Size, if m or n is < 0. 19 | *) 20 | val sub : ('a array2 * int * int) -> 'a 21 | (* sub(a,i,j) returns the (i,j) element. Raises Subscript if i or j 22 | * is out of range. 23 | *) 24 | val update : ('a array2 * int * int * 'a) -> unit 25 | (* update(a,i,j,x) sets the (i,j) element to x. Raises Subscript if 26 | * i or j is out of range. 27 | *) 28 | val dimensions : 'a array2 -> (int * int) 29 | (* return the size of the array *) 30 | val row : ('a array2 * int) -> 'a Array.array 31 | (* project a row of the array. *) 32 | val column : ('a array2 * int) -> 'a Array.array 33 | (* project a column of the array. *) 34 | 35 | end (* ARRAY2 *) 36 | 37 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/atom-binary-map.sml: -------------------------------------------------------------------------------- 1 | (* atom-binary-map.sml 2 | * 3 | * COPYRIGHT (c) 1997 Bell Labs, Lucent Technologies. 4 | * 5 | * Functional finite maps with atom keys. 6 | *) 7 | 8 | structure AtomBinaryMap = 9 | BinaryMapFn ( 10 | struct 11 | type ord_key = Atom.atom 12 | val compare = Atom.compare 13 | end) 14 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/atom-binary-set.sml: -------------------------------------------------------------------------------- 1 | (* atom-binary-map.sml 2 | * 3 | * COPYRIGHT (c) 1997 Bell Labs, Lucent Technologies. 4 | * 5 | * Functional sets of atoms. 6 | *) 7 | 8 | structure AtomBinarySet = 9 | BinarySetFn ( 10 | struct 11 | type ord_key = Atom.atom 12 | val compare = Atom.compare 13 | end) 14 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/atom-map.sml: -------------------------------------------------------------------------------- 1 | (* atom-map.sml 2 | * 3 | * COPYRIGHT (c) 1999 Bell Labs, Lucent Technologies. 4 | * 5 | * Functional finite maps with atom keys. 6 | *) 7 | 8 | structure AtomMap = AtomRedBlackMap 9 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/atom-redblack-map.sml: -------------------------------------------------------------------------------- 1 | (* atom-redblack-map.sml 2 | * 3 | * COPYRIGHT (c) 1999 Bell Labs, Lucent Technologies. 4 | * 5 | * Functional finite maps with atom keys. 6 | *) 7 | 8 | structure AtomRedBlackMap = 9 | RedBlackMapFn ( 10 | struct 11 | type ord_key = Atom.atom 12 | val compare = Atom.compare 13 | end) 14 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/atom-redblack-set.sml: -------------------------------------------------------------------------------- 1 | (* atom-redblack-map.sml 2 | * 3 | * COPYRIGHT (c) 1999 Bell Labs, Lucent Technologies. 4 | * 5 | * Functional sets of atoms. 6 | *) 7 | 8 | structure AtomRedBlackSet = 9 | RedBlackSetFn ( 10 | struct 11 | type ord_key = Atom.atom 12 | val compare = Atom.compare 13 | end) 14 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/atom-set.sml: -------------------------------------------------------------------------------- 1 | (* atom-map.sml 2 | * 3 | * COPYRIGHT (c) 1999 Bell Labs, Lucent Technologies. 4 | * 5 | * Functional sets of atoms. 6 | *) 7 | 8 | structure AtomSet = AtomRedBlackSet 9 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/atom-sig.sml: -------------------------------------------------------------------------------- 1 | (* atom-sig.sml 2 | * 3 | * COPYRIGHT (c) 1996 by AT&T Research 4 | * 5 | * AUTHOR: John Reppy 6 | * AT&T Bell Laboratories 7 | * Murray Hill, NJ 07974 8 | * jhr@research.att.com 9 | * 10 | * TODO: add a gensym operation? 11 | *) 12 | 13 | signature ATOM = 14 | sig 15 | 16 | type atom 17 | (* Atoms are hashed strings that support fast equality testing. *) 18 | 19 | val atom : string -> atom 20 | val atom' : substring -> atom 21 | (* Map a string/substring to the corresponding unique atom. *) 22 | val toString : atom -> string 23 | (* return the string representation of the atom *) 24 | val sameAtom : (atom * atom) -> bool 25 | (* return true if the atoms are the same *) 26 | val compare : (atom * atom) -> order 27 | (* compare two atoms for their relative order; note that this is 28 | * not lexical order! 29 | *) 30 | val hash : atom -> word 31 | (* return a hash key for the atom *) 32 | 33 | end (* signature ATOM *) 34 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/atom-table.sml: -------------------------------------------------------------------------------- 1 | (* atom-table.sml 2 | * 3 | * COPYRIGHT (c) 1996 AT&T Research. 4 | * 5 | * Hash tables of atoms. 6 | *) 7 | 8 | structure AtomTable = HashTableFn (struct 9 | type hash_key = Atom.atom 10 | val hashVal = Atom.hash 11 | val sameKey = Atom.sameAtom 12 | end); 13 | 14 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/bit-vector.sml: -------------------------------------------------------------------------------- 1 | (* bit-vector.sml 2 | * 3 | * COPYRIGHT (c) 1995 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | *) 6 | 7 | structure BitVector = BitArray.Vector 8 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/bsearch-fn.sml: -------------------------------------------------------------------------------- 1 | (* bsearch-fn.sml 2 | * 3 | * COPYRIGHT (c) 1994 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | * Binary searching on sorted monomorphic arrays. 6 | *) 7 | 8 | functor BSearchFn (A : MONO_ARRAY) : sig 9 | 10 | structure A : MONO_ARRAY 11 | 12 | val bsearch : (('a * A.elem) -> order) 13 | -> ('a * A.array) -> (int * A.elem) option 14 | (* binary search on ordered monomorphic arrays. The comparison function 15 | * cmp embeds a projection function from the element type to the key 16 | * type. 17 | *) 18 | 19 | end = struct 20 | 21 | structure A = A 22 | 23 | (* binary search on ordered monomorphic arrays. The comparison function 24 | * cmp embeds a projection function from the element type to the key 25 | * type. 26 | *) 27 | fun bsearch cmp (key, arr) = let 28 | fun look (lo, hi) = 29 | if hi >= lo then let 30 | val m = lo + (hi - lo) div 2 31 | val x = A.sub(arr, m) 32 | in 33 | case cmp(key, x) 34 | of LESS => look(lo, m-1) 35 | | EQUAL => (SOME(m, x)) 36 | | GREATER => look(m+1, hi) 37 | (* end case *) 38 | end 39 | else NONE 40 | in 41 | look (0, A.length arr - 1) 42 | end 43 | 44 | end; (* BSearch *) 45 | 46 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/char-map-sig.sml: -------------------------------------------------------------------------------- 1 | (* char-map-sig.sml 2 | * 3 | * COPYRIGHT (c) 1994 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | * Fast, read-only, maps from characters to values. 6 | * 7 | * AUTHOR: John Reppy 8 | * AT&T Bell Laboratories 9 | * Murray Hill, NJ 07974 10 | * jhr@research.att.com 11 | *) 12 | 13 | signature CHAR_MAP = 14 | sig 15 | 16 | type 'a char_map 17 | (* a finite map from characters to 'a *) 18 | 19 | val mkCharMap : {default : 'a, bindings : (string * 'a) list} -> 'a char_map 20 | (* make a character map which maps the bound characters to their 21 | * bindings and maps everything else to the default value. 22 | *) 23 | 24 | val mapChr : 'a char_map -> char -> 'a 25 | (* map the given character *) 26 | val mapStrChr : 'a char_map -> (string * int) -> 'a 27 | (* (mapStrChr c (s, i)) is equivalent to (mapChr c (String.sub(s, i))) *) 28 | 29 | end (* CHAR_MAP *) 30 | 31 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/fifo-sig.sml: -------------------------------------------------------------------------------- 1 | (* fifo-sig.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | * Applicative fifos 6 | * 7 | *) 8 | 9 | signature FIFO = 10 | sig 11 | type 'a fifo 12 | 13 | exception Dequeue 14 | 15 | val empty : 'a fifo 16 | val isEmpty : 'a fifo -> bool 17 | val enqueue : 'a fifo * 'a -> 'a fifo 18 | val dequeue : 'a fifo -> 'a fifo * 'a 19 | val delete : ('a fifo * ('a -> bool)) -> 'a fifo 20 | val head : 'a fifo -> 'a 21 | val peek : 'a fifo -> 'a option 22 | val length : 'a fifo -> int 23 | val contents : 'a fifo -> 'a list 24 | val app : ('a -> unit) -> 'a fifo -> unit 25 | val map : ('a -> 'b) -> 'a fifo -> 'b fifo 26 | val foldl : ('a * 'b -> 'b) -> 'b -> 'a fifo -> 'b 27 | val foldr : ('a * 'b -> 'b) -> 'b -> 'a fifo -> 'b 28 | 29 | end (* FIFO *) 30 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/format-sig.sml: -------------------------------------------------------------------------------- 1 | (* format-sig.sml 2 | * 3 | * COPYRIGHT (c) 1992 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | * Formatted conversion to and from strings. 6 | * 7 | * AUTHOR: John Reppy 8 | * AT&T Bell Laboratories 9 | * Murray Hill, NJ 07974 10 | * jhr@research.att.com 11 | *) 12 | 13 | signature FORMAT = 14 | sig 15 | 16 | datatype fmt_item 17 | = ATOM of Atom.atom 18 | | LINT of LargeInt.int 19 | | INT of Int.int 20 | | LWORD of LargeWord.word 21 | | WORD of Word.word 22 | | WORD8 of Word8.word 23 | | BOOL of bool 24 | | CHR of char 25 | | STR of string 26 | | REAL of Real.real 27 | | LREAL of LargeReal.real 28 | | LEFT of (int * fmt_item) (* left justify in field of given width *) 29 | | RIGHT of (int * fmt_item) (* right justify in field of given width *) 30 | 31 | exception BadFormat (* bad format string *) 32 | exception BadFmtList (* raised on specifier/item type mismatch *) 33 | 34 | val format : string -> fmt_item list -> string 35 | val formatf : string -> (string -> unit) -> fmt_item list -> unit 36 | 37 | end (* FORMAT *) 38 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/graph-scc-sig.sml: -------------------------------------------------------------------------------- 1 | (* graph-scc-sig.sml 2 | * 3 | * COPYRIGHT (c) 1999 Lucent Bell Laboratories. 4 | * 5 | * Calculate strongly-connected components of directed graph. 6 | * The graph can have nodes with self-loops. 7 | * 8 | * author: Matthias Blume 9 | *) 10 | 11 | signature GRAPH_SCC = 12 | sig 13 | 14 | structure Nd : ORD_KEY 15 | 16 | type node = Nd.ord_key 17 | 18 | datatype component 19 | = SIMPLE of node (* singleton, no self-loop *) 20 | | RECURSIVE of node list 21 | 22 | val topOrder: { root: node, follow: node -> node list } -> component list 23 | (* take root node and follow function and return 24 | * list of topologically sorted strongly-connected components; 25 | * root component goes first 26 | *) 27 | 28 | end 29 | 30 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/hash-key-sig.sml: -------------------------------------------------------------------------------- 1 | (* hash-key-sig.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | * Abstract hash table keys. This is the argument signature for the hash table 6 | * functor (see hash-table-sig.sml and hash-table.sml). 7 | * 8 | * AUTHOR: John Reppy 9 | * AT&T Bell Laboratories 10 | * Murray Hill, NJ 07974 11 | * jhr@research.att.com 12 | *) 13 | 14 | signature HASH_KEY = 15 | sig 16 | type hash_key 17 | 18 | val hashVal : hash_key -> word 19 | (* Compute an unsigned integer key from a hash key. *) 20 | 21 | val sameKey : (hash_key * hash_key) -> bool 22 | (* Return true if two keys are the same. 23 | * NOTE: if sameKey(h1, h2), then it must be the 24 | * case that (hashVal h1 = hashVal h2). 25 | *) 26 | 27 | end (* HASH_KEY *) 28 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/hash-string.sml: -------------------------------------------------------------------------------- 1 | (* hash-string.sml 2 | * 3 | * COPYRIGHT (c) 1992 by AT&T Bell Laboratories 4 | *) 5 | 6 | structure HashString : sig 7 | 8 | val hashString : string -> word 9 | 10 | end = struct 11 | 12 | fun charToWord c = Word.fromInt(Char.ord c) 13 | 14 | (* A function to hash a character. The computation is: 15 | * 16 | * h = 33 * h + 720 + c 17 | *) 18 | fun hashChar (c, h) = Word.<<(h, 0w5) + h + 0w720 + (charToWord c) 19 | 20 | (* NOTE: another function we might try is h = 5*h + c, which is used 21 | * in STL. 22 | *) 23 | 24 | fun hashString s = CharVector.foldl hashChar 0w0 s 25 | 26 | end (* HashString *) 27 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/int-inf-sig.sml: -------------------------------------------------------------------------------- 1 | (* int-inf-sig.sml 2 | * 3 | * COPYRIGHT (c) 1995 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | * This package is derived from Andrzej Filinski's bignum package. It is versy 6 | * close to the definition of the optional IntInf structure in the SML'97 basis. 7 | *) 8 | 9 | signature INT_INF = 10 | sig 11 | include INTEGER 12 | 13 | val divmod : (int * int) -> (int * int) 14 | val quotrem : (int * int) -> (int * int) 15 | val pow : (int * Int.int) -> int 16 | val log2 : int -> Int.int 17 | 18 | end (* signature INT_INF *) 19 | 20 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/io-util-sig.sml: -------------------------------------------------------------------------------- 1 | (* io-util-sig.sml 2 | * 3 | * COPYRIGHT (c) 1997 AT&T Labs Research. 4 | *) 5 | 6 | signature IO_UTIL = 7 | sig 8 | type instream 9 | type outstream 10 | 11 | val withInputFile : string * ('a -> 'b) -> 'a -> 'b 12 | val withInstream : instream * ('a -> 'b) -> 'a -> 'b 13 | val withOutputFile : string * ('a -> 'b) -> 'a -> 'b 14 | val withOutstream : outstream * ('a -> 'b) -> 'a -> 'b 15 | end 16 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/iterate-sig.sml: -------------------------------------------------------------------------------- 1 | (* iterate-sig.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | *) 6 | 7 | signature ITERATE = 8 | sig 9 | 10 | val iterate : ('a -> 'a) -> int -> 'a -> 'a 11 | (* iterate f cnt init = f(f(...f(f(init))...)) (cnt times) 12 | * iterate f 0 init = init 13 | * raises BadArg if cnt < 0 14 | *) 15 | 16 | val repeat : (int * 'a -> 'a) -> int -> 'a -> 'a 17 | (* repeat f cnt init 18 | * = #2(iterate (fn (i,v) => (i+1,f(i,v))) cnt (0,init)) 19 | *) 20 | 21 | val for : (int * 'a -> 'a) -> (int * int * int) -> 'a -> 'a 22 | (* for f (start,stop,inc) init 23 | * "for loop" 24 | * implements f(...f(start+2*inc,f(start+inc,f(start,init)))...) 25 | * until the first argument of f > stop if inc > 0 26 | * or the first argument of f < stop if inc < 0 27 | * raises BadArg if inc <= 0 and start < stop or if inc >=0 and 28 | * start > stop. 29 | *) 30 | 31 | end (* ITERATE *) 32 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/lib-base-sig.sml: -------------------------------------------------------------------------------- 1 | (* lib-base-sig.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | *) 5 | 6 | signature LIB_BASE = 7 | sig 8 | 9 | exception Unimplemented of string 10 | (* raised to report unimplemented features *) 11 | exception Impossible of string 12 | (* raised to report internal errors *) 13 | 14 | exception NotFound 15 | (* raised by searching operations *) 16 | 17 | val failure : {module : string, func : string, msg : string} -> 'a 18 | (* raise the exception Fail with a standard format message. *) 19 | 20 | val version : {date : string, system : string, version_id : int list} 21 | val banner : string 22 | 23 | end (* LIB_BASE *) 24 | 25 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/lib-base.sml: -------------------------------------------------------------------------------- 1 | (* lib-base.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | *) 5 | 6 | structure LibBase : LIB_BASE = 7 | struct 8 | 9 | (* raised to report unimplemented features *) 10 | exception Unimplemented of string 11 | 12 | (* raised to report internal errors *) 13 | exception Impossible of string 14 | 15 | (* raised by searching operations *) 16 | exception NotFound 17 | 18 | (* raise the exception Fail with a standard format message. *) 19 | fun failure {module, func, msg} = 20 | raise (Fail(concat[module, ".", func, ": ", msg])) 21 | 22 | val version = { 23 | date = "June 1, 1996", 24 | system = "SML/NJ Library", 25 | version_id = [1, 0] 26 | } 27 | 28 | fun f ([], l) = l 29 | | f ([x : int], l) = (Int.toString x)::l 30 | | f (x::r, l) = (Int.toString x) :: "." :: f(r, l) 31 | 32 | val banner = concat ( 33 | #system version :: ", Version " :: 34 | f (#version_id version, [", ", #date version])) 35 | 36 | end (* LibBase *) 37 | 38 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/list-xprod-sig.sml: -------------------------------------------------------------------------------- 1 | (* list-xprod-sig.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | * Functions for computing with the cross product of two lists. 6 | *) 7 | 8 | signature LIST_XPROD = 9 | sig 10 | 11 | val appX : (('a * 'b) -> 'c) -> ('a list * 'b list) -> unit 12 | (* apply a function to the cross product of two lists *) 13 | 14 | val mapX : (('a * 'b) -> 'c) -> ('a list * 'b list) -> 'c list 15 | (* map a function across the cross product of two lists *) 16 | 17 | val foldX : (('a * 'b * 'c) -> 'c) -> ('a list * 'b list) -> 'c -> 'c 18 | (* fold a function across the cross product of two lists *) 19 | 20 | end; (* LIST_XPROD *) 21 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/listsort-sig.sml: -------------------------------------------------------------------------------- 1 | (* listsort-sig.sml 2 | * 3 | * COPYRIGHT (c) 1989 by AT&T Bell Laboratories 4 | * 5 | * The generic list sorting interface. Taken from the SML/NJ compiler. 6 | *) 7 | 8 | signature LIST_SORT = 9 | sig 10 | 11 | val sort : ('a * 'a -> bool) -> 'a list -> 'a list 12 | (* (sort gt l) sorts the list l in ascending order using the 13 | * ``greater-than'' relationship defined by gt. 14 | *) 15 | 16 | val uniqueSort : ('a * 'a -> order) -> 'a list -> 'a list 17 | (* uniquesort produces an increasing list, removing equal 18 | * elements 19 | *) 20 | 21 | val sorted : ('a * 'a -> bool) -> 'a list -> bool 22 | (* (sorted gt l) returns true if the list is sorted in ascending 23 | * order under the ``greater-than'' predicate gt. 24 | *) 25 | 26 | end; (* LIST_SORT *) 27 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/load: -------------------------------------------------------------------------------- 1 | app use [ 2 | "lib-base-sig.sml", "lib-base.sml", 3 | "fifo-sig.sml", "fifo.sml", 4 | "queue-sig.sml", "queue.sml", 5 | "ord-key-sig.sml", 6 | "ord-map-sig.sml", 7 | "ord-set-sig.sml", 8 | "list-map-fn.sml", 9 | "list-set-fn.sml", 10 | "binary-map-fn.sml", 11 | "binary-set-fn.sml", 12 | (* "splay-map-fn.sml", *) 13 | (* "splay-set-fn.sml", *) 14 | "int-list-map.sml", 15 | "int-list-set.sml", 16 | "int-binary-map.sml", 17 | "int-binary-set.sml" 18 | ]; 19 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/mono-array-fn.sml: -------------------------------------------------------------------------------- 1 | (* mono-array-fn.sml 2 | * 3 | * COPYRIGHT (c) 1997 Bell Labs, Lucent Technologies. 4 | * 5 | * This simple functor allows easy construction of new monomorphic array 6 | * structures. 7 | *) 8 | 9 | functor MonoArrayFn (type elem) :> MONO_ARRAY where type elem = elem 10 | = struct 11 | open Array 12 | type elem = elem 13 | type array = elem Array.array 14 | type vector = elem Vector.vector 15 | end 16 | 17 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/mono-array-sort-sig.sml: -------------------------------------------------------------------------------- 1 | (* mono-array-sort-sig.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | * Signature for in-place sorting of monomorphic arrays 6 | * 7 | *) 8 | 9 | signature MONO_ARRAY_SORT = 10 | sig 11 | 12 | structure A : MONO_ARRAY 13 | 14 | val sort : (A.elem * A.elem -> order) -> A.array -> unit 15 | 16 | val sorted : (A.elem * A.elem -> order) -> A.array -> bool 17 | 18 | end; (* MONO_ARRAY_SORT *) 19 | 20 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/ord-key-sig.sml: -------------------------------------------------------------------------------- 1 | (* ord-key-sig.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | * Abstract linearly ordered keys. 6 | * 7 | *) 8 | 9 | signature ORD_KEY = 10 | sig 11 | type ord_key 12 | 13 | val compare : ord_key * ord_key -> order 14 | 15 | end (* ORD_KEY *) 16 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/path-util-sig.sml: -------------------------------------------------------------------------------- 1 | (* path-util-sig.sml 2 | * 3 | * COPYRIGHT (c) 1997 Bell Labs, Lucent Technologies. 4 | * 5 | * Various higher-level pathname and searching utilities. 6 | *) 7 | 8 | signature PATH_UTIL = 9 | sig 10 | 11 | val findFile : string list -> string -> string option 12 | val findFiles : string list -> string -> string list 13 | 14 | val existsFile : (string -> bool) -> string list -> string -> string option 15 | val allFiles : (string -> bool) -> string list -> string -> string list 16 | 17 | end; 18 | 19 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/path-util.sml: -------------------------------------------------------------------------------- 1 | (* path-util.sml 2 | * 3 | * COPYRIGHT (c) 1997 Bell Labs, Lucent Technologies. 4 | * 5 | * Various higher-level pathname and searching utilities. 6 | *) 7 | 8 | structure PathUtil : PATH_UTIL = 9 | struct 10 | 11 | structure P = OS.Path 12 | structure F = OS.FileSys 13 | 14 | fun existsFile pred pathList fileName = let 15 | fun chk s = if (pred s) then SOME s else NONE 16 | fun iter [] = NONE 17 | | iter (p::r) = (case chk(P.joinDirFile{dir=p, file=fileName}) 18 | of NONE => iter r 19 | | res => res 20 | (* end case *)) 21 | in 22 | iter pathList 23 | end 24 | fun allFiles pred pathList fileName = let 25 | fun chk s = if (pred s) then SOME s else NONE 26 | fun iter ([], l) = rev l 27 | | iter (p::r, l) = (case chk(P.joinDirFile{dir=p, file=fileName}) 28 | of NONE => iter(r, l) 29 | | (SOME s) => iter(r, s::l) 30 | (* end case *)) 31 | in 32 | iter (pathList, []) 33 | end 34 | 35 | fun fileExists s = F.access(s, []) 36 | 37 | val findFile = existsFile fileExists 38 | val findFiles = allFiles fileExists 39 | 40 | end; 41 | 42 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/queue-sig.sml: -------------------------------------------------------------------------------- 1 | (* queue-sig.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | * Imperative fifos 6 | * 7 | *) 8 | 9 | signature QUEUE = 10 | sig 11 | type 'a queue 12 | 13 | exception Dequeue 14 | 15 | val mkQueue : unit -> 'a queue 16 | (* make a new queue *) 17 | val clear : 'a queue -> unit 18 | (* remove all elements *) 19 | val isEmpty : 'a queue -> bool 20 | (* test for empty queue *) 21 | val enqueue : 'a queue * 'a -> unit 22 | (* enqueue an element at the rear *) 23 | val dequeue : 'a queue -> 'a 24 | (* remove the front element (raise Dequeue if empty) *) 25 | val delete : ('a queue * ('a -> bool)) -> unit 26 | (* delete all elements satisfying the given predicate *) 27 | val head : 'a queue -> 'a 28 | val peek : 'a queue -> 'a option 29 | val length : 'a queue -> int 30 | val contents : 'a queue -> 'a list 31 | val app : ('a -> unit) -> 'a queue -> unit 32 | val map : ('a -> 'b) -> 'a queue -> 'b queue 33 | val foldl : ('a * 'b -> 'b) -> 'b -> 'a queue -> 'b 34 | val foldr : ('a * 'b -> 'b) -> 'b -> 'a queue -> 'b 35 | 36 | end 37 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/queue.sml: -------------------------------------------------------------------------------- 1 | (* queue.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | * Imperative fifos 6 | * 7 | *) 8 | 9 | structure Queue :> QUEUE = 10 | struct 11 | type 'a queue = 'a Fifo.fifo ref 12 | 13 | exception Dequeue = Fifo.Dequeue 14 | 15 | fun mkQueue () = ref Fifo.empty 16 | 17 | fun clear q = (q := Fifo.empty) 18 | 19 | fun enqueue (q,x) = q := (Fifo.enqueue (!q, x)) 20 | 21 | fun dequeue q = let 22 | val (newq, x) = Fifo.dequeue (!q) 23 | in 24 | q := newq; 25 | x 26 | end 27 | 28 | fun delete (q, pred) = (q := Fifo.delete (!q, pred)) 29 | fun head q = Fifo.head (!q) 30 | fun peek q = Fifo.peek (!q) 31 | fun isEmpty q = Fifo.isEmpty (!q) 32 | fun length q = Fifo.length (!q) 33 | fun contents q = Fifo.contents (!q) 34 | fun app f q = Fifo.app f (!q) 35 | fun map f q = ref(Fifo.map f (!q)) 36 | fun foldl f b q = Fifo.foldl f b (!q) 37 | fun foldr f b q = Fifo.foldr f b (!q) 38 | 39 | end 40 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/rand-sig.sml: -------------------------------------------------------------------------------- 1 | (* rand-sig.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * COPYRIGHT (c) 1998 by AT&T Laboratories. 5 | * 6 | * Signature for a simple random number generator. 7 | * 8 | *) 9 | 10 | signature RAND = 11 | sig 12 | 13 | type rand = Word31.word 14 | 15 | val randMin : rand 16 | val randMax : rand 17 | 18 | val random : rand -> rand 19 | (* Given seed, return value randMin <= v <= randMax 20 | * Iteratively using the value returned by random as the 21 | * next seed to random will produce a sequence of pseudo-random 22 | * numbers. 23 | *) 24 | 25 | val mkRandom : rand -> unit -> rand 26 | (* Given seed, return function generating a sequence of 27 | * random numbers randMin <= v <= randMax 28 | *) 29 | 30 | val norm : rand -> real 31 | (* Map values in the range [randMin,randMax] to (0.0,1.0) *) 32 | 33 | val range : (int * int) -> rand -> int 34 | (* Map v, randMin <= v <= randMax, to integer range [i,j] 35 | * Exception - 36 | * Fail if j < i 37 | *) 38 | 39 | end (* RAND *) 40 | 41 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/random-sig.sml: -------------------------------------------------------------------------------- 1 | (* random-sig.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | *) 5 | 6 | signature RANDOM = 7 | sig 8 | 9 | type rand 10 | (* the internal state of a random number generator *) 11 | 12 | val rand : (int * int) -> rand 13 | (* create rand from initial seed *) 14 | 15 | val toString : rand -> string 16 | val fromString : string -> rand 17 | (* convert state to and from string 18 | * fromString raises Fail if its argument 19 | * does not have the proper form. 20 | *) 21 | 22 | val randInt : rand -> int 23 | (* generate ints uniformly in [minInt,maxInt] *) 24 | 25 | val randNat : rand -> int 26 | (* generate ints uniformly in [0,maxInt] *) 27 | 28 | val randReal : rand -> real 29 | (* generate reals uniformly in [0.0,1.0) *) 30 | 31 | val randRange : (int * int) -> rand -> int 32 | (* randRange (lo,hi) generates integers uniformly [lo,hi]. 33 | * Raises Fail if hi < lo. 34 | *) 35 | 36 | end; (* RANDOM *) 37 | 38 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/scan-sig.sml: -------------------------------------------------------------------------------- 1 | (* scan-sig.sml 2 | * 3 | * COPYRIGHT (c) 1996 by AT&T Research. See COPYRIGHT file for details. 4 | * 5 | * C-style conversions from string representations. 6 | * 7 | * AUTHOR: John Reppy 8 | * AT&T Research 9 | * jhr@research.att.com 10 | *) 11 | 12 | signature SCAN = 13 | sig 14 | 15 | datatype fmt_item 16 | = ATOM of Atom.atom 17 | | LINT of LargeInt.int 18 | | INT of Int.int 19 | | LWORD of LargeWord.word 20 | | WORD of Word.word 21 | | WORD8 of Word8.word 22 | | BOOL of bool 23 | | CHR of char 24 | | STR of string 25 | | REAL of Real.real 26 | | LREAL of LargeReal.real 27 | | LEFT of (int * fmt_item) (* left justify in field of given width *) 28 | | RIGHT of (int * fmt_item) (* right justify in field of given width *) 29 | 30 | exception BadFormat (* bad format string *) 31 | 32 | val sscanf : string -> string -> fmt_item list option 33 | val scanf : string -> (char, 'a) StringCvt.reader 34 | -> (fmt_item list, 'a) StringCvt.reader 35 | 36 | end (* SCAN *) 37 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/simple-uref.sml: -------------------------------------------------------------------------------- 1 | (* simple-uref.sml 2 | * 3 | * UNIONFIND DATA STRUCTURE WITH PATH COMPRESSION 4 | * 5 | * Author: 6 | * Fritz Henglein 7 | * DIKU, University of Copenhagen 8 | * henglein@diku.dk 9 | *) 10 | 11 | structure SimpleURef : UREF = 12 | struct 13 | 14 | exception UnionFind of string 15 | 16 | datatype 'a urefC 17 | = ECR of 'a 18 | | PTR of 'a uref 19 | withtype 'a uref = 'a urefC ref 20 | 21 | fun find (p as ref(ECR _)) = p 22 | | find (p as ref(PTR p')) = let 23 | val p'' = find p' 24 | in 25 | p := PTR p''; p'' 26 | end 27 | 28 | fun uRef x = ref (ECR x) 29 | 30 | fun !! p = (case !(find p) 31 | of ECR x => x 32 | | _ => raise Match 33 | (* end case *)) 34 | 35 | fun equal (p, p') = (find p = find p') 36 | 37 | fun update (p, x) = let val p' = find p 38 | in 39 | p' := ECR x 40 | end 41 | 42 | fun link (p, q) = let 43 | val p' = find p 44 | val q' = find q 45 | in 46 | if p' = q' then false else (p' := PTR q'; true) 47 | end 48 | 49 | val union = link 50 | 51 | fun unify f (p, q) = let 52 | val v = f(!!p, !!q) 53 | in 54 | union (p, q) before update (q, v) 55 | end 56 | 57 | end (* SimpleURef *) 58 | 59 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/splaytree-sig.sml: -------------------------------------------------------------------------------- 1 | (* splaytree-sig.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | * 5 | * Signature for a splay tree data structure. 6 | * 7 | *) 8 | 9 | signature SPLAY_TREE = 10 | sig 11 | datatype 'a splay = 12 | SplayObj of { 13 | value : 'a, 14 | right : 'a splay, 15 | left : 'a splay 16 | } 17 | | SplayNil 18 | 19 | 20 | val splay : (('a -> order) * 'a splay) -> (order * 'a splay) 21 | (* (r,tree') = splay (cmp,tree) 22 | * where tree' is tree adjusted using the comparison function cmp 23 | * and, if tree' = SplayObj{value,...}, r = cmp value. 24 | * tree' = SplayNil iff tree = SplayNil, in which case r is undefined. 25 | *) 26 | 27 | val join : 'a splay * 'a splay -> 'a splay 28 | (* join(t,t') returns a new splay tree formed of t and t' 29 | *) 30 | 31 | end (* SPLAY_TREE *) 32 | 33 | -------------------------------------------------------------------------------- /src/Common/smlnj-lib/Util/time-limit.sml: -------------------------------------------------------------------------------- 1 | (* time-limit.sml 2 | * 3 | * COPYRIGHT (c) 1993 by AT&T Bell Laboratories. See COPYRIGHT file for details. 4 | *) 5 | 6 | structure TimeLimit : sig 7 | exception TimeOut 8 | val timeLimit : Time.time -> ('a -> 'b) -> 'a -> 'b 9 | end = struct 10 | 11 | exception TimeOut 12 | 13 | fun timeLimit t f x = let 14 | val setitimer = SMLofNJ.IntervalTimer.setIntTimer 15 | fun timerOn () = ignore(setitimer (SOME t)) 16 | fun timerOff () = ignore(setitimer NONE) 17 | val escapeCont = SMLofNJ.Cont.callcc (fn k => ( 18 | SMLofNJ.Cont.callcc (fn k' => (SMLofNJ.Cont.throw k k')); 19 | timerOff(); 20 | raise TimeOut)) 21 | fun handler _ = escapeCont 22 | in 23 | Signals.setHandler (Signals.sigALRM, Signals.HANDLER handler); 24 | timerOn(); 25 | ((f x) handle ex => (timerOff(); raise ex)) 26 | before timerOff() 27 | end 28 | 29 | end; (* TimeLimit *) 30 | -------------------------------------------------------------------------------- /src/Edlib/.cvsignore: -------------------------------------------------------------------------------- 1 | CM PM -------------------------------------------------------------------------------- /src/Edlib/Edlib.sml: -------------------------------------------------------------------------------- 1 | (* Parts of the Edinburgh Library used by the Kit *) 2 | 3 | structure Edlib = 4 | struct 5 | structure List = EdList 6 | structure ListPair = EdListPair 7 | end -------------------------------------------------------------------------------- /src/Edlib/LIST_SORT.sml: -------------------------------------------------------------------------------- 1 | (*$LIST_SORT *) 2 | 3 | signature LIST_SORT = 4 | sig 5 | 6 | (* FUNCTIONS TO SORT AND PERMUTE LISTS 7 | 8 | Created by: Dave Berry, LFCS, University of Edinburgh 9 | db@lfcs.ed.ac.uk 10 | Date: 6 Feb 1991 11 | 12 | Maintenance: Author 13 | 14 | 15 | DESCRIPTION 16 | 17 | Functions to sort and permute elements of a list. 18 | 19 | 20 | NOTES 21 | 22 | These functions were originally in the main list structure. 23 | 24 | 25 | SEE ALSO 26 | 27 | LIST. 28 | 29 | 30 | RCS LOG 31 | 32 | $Log: LIST_SORT.sml,v $ 33 | Revision 1.1.1.1 1999/04/06 16:46:13 rowan 34 | Imported sources 35 | 36 | Revision 1.1 1998/01/22 17:01:14 mael 37 | I have ported the ML Kit to SML/NJ 110.0.2. Use CM.make() to build the system. 38 | Parts of the Edinburgh Library are still used; they are located in the Edlib 39 | directory. 40 | 41 | Revision 1.1 91/02/11 18:43:28 18:43:28 db (Dave Berry) 42 | Initial revision 43 | 44 | 45 | 46 | *) 47 | 48 | 49 | (* MANIPULATORS *) 50 | 51 | val perms: 'a list -> 'a list list 52 | (* perms l; returns a list whose elements are all the permutations of l*) 53 | 54 | val sort: ('a -> 'a -> bool) -> 'a list -> 'a list 55 | (* sort p l; returns l sorted by p. *) 56 | 57 | 58 | end 59 | 60 | -------------------------------------------------------------------------------- /src/Edlib/ORDERING.sml: -------------------------------------------------------------------------------- 1 | (*$ORDERING *) 2 | 3 | signature ORDERING = 4 | sig 5 | 6 | (* A TYPE WITH AN ORDERING FUNCTION 7 | 8 | Created by: Dave Berry, LFCS, University of Edinburgh 9 | db@lfcs.ed.ac.uk 10 | Date: 5 Feb 1991 11 | 12 | Maintenance: Author 13 | 14 | 15 | DESCRIPTION 16 | 17 | This signature defines a type T and an ordering function. 18 | 19 | 20 | SEE ALSO 21 | 22 | FULL_ORD, EQUALITY, PRINT, EQ_ORD, EQTYPE_ORD, OBJECT. 23 | 24 | 25 | RCS LOG 26 | 27 | $Log: ORDERING.sml,v $ 28 | Revision 1.1.1.1 1999/04/06 16:46:13 rowan 29 | Imported sources 30 | 31 | Revision 1.1 1998/01/22 17:01:21 mael 32 | I have ported the ML Kit to SML/NJ 110.0.2. Use CM.make() to build the system. 33 | Parts of the Edinburgh Library are still used; they are located in the Edlib 34 | directory. 35 | 36 | Revision 1.1 91/02/11 18:54:54 18:54:54 db (Dave Berry) 37 | Initial revision 38 | 39 | 40 | 41 | *) 42 | 43 | 44 | (* TYPES *) 45 | 46 | type T 47 | 48 | 49 | (* OBSERVERS *) 50 | 51 | val lt: T -> T -> bool 52 | (* lt x y; returns true if x is less than y; returns false otherwise. *) 53 | 54 | end; 55 | 56 | -------------------------------------------------------------------------------- /src/Edlib/edlib.cm: -------------------------------------------------------------------------------- 1 | Group 2 | 3 | structure Edlib 4 | structure Set 5 | structure EqSet 6 | structure ListSort 7 | 8 | signature ORDERING 9 | 10 | is 11 | 12 | $/basis.cm 13 | Edlib.sml 14 | EDLIB_GENERAL.sml 15 | EdlibGeneral.sml 16 | LIST-sig.sml 17 | List.sml 18 | EQ_SET.sml 19 | EqSet.sml 20 | LIST_PAIR.sml 21 | ListPair.sml 22 | LIST_SORT.sml 23 | ListSort.sml 24 | SET-sig.sml 25 | Set.sml 26 | ORDERING.sml 27 | -------------------------------------------------------------------------------- /src/Edlib/edlib.pm: -------------------------------------------------------------------------------- 1 | 2 | local 3 | EDLIB_GENERAL.sml EdlibGeneral.sml 4 | LIST.sml List.sml 5 | EQ_SET.sml SET.sml 6 | LIST_PAIR.sml ListPair.sml LIST_SORT.sml 7 | in 8 | ListSort.sml 9 | Set.sml 10 | EqSet.sml 11 | ORDERING.sml 12 | Edlib.sml 13 | end 14 | 15 | -------------------------------------------------------------------------------- /src/Manager/.cvsignore: -------------------------------------------------------------------------------- 1 | CM PM -------------------------------------------------------------------------------- /src/Manager/FREE_IDS.sml: -------------------------------------------------------------------------------- 1 | 2 | signature FREE_IDS = 3 | sig 4 | 5 | type longtycon and longstrid and strid and longid 6 | type funid and sigid 7 | type topdec and dec and strexp and sigexp 8 | 9 | type longids = {funids: funid list, sigids: sigid list, 10 | longstrids: longstrid list, longtycons: longtycon list, 11 | longvids: longid list} 12 | 13 | val fid_topdec : topdec -> longids 14 | val fid_strexp : strexp -> longids 15 | val fid_strexp_sigexp : strid -> strexp -> sigexp -> longids (* in strexp, do not include 16 | * longids with qualifier strid *) 17 | val fid_dec : dec -> longids 18 | 19 | 20 | type StringTree 21 | val layout_longids : longids -> StringTree 22 | 23 | end -------------------------------------------------------------------------------- /src/Manager/INT_MODULES.sml: -------------------------------------------------------------------------------- 1 | 2 | signature INT_MODULES = 3 | sig 4 | type IntBasis and topdec and modcode 5 | 6 | type prjid = string 7 | 8 | val interp : prjid * IntBasis * topdec * string -> IntBasis * modcode (* Can effect repository. 9 | * The string is the string-rep of 10 | * the funid for the unit. *) 11 | end 12 | -------------------------------------------------------------------------------- /src/Manager/MANAGER-sig.sml: -------------------------------------------------------------------------------- 1 | 2 | signature MANAGER = 3 | sig 4 | 5 | structure ErrorCode : ERROR_CODE 6 | 7 | exception PARSE_ELAB_ERROR of ErrorCode.ErrorCode list 8 | 9 | val build : string -> unit (* build pmfile builds the project pmfile. 10 | * May raise PARSE_ELAB_ERROR. *) 11 | 12 | val comp : string -> unit (* comp path compiles path into file `run'. 13 | * Log's, vcg's and linkfile are put in current directory. 14 | * May raise PARSE_ELAB_ERROR. *) 15 | 16 | val elab : string -> unit (* elab path elaborates path 17 | * May raise PARSE_ELAB_ERROR. *) 18 | end 19 | -------------------------------------------------------------------------------- /src/Manager/OPACITY_ELIM.sml: -------------------------------------------------------------------------------- 1 | 2 | signature OPACITY_ELIM = 3 | sig 4 | structure TyName : TYNAME 5 | structure OpacityEnv : OPACITY_ENV 6 | sharing OpacityEnv.TyName = TyName 7 | 8 | type realisation 9 | type topdec 10 | type opaq_env = OpacityEnv.opaq_env 11 | 12 | (* Eliminate opaque signature constraints by translating them into 13 | * transparent signature constraints; this is fine, because, we have 14 | * already done elaboration at this stage. One can prove that 15 | * opaque signature constraints only limit what programs 16 | * elaborate. The translation here also alter type information 17 | * recorded during elaboration. Martin Elsman 13/10/97 *) 18 | 19 | val opacity_elimination : opaq_env * topdec -> topdec * opaq_env 20 | (* post elab topdec *) 21 | 22 | end -------------------------------------------------------------------------------- /src/Manager/PARSE_ELAB.sml: -------------------------------------------------------------------------------- 1 | (*$PARSE_ELAB: ERROR_CODE*) 2 | 3 | signature PARSE_ELAB = 4 | sig 5 | structure ErrorCode : ERROR_CODE 6 | 7 | type Report and InfixBasis and ElabBasis and topdec 8 | 9 | type prjid = string 10 | 11 | datatype Result = SUCCESS of {report: Report, infB: InfixBasis, 12 | elabB: ElabBasis, topdec: topdec} 13 | | FAILURE of Report * ErrorCode.ErrorCode list 14 | 15 | val parse_elab : {infB: InfixBasis, elabB: ElabBasis, 16 | prjid: prjid, file: string} -> Result 17 | 18 | val refine_string : string -> unit 19 | val refine_stdin : unit -> unit 20 | val refine_file : string -> unit 21 | 22 | val currentInfB : InfixBasis ref 23 | val currentElabB : ElabBasis ref 24 | 25 | val resetBasis : unit -> unit 26 | 27 | end 28 | -------------------------------------------------------------------------------- /src/Parsing/.cvsignore: -------------------------------------------------------------------------------- 1 | Infixing.sml.flc 2 | Topdec.grm.desc CM PM 3 | Topdec.grm.sml 4 | -------------------------------------------------------------------------------- /src/Parsing/HOOKS.sml: -------------------------------------------------------------------------------- 1 | (* MAKE Hooks for automatic file generation. *) 2 | 3 | (*$LexSML_: ParseSIG_ LEX_BASICS LEX_UTILS*) 4 | val _ = System.use "Parsing/Topdec.lex.sml"; 5 | 6 | (*$ParseSIG_: MyBase*) 7 | val _ = System.use "Parsing/Topdec.grm.sig"; 8 | 9 | (*$ParseSML_: MyBase ParseSIG_ LEX_BASICS GRAMMAR_UTILS*) 10 | val _ = System.use "Parsing/Topdec.grm.sml"; 11 | -------------------------------------------------------------------------------- /src/Parsing/INFIXING-sig.sml: -------------------------------------------------------------------------------- 1 | (* INFIXING - resolve infix expressions and patterns, and try to make some 2 | sense of `fun'-declarations. *) 3 | 4 | (*$INFIXING*) 5 | signature INFIXING = 6 | sig 7 | type InfixBasis 8 | type topdec 9 | type Report 10 | 11 | datatype 'a result = SUCCESS of 'a | FAILURE of Report 12 | val resolve: InfixBasis * topdec -> (InfixBasis * topdec) result 13 | end; 14 | 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | -------------------------------------------------------------------------------- /src/Parsing/INFIX_STACK.sml: -------------------------------------------------------------------------------- 1 | (* INFIX_STACK - we've distilled out all the common algorithmic code for 2 | dealing with precedence of operators, and put it into 3 | a functor which can be parameterised for operation over 4 | expressions or patterns. Non-trivial, though - expressions 5 | and patterns are rather wildly different things. *) 6 | 7 | (*$INFIX_STACK*) 8 | signature INFIX_STACK = 9 | sig 10 | type InfixBasis 11 | type AtomObject 12 | type FullObject 13 | 14 | val resolveInfix: InfixBasis * AtomObject list -> FullObject 15 | end; 16 | -------------------------------------------------------------------------------- /src/Parsing/PARSE-sig.sml: -------------------------------------------------------------------------------- 1 | (* The lexing function is expressed in concrete types because of the untidy 2 | nature of the MLLex and MLYacc interfaces. You really don't want to see 3 | them. *) 4 | 5 | (*$PARSE*) 6 | signature PARSE = 7 | sig 8 | type InfixBasis 9 | type topdec 10 | type SourceReader 11 | 12 | val nameOf: SourceReader -> string 13 | 14 | val sourceFromStdIn: unit -> SourceReader 15 | val sourceFromFile: string -> SourceReader (*may raise Io s*) 16 | val sourceFromString: string -> SourceReader 17 | 18 | type Report 19 | 20 | (* In the following, the reason for an intermediate State type is that 21 | SourceReaders are line-by-line things. On a successful parse we want to 22 | continue reading the current line rather than rebuilding the lexing 23 | context and starting again (on the next line). *) 24 | 25 | type State 26 | datatype Result = SUCCESS of InfixBasis * topdec * State 27 | | ERROR of Report 28 | | LEGAL_EOF (* End-of-file before a phrase encountered. 29 | (EOF in the middle of a phrase is an 30 | error) *) 31 | 32 | val begin: SourceReader -> State 33 | val parse: InfixBasis * State -> Result 34 | end; 35 | -------------------------------------------------------------------------------- /src/Parsing/parsing.cm: -------------------------------------------------------------------------------- 1 | Group is 2 | 3 | -------------------------------------------------------------------------------- /src/cm2mlb/Makefile: -------------------------------------------------------------------------------- 1 | ## Copyright (C) 2010 Matthew Fluet. 2 | # 3 | # MLton is released under a BSD-style license. 4 | # See the file MLton-LICENSE for details. 5 | ## 6 | 7 | # 8 | # SML/NJ tools and heap suffix 9 | # 10 | ML_BUILD := ml-build 11 | ML_BUILD_FLAGS := 12 | ML_HEAP_SUFFIX := $(shell echo 'TextIO.output (TextIO.stdErr, SMLofNJ.SysInfo.getHeapSuffix ());' | sml 2>&1 1> /dev/null) 13 | 14 | # 15 | # cm2mlb root .cm 16 | # 17 | CM2MLB_CM := cm2mlb.cm 18 | # 19 | # cm2mlb heap image 20 | # 21 | CM2MLB_HEAP := cm2mlb.$(ML_HEAP_SUFFIX) 22 | 23 | all: $(CM2MLB_HEAP) 24 | 25 | $(CM2MLB_HEAP): cm2mlb.cm cm2mlb.sml gen-mlb.sml cm2mlb-map 26 | rm -f $(CM2MLB_HEAP) 27 | # $(ML_BUILD) $(ML_BUILD_FLAGS) $(CM2MLB_CM) CM2MLB.main $(CM2MLB_HEAP) 28 | ( \ 29 | echo 'if (CM.make "cm2mlb.cm") handle _ => false'; \ 30 | echo ' then ()'; \ 31 | echo ' else OS.Process.exit OS.Process.failure;'; \ 32 | echo 'CM2MLB.export();' \ 33 | ) | sml 34 | 35 | .PHONY: clean 36 | clean: 37 | ../../bin/clean 38 | 39 | SMLDIR := $(dir $(shell which sml)) 40 | .PHONY: install 41 | install: $(CM2MLB_HEAP) 42 | rm -f $(SMLDIR).heap/$(CM2MLB_HEAP) $(SMLDIR)cm2mlb 43 | cp $(CM2MLB_HEAP) $(SMLDIR).heap 44 | (cd $(SMLDIR) ; ln -s .run-sml cm2mlb) -------------------------------------------------------------------------------- /src/cm2mlb/cm2mlb-map: -------------------------------------------------------------------------------- 1 | $SMLNJ-BASIS $(SML_LIB)/basis 2 | $basis.cm $(SML_LIB)/basis 3 | $basis.cm/basis.cm $(SML_LIB)/basis/basis.mlb 4 | 5 | $SMLNJ-ML-YACC-LIB $(SML_LIB)/mlyacc-lib 6 | $SMLNJ-ML-YACC-LIB/ml-yacc-lib.cm $(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb 7 | $ml-yacc-lib.cm $(SML_LIB)/mlyacc-lib 8 | $ml-yacc-lib.cm/ml-yacc-lib.cm $(SML_LIB)/mlyacc-lib/mlyacc-lib.mlb 9 | 10 | $cml $(SML_LIB)/cml 11 | $cml/cml.cm $(SML_LIB)/cml/cml.mlb 12 | 13 | $c $(SML_LIB)/mlnlffi-lib 14 | $c/c.cm $(SML_LIB)/mlnlffi-lib/mlnlffi-lib.mlb 15 | 16 | $SMLNJ-LIB $(SML_LIB)/smlnj-lib 17 | $controls-lib.cm $(SML_LIB)/smlnj-lib/Controls 18 | $hash-cons-lib.cm $(SML_LIB)/smlnj-lib/HashCons 19 | $html-lib.cm $(SML_LIB)/smlnj-lib/HTML 20 | $inet-lib.cm $(SML_LIB)/smlnj-lib/INet 21 | $pp-lib.cm $(SML_LIB)/smlnj-lib/PP 22 | $reactive-lib.cm $(SML_LIB)/smlnj-lib/Reactive 23 | $regexp-lib.cm $(SML_LIB)/smlnj-lib/RegExp 24 | $smlnj-lib.cm $(SML_LIB)/smlnj-lib/Util 25 | $unix-lib.cm $(SML_LIB)/smlnj-lib/Unix 26 | 27 | $ckit-lib.cm $(SML_LIB)/ckit-lib 28 | $ckit-lib.cm/ckit-lib.cm $(SML_LIB)/ckit-lib/ckit-lib.mlb 29 | 30 | $SMLNJ-MLRISC $(SML_LIB)/mlrisc-lib/mlb 31 | -------------------------------------------------------------------------------- /src/cm2mlb/cm2mlb.cm: -------------------------------------------------------------------------------- 1 | Group 2 | structure CM2MLB 3 | is 4 | $/pgraph.cm 5 | $smlnj/cm.cm 6 | $smlnj/viscomp/core.cm 7 | $/smlnj-lib.cm 8 | $/basis.cm 9 | gen-mlb.sml 10 | cm2mlb.sml 11 | -------------------------------------------------------------------------------- /src/sources.cm: -------------------------------------------------------------------------------- 1 | Group 2 | 3 | structure R (* Cidre *) 4 | 5 | is 6 | 7 | $/basis.cm 8 | (* $/smlnj-lib.cm *) 9 | Common/common.cm 10 | (* Compiler/compiler.cm *) 11 | 12 | (* Manager/FREE_IDS.sml 13 | Manager/FreeIds.sml 14 | Manager/INT_MODULES.sml 15 | Manager/IntModules.sml 16 | Manager/OPACITY_ELIM.sml 17 | Manager/OpacityElim.sml 18 | *) 19 | Manager/PARSE_ELAB.sml 20 | Manager/ParseElab.sml 21 | (* Manager/MANAGER_OBJECTS.sml 22 | Manager/ManagerObjects.sml 23 | Manager/MANAGER.sml 24 | Manager/Manager.sml 25 | *) 26 | Common/Elaboration.sml 27 | (* Common/Execution.sml *) 28 | (* Common/KitCompiler.sml *) 29 | Common/RefineCheck.sml 30 | 31 | (* Cidre/cidre.cm *) 32 | 33 | (*$smlnj/compiler/current.cm 34 | $smlnj/cm.cm 35 | 36 | CMIntegration/CMIntegration.sml *) -------------------------------------------------------------------------------- /src/sources.pm: -------------------------------------------------------------------------------- 1 | import Edlib/edlib.pm 2 | Common/common.pm 3 | Compiler/compiler.pm 4 | 5 | in 6 | Manager/FREE_IDS.sml 7 | Manager/FreeIds.sml 8 | Manager/INT_MODULES.sml 9 | Manager/MANAGER_OBJECTS.sml 10 | Manager/OPACITY_ELIM.sml 11 | Manager/PARSE_ELAB.sml 12 | Manager/MANAGER.sml 13 | 14 | Manager/IntModules.sml 15 | Manager/OpacityElim.sml 16 | Manager/ParseElab.sml 17 | Manager/ManagerObjects.sml 18 | Manager/Manager.sml 19 | 20 | Common/Elaboration.sml 21 | Common/Execution.sml 22 | Common/SMLofNJOnKit.sml (* hack *) 23 | Common/KitCompiler.sml 24 | Common/KitOnKit.sml (* running the Kit *) 25 | end 26 | -------------------------------------------------------------------------------- /test-examples/bugs/all-datatype-tyvars-generalised.sml: -------------------------------------------------------------------------------- 1 | (* This example crashes the elaborator in the ML/Kit 3.0, because all 2 | tyvars are incorrectly generalised, but the explicitly scoped variable 3 | 'a should not be. 4 | 5 | If the elaborator was fixed, then the sort checking code would also need to 6 | be fixed otherwise it would crash. - Rowan 14aug02 7 | 8 | [Checked 12sep03, this is still the case. - Rowan] *) 9 | 10 | 11 | local fun 'a f x:'a = x 12 | in 13 | datatype T = c of 'a * 'b (* Both 'a and 'b are generalised, each of which leads to a crash *) 14 | end (* instead of an error message. *) -------------------------------------------------------------------------------- /test-examples/bugs/cant-specify-manifest-opaque-refinements.sml: -------------------------------------------------------------------------------- 1 | 2 | structure S :> sig type 'a t (*[ sortdef 'a d < t ]*) end = 3 | struct 4 | datatype 'a t = T of 'a -> 'a | TT of 'a -> unit 5 | (*[ datasort 'a d = T of 'a -> 'a ]*) 6 | end 7 | 8 | signature S2 = sig 9 | 10 | type 'a d = 'a S.t 11 | 12 | (* Now, what's the equivalent for refinements? *) 13 | (* There's no way to just "package" them up with the type. *) 14 | 15 | (*[ sortdef 'a d < S.t ]*) (* Accepted due to a bug currently, but crashes below. *) 16 | 17 | end 18 | 19 | 20 | (* This at least prints an appropriate error about giving the whole signature - 21 | but there's no way to give the whole signature! *) 22 | (* 23 | signature S3 = S2 where type 'a d = 'a S.t 24 | *) 25 | 26 | (* Reports a bug, then prints a rigidity error. *) 27 | structure ST2 :> S2 = S 28 | -------------------------------------------------------------------------------- /test-examples/bugs/opaque-refinements-of-datasorts-not-caught.sml: -------------------------------------------------------------------------------- 1 | signature S = sig 2 | 3 | datatype 'a d = D 4 | (*[ datasort '+a d = D ]*) 5 | (* (*[ sortdef '+a d |: d ]*) 6 | (*[ sortdef '+a srt |: d ]*) 7 | *) 8 | end 9 | 10 | 11 | signature S2 = sig 12 | 13 | type 'a d 14 | (*[ sortdef '+a d2 < d ]*) 15 | (*[ subsort d < d2 ]*) 16 | (*[ sortdef '+a srt2 < d ]*) 17 | 18 | end 19 | -------------------------------------------------------------------------------- /test-examples/bugs/opaque-sig-mixed-defs-crashs.sml: -------------------------------------------------------------------------------- 1 | 2 | structure S :> sig type 'a d (*[ sortdef 'a srt2 < d ]*) end = 3 | struct 4 | datatype 'a d = T of 'a -> 'a | TT of 'a -> unit 5 | (*[ datasort 'a srt2 = TT of 'a -> unit ]*) 6 | end 7 | 8 | 9 | signature S2 = sig 10 | type 'a d = 'a S.d 11 | (*[ sortdef '+a srt2 < d ]*) (* This should be caught as an opaque refinement of an existing type. *) 12 | end 13 | 14 | structure ST2 :> S2 = S (* Instead here it prints "BUG: RefinedEnvironments.conjoinRL srt2<1454>, srt2<1451>" *) 15 | (* an then correctly reports a rigid type clash error for srt2. *) 16 | -------------------------------------------------------------------------------- /test-examples/bugs/robs-pattern-bug-min.sml: -------------------------------------------------------------------------------- 1 | datatype foo = BAR | BAZ 2 | (*[ datasort bar = BAR ]*) 3 | 4 | (*[ val check: unit -> unit ]*) 5 | fun check () = 6 | (( (case (raise Match (*[ <: bar ]*)) of 7 | BAR => ()) ) 8 | ; ()) 9 | 10 | -------------------------------------------------------------------------------- /test-examples/bugs/sigs-cant-specify-type-constr-variance.sml: -------------------------------------------------------------------------------- 1 | 2 | (* There's two things wrong: 3 | a) The variance of d isn't improved, instead d2 loses it's variance 4 | b) The variance for the struct in the assumesig doesn't match the signature. 5 | Instead it's always mixed variance. 6 | 7 | Okay, this works now. When d becomes a subsort of d2, it acquires covariance. 8 | And it fails when you remove the "+" in d2 in S2. As it should. 9 | *) 10 | signature S2 = sig 11 | 12 | type 'a d 13 | (*[ sortdef '+a d2 < d ]*) 14 | (*[ subsort d < d2 ]*) 15 | (*[ sortdef '+a srt2 < d ]*) 16 | 17 | end 18 | 19 | structure ST = struct (*[ assumesig S2 ]*) end 20 | 21 | 22 | structure S3 = struct 23 | 24 | (*[ f <: 'a ST.srt2 ST.d -> 'a ST.d ST.d ]*) 25 | fun f x = x 26 | 27 | (*[ g <: 'a ST.srt2 VectorSlice.slice -> 'a ST.d VectorSlice.slice ]*) 28 | fun g x = x 29 | 30 | 31 | end 32 | 33 | 34 | 35 | 36 | 37 | (* This is just for comparison - for datasorts it seems to work. *) 38 | (* 39 | signature S = sig 40 | 41 | datatype 'a d = D 42 | (*[ datasort '+a d = D ]*) 43 | (* (*[ sortdef '+a d |: d ]*) 44 | (*[ sortdef '+a srt |: d ]*) 45 | *) 46 | end 47 | *) 48 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/README: -------------------------------------------------------------------------------- 1 | This directory contains examples which previously triggered bugs. 2 | 3 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/abstract-sort.sml: -------------------------------------------------------------------------------- 1 | 2 | signature S = 3 | sig 4 | type t 5 | (*[ sortdef s1 |: t ]*) 6 | (*[ sortdef s2 < t ]*) 7 | end 8 | 9 | structure S :> S = 10 | struct 11 | datatype t = C of t -> t | C2 of unit 12 | 13 | (*[ datasort s1 = C of s1 -> s1 ]*) 14 | (*[ datasort s2 = C2 of unit ]*) 15 | end -------------------------------------------------------------------------------- /test-examples/fixed-bugs/constructor-sorts.sml: -------------------------------------------------------------------------------- 1 | (* This example used to trigger a bug in the way sorts for 2 | constructors were calculated. That's now fixed. 3 | 4 | But, it still demonstrates that something more needs to be printed 5 | for sorts which are equivalent to each other. Currently only 6 | information for one representitive is included. 7 | *) 8 | 9 | datatype three = C1 | C2 | C3 10 | and mythree = D of three 11 | 12 | (*[ datasort s1 = C1 and s2 = C2 13 | and r12 = D of s1 | D of s2 ]*) 14 | 15 | (*[ datasort s12 = C1 | C2 16 | and r12' = D of s12 ]*) 17 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/crash-printing-functor-result-simplified.sml: -------------------------------------------------------------------------------- 1 | 2 | functor F () = 3 | struct 4 | datatype D = C 5 | end 6 | 7 | structure S = F () 8 | 9 | structure S2 = struct type t = S.D end 10 | 11 | structure S3 = F () 12 | 13 | structure S4 = struct type t = S3.D val c = S3.C end 14 | 15 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/datasort-qualified-constructors-wrong.sml: -------------------------------------------------------------------------------- 1 | 2 | structure Mine = struct 3 | (*[ datasort 'a null = List.nil ]*) 4 | 5 | val x = List.nil 6 | val y (*[:> 'a null ]*) = List.nil 7 | end -------------------------------------------------------------------------------- /test-examples/fixed-bugs/datasort-qualified-constructors.sml: -------------------------------------------------------------------------------- 1 | 2 | structure S = struct 3 | datatype t = C1 | C2 4 | (*[ datasort s = C1 ]*) 5 | end 6 | 7 | structure S2 = struct 8 | 9 | (* The following doesn't work, because 10 | the sorts for values in S doesn't change. *) 11 | 12 | (*[ datasort s2 = S.C2 ]*) 13 | 14 | val y (*[:> s2 ]*) = S.C2 15 | end 16 | 17 | 18 | structure S3 = struct 19 | 20 | (* Replicating the datatype to here fixes the problem. *) 21 | 22 | datatype t = datatype S.t 23 | (*[ datasort s2 = C2 ]*) 24 | 25 | val y (*[:> s2 ]*) = C2 26 | 27 | end 28 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/datatype-in-functor-parameter-wrong-sortname.sml: -------------------------------------------------------------------------------- 1 | 2 | (*** BUG: This program seems to result in a TYNAMEENV that isn't consistent with 3 | the sortname for P.MYNIL in the "duplicate" function. 4 | This bug has been fixed. - Rowan 12sep03 5 | ***) 6 | 7 | (*** LOG: 8 | - R.refine_file "../test-ssml/bugs/datatype-in-functor-parameter.sml"; 9 | Impossible: RefDec.dividePatsort(2) 10 | 11 | uncaught exception CRASH 12 | raised at: Common/Crash.sml:11.8-11.13 13 | Manager/ParseElab.sml:164.59 14 | Manager/ParseElab.sml:169.34 15 | 16 | 17 | ***) 18 | 19 | signature MySig = 20 | sig 21 | datatype 'a MyList = MYNIL | MYCONS of 'a * 'a MyList 22 | end 23 | 24 | functor testFunctor( P : MySig 25 | (*** inlining MySig avoids the bug ***) 26 | (* structure P : sig 27 | datatype 'a MyList = MYNIL | MYCONS of 'a * 'a MyList 28 | end 29 | *) 30 | ) = 31 | struct 32 | open P 33 | fun duplicate P.MYNIL = P.MYNIL 34 | | duplicate (P.MYCONS (x, t)) = P.MYCONS (x, P.MYCONS (x, duplicate t)) 35 | end 36 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/datatype-names-missing-functor.sml: -------------------------------------------------------------------------------- 1 | 2 | signature S = sig datatype t = C of unit end 3 | 4 | 5 | functor F (structure s : S) = 6 | struct 7 | open s 8 | local fun f (s.C x) = x 9 | in 10 | val x = () 11 | end 12 | end -------------------------------------------------------------------------------- /test-examples/fixed-bugs/elabtopdec-bug.sml: -------------------------------------------------------------------------------- 1 | (* local *) 2 | val xxxx = () 3 | val yyyy = () 4 | structure A = struct end 5 | val zzzz = yyyy 6 | (* in *) 7 | val aaaa = () 8 | (* end *) -------------------------------------------------------------------------------- /test-examples/fixed-bugs/field-swap-bug.sml: -------------------------------------------------------------------------------- 1 | fun fst {1=x:int, 2=y:unit} = x; 2 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/functor-where-bug.sml: -------------------------------------------------------------------------------- 1 | functor RefDec( 2 | structure OG: sig 3 | type info 4 | datatype datbind = DATBIND of info 5 | end where type info = unit 6 | ) = 7 | struct 8 | val x = OG.DATBIND 9 | end; 10 | 11 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/ignored-wrong-in-all-covariant.sml: -------------------------------------------------------------------------------- 1 | 2 | datatype 'a option = NONE | SOME of 'a 3 | 4 | (*[ datasort tt = true ]*) 5 | (*[ datasort 'a none = NONE ]*) 6 | (*[ datasort 'a some = SOME of 'a ]*) 7 | 8 | (* 9 | (*[ val x :> bool none ]*) 10 | val x = NONE 11 | 12 | (*[ val y :> tt none ]*) 13 | val y = x 14 | 15 | (*[ val x2 :> bool some ]*) 16 | val x2 = SOME false 17 | 18 | 19 | (*[ val y2 :> tt some ]*) 20 | val y2 = x 21 | *) -------------------------------------------------------------------------------- /test-examples/fixed-bugs/intersection-allowed-in-types.sml: -------------------------------------------------------------------------------- 1 | (* A tiny example that demonstrates that "&" can be used in types, when it should 2 | be restricted to sorts. This shouldn't be very hard to fix, and we'd like to prevent 3 | programs from sort checking that won't type check with a standard SML compiler. 4 | - Rowan 14aug02, updated 12sep03. *) 5 | 6 | () : unit & unit 7 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/no-lattice-printed.sml: -------------------------------------------------------------------------------- 1 | 2 | local 3 | (* datatype bool = datatype bool 4 | datatype option = datatype option 5 | *) 6 | in 7 | datatype abcd = C of bool * bool 8 | 9 | (*[ datasort tt = true ]*) 10 | (*[ datasort '?a none = NONE ]*) 11 | (*[ datasort '+a some = SOME of '+a ]*) 12 | 13 | (*[ sortdef abc = int * int ]*) 14 | 15 | (*[ val x :> bool none ]*) 16 | val x = NONE 17 | 18 | (*[ val y :> tt none ]*) 19 | val y = x 20 | 21 | (*[ val x2 :> bool some ]*) 22 | val x2 = SOME false 23 | 24 | 25 | (*[ val y2 :> tt none ]*) 26 | val y2 = x 27 | 28 | end -------------------------------------------------------------------------------- /test-examples/fixed-bugs/opaque-refinements-generate-types.sml: -------------------------------------------------------------------------------- 1 | 2 | signature S2 = sig 3 | 4 | type 'a d 5 | (*[ sortdef '+a d2 < d ]*) 6 | (*[ subsort d < d2 ]*) 7 | (*[ sortdef '+a srt2 < d ]*) 8 | 9 | (*[ abc <: 'a srt2 ]*) 10 | val abc : 'a d 11 | 12 | end 13 | 14 | structure ST = struct (*[ assumesig S2 ]*) end 15 | 16 | 17 | type 'a x = 'a ST.d 18 | type 'a x = 'a ST.d2 (* reports a type. I"m guessing because the sort equals the mlTy *) 19 | (*type 'a x = 'a ST.str2*) (* fails with "unbound type constructor ST.str2." *) 20 | (* Argh! str2 <> srt2 ! Oh dear, a typo... *) 21 | 22 | (* Turns out this is a feature rather than a bug. Basically the elaborator needs to 23 | interpret the types associated with sort annotations, and it seems reasonable not 24 | to allow an unrelated type and sort with the same name. So, types are always generated 25 | with the same name as types. *) 26 | 27 | (*[ x <: 'a ST.srt2 ]*) 28 | val x : 'a ST.srt2 = ST.abc 29 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/parameter-unions-unsound.sml: -------------------------------------------------------------------------------- 1 | 2 | 3 | (*[ datasort tt = true and ff = false ]*) 4 | 5 | datatype 'a prod = PROD of 'a * 'a 6 | 7 | datatype bools = B of bool prod 8 | 9 | (*[ datasort ttffbool = B of tt prod 10 | | B of ff prod 11 | ]*) 12 | 13 | 14 | (*[ val f :> bools -> tt ]*) 15 | fun f (B (PROD (true, true))) = true 16 | | f (B (PROD (false, false))) = true 17 | | f (B (PROD _)) = false 18 | 19 | val x = f (B (PROD (true, false))) 20 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/qualified-top-level.sml: -------------------------------------------------------------------------------- 1 | 2 | structure Eg = struct 3 | (* datatype list = datatype list *) 4 | (*[ datasort 'a null = nil ]*) 5 | 6 | val x = nil 7 | val y (*[:> 'a null ]*) = nil 8 | 9 | end 10 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/realiser-combines-datatypes.sml: -------------------------------------------------------------------------------- 1 | 2 | signature S = 3 | sig 4 | type t 5 | (*[ sortdef s1 < t ]*) 6 | 7 | type t2 8 | (*[ sortdef s2 < t2 ]*) 9 | 10 | end 11 | 12 | structure S :> S = 13 | struct 14 | datatype t = C1 | C2 15 | (*[ datasort s1 = C1 ]*) 16 | (*[ datasort s2 = C2 ]*) 17 | 18 | (* datatype t2 = datatype t *) 19 | type t2 = t 20 | end 21 | 22 | functor F() :> S = 23 | struct 24 | datatype t = C1 of t -> t | C2 of t -> t 25 | (*[ datasort s1 = C1 of t -> s1 ]*) 26 | (*[ datasort s2 = C2 of t -> s2 ]*) 27 | 28 | (* datatype t2 = datatype t *) 29 | type t2 = t 30 | end -------------------------------------------------------------------------------- /test-examples/fixed-bugs/sig-datatype-replication-crashes.sml: -------------------------------------------------------------------------------- 1 | (* A simple example to demonstrate that the checker handles datatype 2 | replication in signatures. Rowan 17sep04 *) 3 | 4 | local 5 | structure A = 6 | struct 7 | datatype nat = z | s of nat 8 | (*[ datasort ev = z | s of od and od = s of ev ]*) 9 | 10 | structure T = 11 | struct 12 | datatype t = datatype nat 13 | end 14 | 15 | (*[ val f :> nat -> ev ]*) 16 | fun f (s x) = s (s (f x)) 17 | | f z = z 18 | end : sig 19 | datatype nat = z | s of nat 20 | structure T : 21 | sig 22 | datatype t = datatype nat 23 | end 24 | (*[ datasort ev = z | T.s of od and od = s of ev ]*) 25 | (*[ val f :> ev -> ev ]*) 26 | val f : T.t -> T.t 27 | end 28 | in 29 | structure A = A 30 | val x = A.f 31 | end 32 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/sort-printing.sml: -------------------------------------------------------------------------------- 1 | 2 | datatype ('a, 'b) t = T1 | T2 3 | 4 | fun f T1 = () 5 | 6 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/top-level-val-sort-specs-propagate-to-other-files.sml: -------------------------------------------------------------------------------- 1 | 2 | (* If this file is loaded followed by the file top-level-val-sort-specs-propagate-to-other-files2 3 | an error occurs. Probably the val sort spec should be limited to one file. - Rowan 7sep04 *) 4 | 5 | datatype T = C 6 | 7 | (*[ val bugfun :> T -> T ]*) 8 | fun bugfun x = x 9 | 10 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/top-level-val-sort-specs-propagate-to-other-files2.sml: -------------------------------------------------------------------------------- 1 | 2 | (* If this file is loaded after top-level-val-sort-specs-propagate-to-other-files, 3 | an error occurs. *) 4 | 5 | datatype T = C 6 | 7 | fun bugfun C = C 8 | 9 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/transparent-sig.sml: -------------------------------------------------------------------------------- 1 | signature S = 2 | sig 3 | type t 4 | type t1 = t * t 5 | structure s3 : sig 6 | type t 7 | type t2 8 | (* (*[ sortdef r2 < t2 ]*) *) 9 | end where type t2 = t1 10 | val v : t 11 | val f : s3.t2 -> s3.t2 12 | end 13 | 14 | 15 | 16 | functor F(structure s:S 17 | structure s2:S where type s3.t = s.s3.t 18 | sharing s=s2 ) :> sig type t2 19 | val result : t2 end = 20 | struct 21 | type t2 = s.s3.t2 22 | (*[ val result :> s.s3.t2 ]*) 23 | val result = s2.f (s.v, s2.v) 24 | end -------------------------------------------------------------------------------- /test-examples/fixed-bugs/transparent-sig2.sml: -------------------------------------------------------------------------------- 1 | signature S = 2 | sig 3 | type t 4 | type t1 = t * t 5 | structure s3 : sig 6 | type t = t 7 | type t2 = t1 8 | (*[ sortdef r2 < t ]*) 9 | end 10 | val v : t 11 | val f : s3.t2 -> s3.t2 12 | end 13 | 14 | 15 | 16 | functor F(structure s:S 17 | structure s2:S where type s3.t = s.s3.t 18 | sharing s=s2 ) :> sig type t2 19 | val result : t2 end = 20 | struct 21 | type t2 = s.s3.t2 22 | (* (*[ val result :> s2.s3.r2 ]*) *) 23 | val result = s2.f (s.v, s2.v) 24 | end -------------------------------------------------------------------------------- /test-examples/fixed-bugs/tygoals-not-erased-in-refdec.sml: -------------------------------------------------------------------------------- 1 | 2 | (*[ datasort tt = true and ff = false ]*) 3 | 4 | 5 | (*[ val bugfun :> tt -> tt ]*) 6 | fun f y = 7 | let 8 | fun bugfun x = x 9 | in 10 | bugfun y 11 | end 12 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/tyvars-error-not-reported-crashes.sml: -------------------------------------------------------------------------------- 1 | 2 | structure SS = 3 | struct 4 | datatype 'a mixed = MM of 'a -> 'a | MM2 of 'a 5 | (*[ datasort '+a mixed2 = MM2 of 'a ]*) 6 | end :> sig type 'a mixed (*[ sortdef 'a mixed2 <| mixed ]*) end -------------------------------------------------------------------------------- /test-examples/fixed-bugs/tyvars-wrong.sml: -------------------------------------------------------------------------------- 1 | 2 | signature Map = 3 | sig 4 | eqtype ('a, 'b) map 5 | val composemap: ('b -> 'c) -> ('a, 'b) map -> ('a, 'c) map 6 | end 7 | 8 | structure Map :> Map = 9 | struct 10 | type ('a, 'b) map = ('a * 'b) list 11 | fun composemap x y = raise (Fail "Sorry") 12 | end 13 | 14 | (* (*[ val y :> ('b -> 'c) -> ('a, 'b) Map.map -> ('a, 'c) Map.map ]*) *) 15 | val y = Map.composemap -------------------------------------------------------------------------------- /test-examples/fixed-bugs/underscore-patterns-not-considered-empty.sml: -------------------------------------------------------------------------------- 1 | (*[ datasort tt = true and ff = false ]*) 2 | 3 | (* f is accepted, but g is not. *) 4 | 5 | (*[ val f :> bool -> tt ]*) 6 | fun f x = true 7 | | f y = false 8 | 9 | 10 | (*[ val g :> bool -> tt ]*) 11 | fun g x = true 12 | | g _ = false -------------------------------------------------------------------------------- /test-examples/fixed-bugs/variances-are-matched-with-transparent.sml: -------------------------------------------------------------------------------- 1 | 2 | structure SS = 3 | struct 4 | datatype '+a mixed = MM of '+a | MM2 of '+a 5 | (*[ datasort '+a mixed3 = MM2 of '+a ]*) 6 | (*[ datasort '+a mixed2 = MM of '+a ]*) 7 | (*[ sortdef 'a mixed4 = 'a mixed2 8 | val f :> 'a mixed4 -> 'a mixed4 ]*) 9 | fun f x = x 10 | end :> 11 | sig 12 | (* type 'a mixed 13 | (*[ sortdef 'a mixed2 <| mixed 14 | sortdef 'a mixed3 <| mixed 15 | sortdef 'a mixed4 <| mixed2 & mixed3 ]*) 16 | *) 17 | datatype 'a mixed = MM of 'a | MM2 of 'a 18 | (*[ datasort '+a mixed2 = MM of '+a ]*) 19 | (*[ datasort '+a mixed3 = MM2 of '+a ]*) 20 | (*[ datasort '+a mixed4 = MM of '+a ]*) 21 | 22 | (*[ val f :> 'a mixed2 -> 'a mixed ]*) 23 | val f : 'a mixed -> 'a mixed 24 | end -------------------------------------------------------------------------------- /test-examples/fixed-bugs/variances-not-improved.sml: -------------------------------------------------------------------------------- 1 | 2 | 3 | (*[ datasort tt = true ]*) 4 | (*[ datasort 'a none1 = NONE ]*) 5 | (*[ datasort 'a some1 = SOME of 'a ]*) 6 | (*[ datasort '?a none2 = NONE ]*) 7 | (*[ datasort '+a some2 = SOME of '+a ]*) 8 | 9 | 10 | (*[ val x :> bool none1 ]*) 11 | val x = NONE 12 | 13 | (* The following should succeed, if the variance is improved. *) 14 | (*[ val y :> tt none1 ]*) 15 | val y = x 16 | 17 | (*[ val x2 :> bool some1 ]*) 18 | val x2 = SOME false 19 | 20 | (* The following should fail, regardless. *) 21 | (*[ val y2 :> tt some1 ]*) 22 | (* val y2 = x *) 23 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/variances-not-improved2.sml: -------------------------------------------------------------------------------- 1 | 2 | datatype 'a c123 = C1 | C2 | C3 3 | 4 | (*[ datasort 'a c12 = C1 | C2 ]*) 5 | (*[ datasort 'a c23 = C2 | C3 ]*) 6 | 7 | (*[ datasort '-a c2 = C2 ]*) 8 | 9 | datatype 'a d = D of 'a c123 10 | 11 | (*[ datasort 'a d12 = D of 'a c12 ]*) 12 | 13 | (*[ datasort 'a c1 = C1 ]*) 14 | (*[ datasort 'a d12' = D of 'a c1 | D of 'a c2 ]*) 15 | 16 | 17 | -------------------------------------------------------------------------------- /test-examples/fixed-bugs/variances-not-matched.sml: -------------------------------------------------------------------------------- 1 | 2 | structure SS = 3 | struct 4 | datatype 'a mixed = MM of 'a -> 'a | MM2 of 'a 5 | (*[ datasort 'a mixed2 = MM2 of 'a ]*) 6 | end :> sig type 'a mixed (*[ sortdef '+a mixed2 <| mixed ]*) end -------------------------------------------------------------------------------- /test-examples/fixed-bugs/where.sml: -------------------------------------------------------------------------------- 1 | signature s = 2 | sig 3 | type t 4 | (*[ sortdef s |: t ]*) 5 | end where type t = int -------------------------------------------------------------------------------- /test-examples/fixed-performance-bugs/long-lists2.sml: -------------------------------------------------------------------------------- 1 | 2 | 3 | structure LongList = 4 | struct 5 | (*[ datasort 'a ev_l = nil | :: of 'a * 'a od_l 6 | and 'a od_l = :: of 'a * 'a ev_l ]*) 7 | 8 | val ll = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14] 9 | (* val ll = [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20] *) 10 | 11 | end -------------------------------------------------------------------------------- /test-examples/fixed-performance-bugs/ref-instance.sml: -------------------------------------------------------------------------------- 1 | 2 | (*[ datasort tt = true and ff = false ]*) 3 | 4 | (*[ val id :> (tt -> tt) ]*) 5 | fun id x = x 6 | val _ = ref id 7 | 8 | -------------------------------------------------------------------------------- /test-examples/fixed-performance-bugs/tarjan-sig.sml: -------------------------------------------------------------------------------- 1 | 2 | signature STACK = 3 | sig 4 | type 'a stack 5 | 6 | (*[ 7 | sortdef 'a valid < stack 8 | sortdef 'a nonempty < stack 9 | ]*) 10 | 11 | val push : 'a * 'a stack -> 'a stack 12 | val pop : 'a stack -> 'a * 'a stack 13 | 14 | (*[ 15 | val push : 'a * 'a valid -> ('a valid & 'a nonempty) 16 | val pop : ('a valid & 'a nonempty) -> 'a * 'a valid 17 | ]*) 18 | 19 | end 20 | -------------------------------------------------------------------------------- /test-examples/fp-examples/pairs.sml: -------------------------------------------------------------------------------- 1 | (* Pairs as functions *) 2 | (* Almost a Church encoding *) 3 | (* Author: Frank Pfenning *) 4 | (* Based on a student's idea form 15-312, Fall'03 *) 5 | 6 | datatype ('a,'b) sum = inl of 'a | inr of 'b 7 | (*[ 8 | datasort ('a,'b) left = inl of 'a 9 | and ('a,'b) right = inr of 'b 10 | ]*) 11 | 12 | type ('a,'b) pair = ('a -> 'b -> ('a,'b) sum) -> ('a,'b) sum 13 | (*[ 14 | sortdef ('a,'b) prod = ('a -> 'b -> ('a,'b) left) -> ('a,'b) left 15 | & ('a -> 'b -> ('a,'b) right) -> ('a,'b) right 16 | ]*) 17 | 18 | (*[ val pair : 'a -> 'b -> ('a,'b) prod ]*) 19 | fun pair (x:'a) (y:'b) : ('a,'b) pair = 20 | fn f => f x y 21 | (*[ val fst : ('a,'b) prod -> 'a ]*) 22 | fun fst (p:('a,'b) pair) : 'a = 23 | case p (fn x => fn y => inl x) of inl x => x (* missing case impossible! *) 24 | (*[ val snd : ('a,'b) prod -> 'b ]*) 25 | fun snd (p:('a,'b) pair) : 'b = 26 | case p (fn x => fn y => inr y) of inr y => y (* missing case impossible! *) 27 | 28 | val p12 = pair 1 2; 29 | val one = fst p12; 30 | val two = snd p12; 31 | 32 | val p1t = pair 1 true; 33 | val one = fst p1t; 34 | val t = snd p1t; 35 | 36 | val ptf = pair true false; 37 | val t = fst ptf; 38 | val f = snd ptf; 39 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/README: -------------------------------------------------------------------------------- 1 | This directory contains some examples designed to illustrate 2 | particular features of the design of the sort checker. 3 | 4 | Many of them are not currently well documented. 5 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/abstract-lattice-large.sml: -------------------------------------------------------------------------------- 1 | 2 | signature S = 3 | sig 4 | type t 5 | (*[ sortdef s1 |: t 6 | sortdef s2 |: t 7 | sortdef s3 |: t 8 | sortdef s4 |: t 9 | sortdef s5 |: t 10 | sortdef s6 |: t 11 | sortdef s7 |: t 12 | sortdef s8 |: t 13 | sortdef s9 |: t 14 | sortdef s10 |: t 15 | ]*) 16 | 17 | end 18 | 19 | (* 20 | - R.refine_file "../test-ssml/illustrative-examples/abstract-lattice-large.sml"; 21 | Sort Checking file: ../test-ssml/illustrative-examples/abstract-lattice-large.sml 22 | 23 | Time for Elaboration and Sort Checking 24 | non-gc system gc wallclock 25 | 105.682 0.000 39.617 105.682 26 | > signature S = 27 | sig 28 | type t 29 | sortdef t = t |: t 30 | sortdef s1 = s1 |: t 31 | sortdef s2 = s2 |: t 32 | sortdef s3 = s3 |: t 33 | sortdef s4 = s4 |: t 34 | sortdef s5 = s5 |: t 35 | sortdef s6 = s6 |: t 36 | sortdef s7 = s7 |: t 37 | sortdef s8 = s8 |: t 38 | sortdef s9 = s9 |: t 39 | sortdef s10 = s10 |: t 40 | 41 | Table of Intersections: 42 | [Skipped large table with 2047 X 2047 elements.] 43 | 44 | end 45 | val it = () : unit 46 | 47 | *) 48 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/abstract-lattice.sml: -------------------------------------------------------------------------------- 1 | 2 | signature S = 3 | sig 4 | type t 5 | (*[ sortdef s1 |: t 6 | sortdef s2 |: t ]*) 7 | 8 | (*[ subsort s1 & s2 < t & s1 ]*) 9 | (*[ subsort t & s1 < t & s2 ]*) 10 | (*[ subsort t & s2 < s1 & s2 ]*) 11 | end 12 | 13 | (* 14 | structure S :> S = 15 | struct 16 | datatype t = C of t -> t | C2 of unit 17 | 18 | (*[ datasort s1 = C of s1 -> s1 ]*) 19 | (*[ datasort s2 = C2 of unit ]*) 20 | end 21 | *) -------------------------------------------------------------------------------- /test-examples/illustrative-examples/backtracking.sml: -------------------------------------------------------------------------------- 1 | 2 | (*[ datasort tt = true and ff = false ]*) 3 | 4 | (* Only the best successful sort is chosen at the top (module) level *) 5 | (*[ val x <: tt, ff, bool ]*) 6 | val x = true 7 | 8 | 9 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/constructor-intersections.sml: -------------------------------------------------------------------------------- 1 | (* This example illustrates the calculation of the sorts of 2 | constructors. *) 3 | 4 | (*[ datasort tt = true and ff = false ]*) 5 | 6 | datatype d = C of bool -> bool 7 | 8 | (*[ datasort s1 = C of tt -> tt 9 | datasort s2 = C of ff -> ff 10 | ]*) 11 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/constructor-sorts.sml: -------------------------------------------------------------------------------- 1 | 2 | (* This example illustrates the calculation of the sorts of 3 | constructors. *) 4 | 5 | 6 | datatype three = C1 | C2 | C3 7 | datatype mythree = D of three 8 | 9 | (*[ datasort s1 = C1 10 | and s2 = C2 11 | and r12 = D of s1 | D of s2 ]*) 12 | 13 | (*[ datasort s12 = C1 | C2 14 | and r12' = D of s12 ]*) 15 | 16 | (*[ datasort s3 = C3 17 | and r13 = D of s1 | D of s3 18 | and r23 = D of s2 | D of s3 ]*) 19 | 20 | 21 | (*[ val f :> s12 -> r12' ]*) 22 | fun f x = D x -------------------------------------------------------------------------------- /test-examples/illustrative-examples/datasort-extrusion.sml: -------------------------------------------------------------------------------- 1 | 2 | local 3 | datatype myBool = myTrue | myFalse 4 | (*[ datasort myTT = myTrue 5 | and myFF = myFalse ]*) 6 | in 7 | (*[ val myNot :> myTT -> myFF 8 | & myFF -> myTT ]*) 9 | fun myNot myTrue = myFalse 10 | | myNot myFalse = myTrue 11 | val myBoolVal = myTrue 12 | end 13 | val myResult = myNot myBoolVal 14 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/datasort-no-extrusion-let.sml: -------------------------------------------------------------------------------- 1 | 2 | let 3 | (*[ datasort tt = true ]*) 4 | (*[ val f :> tt -> tt ]*) 5 | fun f x = x 6 | in 7 | f 8 | end -------------------------------------------------------------------------------- /test-examples/illustrative-examples/exception-matching.sml: -------------------------------------------------------------------------------- 1 | 2 | exception MyException 3 | 4 | (* This is accepted. We don't check coverage in a handle. *) 5 | fun g x = raise MyException handle Match => () 6 | 7 | (* This is rejected. *) 8 | fun f MyException = () 9 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/first-warnings.sml: -------------------------------------------------------------------------------- 1 | 2 | (*[ datasort tt = true and ff = false ]*) 3 | 4 | datatype t = C of bool 5 | (*[ datasort s = C of tt | C of ff ]*) 6 | 7 | (*[ val g :> ff -> unit ]*) 8 | fun g x = () 9 | 10 | (* There is an error here, it should be reported. The warning occurs for a different case 11 | so is omitted. *) 12 | fun f (C x) = let val true = x 13 | in g x 14 | end 15 | 16 | (* There is an error here, it should be reported, along with the warning. *) 17 | fun f (C x) = let val false = x 18 | in g x 19 | end 20 | 21 | (* There is only a warning here, so it should be reported. *) 22 | fun f (C x) = let val true = x 23 | in x 24 | end 25 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/ignored-allowed-in-all-covariant.sml: -------------------------------------------------------------------------------- 1 | 2 | (*[ datasort tt = true ]*) 3 | (*[ datasort '?a none = NONE ]*) 4 | 5 | (*[ val x :> bool none ]*) 6 | val x = NONE 7 | 8 | (*[ val y :> tt none ]*) 9 | val y = x 10 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/interesting-functor.sml: -------------------------------------------------------------------------------- 1 | 2 | 3 | functor F (type 'a t) = 4 | struct 5 | datatype d = D1 of d t | D2 6 | end 7 | 8 | structure S = F (type 'a t = 'a) 9 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/intersection-printing.sml: -------------------------------------------------------------------------------- 1 | 2 | datatype myFour = C1 | C2 | C3 | C4 3 | 4 | (*[ datasort my123 = C1 | C2 | C3 ]*) 5 | (*[ datasort my134 = C1 | C3 | C4 ]*) 6 | (*[ datasort my124 = C1 | C2 | C4 ]*) 7 | (*[ datasort my234 = C2 | C3 | C4 ]*) 8 | 9 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/intersection-realisation.sml: -------------------------------------------------------------------------------- 1 | 2 | (* This example demonstrates the checking for intersections during signature matching. *) 3 | 4 | signature S = 5 | sig 6 | type t 7 | (*[ sortdef s < t ]*) 8 | (*[ sortdef s2 < t ]*) 9 | (*[ sortdef s3 |: t ]*) 10 | 11 | (*[ subsort s3 < s & s2 ]*) 12 | 13 | val f : t 14 | end 15 | 16 | structure S : S = 17 | struct 18 | (*[ datasort tt = true and ff = false ]*) 19 | type t = bool -> bool 20 | (*[ sortdef t = (tt & ff) -> bool ]*) 21 | 22 | (*[ sortdef s = bool -> bool ]*) 23 | (*[ sortdef s2 = tt -> tt ]*) 24 | (*[ sortdef s3 = bool -> bool & tt -> bool ]*) 25 | 26 | fun f x = x 27 | end -------------------------------------------------------------------------------- /test-examples/illustrative-examples/large-lattice.sml: -------------------------------------------------------------------------------- 1 | 2 | datatype t = C1 | C2 | C3 | C4 | C5 | C6 | C7 | C8 | C9 | C10 | C11 3 | 4 | (*[ datasort s1 = C2 | C3 | C4 | C5 | C6 | C7 | C8 | C9 | C10 | C11 ]*) 5 | (*[ datasort s2 = C1 | C3 | C4 | C5 | C6 | C7 | C8 | C9 | C10 | C11 ]*) 6 | (*[ datasort s3 = C1 | C2 | C4 | C5 | C6 | C7 | C8 | C9 | C10 | C11 ]*) 7 | (*[ datasort s4 = C1 | C2 | C3 | C5 | C6 | C7 | C8 | C9 | C10 | C11 ]*) 8 | (*[ datasort s5 = C1 | C2 | C3 | C4 | C6 | C7 | C8 | C9 | C10 | C11 ]*) 9 | (*[ datasort s6 = C1 | C2 | C3 | C4 | C5 | C7 | C8 | C9 | C10 | C11 ]*) 10 | (*[ datasort s7 = C1 | C2 | C3 | C4 | C5 | C6 | C8 | C9 | C10 | C11 ]*) 11 | (*[ datasort s8 = C1 | C2 | C3 | C4 | C5 | C6 | C7 | C9 | C10 | C11 ]*) 12 | (*[ datasort s9 = C1 | C2 | C3 | C4 | C5 | C6 | C7 | C8 | C10 | C11 ]*) 13 | (* (*[ datasort s10= C1 | C2 | C3 | C4 | C5 | C6 | C7 | C8 | C9 | C11 ]*) 14 | (*[ datasort s11= C1 | C2 | C3 | C4 | C5 | C6 | C7 | C8 | C9 | C10 ]*) *) 15 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/lattice-consistency-correct.sml: -------------------------------------------------------------------------------- 1 | 2 | 3 | (* This example should be accepted: the second subsorting is validated 4 | by the structure, (r1 & r2 < s1 & s2). 5 | *) 6 | 7 | structure LatticeConsistency : 8 | sig 9 | type t 10 | (*[ sortdef s1 < t ]*) 11 | (*[ sortdef s2 < t ]*) 12 | (*[ sortdef r1 < t ]*) 13 | (*[ sortdef r2 < t ]*) 14 | 15 | (*[ subsort s1 & s2 < r1 & r2 ]*) 16 | (*[ subsort r1 & r2 < s1 & s2 ]*) 17 | end 18 | = 19 | struct 20 | datatype t = C | D1 | D2 | E1 | E2 | F 21 | 22 | (*[ datasort s1 = C | D1 and s2 = C | D2 ]*) 23 | (*[ datasort r1 = C | E1 (* | F *) and r2 = C | E2 (* | F *) ]*) 24 | 25 | end -------------------------------------------------------------------------------- /test-examples/illustrative-examples/lattice-consistency.sml: -------------------------------------------------------------------------------- 1 | 2 | 3 | (* This example should be rejected: the second subsorting isn't validated 4 | by the structure, (not: r1 & r2 < s1 & s2). An additional check needs 5 | to be added to the implementation. 6 | *) 7 | 8 | structure LatticeConsistency : 9 | sig 10 | type t 11 | (*[ sortdef s1 < t ]*) 12 | (*[ sortdef s2 < t ]*) 13 | (*[ sortdef r1 < t ]*) 14 | (*[ sortdef r2 < t ]*) 15 | 16 | (*[ subsort s1 & s2 < r1 & r2 ]*) 17 | (*[ subsort r1 & r2 < s1 & s2 ]*) 18 | end 19 | = 20 | struct 21 | datatype t = C | D1 | D2 | E1 | E2 | F 22 | 23 | (*[ datasort s1 = C | D1 and s2 = C | D2 ]*) 24 | (*[ datasort r1 = C | E1 | F and r2 = C | E2 | F ]*) 25 | 26 | end -------------------------------------------------------------------------------- /test-examples/illustrative-examples/multiple-bindings.sml: -------------------------------------------------------------------------------- 1 | 2 | (*[ datasort tt = true and ff = false ]*) 3 | datatype d = C1 | C2 of bool 4 | 5 | (*[ datasort d1 = C2 of tt | C2 of ff 6 | and d2 = C1 | C2 of tt 7 | and d3 = C2 of tt]*) 8 | 9 | val y (*[ :> d1 ]*) = C2 true 10 | 11 | 12 | val (C2 x) = y 13 | 14 | (* Even a sort constraint doesn't help. This is because it is only a bound. *) 15 | val (C2 (x(*[ :> bool ]*)) ) = y 16 | 17 | (* This does work, at the expense of generating a warning about unmatched cases *) 18 | val (C2 x (*[ :> d ]*) ) = y 19 | 20 | (* And this won't work, since we specified y :> d1. *) 21 | val (C2 x (*[ :> d3 ]*) ) = y 22 | 23 | (* Rewriting like this solves the problem. *) 24 | (*[ val x2 :> bool ]*) 25 | val x2 = case y of C2 x => x 26 | 27 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/no-case-analysis.cduce: -------------------------------------------------------------------------------- 1 | (** This file is intended to demonstrate that CDuce doesn't do case 2 | analysis, at least not in the same sense as the sort checker. 3 | 4 | It is rejected, while the ssml system accepts the corresponding code. 5 | - Rowan **) 6 | 7 | 8 | Type bool = | ;; 9 | 10 | Type c2 = ( * * ) | ( * * );; 11 | 12 | Type tt = ;; 13 | 14 | let fun orelse (tt * bool -> tt ; bool * tt -> tt ; bool * bool -> bool) 15 | | , -> 16 | | _ -> ;; 17 | 18 | let fun f (c2 -> tt) 19 | , x, y -> orelse (x, y) 20 | ;; 21 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/no-need-for-datasort-replication.sml: -------------------------------------------------------------------------------- 1 | 2 | (*[ datasort 'a some = SOME of 'a 3 | and 'a none = NONE ]*) 4 | 5 | structure NoNeed = 6 | struct 7 | 8 | datatype myOption = datatype option 9 | 10 | (*[ sortdef 'a mySome = 'a some 11 | and 'a myNone = 'a none ]*) 12 | 13 | end -------------------------------------------------------------------------------- /test-examples/illustrative-examples/non-covariant-opt.sml: -------------------------------------------------------------------------------- 1 | structure opt :> 2 | sig type 'a t (*[ sortdef 'a nn < t ]*) (*[ sortdef 'a ss |: t ]*) 3 | val none : 'a t and some : 'a -> 'a t 4 | (*[ none <: 'a nn and some <: 'a -> 'a ss ]*) 5 | end = 6 | struct type 'a t = 'a option (*[ sortdef 'a nn = 'a none and 'a ss = 'a some ]*) 7 | val none = NONE and some = SOME 8 | end 9 | 10 | (*[ whatSort <: unit opt.ss opt.t ]*) 11 | val whatSort = opt.some (opt.some ()) 12 | 13 | val newSort = (whatSort (*[ <: unit opt.t ]*) ) 14 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/parameter-unions.sml: -------------------------------------------------------------------------------- 1 | 2 | 3 | (*[ datasort tt = true and ff = false ]*) 4 | 5 | datatype 'a prod = PROD1 of 'a * 'a 6 | | PROD2 of 'a 7 | 8 | (*[ datasort 'a prod1 = PROD1 of 'a * 'a 9 | and 'a prod2 = PROD2 of 'a ]*) 10 | 11 | datatype bools = B of bool prod 12 | 13 | (*[ datasort ttffbool = B of bool prod1 14 | | B of bool prod2 15 | ]*) 16 | 17 | 18 | (* 19 | (*[ val f :> bools -> tt ]*) 20 | fun f (B (PROD (true, true))) = true 21 | | f (B (PROD (false, false))) = true 22 | | f (B (PROD _)) = false 23 | 24 | val x = f (B (PROD (true, false))) 25 | *) -------------------------------------------------------------------------------- /test-examples/illustrative-examples/poly-recursion-allowed.sml: -------------------------------------------------------------------------------- 1 | 2 | datatype 'a l = C1 of 'a l l | C2 3 | 4 | (*[ datasort 'a l1 = C1 of 'a l1 l1 ]*) 5 | (*[ datasort 'a l2 = C2 ]*) 6 | 7 | (*[ val f :> 'a l1 l1 l1 l1 -> 'a l2 l1 l1 8 | & 'a l2 l1 l1 l1 -> 'a l l1 l ]*) 9 | fun f x = C1 x 10 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/poly-recursion-allowed2.sml: -------------------------------------------------------------------------------- 1 | 2 | datatype 'a l = C1 of ('a -> 'a) l | C2 of 'a | C3 3 | 4 | (*[ datasort 'a l1 = C1 of ('a -> 'a) l1 ]*) 5 | (*[ datasort 'a l2 = C2 of 'a ]*) 6 | 7 | (*[ val f :> ('a l2 -> 'a l1) l1 -> ('a l2 -> 'a l1) l1 l2 ]*) 8 | (* fun f x = C2 x *) 9 | 10 | val x = C2 (C1 (C2 (fn x => x))) -------------------------------------------------------------------------------- /test-examples/illustrative-examples/poly-recursion-allowed3.sml: -------------------------------------------------------------------------------- 1 | 2 | datatype 'a l = C1 of 'a * ('a l) l | C2 3 | 4 | (*[ datasort 'a l1 = C1 of 'a * 'a l1 l ]*) 5 | (*[ datasort 'a l2 = C2 ]*) 6 | 7 | (*[ val f :> 'a l1 l1 l1 l1 -> 'a l1 l1 l1 l1 l 8 | & 'a l2 l1 l1 l2 -> 'a l l1 l1 l1 l ]*) 9 | fun f x = C1 (x, C2) 10 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/polypattern-subtraction.sml: -------------------------------------------------------------------------------- 1 | 2 | (*[ datasort tt = true and ff = false ]*) 3 | 4 | fun myfun [] = false 5 | | myfun (true :: tail) = true 6 | | myfun (false :: tail) = false 7 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/promote-sort-to-type.sml: -------------------------------------------------------------------------------- 1 | 2 | datatype T1 = C1 | C2 3 | 4 | (*[ datasort S1 = C1 ]*) 5 | 6 | (*[ sortdef T1 = S1 ]*) 7 | 8 | fun f C1 = C1 9 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/ref-pat-multiple.sml: -------------------------------------------------------------------------------- 1 | 2 | (* This example shows that there may be multiple sorts for a "ref" in 3 | a pattern. It might be possible to rule some out by checking emptiness of 4 | the intersection with the pattern. *) 5 | 6 | (*[ datasort tt = true and ff = false ]*) 7 | 8 | datatype t = C of bool ref 9 | 10 | (*[ datasort s = C of tt ref | C of ff ref ]*) 11 | 12 | 13 | (*[ val f :> s -> tt ]*) 14 | fun f (C (y as ref true)) = ((*y:=false;*) !y) 15 | | f (C x) = true 16 | 17 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/ref-pat-subtract.sml: -------------------------------------------------------------------------------- 1 | 2 | (* This example shows that "ref" in patterns needs special treatment to avoid unsoundness. *) 3 | 4 | (*[ datasort tt = true and ff = false ]*) 5 | 6 | 7 | 8 | (*[ val f :> bool ref -> ff ]*) 9 | fun f (y as (ref true)) = (y:=false; (*!y*) false) 10 | | f (y as (ref false)) = (!y) 11 | 12 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/ref-pat.sml: -------------------------------------------------------------------------------- 1 | 2 | (* This example shows that "ref" in patterns needs special treatment to avoid unsoundness. *) 3 | 4 | (*[ datasort tt = true and ff = false ]*) 5 | 6 | 7 | 8 | (*[ val f :> bool ref -> tt ]*) 9 | fun f (y as (ref true)) = (y:=false; !y) 10 | | f (ref false) = true 11 | 12 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/slow-exp-instances.sml: -------------------------------------------------------------------------------- 1 | (* This example used to show that instantiation could be slow. Now it 2 | demonstrates the use of sort annotations to specify instances, and 3 | the automatic use of the default sort when there is no annotation 4 | non-covariant sorts are involved. *) 5 | 6 | (*[ datasort tt = true and ff = false ]*) 7 | 8 | (*[ val not :> bool -> bool & tt -> ff ]*) 9 | fun not true = false 10 | | not false = true 11 | 12 | fun id x = x 13 | 14 | val inot = (id (*[ :> (tt -> ff) -> (tt -> ff) ]*)) not 15 | val inot2 = (id (*[ :> (tt -> ff) -> ((tt&ff) -> bool) ]*)) not 16 | val inot3 = (id) not (* Uses default sort: no annotation, non-covariant type. *) 17 | val t = id true (* Generates full instance, since lattice is "small" (covariant). *) -------------------------------------------------------------------------------- /test-examples/illustrative-examples/slow-pattern-instances.sml: -------------------------------------------------------------------------------- 1 | 2 | (*[ datasort tt = true and ff = false ]*) 3 | 4 | (*[ val myfun :> (bool -> bool) list -> unit ]*) 5 | fun myfun [] = () 6 | (* | myfun (h::t) = () *) 7 | 8 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/slow-pattern-instances2.sml: -------------------------------------------------------------------------------- 1 | 2 | (*[ datasort tt = true and ff = false ]*) 3 | 4 | (*[ val myfun :> (tt -> tt) list -> (tt -> tt) list ]*) 5 | fun myfun (l as []) = l 6 | | myfun (h::t) = t 7 | 8 | -------------------------------------------------------------------------------- /test-examples/illustrative-examples/unsound-ref.sml: -------------------------------------------------------------------------------- 1 | 2 | (* The following shows the need for the value restriction on intersection 3 | introduction. It shouldn't sort-check. *) 4 | 5 | 6 | datatype nat = z | s of nat 7 | 8 | (*[ datasort z = z 9 | and nz = s of nat ]*) 10 | 11 | (*[ val natref :> z -> z ref & nat -> nat ref ]*) 12 | fun natref x = ref x 13 | 14 | (*[ val h :> unit -> z ]*) 15 | val h = (fn y => 16 | let 17 | val (r:z ref & nat ref) = natref z 18 | in 19 | (r := (s z); !r) 20 | end) 21 | 22 | 23 | -------------------------------------------------------------------------------- /test-examples/language-constructs/assume.sml: -------------------------------------------------------------------------------- 1 | 2 | structure MyOption :OPTION = 3 | struct(*[ assume OPTION ]*) 4 | end -------------------------------------------------------------------------------- /test-examples/language-constructs/comma-valspec.sml: -------------------------------------------------------------------------------- 1 | 2 | (*[ datasort tt = true and ff = false ]*) 3 | 4 | (*[ val g :> bool -> bool & tt -> tt ]*) 5 | fun g y = 6 | let 7 | val f = (fn x => y (*[ :> bool -> bool , tt -> tt ]*) ) 8 | in 9 | f y 10 | end 11 | 12 | (*[ val gg :> bool -> bool & tt -> tt ]*) 13 | fun gg y = 14 | let 15 | (*[ val f :> bool -> bool , tt -> tt ]*) 16 | fun f x = y 17 | in 18 | f y 19 | end 20 | -------------------------------------------------------------------------------- /test-examples/language-constructs/datasort-qualified-constructors.sml: -------------------------------------------------------------------------------- 1 | (*[ datasort 'a null = List.nil ]*) -------------------------------------------------------------------------------- /test-examples/language-constructs/datasort-spec-error.sml: -------------------------------------------------------------------------------- 1 | (** An example showing that the refinement checker handles datasort 2 | specifications in signatures correctly. See also 3 | datasort-spec.sml. - Rowan 12sep03 4 | 5 | **) 6 | 7 | 8 | local 9 | structure A = 10 | struct 11 | datatype t = c 12 | datatype nat = z | s of nat 13 | (*[ datasort ev = z | s of od and od = s of ev ]*) 14 | 15 | (*[ val f :> nat -> ev ]*) 16 | fun f (s x) = s (s (f x)) 17 | | f z = z 18 | end : sig 19 | datatype t = c 20 | datatype nat = z | s of nat 21 | (* datasort ev = z | s of od and od = s of ev *) 22 | (*[ datasort ev = c ]*) 23 | (*[ val f : ev -> ev ]*) 24 | val f : nat -> nat 25 | end 26 | 27 | in 28 | val x = A.f 29 | end 30 | -------------------------------------------------------------------------------- /test-examples/language-constructs/datasort-spec.sml: -------------------------------------------------------------------------------- 1 | (** An example showing that the refinement checker handles datasort 2 | specifications in signatures correctly. See also 3 | datasort-spec-error.sml. - Rowan 12sep03 4 | **) 5 | 6 | local 7 | structure A = 8 | struct 9 | datatype t = c 10 | datatype nat = z | s of nat 11 | (*[ datasort ev = z | s of od 12 | and od = s of ev ]*) 13 | 14 | (*[ val f :> nat -> ev ]*) 15 | fun f (s x) = s (s (f x)) 16 | | f z = z 17 | end : sig 18 | datatype t = c 19 | datatype nat = z | s of nat 20 | (*[ datasort ev = z | s of od 21 | and od = s of ev ]*) 22 | (*[ val f : ev -> ev ]*) 23 | val f : nat -> nat 24 | end 25 | 26 | in 27 | val x = A.f 28 | end 29 | -------------------------------------------------------------------------------- /test-examples/language-constructs/datatype-replication.sml: -------------------------------------------------------------------------------- 1 | (* A simple example to demonstrate that the checker handles datatype replication. Rowan 14aug02 *) 2 | 3 | local 4 | structure A = 5 | struct 6 | datatype nat = z | s of nat 7 | (*[ datasort ev = z | s of od and od = s of ev ]*) 8 | 9 | datatype t = datatype nat 10 | 11 | (*[ val f :> nat -> ev ]*) 12 | fun f (s x) = s (s (f x)) 13 | | f z = z 14 | end : sig 15 | datatype t = z | s of t 16 | (*[ datasort ev = z | s of od and od = s of ev ]*) 17 | (*[ val f :> ev -> ev ]*) 18 | val f : t -> t 19 | end 20 | in 21 | val x = A.f 22 | end 23 | -------------------------------------------------------------------------------- /test-examples/language-constructs/functor-test-with-error.sml: -------------------------------------------------------------------------------- 1 | 2 | functor F (type t 3 | val x: t) = 4 | struct 5 | type s = unit 6 | (*[ val y :> s ]*) 7 | val y = x 8 | end -------------------------------------------------------------------------------- /test-examples/language-constructs/functor-test.sml: -------------------------------------------------------------------------------- 1 | 2 | functor F (type t 3 | val x: t) = 4 | struct 5 | type s = t 6 | (*[ val y :> s ]*) 7 | val y = x 8 | end -------------------------------------------------------------------------------- /test-examples/language-constructs/pattern-sort-bound.sml: -------------------------------------------------------------------------------- 1 | 2 | (*[ datasort tt = true and ff = false ]*) 3 | 4 | (*[ val f :> ff -> unit, tt -> unit ]*) 5 | fun f (x (*[ :> ff, ff&tt ]*) ) = () -------------------------------------------------------------------------------- /test-examples/language-constructs/poly-test.sml: -------------------------------------------------------------------------------- 1 | 2 | 3 | (* val f :> 'a -> 'a ]*) 4 | fun 'a f x = 5 | let (*[ val y :> 'a -> 'a ]*) 6 | val y = x 7 | in y end 8 | 9 | datatype a = B 10 | (*[ datasort b = B ]*) -------------------------------------------------------------------------------- /test-examples/language-constructs/record-sorts.sml: -------------------------------------------------------------------------------- 1 | 2 | val y = ( {l=true} (*[ :> {l :> bool} ]*) ) 3 | -------------------------------------------------------------------------------- /test-examples/language-constructs/sharing-test.sml: -------------------------------------------------------------------------------- 1 | 2 | functor F (structure A : sig type t end 3 | structure B : sig type s end 4 | sharing type A.t = B.s 5 | val x: A.t) = 6 | struct 7 | (*[ val y :> B.s ]*) 8 | val y = x 9 | end -------------------------------------------------------------------------------- /test-examples/language-constructs/sig-datatype-replication.sml: -------------------------------------------------------------------------------- 1 | (* A simple example to demonstrate that the checker handles datatype 2 | replication in signatures. Rowan 17sep04 *) 3 | 4 | (* local *) 5 | structure A = 6 | struct 7 | 8 | structure T = 9 | struct 10 | datatype nat = z | s of nat 11 | (*[ datasort ev = z | s of od and od = s of ev ]*) 12 | end 13 | 14 | datatype t = datatype T.nat 15 | (*[ datasort ev = z | s of od and od = s of ev ]*) 16 | (* (*[ sortdef ev = T.ev and od = T.od ]*) *) 17 | 18 | (*[ val f :> t -> ev ]*) 19 | fun f (s x) = s (s (f x)) 20 | | f z = z 21 | end (* : sig 22 | structure T : 23 | sig 24 | datatype nat = z | s of nat 25 | (*[ datasort ev = z | s of od and od = s of ev ]*) 26 | end 27 | datatype t = datatype T.nat 28 | (*[ datasort ev = z | s of od and od = s of ev ]*) 29 | (*[ val f :> ev -> ev ]*) 30 | val f : t -> t 31 | end 32 | in 33 | val x = A.f 34 | end 35 | *) -------------------------------------------------------------------------------- /test-examples/language-constructs/sig-match.sml: -------------------------------------------------------------------------------- 1 | 2 | local 3 | structure A = 4 | struct 5 | datatype nat = z | s of nat 6 | (*[ datasort ev = z | s of od and od = s of ev ]*) 7 | 8 | (*[ val f :> ev -> ev & od -> ev ]*) 9 | fun f (s x) = s (s (f x)) 10 | | f z = z 11 | end : sig 12 | type nat 13 | (*[ sortdef ev < nat and od < nat ]*) 14 | (*[ val f : ev -> od ]*) 15 | val f : nat -> nat 16 | end 17 | 18 | in 19 | val x = A.f 20 | end 21 | -------------------------------------------------------------------------------- /test-examples/language-constructs/sigdatatype.sml: -------------------------------------------------------------------------------- 1 | signature S = sig 2 | datatype 'a nat = z | s of 'a nat 3 | end; 4 | 5 | structure A = 6 | struct 7 | 8 | datatype 'a nat = z | s of 'a nat 9 | end :> S 10 | 11 | -------------------------------------------------------------------------------- /test-examples/language-constructs/sigpoly.sml: -------------------------------------------------------------------------------- 1 | signature S = sig 2 | val f : 'a -> 'a 3 | (*[ val f :> 'a -> 'a ]*) 4 | end; 5 | 6 | structure A = 7 | struct 8 | 9 | fun f x = x 10 | 11 | end : S 12 | 13 | -------------------------------------------------------------------------------- /test-examples/language-constructs/sigsort-sub.sml: -------------------------------------------------------------------------------- 1 | 2 | (* This example demonstrates the use of upper bounds to declare refinements of 3 | opaque types. The current state is that only a single upper bound can be 4 | given for each sort. Also, matching a structure against a signature does NOT 5 | actually check that the bounds are satisfied. 6 | *) 7 | 8 | functor SigSortSub(type 'a t 9 | (*[ sortdef 'a s <| t ]*) 10 | (*[ sortdef 'a s2 <| t ]*) 11 | ) = 12 | struct 13 | (*[ val f :> 'a s2 -> 'a t ]*) 14 | fun f x = x 15 | end 16 | 17 | (* 18 | structure AppliedSSS = SigSortSub(datatype 'a t = C1 | C2 | C3 19 | (*[ datasort 'a s = C1 | C2 20 | and 'a s2 = C2 ]*) 21 | ) 22 | *) -------------------------------------------------------------------------------- /test-examples/language-constructs/sigtest.sml: -------------------------------------------------------------------------------- 1 | (* Small test of signatures in Kit3 *) 2 | 3 | structure S : sig val f : 'a -> 'a end = 4 | struct 5 | (*[ val f :> 'a -> 'b ]*) 6 | fun f x = f x 7 | end 8 | -------------------------------------------------------------------------------- /test-examples/language-constructs/sort-scheme-explicit-instantiators.sml: -------------------------------------------------------------------------------- 1 | 2 | datatype ('a,'b,'c,'d) t = C1 of 'b | C2 of 'c | C3 of 'a | C4 of 'd 3 | 4 | (* The instantiators are in the same order as the their first 5 | occurrences in the type scheme *) 6 | 7 | val v = C1 (*[[ 'a->'a, bool, int, real ]]*) (fn x => x) 8 | 9 | val v2 = fn () => C1 (*[[ 'a->'a, 'd, 'c, 'b ]]*) (fn x => x) 10 | 11 | val v3 = v2 (*[[ int, real, bool, word ]]*) 12 | 13 | 14 | fun f x y z = x y z 15 | 16 | val fInst = f (*[[ int, real, bool ]]*) 17 | 18 | fun g x y = x 19 | val g2 = g (*[[ int, bool ]]*) 20 | 21 | fun h x (y,z) = x 22 | val h2 = h (*[[ int, bool, real ]]*) 23 | -------------------------------------------------------------------------------- /test-examples/language-constructs/struct-assume.sml: -------------------------------------------------------------------------------- 1 | signature S = sig 2 | type nat 3 | 4 | (*[ val f :> nat -> nat ]*) 5 | val f : nat -> nat 6 | end; 7 | 8 | datatype nat' = z | s of nat' 9 | (*[ datasort ev = z | s of od and od = s of ev ]*) 10 | 11 | structure A = 12 | struct (*[ assume S where type nat = nat' ]*) 13 | 14 | (* The structure body is ignored by the sort checker *) 15 | type nat = nat' 16 | 17 | (*[ val f :> nat -> ev ]*) 18 | fun f (s x) = s (s (f x)) 19 | | f z = z 20 | end :> S where type nat = nat' 21 | 22 | -------------------------------------------------------------------------------- /test-examples/language-constructs/structure-sharing-test.sml: -------------------------------------------------------------------------------- 1 | 2 | functor F (structure A : sig type t end 3 | structure B : sig type t type s end 4 | sharing A = B 5 | sharing type B.t = B.s 6 | val x: A.t) = 7 | struct 8 | (*[ val y :> B.s ]*) 9 | val y = x 10 | end -------------------------------------------------------------------------------- /test-examples/language-constructs/subsort-spec.sml: -------------------------------------------------------------------------------- 1 | 2 | signature S = 3 | sig 4 | type t 5 | (*[ sortdef s1 |: t 6 | sortdef s2 |: t ]*) 7 | 8 | (*[ subsort s2 < t ]*) 9 | end 10 | 11 | structure S :> S = 12 | struct 13 | datatype t = C of t -> t | C2 of unit 14 | 15 | (*[ datasort s1 = C of s1 -> s1 ]*) 16 | (*[ datasort s2 = C2 of unit ]*) 17 | end -------------------------------------------------------------------------------- /test-examples/language-constructs/wheretype.sml: -------------------------------------------------------------------------------- 1 | signature S = sig 2 | type nat 3 | 4 | (*[ val f :> nat -> nat ]*) 5 | val f : nat -> nat 6 | end; 7 | 8 | datatype nat' = z | s of nat' 9 | (*[ datasort ev = z | s of od and od = s of ev ]*) 10 | 11 | structure A = 12 | struct 13 | 14 | type nat = nat' 15 | 16 | (*[ val f :> nat -> ev ]*) 17 | fun f (s x) = s (s (f x)) 18 | | f z = z 19 | end :> S where type nat = nat' 20 | 21 | -------------------------------------------------------------------------------- /test-examples/large-examples/.cvsignore: -------------------------------------------------------------------------------- 1 | OLD -------------------------------------------------------------------------------- /test-examples/large-examples/parsing/README: -------------------------------------------------------------------------------- 1 | 2 | This directory contains separate files for the parsing example. The 3 | file ../parse-all.sml has all the files concatenated together. 4 | 5 | - Rowan 6 | -------------------------------------------------------------------------------- /test-examples/large-examples/twelf-parsing/.cvsignore: -------------------------------------------------------------------------------- 1 | old -------------------------------------------------------------------------------- /test-examples/large-examples/twelf-parsing/parsing.sig: -------------------------------------------------------------------------------- 1 | (* General basis for parsing modules *) 2 | (* Author: Frank Pfenning *) 3 | 4 | signature PARSING = 5 | sig 6 | (* structure Stream : STREAM *) 7 | 8 | (* structure Lexer : LEXER 9 | sharing Lexer.Stream = Stream 10 | *) 11 | 12 | type lexResult = Lexer.Token * Paths.region 13 | 14 | type 'a parser = lexResult Stream.front -> 'a * lexResult Stream.front 15 | (* sortdef 'a parser = lexResult Stream.infFront -> 'a * lexResult Stream.infFront *) 16 | 17 | (* recursive parser (allows parsing functions that need to parse 18 | a signature expression to temporarily suspend themselves) *) 19 | datatype 'a RecParseResult = 20 | Done of 'a 21 | | Continuation of 'a RecParseResult parser 22 | 23 | type 'a recparser = 'a RecParseResult parser 24 | 25 | (* useful combinator for recursive parsers *) 26 | val recwith : 'a recparser * ('a -> 'b) -> 'b recparser 27 | 28 | exception Error of string 29 | val error : Paths.region * string -> 'a (* always raises Error *) 30 | end; (* signature PARSING *) 31 | 32 | 33 | (* Stub code to allow sorting checking the parser without including a bunch of 34 | other files. *) 35 | structure Parsing :> PARSING = 36 | struct 37 | (*[ assumesig PARSING ]*) 38 | end 39 | -------------------------------------------------------------------------------- /test-examples/large-examples/twelf-parsing/sortcheck-usefile.sml: -------------------------------------------------------------------------------- 1 | 2 | 3 | R.refine_file_report false "../test-ssml/large-examples/twelf-parsing/paths.sig"; 4 | R.refine_file_report false "../test-ssml/large-examples/twelf-parsing/intsyn.sig"; 5 | R.refine_file_report false "../test-ssml/large-examples/twelf-parsing/stream.sml"; 6 | R.refine_file_report false "../test-ssml/large-examples/twelf-parsing/lexer.sig"; 7 | R.refine_file_report false "../test-ssml/large-examples/twelf-parsing/parsing.sig"; 8 | R.refine_file_report false "../test-ssml/large-examples/twelf-parsing/names.sig"; 9 | R.refine_file_report false "../test-ssml/large-examples/twelf-parsing/recon-term.sig"; 10 | 11 | R.refine_file_report false "../test-ssml/large-examples/twelf-parsing/parse-term.sig"; 12 | 13 | R.refine_file_report true "../test-ssml/large-examples/twelf-parsing/parse-term.fun"; 14 | -------------------------------------------------------------------------------- /test-examples/lisp-monotype/lisp-monotype-new-default.sml: -------------------------------------------------------------------------------- 1 | structure s = struct 2 | 3 | datatype monotype = Int of int | Bool of bool 4 | | Nil | Cons of monotype * monotype 5 | | Fun of monotype -> monotype 6 | 7 | (*[ datasort mtInt = Int of int 8 | and mtBool = Bool of bool 9 | and mtList = Nil | Cons of monotype * mtList 10 | and mtFun = Fun of monotype -> monotype 11 | and mtIntArrowInt = Fun of mtInt -> mtInt 12 | ]*) 13 | 14 | 15 | (*[ sortdef monotype = mtInt ]*) 16 | fun double (Int x) = Int (x + x) 17 | val monoDouble = Fun double 18 | 19 | end 20 | -------------------------------------------------------------------------------- /test-examples/lisp-monotype/lisp-monotype.sml: -------------------------------------------------------------------------------- 1 | structure ListMonotype = struct 2 | 3 | datatype monotype = Int of int | Bool of bool 4 | | Nil | Cons of monotype * monotype 5 | | Fun of monotype -> monotype 6 | 7 | (*[ datasort monotypeInt = Int of int 8 | and monotypeBool = Bool of bool 9 | and monotypeList = Nil | Cons of monotype * monotypeList 10 | and monotypeFun = Fun of monotype -> monotype 11 | and monottypeIntArrowInt = Fun of monotypeInt -> monotypeInt 12 | ]*) 13 | 14 | (*[ val double :> monotypeInt -> monotypeInt ]*) 15 | fun double (Int x) = Int (x + x) 16 | val monoDouble = Fun double 17 | 18 | end 19 | -------------------------------------------------------------------------------- /test-examples/performance-bugs/RefinedEnvironments-with-tarjan-datasorts.sml: -------------------------------------------------------------------------------- 1 | 2 | (* Well the actual code isn't here, since the code is the file RefinedEnvironments.sml, 3 | part of the sort checker itself. 4 | It sort checks fine unless you've previously checked "tarjan2.sml" or "tarjan.sml". In which 5 | case it gets stuck at the following: *) 6 | 7 | type subSortNameGoal = SortName list * SortName list list 8 | type subSortNameAssumptions = subSortNameGoal list (* Could do better than a list here *) 9 | 10 | val memoSSN : (subSortNameGoal, bool * subSortNameAssumptions) HashTable.hash_table 11 | = HashTable.mkTable (hashSSN, eqSSN) (65533, memoHashExn) 12 | 13 | 14 | (* Adding a sort annotation fixed this problem, but it still suggests that a better approach 15 | polymorphic instantiation is desirable. *) -------------------------------------------------------------------------------- /test-examples/possible-extensions/tygoals-from-sigs.sml: -------------------------------------------------------------------------------- 1 | 2 | structure TGNR :> 3 | sig 4 | type t 5 | (*[ sortdef s <| t ]*) 6 | 7 | (*[ val f :> s -> s ]*) 8 | val f : t -> t 9 | end 10 | = struct 11 | type t = int option 12 | (*[ sortdef s = int option ]*) 13 | 14 | fun f (SOME x) = x 15 | 16 | end 17 | -------------------------------------------------------------------------------- /test-examples/robs-DictTable.sml: -------------------------------------------------------------------------------- 1 | functor DictTable (structure Dict : DICT 2 | type value) 3 | :> TABLE where type key = Dict.key and type value = value (*[ where sort key = Nat.even ]*) 4 | 5 | = 6 | struct 7 | 8 | (*[ table <: Dict.t ref ]*) 9 | val table = ref Dict.empty 10 | end 11 | -------------------------------------------------------------------------------- /test-examples/robs-lex-error.sml: -------------------------------------------------------------------------------- 1 | signature HASH_INCREMENT = 2 | sig 3 | 4 | val hashInc : Word.word -> Word.word -> Word.word 5 | 6 | end 7 | -------------------------------------------------------------------------------- /test-examples/small/accept-both-yi.sml: -------------------------------------------------------------------------------- 1 | 2 | datatype t = A of int | B of t 3 | | C | D of t 4 | 5 | (*[ datasort t1 = A of int | B of t1 6 | datasort t2 = C | D of t2 ]*) 7 | 8 | (*[ val accept_both : t1 -> int 9 | & t2 -> int ]*) 10 | fun accept_both (A n) = n 11 | | accept_both (B x) = 0 12 | | accept_both C = 0 13 | | accept_both (D y) = 0 14 | 15 | (*[ val f :> (t1 -> t2) & (t2 -> t1) ]*) 16 | fun f (A n) = C 17 | | f (B x) = D (f x) 18 | | f C = A 0 19 | | f (D y) = B (f y) 20 | -------------------------------------------------------------------------------- /test-examples/thesis-examples/intro-ref-unsound.sml: -------------------------------------------------------------------------------- 1 | 2 | 3 | (* Suppose we have a type num, containing zero and one, and refinements for nat and pos. 4 | We can encode these assumptions via a functor. *) 5 | functor IntroUnsoundRef 6 | (Num : sig 7 | type num (*[ sortdef nat < num ]*) 8 | (*[ sortdef pos < nat ]*) 9 | val zero : num (*[ val zero <: nat ]*) 10 | val one : num (*[ val one <: pos ]*) 11 | end 12 | ) = 13 | struct 14 | open Num 15 | 16 | (*[ x <: (pos ref) & (nat ref) ]*) 17 | val x = ref one 18 | val () = (x := zero) 19 | 20 | (*[ y <: pos ]*) 21 | val y = !x 22 | end 23 | -------------------------------------------------------------------------------- /test-examples/thesis-examples/polymorphic-recursion.sml: -------------------------------------------------------------------------------- 1 | 2 | datatype 'a hyperList = Nil 3 | | Cons of 'a * ('a hyperList) hyperList 4 | 5 | (*[ datasort 'a even = Nil | Cons of 'a * ('a hyperList) odd 6 | and 'a odd = Cons of 'a * ('a hyperList) even 7 | ]*) 8 | 9 | 10 | datatype 'a hyperTree = Leaf of 'a 11 | | Node of ('a hyperTree) hyperTree 12 | * ('a hyperTree) hyperTree 13 | 14 | (*[ datasort 'a even = Leaf of 'a 15 | | Node of ('a odd) odd 16 | * ('a even) even 17 | and 'a odd = Leaf of 'a 18 | | Node of ('a odd) even 19 | * ('a even) odd 20 | ]*) 21 | -------------------------------------------------------------------------------- /test-examples/thesis-examples/sig.sml: -------------------------------------------------------------------------------- 1 | signature MONOTYPE = 2 | sig 3 | datatype monotype = 4 | Int of int | Bool of bool 5 | | Nil | Cons of monotype * monotype 6 | | Fun of monotype -> monotype 7 | 8 | (*[ datasort mtInt = Int of int ]*) 9 | type mtArrow 10 | (*[ sortdef mtIntArrow <| mtArrow ]*) 11 | 12 | (*[ val double :> mtIntArrow ]*) 13 | val double : mtArrow 14 | 15 | (*[ val quiteLikelyFour :> mtInt ]*) 16 | val quiteLikelyFour : monotype 17 | end 18 | -------------------------------------------------------------------------------- /test-examples/thesis-examples/struct.sml: -------------------------------------------------------------------------------- 1 | 2 | structure Monotype = 3 | struct 4 | datatype monotype = 5 | Int of int | Bool of bool 6 | | Nil | Cons of monotype * monotype 7 | | Fun of monotype -> monotype 8 | 9 | (*[ datasort mtInt = Int of int ]*) 10 | 11 | (*[ sortdef mtIntArrow = mtInt -> mtInt ]*) 12 | 13 | (*[ val double :> mtIntArrow ]*) 14 | fun double (Int x) = Int (x + x) 15 | 16 | val quiteLikelyFour = double (Int 2 (*[ :> mtInt ]*) ) 17 | end 18 | 19 | structure mtBaseList = 20 | struct 21 | (*[ datasort mtIntList = 22 | Monotype.Nil 23 | | Monotype.Cons of Monotype.mtInt * mtIntList 24 | ]*) 25 | 26 | (*[ val append :> mtIntList -> mtIntList 27 | -> mtIntList ]*) 28 | fun append (Monotype.Cons (h, t)) l = 29 | Monotype.Cons (h, append t l) 30 | | append Monotype.Nil l = l 31 | end 32 | -------------------------------------------------------------------------------- /useme.sml: -------------------------------------------------------------------------------- 1 | 2 | let val cidreDir = OS.FileSys.getDir() 3 | in 4 | OS.FileSys.chDir "src/cm2mlb"; 5 | CM.make "cm2mlb.cm"; 6 | (* OS.FileSys.chDir "src/Cidre"; *) 7 | CM.make "../Cidre/cidre.cm"; 8 | if (SMLofNJ.exportML "../../bin/.heap/sml-cidre") then 9 | case Compiler.version of {system, version_id=major::minor::_,...} => 10 | (print (system ^ " " ^ Int.toString major ^ "." ^ Int.toString minor ^ "\n" ^ 11 | "with SML-CIDRE 0.99999\n\nQuickstart: Cidre.make \"filenm.cm\";\n\n"); 12 | "a piece of") 13 | else 14 | (print "CIDRE export available via: ./bin/sml-cidre \n"; 15 | 16 | let val smlCidre = TextIO.openOut "../../bin/sml-cidre" 17 | val smlCidreBat = TextIO.openOut "../../bin/sml-cidre.bat" 18 | in 19 | TextIO.output (smlCidre, "#! /bin/sh\nsml @SMLload=\"" ^ cidreDir ^ "/bin/.heap/sml-cidre\""); 20 | TextIO.output (smlCidreBat, "sml @SMLload=\"" ^ cidreDir ^ "/bin/.heap/sml-cidre\""); 21 | TextIO.closeOut smlCidre; 22 | OS.Process.exit (OS.Process.success); 23 | "" 24 | end 25 | ) 26 | end 27 | --------------------------------------------------------------------------------