├── .gitignore ├── .mailmap ├── .travis.yml ├── LICENSE ├── Makefile ├── Readme.md ├── bin └── .README ├── doc ├── announce │ └── HCAR │ │ ├── Disciple-201011.tex │ │ ├── Disciple-201111.tex │ │ ├── Disciple-201211.tex │ │ ├── Disciple-201304.tex │ │ ├── Disciple-201404.tex │ │ ├── Disciple-201605.tex │ │ ├── Disciple-201611.tex │ │ └── hcar.sty ├── notes │ └── ddc │ │ ├── design │ │ ├── Collections.txt │ │ ├── Curring.txt │ │ ├── Documentation.txt │ │ ├── ExistentialRegions.txt │ │ ├── Quantifiers.txt │ │ ├── Shimmer.txt │ │ └── Tuples.txt │ │ └── plan │ │ └── Bootstrap.txt ├── sphinx │ ├── discus │ │ ├── Makefile │ │ └── source │ │ │ ├── _static │ │ │ └── .keep │ │ │ ├── _templates │ │ │ └── .keep │ │ │ ├── conf.py │ │ │ ├── index.rst │ │ │ ├── logo │ │ │ └── discus-512x512.jpg │ │ │ ├── release │ │ │ ├── ddc-0.3.1.rst │ │ │ ├── ddc-0.3.2.rst │ │ │ ├── ddc-0.4.1.rst │ │ │ ├── ddc-0.4.2.rst │ │ │ ├── ddc-0.4.3.rst │ │ │ └── ddc-0.5.1.rst │ │ │ ├── section │ │ │ ├── 01-GettingStarted.rst │ │ │ ├── 02-Specification.rst │ │ │ └── 03-Release.rst │ │ │ ├── specification │ │ │ ├── 01-Source.rst │ │ │ ├── 02-Core.rst │ │ │ ├── core │ │ │ │ ├── 01-Concrete.rst │ │ │ │ ├── 02-Statics.rst │ │ │ │ ├── 03-CoreDiscus.rst │ │ │ │ ├── 04-CoreSalt.rst │ │ │ │ └── 05-Shimmer.rst │ │ │ └── source │ │ │ │ └── 01-Concrete.rst │ │ │ └── theme │ │ │ ├── static │ │ │ └── haiku-mod.css │ │ │ └── theme.conf │ └── shimmer │ │ ├── Makefile │ │ ├── build │ │ └── .keep │ │ └── source │ │ ├── _static │ │ └── .keep │ │ ├── _templates │ │ └── .keep │ │ ├── conf.py │ │ ├── index.rst │ │ └── section │ │ ├── 01-definition.rst │ │ ├── 02-primitives.rst │ │ ├── 03-examples.rst │ │ └── examples │ │ ├── 00-Intro.smr │ │ ├── 01-Lambda.smr │ │ ├── 02-NoNameCapture.smr │ │ ├── 03-ChurchEncoding.smr │ │ ├── 04-PrimitiveNats.smr │ │ └── 05-Fixpoints.smr └── syntax │ ├── Disciple │ ├── Disciple Core.tmLanguage │ └── Disciple Tetra.tmLanguage │ ├── Haskell │ ├── Comments.tmPreferences │ └── Haskell.tmLanguage │ ├── Inky.tmTheme │ └── Shimmer │ └── Shimmer.tmLanguage ├── make ├── build.mk ├── config.mk ├── config │ ├── flavour.mk │ ├── goop │ │ └── getArch.sh │ ├── options.mk │ └── target.mk ├── deps │ └── .README ├── rules.mk └── targets │ ├── bin-ddc-main.mk │ ├── bin-ddci-core.mk │ ├── bin-ddci-tetra.mk │ ├── bin-smr.mk │ ├── clean.mk │ ├── docs.mk │ ├── libs.mk │ ├── packages.mk │ ├── runtime.mk │ ├── setup.mk │ ├── tarball.mk │ └── war.mk ├── src ├── s1 │ ├── ddc-build │ │ ├── DDC │ │ │ └── Build │ │ │ │ ├── Builder.hs │ │ │ │ ├── Builder │ │ │ │ ├── Base.hs │ │ │ │ ├── BuilderPPC32Linux.hs │ │ │ │ ├── BuilderX8632Darwin.hs │ │ │ │ ├── BuilderX8632Linux.hs │ │ │ │ ├── BuilderX8664Darwin.hs │ │ │ │ ├── BuilderX8664Linux.hs │ │ │ │ └── Error.hs │ │ │ │ ├── Language.hs │ │ │ │ ├── Language │ │ │ │ ├── Base.hs │ │ │ │ ├── Discus.hs │ │ │ │ ├── Flow.hs │ │ │ │ ├── Machine.hs │ │ │ │ ├── Salt.hs │ │ │ │ └── Zero.hs │ │ │ │ ├── Pipeline.hs │ │ │ │ ├── Pipeline │ │ │ │ ├── Core.hs │ │ │ │ ├── Error.hs │ │ │ │ ├── Sink.hs │ │ │ │ └── Text.hs │ │ │ │ ├── Platform.hs │ │ │ │ ├── Platform │ │ │ │ ├── Base.hs │ │ │ │ ├── Determine.hs │ │ │ │ └── Error.hs │ │ │ │ ├── Spec.hs │ │ │ │ ├── Spec │ │ │ │ ├── Base.hs │ │ │ │ ├── Check.hs │ │ │ │ └── Parser.hs │ │ │ │ └── Stage │ │ │ │ ├── Core.hs │ │ │ │ ├── Core │ │ │ │ ├── Discus.hs │ │ │ │ └── Salt.hs │ │ │ │ └── Source │ │ │ │ └── Discus.hs │ │ ├── LICENSE │ │ └── Setup.hs │ ├── ddc-core-discus │ │ ├── DDC │ │ │ └── Core │ │ │ │ ├── Discus.hs │ │ │ │ └── Discus │ │ │ │ ├── Check.hs │ │ │ │ ├── Codec │ │ │ │ └── Shimmer │ │ │ │ │ ├── Decode.hs │ │ │ │ │ └── Encode.hs │ │ │ │ ├── Compounds.hs │ │ │ │ ├── Convert.hs │ │ │ │ ├── Convert │ │ │ │ ├── Boxing.hs │ │ │ │ ├── Data.hs │ │ │ │ ├── Error.hs │ │ │ │ ├── Exp.hs │ │ │ │ ├── Exp │ │ │ │ │ ├── Alt.hs │ │ │ │ │ ├── Arg.hs │ │ │ │ │ ├── Base.hs │ │ │ │ │ ├── Ctor.hs │ │ │ │ │ ├── Lets.hs │ │ │ │ │ ├── Lit.hs │ │ │ │ │ ├── PrimArith.hs │ │ │ │ │ ├── PrimBoxing.hs │ │ │ │ │ ├── PrimCall.hs │ │ │ │ │ ├── PrimError.hs │ │ │ │ │ ├── PrimInfo.hs │ │ │ │ │ ├── PrimRecord.hs │ │ │ │ │ └── PrimVector.hs │ │ │ │ ├── Layout.hs │ │ │ │ ├── Type.hs │ │ │ │ └── Type │ │ │ │ │ ├── Base.hs │ │ │ │ │ ├── DaCon.hs │ │ │ │ │ ├── Data.hs │ │ │ │ │ ├── Kind.hs │ │ │ │ │ ├── Region.hs │ │ │ │ │ ├── Super.hs │ │ │ │ │ └── Witness.hs │ │ │ │ ├── Env.hs │ │ │ │ ├── Error.hs │ │ │ │ ├── Prim.hs │ │ │ │ ├── Prim │ │ │ │ ├── Base.hs │ │ │ │ ├── DaConDiscus.hs │ │ │ │ ├── OpArith.hs │ │ │ │ ├── OpCast.hs │ │ │ │ ├── OpError.hs │ │ │ │ ├── OpFun.hs │ │ │ │ ├── OpInfo.hs │ │ │ │ ├── OpVector.hs │ │ │ │ ├── TyConDiscus.hs │ │ │ │ └── TyConPrim.hs │ │ │ │ ├── Profile.hs │ │ │ │ └── Transform │ │ │ │ ├── Boxing.hs │ │ │ │ ├── Curry.hs │ │ │ │ ├── Curry │ │ │ │ ├── Call.hs │ │ │ │ ├── CallSuper.hs │ │ │ │ ├── CallThunk.hs │ │ │ │ ├── Callable.hs │ │ │ │ └── Error.hs │ │ │ │ └── Initialize.hs │ │ ├── LICENSE │ │ └── Setup.hs │ ├── ddc-core-flow │ │ ├── DDC │ │ │ └── Core │ │ │ │ ├── Flow.hs │ │ │ │ └── Flow │ │ │ │ ├── Compounds.hs │ │ │ │ ├── Context.hs │ │ │ │ ├── Context │ │ │ │ ├── Base.hs │ │ │ │ └── FillPath.hs │ │ │ │ ├── Convert.hs │ │ │ │ ├── Convert │ │ │ │ ├── Base.hs │ │ │ │ ├── Exp.hs │ │ │ │ └── Type.hs │ │ │ │ ├── Env.hs │ │ │ │ ├── Exp.hs │ │ │ │ ├── Exp │ │ │ │ └── Simple │ │ │ │ │ ├── Collect.hs │ │ │ │ │ ├── Compounds.hs │ │ │ │ │ └── Exp.hs │ │ │ │ ├── Lower.hs │ │ │ │ ├── Prim.hs │ │ │ │ ├── Prim │ │ │ │ ├── Base.hs │ │ │ │ ├── DaConFlow.hs │ │ │ │ ├── DaConPrim.hs │ │ │ │ ├── KiConFlow.hs │ │ │ │ ├── OpConcrete.hs │ │ │ │ ├── OpControl.hs │ │ │ │ ├── OpPrim.hs │ │ │ │ ├── OpSeries.hs │ │ │ │ ├── OpStore.hs │ │ │ │ ├── OpVector.hs │ │ │ │ ├── TyConFlow.hs │ │ │ │ └── TyConPrim.hs │ │ │ │ ├── Procedure.hs │ │ │ │ ├── Process.hs │ │ │ │ ├── Process │ │ │ │ ├── Operator.hs │ │ │ │ ├── Pretty.hs │ │ │ │ └── Process.hs │ │ │ │ ├── Profile.hs │ │ │ │ └── Transform │ │ │ │ ├── Annotate.hs │ │ │ │ ├── Concretize.hs │ │ │ │ ├── Deannotate.hs │ │ │ │ ├── Extract.hs │ │ │ │ ├── Forward.hs │ │ │ │ ├── Melt.hs │ │ │ │ ├── Rates │ │ │ │ ├── Clusters.hs │ │ │ │ ├── Clusters │ │ │ │ │ ├── Base.hs │ │ │ │ │ ├── Greedy.hs │ │ │ │ │ └── Linear.hs │ │ │ │ ├── CnfFromExp.hs │ │ │ │ ├── Combinators.hs │ │ │ │ ├── Fail.hs │ │ │ │ ├── Graph.hs │ │ │ │ ├── SeriesOfVector.hs │ │ │ │ └── SizeInference.hs │ │ │ │ ├── Schedule.hs │ │ │ │ ├── Schedule │ │ │ │ ├── Base.hs │ │ │ │ ├── Error.hs │ │ │ │ ├── Kernel.hs │ │ │ │ ├── Lifting.hs │ │ │ │ ├── Nest.hs │ │ │ │ └── Scalar.hs │ │ │ │ ├── Slurp.hs │ │ │ │ ├── Slurp │ │ │ │ ├── Context.hs │ │ │ │ ├── Error.hs │ │ │ │ ├── Operator.hs │ │ │ │ └── Resize.hs │ │ │ │ ├── Thread.hs │ │ │ │ ├── TransformUpX.hs │ │ │ │ └── Wind.hs │ │ ├── LICENSE │ │ └── Setup.hs │ ├── ddc-core-llvm │ │ ├── DDC │ │ │ ├── Core │ │ │ │ └── Llvm │ │ │ │ │ ├── Convert.hs │ │ │ │ │ ├── Convert │ │ │ │ │ ├── Base.hs │ │ │ │ │ ├── Context.hs │ │ │ │ │ ├── Error.hs │ │ │ │ │ ├── Exp.hs │ │ │ │ │ ├── Exp │ │ │ │ │ │ ├── Atom.hs │ │ │ │ │ │ ├── Case.hs │ │ │ │ │ │ ├── PrimArith.hs │ │ │ │ │ │ ├── PrimCall.hs │ │ │ │ │ │ ├── PrimCast.hs │ │ │ │ │ │ └── PrimStore.hs │ │ │ │ │ ├── Super.hs │ │ │ │ │ └── Type.hs │ │ │ │ │ ├── Metadata │ │ │ │ │ ├── Graph.hs │ │ │ │ │ └── Tbaa.hs │ │ │ │ │ └── Runtime.hs │ │ │ └── Llvm │ │ │ │ ├── Analysis │ │ │ │ ├── Children.hs │ │ │ │ ├── Defs.hs │ │ │ │ └── Parents.hs │ │ │ │ ├── Graph.hs │ │ │ │ ├── Syntax.hs │ │ │ │ ├── Syntax │ │ │ │ ├── Attr.hs │ │ │ │ ├── Exp.hs │ │ │ │ ├── Function.hs │ │ │ │ ├── Instr.hs │ │ │ │ ├── Metadata.hs │ │ │ │ ├── Module.hs │ │ │ │ ├── NFData.hs │ │ │ │ ├── Prim.hs │ │ │ │ └── Type.hs │ │ │ │ ├── Transform │ │ │ │ ├── Calls.hs │ │ │ │ ├── Flatten.hs │ │ │ │ └── Simpl.hs │ │ │ │ ├── Write.hs │ │ │ │ └── Write │ │ │ │ ├── Attr.hs │ │ │ │ ├── Base.hs │ │ │ │ ├── Exp.hs │ │ │ │ ├── Function.hs │ │ │ │ ├── Instr.hs │ │ │ │ ├── Metadata.hs │ │ │ │ ├── Module.hs │ │ │ │ ├── Prim.hs │ │ │ │ └── Type.hs │ │ ├── LICENSE │ │ └── Setup.hs │ ├── ddc-core-machine │ │ ├── DDC │ │ │ └── Core │ │ │ │ ├── Machine.hs │ │ │ │ └── Machine │ │ │ │ ├── Env.hs │ │ │ │ ├── Prim.hs │ │ │ │ ├── Process.hs │ │ │ │ ├── Process │ │ │ │ ├── Base.hs │ │ │ │ ├── Fuse.hs │ │ │ │ └── Slurp.hs │ │ │ │ └── Profile.hs │ │ ├── LICENSE │ │ ├── README.md │ │ └── Setup.hs │ ├── ddc-core-salt │ │ ├── DDC │ │ │ └── Core │ │ │ │ ├── Salt.hs │ │ │ │ └── Salt │ │ │ │ ├── Analysis │ │ │ │ └── Primitive.hs │ │ │ │ ├── Compounds.hs │ │ │ │ ├── Compounds │ │ │ │ ├── Lit.hs │ │ │ │ ├── PrimArith.hs │ │ │ │ ├── PrimCast.hs │ │ │ │ ├── PrimControl.hs │ │ │ │ ├── PrimStore.hs │ │ │ │ └── PrimTyCon.hs │ │ │ │ ├── Env.hs │ │ │ │ ├── Exp.hs │ │ │ │ ├── Name.hs │ │ │ │ ├── Name │ │ │ │ ├── PrimArith.hs │ │ │ │ ├── PrimCast.hs │ │ │ │ ├── PrimControl.hs │ │ │ │ ├── PrimStore.hs │ │ │ │ ├── PrimTyCon.hs │ │ │ │ └── PrimVec.hs │ │ │ │ ├── Platform.hs │ │ │ │ ├── Profile.hs │ │ │ │ ├── Runtime.hs │ │ │ │ └── Transform │ │ │ │ ├── Initialize.hs │ │ │ │ ├── Slotify.hs │ │ │ │ ├── Slotify │ │ │ │ ├── Inject.hs │ │ │ │ ├── Object.hs │ │ │ │ └── Replace.hs │ │ │ │ └── Transfer.hs │ │ ├── LICENSE │ │ └── Setup.hs │ ├── ddc-core │ │ ├── DDC │ │ │ ├── Control │ │ │ │ ├── Check.hs │ │ │ │ ├── CheckIO.hs │ │ │ │ └── Parser.hs │ │ │ ├── Core │ │ │ │ ├── Analysis │ │ │ │ │ ├── Arity.hs │ │ │ │ │ └── Usage.hs │ │ │ │ ├── Call.hs │ │ │ │ ├── Check.hs │ │ │ │ ├── Check │ │ │ │ │ ├── Base.hs │ │ │ │ │ ├── Close.hs │ │ │ │ │ ├── Config.hs │ │ │ │ │ ├── Context.hs │ │ │ │ │ ├── Context │ │ │ │ │ │ ├── Apply.hs │ │ │ │ │ │ ├── Base.hs │ │ │ │ │ │ ├── Effect.hs │ │ │ │ │ │ ├── Elem.hs │ │ │ │ │ │ ├── Mode.hs │ │ │ │ │ │ └── Resolve.hs │ │ │ │ │ ├── Error.hs │ │ │ │ │ ├── Error │ │ │ │ │ │ ├── ErrorData.hs │ │ │ │ │ │ ├── ErrorDataMessage.hs │ │ │ │ │ │ ├── ErrorExp.hs │ │ │ │ │ │ ├── ErrorExpMessage.hs │ │ │ │ │ │ ├── ErrorType.hs │ │ │ │ │ │ └── ErrorTypeMessage.hs │ │ │ │ │ ├── Exp.hs │ │ │ │ │ ├── Judge │ │ │ │ │ │ ├── DataDefs.hs │ │ │ │ │ │ ├── EqT.hs │ │ │ │ │ │ ├── Inst.hs │ │ │ │ │ │ ├── Kind.hs │ │ │ │ │ │ ├── Kind │ │ │ │ │ │ │ └── TyCon.hs │ │ │ │ │ │ ├── Module.hs │ │ │ │ │ │ ├── Module │ │ │ │ │ │ │ ├── Binds.hs │ │ │ │ │ │ │ ├── Exports.hs │ │ │ │ │ │ │ └── Imports.hs │ │ │ │ │ │ ├── Sub.hs │ │ │ │ │ │ ├── Type │ │ │ │ │ │ │ ├── AppT.hs │ │ │ │ │ │ │ ├── AppX.hs │ │ │ │ │ │ │ ├── Base.hs │ │ │ │ │ │ │ ├── Case.hs │ │ │ │ │ │ │ ├── Cast.hs │ │ │ │ │ │ │ ├── DaCon.hs │ │ │ │ │ │ │ ├── LamT.hs │ │ │ │ │ │ │ ├── LamX.hs │ │ │ │ │ │ │ ├── Let.hs │ │ │ │ │ │ │ ├── LetPrivate.hs │ │ │ │ │ │ │ ├── Prim.hs │ │ │ │ │ │ │ ├── Sub.hs │ │ │ │ │ │ │ ├── VarCon.hs │ │ │ │ │ │ │ └── Witness.hs │ │ │ │ │ │ └── Witness.hs │ │ │ │ │ ├── Post.hs │ │ │ │ │ └── State.hs │ │ │ │ ├── Codec │ │ │ │ │ ├── Shimmer │ │ │ │ │ │ ├── Decode.hs │ │ │ │ │ │ ├── Encode.hs │ │ │ │ │ │ └── Hash.hs │ │ │ │ │ └── Text │ │ │ │ │ │ ├── Lexer.hs │ │ │ │ │ │ ├── Lexer │ │ │ │ │ │ ├── Offside.hs │ │ │ │ │ │ ├── Offside │ │ │ │ │ │ │ ├── Base.hs │ │ │ │ │ │ │ └── Starts.hs │ │ │ │ │ │ ├── Token │ │ │ │ │ │ │ ├── Builtin.hs │ │ │ │ │ │ │ ├── Index.hs │ │ │ │ │ │ │ ├── Keyword.hs │ │ │ │ │ │ │ ├── Literal.hs │ │ │ │ │ │ │ ├── Names.hs │ │ │ │ │ │ │ ├── Operator.hs │ │ │ │ │ │ │ └── Symbol.hs │ │ │ │ │ │ ├── Tokens.hs │ │ │ │ │ │ └── Unicode.hs │ │ │ │ │ │ ├── Parser.hs │ │ │ │ │ │ ├── Parser │ │ │ │ │ │ ├── Base.hs │ │ │ │ │ │ ├── Context.hs │ │ │ │ │ │ ├── DataDef.hs │ │ │ │ │ │ ├── Exp.hs │ │ │ │ │ │ ├── ExportSpec.hs │ │ │ │ │ │ ├── ImportSpec.hs │ │ │ │ │ │ ├── Module.hs │ │ │ │ │ │ ├── Param.hs │ │ │ │ │ │ ├── Type.hs │ │ │ │ │ │ └── Witness.hs │ │ │ │ │ │ ├── Pretty.hs │ │ │ │ │ │ └── Pretty │ │ │ │ │ │ └── Type.hs │ │ │ │ ├── Collect.hs │ │ │ │ ├── Collect │ │ │ │ │ ├── BindStruct.hs │ │ │ │ │ ├── FreeT.hs │ │ │ │ │ ├── FreeX.hs │ │ │ │ │ └── Support.hs │ │ │ │ ├── Env │ │ │ │ │ ├── EnvT.hs │ │ │ │ │ └── EnvX.hs │ │ │ │ ├── Exp.hs │ │ │ │ ├── Exp │ │ │ │ │ ├── Annot.hs │ │ │ │ │ ├── Annot │ │ │ │ │ │ ├── AnT.hs │ │ │ │ │ │ ├── AnTEC.hs │ │ │ │ │ │ ├── Compounds.hs │ │ │ │ │ │ ├── Context.hs │ │ │ │ │ │ ├── Ctx.hs │ │ │ │ │ │ ├── Exp.hs │ │ │ │ │ │ ├── NFData.hs │ │ │ │ │ │ ├── Predicates.hs │ │ │ │ │ │ └── Pretty.hs │ │ │ │ │ ├── DaCon.hs │ │ │ │ │ ├── Generic.hs │ │ │ │ │ ├── Generic │ │ │ │ │ │ ├── BindStruct.hs │ │ │ │ │ │ ├── Compounds.hs │ │ │ │ │ │ ├── Exp.hs │ │ │ │ │ │ ├── Predicates.hs │ │ │ │ │ │ └── Pretty.hs │ │ │ │ │ ├── Literal.hs │ │ │ │ │ ├── Simple.hs │ │ │ │ │ └── WiCon.hs │ │ │ │ ├── Fragment.hs │ │ │ │ ├── Fragment │ │ │ │ │ ├── Compliance.hs │ │ │ │ │ ├── Error.hs │ │ │ │ │ ├── Feature.hs │ │ │ │ │ └── Profile.hs │ │ │ │ ├── Interface │ │ │ │ │ ├── Oracle.hs │ │ │ │ │ ├── Store.hs │ │ │ │ │ └── Store │ │ │ │ │ │ ├── Base.hs │ │ │ │ │ │ ├── Construct.hs │ │ │ │ │ │ ├── Fetch.hs │ │ │ │ │ │ └── Resolve.hs │ │ │ │ ├── Load.hs │ │ │ │ ├── Module.hs │ │ │ │ ├── Module │ │ │ │ │ ├── Export.hs │ │ │ │ │ ├── Import.hs │ │ │ │ │ └── Name.hs │ │ │ │ ├── Simplifier.hs │ │ │ │ ├── Simplifier │ │ │ │ │ ├── Apply.hs │ │ │ │ │ ├── Base.hs │ │ │ │ │ ├── Lexer.hs │ │ │ │ │ ├── Parser.hs │ │ │ │ │ ├── Recipe.hs │ │ │ │ │ └── Result.hs │ │ │ │ └── Transform │ │ │ │ │ ├── AnonymizeX.hs │ │ │ │ │ ├── Beta.hs │ │ │ │ │ ├── BoundT.hs │ │ │ │ │ ├── BoundX.hs │ │ │ │ │ ├── Boxing.hs │ │ │ │ │ ├── Bubble.hs │ │ │ │ │ ├── Elaborate.hs │ │ │ │ │ ├── Eta.hs │ │ │ │ │ ├── Expliciate.hs │ │ │ │ │ ├── Expose.hs │ │ │ │ │ ├── Flatten.hs │ │ │ │ │ ├── FoldCase.hs │ │ │ │ │ ├── Forward.hs │ │ │ │ │ ├── Inline.hs │ │ │ │ │ ├── Inline │ │ │ │ │ └── Templates.hs │ │ │ │ │ ├── Lambdas.hs │ │ │ │ │ ├── Lambdas │ │ │ │ │ ├── Base.hs │ │ │ │ │ └── Lift.hs │ │ │ │ │ ├── MapT.hs │ │ │ │ │ ├── Namify.hs │ │ │ │ │ ├── Prune.hs │ │ │ │ │ ├── Reannotate.hs │ │ │ │ │ ├── Rename.hs │ │ │ │ │ ├── Resolve.hs │ │ │ │ │ ├── Resolve │ │ │ │ │ ├── Base.hs │ │ │ │ │ ├── Build.hs │ │ │ │ │ └── Context.hs │ │ │ │ │ ├── Rewrite.hs │ │ │ │ │ ├── Rewrite │ │ │ │ │ ├── Disjoint.hs │ │ │ │ │ ├── Env.hs │ │ │ │ │ ├── Error.hs │ │ │ │ │ ├── Match.hs │ │ │ │ │ ├── Parser.hs │ │ │ │ │ └── Rule.hs │ │ │ │ │ ├── Snip.hs │ │ │ │ │ ├── SubstituteTX.hs │ │ │ │ │ ├── SubstituteWX.hs │ │ │ │ │ ├── SubstituteXX.hs │ │ │ │ │ ├── Thread.hs │ │ │ │ │ ├── TransformDownX.hs │ │ │ │ │ ├── TransformModX.hs │ │ │ │ │ ├── TransformUpX.hs │ │ │ │ │ └── Unshare.hs │ │ │ ├── Data │ │ │ │ ├── Canned.hs │ │ │ │ ├── Env.hs │ │ │ │ ├── Label.hs │ │ │ │ ├── ListUtils.hs │ │ │ │ ├── Name.hs │ │ │ │ ├── Pretty.hs │ │ │ │ ├── PrettyPrint.hs │ │ │ │ ├── SourcePos.hs │ │ │ │ ├── Textual.hs │ │ │ │ └── Write.hs │ │ │ ├── Type │ │ │ │ ├── Bind.hs │ │ │ │ ├── DataDef.hs │ │ │ │ ├── Env.hs │ │ │ │ ├── Exp.hs │ │ │ │ ├── Exp │ │ │ │ │ ├── Simple.hs │ │ │ │ │ ├── Simple │ │ │ │ │ │ ├── Compounds.hs │ │ │ │ │ │ ├── Equiv.hs │ │ │ │ │ │ ├── Exp.hs │ │ │ │ │ │ ├── NFData.hs │ │ │ │ │ │ ├── Predicates.hs │ │ │ │ │ │ └── Subsumes.hs │ │ │ │ │ └── TyCon.hs │ │ │ │ ├── Sum.hs │ │ │ │ ├── Transform │ │ │ │ │ ├── Alpha.hs │ │ │ │ │ ├── AnonymizeT.hs │ │ │ │ │ ├── BoundT.hs │ │ │ │ │ ├── Instantiate.hs │ │ │ │ │ ├── Rename.hs │ │ │ │ │ ├── SubstituteT.hs │ │ │ │ │ └── Unify.hs │ │ │ │ └── Universe.hs │ │ │ └── Version.hs │ │ ├── LICENSE │ │ └── Setup.hs │ ├── ddc-driver │ │ ├── DDC │ │ │ └── Driver │ │ │ │ ├── Build.hs │ │ │ │ ├── Build │ │ │ │ ├── Query.hs │ │ │ │ ├── Run.hs │ │ │ │ ├── State.hs │ │ │ │ └── Taste.hs │ │ │ │ ├── Command │ │ │ │ ├── BaseBuild.hs │ │ │ │ ├── Build.hs │ │ │ │ ├── Check.hs │ │ │ │ ├── Compile.hs │ │ │ │ ├── Flow │ │ │ │ │ ├── Concretize.hs │ │ │ │ │ ├── Lower.hs │ │ │ │ │ ├── Melt.hs │ │ │ │ │ ├── Prep.hs │ │ │ │ │ ├── Rate.hs │ │ │ │ │ ├── Thread.hs │ │ │ │ │ ├── ToTetra.hs │ │ │ │ │ └── Wind.hs │ │ │ │ ├── LSP.hs │ │ │ │ ├── Load.hs │ │ │ │ ├── Machine │ │ │ │ │ ├── Prep.hs │ │ │ │ │ └── Slurp.hs │ │ │ │ ├── Parse.hs │ │ │ │ ├── Read.hs │ │ │ │ ├── RewriteRules.hs │ │ │ │ ├── Scan.hs │ │ │ │ ├── ToLlvm.hs │ │ │ │ ├── ToSalt.hs │ │ │ │ └── Trans.hs │ │ │ │ ├── Config.hs │ │ │ │ ├── Dump.hs │ │ │ │ ├── Interface │ │ │ │ ├── Input.hs │ │ │ │ ├── Load.hs │ │ │ │ ├── Locate.hs │ │ │ │ ├── Source.hs │ │ │ │ └── Status.hs │ │ │ │ ├── LSP │ │ │ │ └── Protocol │ │ │ │ │ ├── Data.hs │ │ │ │ │ ├── Data │ │ │ │ │ ├── Base.hs │ │ │ │ │ ├── ClientCapabilities.hs │ │ │ │ │ ├── Initialize.hs │ │ │ │ │ ├── Request.hs │ │ │ │ │ ├── Response.hs │ │ │ │ │ ├── ServerCapabilities.hs │ │ │ │ │ └── ShowMessage.hs │ │ │ │ │ ├── Pack.hs │ │ │ │ │ ├── Parse.hs │ │ │ │ │ └── Unpack.hs │ │ │ │ ├── Output.hs │ │ │ │ ├── Stage.hs │ │ │ │ └── Stage │ │ │ │ ├── Flow.hs │ │ │ │ ├── Machine.hs │ │ │ │ ├── Salt.hs │ │ │ │ └── Tetra.hs │ │ ├── LICENSE │ │ └── Setup.hs │ ├── ddc-source-discus │ │ ├── DDC │ │ │ └── Source │ │ │ │ └── Discus │ │ │ │ ├── Collect │ │ │ │ └── FreeVars.hs │ │ │ │ ├── Convert.hs │ │ │ │ ├── Convert │ │ │ │ ├── Base.hs │ │ │ │ ├── Clause.hs │ │ │ │ ├── Error.hs │ │ │ │ ├── Prim.hs │ │ │ │ ├── Type.hs │ │ │ │ └── Witness.hs │ │ │ │ ├── Env.hs │ │ │ │ ├── Exp.hs │ │ │ │ ├── Exp │ │ │ │ ├── Bind.hs │ │ │ │ ├── DataDef.hs │ │ │ │ ├── Term │ │ │ │ │ ├── Base.hs │ │ │ │ │ ├── Compounds.hs │ │ │ │ │ ├── NFData.hs │ │ │ │ │ ├── Predicates.hs │ │ │ │ │ ├── Pretty.hs │ │ │ │ │ └── Prim.hs │ │ │ │ └── Type │ │ │ │ │ ├── Base.hs │ │ │ │ │ ├── Compounds.hs │ │ │ │ │ ├── NFData.hs │ │ │ │ │ ├── Predicates.hs │ │ │ │ │ ├── Pretty.hs │ │ │ │ │ └── Prim.hs │ │ │ │ ├── Lexer.hs │ │ │ │ ├── Module.hs │ │ │ │ ├── Parser.hs │ │ │ │ ├── Parser │ │ │ │ ├── Base.hs │ │ │ │ ├── Exp.hs │ │ │ │ ├── Module.hs │ │ │ │ ├── Param.hs │ │ │ │ ├── Type.hs │ │ │ │ └── Witness.hs │ │ │ │ ├── Pretty.hs │ │ │ │ └── Transform │ │ │ │ ├── BoundX.hs │ │ │ │ ├── Defix.hs │ │ │ │ ├── Defix │ │ │ │ ├── Error.hs │ │ │ │ └── FixTable.hs │ │ │ │ ├── Expand.hs │ │ │ │ ├── Freshen.hs │ │ │ │ ├── Freshen │ │ │ │ └── State.hs │ │ │ │ ├── Guards.hs │ │ │ │ ├── Matches.hs │ │ │ │ └── Prep.hs │ │ ├── LICENSE │ │ └── Setup.hs │ └── ddc-tools │ │ ├── LICENSE │ │ ├── Setup.hs │ │ └── src │ │ ├── ddc-check │ │ ├── Config.hs │ │ └── Main.hs │ │ ├── ddc-main │ │ ├── DDC │ │ │ └── Main │ │ │ │ ├── Args.hs │ │ │ │ ├── Config.hs │ │ │ │ ├── Help.hs │ │ │ │ └── OptLevels.hs │ │ └── Main.hs │ │ ├── ddc-war │ │ ├── DDC │ │ │ └── War │ │ │ │ ├── Config.hs │ │ │ │ ├── Create.hs │ │ │ │ ├── Create │ │ │ │ ├── CreateDC.hs │ │ │ │ ├── CreateDCX.hs │ │ │ │ ├── CreateDSX.hs │ │ │ │ ├── CreateMainHS.hs │ │ │ │ ├── CreateMainSH.hs │ │ │ │ ├── CreateTestDS.hs │ │ │ │ └── Way.hs │ │ │ │ ├── Driver.hs │ │ │ │ ├── Driver │ │ │ │ ├── Base.hs │ │ │ │ ├── Chain.hs │ │ │ │ └── Gang.hs │ │ │ │ ├── Interface │ │ │ │ ├── Controller.hs │ │ │ │ └── VT100.hs │ │ │ │ ├── Job.hs │ │ │ │ ├── Job │ │ │ │ ├── CompileDC.hs │ │ │ │ ├── CompileDS.hs │ │ │ │ ├── CompileHS.hs │ │ │ │ ├── Diff.hs │ │ │ │ ├── RunDCX.hs │ │ │ │ ├── RunDSX.hs │ │ │ │ ├── RunExe.hs │ │ │ │ └── Shell.hs │ │ │ │ ├── Option.hs │ │ │ │ └── Task │ │ │ │ ├── Nightly.hs │ │ │ │ └── Test.hs │ │ ├── LICENSE │ │ └── Main.hs │ │ ├── ddci-core │ │ ├── DDCI │ │ │ └── Core │ │ │ │ ├── Command.hs │ │ │ │ ├── Command │ │ │ │ ├── Help.hs │ │ │ │ ├── Set.hs │ │ │ │ ├── TransInteract.hs │ │ │ │ └── With.hs │ │ │ │ ├── Input.hs │ │ │ │ ├── Interface │ │ │ │ ├── Args.hs │ │ │ │ ├── Batch.hs │ │ │ │ └── Interactive.hs │ │ │ │ ├── Mode.hs │ │ │ │ ├── Output.hs │ │ │ │ ├── Rewrite.hs │ │ │ │ └── State.hs │ │ └── Main.hs │ │ ├── ddci-tetra │ │ ├── DDCI │ │ │ └── Tetra │ │ │ │ ├── Command.hs │ │ │ │ ├── Command │ │ │ │ ├── Desugar.hs │ │ │ │ ├── Help.hs │ │ │ │ ├── Infer.hs │ │ │ │ ├── Parse.hs │ │ │ │ ├── Set.hs │ │ │ │ └── ToCore.hs │ │ │ │ ├── Input.hs │ │ │ │ ├── Interface │ │ │ │ ├── Args.hs │ │ │ │ ├── Batch.hs │ │ │ │ └── Interactive.hs │ │ │ │ ├── Mode.hs │ │ │ │ ├── Output.hs │ │ │ │ └── State.hs │ │ └── Main.hs │ │ └── hp-sort │ │ └── Main.hs ├── s2 │ ├── base │ │ ├── Class │ │ │ ├── Applicative.ds │ │ │ ├── Bits.ds │ │ │ ├── Category.ds │ │ │ ├── Eq.ds │ │ │ ├── Functor.ds │ │ │ ├── Monad.ds │ │ │ ├── Numeric.ds │ │ │ ├── Ord.ds │ │ │ ├── Parse.ds │ │ │ ├── Pretty.ds │ │ │ ├── Profunctor.ds │ │ │ └── Show.ds │ │ ├── Codec │ │ │ ├── Json.ds │ │ │ └── Json │ │ │ │ ├── Base.ds │ │ │ │ ├── Parser.ds │ │ │ │ ├── Pretty.ds │ │ │ │ └── State.ds │ │ ├── Control │ │ │ ├── Exception.ds │ │ │ └── Parsec.ds │ │ ├── Data │ │ │ ├── Array.ds │ │ │ ├── Array │ │ │ │ ├── Base.ds │ │ │ │ ├── Bulk.ds │ │ │ │ ├── Fun.ds │ │ │ │ └── Store.ds │ │ │ ├── Bag.ds │ │ │ ├── CompactRegion.ds │ │ │ ├── Either.ds │ │ │ ├── Function.ds │ │ │ ├── Lens.ds │ │ │ ├── List.ds │ │ │ ├── Map.ds │ │ │ ├── Map │ │ │ │ ├── Base.ds │ │ │ │ ├── Fun.ds │ │ │ │ └── Tree.ds │ │ │ ├── Maybe.ds │ │ │ ├── Numeric.ds │ │ │ ├── Numeric │ │ │ │ ├── Addr.ds │ │ │ │ ├── Bool.ds │ │ │ │ ├── Float32.ds │ │ │ │ ├── Float64.ds │ │ │ │ ├── Int.ds │ │ │ │ ├── Nat.ds │ │ │ │ ├── Word16.ds │ │ │ │ ├── Word32.ds │ │ │ │ ├── Word64.ds │ │ │ │ └── Word8.ds │ │ │ ├── Ref.ds │ │ │ ├── Stream.ds │ │ │ ├── Text.ds │ │ │ ├── Text │ │ │ │ ├── Base.ds │ │ │ │ ├── Char.ds │ │ │ │ ├── Escape.ds │ │ │ │ ├── List.ds │ │ │ │ ├── Location.ds │ │ │ │ ├── Numeric.ds │ │ │ │ ├── Operator.ds │ │ │ │ ├── Parse.ds │ │ │ │ ├── Show.ds │ │ │ │ └── Stream.ds │ │ │ ├── Tuple.ds │ │ │ └── Vector.ds │ │ ├── Debug │ │ │ └── Trace.ds │ │ ├── Main │ │ │ └── Args.ds │ │ ├── Math │ │ │ ├── Combinations.ds │ │ │ ├── Crypto │ │ │ │ └── Sha256.ds │ │ │ └── Vec3.ds │ │ ├── Prelude │ │ │ ├── Data.ds │ │ │ └── Numeric.ds │ │ ├── System │ │ │ ├── Env.ds │ │ │ ├── IO │ │ │ │ ├── Console.ds │ │ │ │ └── File.ds │ │ │ ├── Posix │ │ │ │ ├── Errno.ds │ │ │ │ ├── Stdio.ds │ │ │ │ ├── Stdlib.ds │ │ │ │ └── Unistd.ds │ │ │ ├── Runtime.ds │ │ │ └── Runtime │ │ │ │ ├── Info.ds │ │ │ │ └── Reflect.ds │ │ └── base.build │ ├── ddc-core │ │ ├── DDC │ │ │ └── Core │ │ │ │ ├── Codec │ │ │ │ └── SExp │ │ │ │ │ ├── Lexer.ds │ │ │ │ │ ├── Lexer │ │ │ │ │ └── Token.ds │ │ │ │ │ ├── Parser.ds │ │ │ │ │ ├── Parser │ │ │ │ │ └── Base.ds │ │ │ │ │ ├── Pretty.ds │ │ │ │ │ └── Pretty │ │ │ │ │ └── Base.ds │ │ │ │ └── Exp.ds │ │ └── Main.ds │ ├── ddc-runtime │ │ ├── build │ │ │ └── .README │ │ ├── salt │ │ │ ├── runtime │ │ │ │ ├── Alloc.dcs │ │ │ │ ├── Collect.dcs │ │ │ │ ├── Hash.dcs │ │ │ │ ├── Hook.dcs │ │ │ │ ├── Init.dcs │ │ │ │ └── Stats.dcs │ │ │ └── runtime64 │ │ │ │ ├── Apply.dcs │ │ │ │ ├── Info.dcs │ │ │ │ ├── Object.dcs │ │ │ │ ├── debug │ │ │ │ ├── Check.dcs │ │ │ │ └── Trace.dcs │ │ │ │ └── primitive │ │ │ │ ├── Array.dcs │ │ │ │ ├── CRegion.dcs │ │ │ │ ├── Env.dcs │ │ │ │ ├── Numeric.dcs │ │ │ │ ├── Record.dcs │ │ │ │ ├── Ref.dcs │ │ │ │ ├── Reflect.dcs │ │ │ │ ├── Text.dcs │ │ │ │ └── Vector.dcs │ │ └── sea │ │ │ ├── Runtime.h │ │ │ ├── primitive │ │ │ └── File.c │ │ │ └── runtime │ │ │ ├── Collect.c │ │ │ ├── Collect.h │ │ │ ├── Hook.h │ │ │ ├── Primitive.h │ │ │ ├── Stats.c │ │ │ ├── Types.h │ │ │ └── primitive │ │ │ ├── Console.c │ │ │ ├── Errno.c │ │ │ ├── Error.c │ │ │ ├── Exception.c │ │ │ ├── File.c │ │ │ ├── Parse.c │ │ │ ├── Sha256.c │ │ │ ├── Show.c │ │ │ └── Text.c │ └── smr-core │ │ ├── lib │ │ ├── Church.smr │ │ ├── Comb.smr │ │ ├── List.smr │ │ └── Nat.smr │ │ └── src │ │ ├── Main.ds │ │ └── SMR │ │ ├── Core │ │ ├── Exp.ds │ │ ├── Exp │ │ │ ├── Base.ds │ │ │ ├── Compounds.ds │ │ │ ├── Eq.ds │ │ │ ├── Push.ds │ │ │ ├── Show.ds │ │ │ └── Train.ds │ │ ├── Step.ds │ │ └── Step │ │ │ └── Base.ds │ │ ├── Prim │ │ ├── Name.ds │ │ ├── Op.ds │ │ └── Op │ │ │ ├── Base.ds │ │ │ ├── Bool.ds │ │ │ ├── Comb.ds │ │ │ ├── List.ds │ │ │ ├── Match.ds │ │ │ ├── Nat.ds │ │ │ └── Smr.ds │ │ ├── Repl │ │ ├── Args.ds │ │ ├── Command │ │ │ └── Load.ds │ │ └── Error.ds │ │ ├── Source │ │ ├── Config.ds │ │ ├── Expected.ds │ │ ├── Lexer.ds │ │ ├── Parser.ds │ │ ├── Pretty.ds │ │ └── Token.ds │ │ └── Transform │ │ └── Combinate.ds └── sx │ └── data-graphics-svg │ └── Data │ └── Graphics │ └── SVG │ └── Tiny.ds └── test ├── ddc-broken ├── 99-skip │ ├── 01-Records │ │ ├── Main.ds │ │ └── Main.stdout.check │ ├── 04-CRTableMax │ │ ├── Main.dcs │ │ └── Main.stdout.check │ ├── 10-LLVM-phi │ │ └── Test.ds │ └── 20-Effect-local │ │ └── Test.ds └── Readme.md ├── ddc-demo ├── Readme.md ├── core │ ├── Discus │ │ ├── 00-Hello │ │ │ ├── Main.dct │ │ │ └── Main.stdout.check │ │ ├── 01-Factorial │ │ │ ├── Main.dct │ │ │ └── Main.stdout.check │ │ └── 02-Lists │ │ │ ├── Main.dct │ │ │ └── Main.stdout.check │ └── Salt │ │ ├── 00-Hello │ │ ├── Main.dcs │ │ └── Main.stdout.check │ │ ├── 01-Factorial │ │ ├── Main.dcs │ │ └── Main.stdout.check │ │ ├── 02-Boxing │ │ ├── Main.dcs │ │ └── Main.stdout.check │ │ └── 03-CRHello │ │ ├── Main.dcs │ │ └── Main.stdout.check └── source │ └── Discus │ ├── 00-Hello │ └── Main.ds │ ├── 10-Defib │ ├── 00-Integer │ │ ├── Main.ds │ │ └── Main.stdout.check │ ├── 01-Exp3_8 │ │ ├── Main.ds │ │ └── Main.stdout.check │ ├── 02-Backpatch │ │ ├── Main.ds │ │ └── Main.stdout.check │ ├── 03-Primes │ │ └── 01-Array │ │ │ ├── Main.ds │ │ │ └── Main.stdout.check │ ├── 04-Life │ │ ├── Cell.ds │ │ ├── Main.ds │ │ └── World.ds │ ├── 05-SKI │ │ ├── Main.ds │ │ └── Main.stdout.check │ └── 06-NormEval │ │ ├── Main.ds │ │ └── Main.stdout.check │ ├── 20-Types │ ├── 01-Freezing │ │ ├── Main.ds │ │ └── Main.stdout.check │ └── 02-Update │ │ ├── Main.ds │ │ └── Main.error.check │ ├── 30-Library │ ├── 01-Data │ │ ├── 01-Text │ │ │ └── Main.ds │ │ ├── 02-List │ │ │ ├── 01-Basic │ │ │ │ ├── Main.ds │ │ │ │ └── Main.stdout.check │ │ │ └── 02-Reverse │ │ │ │ ├── Main.ds │ │ │ │ └── Main.stdout.check │ │ ├── 03-Map │ │ │ ├── Main.ds │ │ │ └── Main.stdout.check │ │ ├── 04-Stream │ │ │ ├── Main.ds │ │ │ └── Main.stdout.check │ │ ├── 05-Array │ │ │ └── Main.ds │ │ ├── 06-Vector │ │ │ └── Main.ds │ │ └── 07-CR │ │ │ ├── 01-Base │ │ │ └── Main.ds │ │ │ └── 02-HitLimit │ │ │ └── Main.ds │ └── 02-Math │ │ └── 01-Combinations │ │ └── Main.ds │ ├── 40-Graphics │ └── 10-RayTrace │ │ ├── Light.ds │ │ ├── Main.ds │ │ ├── Main.stdout.check │ │ ├── Object.ds │ │ ├── Trace.ds │ │ └── World.ds │ ├── 50-System │ └── 01-Process │ │ └── Main.ds │ ├── 80-Rosetta │ ├── 100_doors │ │ ├── Main.ds │ │ └── Main.stdout.check │ ├── 9_billion_names │ │ ├── Main.ds │ │ └── Main.stdout.check │ ├── AlmostPrime │ │ ├── Main.ds │ │ └── Main.stdout.check │ └── GrayCode │ │ ├── Main.ds │ │ └── Main.stdout.check │ └── 90-Language │ └── 01-Lambda │ ├── Lambda │ ├── Eval │ │ └── Step.ds │ ├── Exp.ds │ ├── Exp │ │ ├── Base.ds │ │ └── Pretty.ds │ └── Source │ │ ├── Lexer.ds │ │ ├── Parser.ds │ │ └── Token.ds │ └── Main.ds ├── ddc-regress ├── Readme.md ├── core │ ├── 01-ddci-core │ │ ├── Test.dcx │ │ └── Test.stdout.check │ ├── 02-Salt │ │ ├── 10-Primitive │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ ├── 13-Offside │ │ │ └── Test.dcs │ │ ├── 23-Fragment │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ ├── 32-ToLLVM │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ ├── 33-ToLLVM-MD │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ └── 40-Standalone │ │ │ ├── 40-Factorial │ │ │ ├── Main.dcs │ │ │ └── Main.stdout.check │ │ │ └── 41-Normalise │ │ │ ├── Main.dcs │ │ │ └── Main.stdout.check │ ├── 03-Discus │ │ ├── 01-Primitive │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ ├── 10-Syntax │ │ │ ├── 10-Type │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 11-Data │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 20-Lambda │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 30-Let │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ └── 40-Module │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ ├── 11-Parser │ │ │ ├── 10-Errors │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 20-MixForall │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ └── T289-UnmatchedBraces │ │ │ │ ├── Main.dct │ │ │ │ └── Main.error.check │ │ ├── 12-Pretty │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ ├── 21-Kinding │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ ├── 22-Typing │ │ │ ├── 01-Names │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 02-Let │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 03-LetRegion │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 04-Case │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 10-Functions │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 11-Application │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 30-Data │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 31-Records │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 40-Module │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 80-Synth │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ └── T253-RedefinedTopBind │ │ │ │ ├── Main.dct │ │ │ │ └── Main.error.check │ │ ├── 23-Fragment │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ ├── 30-ToSalt │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ └── 50-Transform │ │ │ ├── 10-Anonymize │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ │ ├── 20-Beta │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ │ ├── 21-Eta │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ │ ├── 30-Snip │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ │ ├── 40-Lambdas │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ │ └── 70-FoldCase │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ ├── 04-Flow │ │ ├── 01-Primitive │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ ├── 10-Load │ │ │ ├── 10-Reduce │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ └── 20-Diamond │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ ├── 11-Typing │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ ├── 20-Prep │ │ │ ├── 10-Fold │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ └── 20-Eta │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ ├── 30-Scalar │ │ │ ├── 10-Reduce │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 11-Fill │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 20-Map │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 30-Pack │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 40-Reps │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 50-Indices │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 60-Generate │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ └── 70-Append │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ ├── 31-Kernel │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ ├── 32-Vector │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ ├── 50-Wind │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ ├── 60-Melt │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ ├── 70-Thread │ │ │ ├── Test.dcx │ │ │ └── Test.stdout.check │ │ ├── 80-Rate │ │ │ ├── 10-Fold │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 11-Generate │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 20-Normalise │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 30-Map2 │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 40-Multirate │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 50-Filter │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 60-MinManifest │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 80-Gather │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ ├── 91-Weird │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ └── 99-Lower │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ ├── 90-ToTetra-skip │ │ │ ├── 10-Simple │ │ │ │ ├── Test.dcx │ │ │ │ └── Test.stdout.check │ │ │ └── 20-OutVector │ │ │ │ └── Main.dcf │ │ └── Broken-skip │ │ │ └── Test.dcx │ └── 05-Machine │ │ ├── 01-Primitive │ │ ├── Test.dcx │ │ └── Test.stdout.check │ │ ├── 02-MapCombinator │ │ ├── Test.dcx │ │ └── Test.stdout.check │ │ ├── 10-Prep │ │ ├── Test.dcx │ │ └── Test.stdout.check │ │ ├── 20-Slurp │ │ ├── Test.dcx │ │ └── Test.stdout.check │ │ └── 30-Fused │ │ ├── Test.dcx │ │ └── Test.stdout.check └── source │ ├── 01-Discus │ ├── 10-Parser │ │ ├── Test.dsx │ │ └── Test.stdout.check │ ├── 20-Defix │ │ ├── Test.dsx │ │ └── Test.stdout.check │ ├── 21-Guards │ │ ├── 01-InexhBindGuards │ │ │ ├── Main.ds │ │ │ └── Main.runerror.check │ │ ├── 02-InexhAltGuards │ │ │ ├── Main.ds │ │ │ └── Main.runerror.check │ │ └── 03-CombinedAnon │ │ │ ├── Main.ds │ │ │ └── Main.stdout.check │ ├── 30-Data │ │ ├── 10-Simple │ │ │ ├── Test.dsx │ │ │ └── Test.stdout.check │ │ ├── 21-NameClash │ │ │ └── Main.ds │ │ └── 30-Vector │ │ │ ├── Main.ds │ │ │ └── Main.stdout.check │ ├── 40-Infer │ │ ├── 01-Simple │ │ │ ├── Test.dsx │ │ │ └── Test.stdout.check │ │ ├── 02-Loop │ │ │ ├── Main.ds │ │ │ └── Main.error.check │ │ ├── 10-ListPoly │ │ │ └── Main.ds │ │ ├── 20-MetaVar │ │ │ ├── Main.ds │ │ │ └── Main.error.check │ │ └── T419-ExplicitDictionaries │ │ │ └── Test.ds │ ├── 41-Modules │ │ └── 01-ExportFun │ │ │ ├── Main.ds │ │ │ ├── Main.stdout.check │ │ │ └── Module.ds │ ├── 50-ToCore │ │ ├── Test.dsx │ │ └── Test.stdout.check │ ├── 60-ToSalt │ │ ├── Test.dsx │ │ └── Test.stdout.check │ ├── 61-ToLLVM │ │ └── T412-DoubleBackslash │ │ │ ├── Main.ds │ │ │ └── Main.stdout.check │ ├── 62-Lambdas │ │ ├── 01-BoxRun │ │ │ ├── Main.ds │ │ │ └── Main.stdout.check │ │ ├── 02-AppOver │ │ │ └── Main.ds │ │ ├── 03-AppUnder │ │ │ ├── Main.ds │ │ │ └── Main.stdout.check │ │ ├── 04-AppMono │ │ │ ├── Main.ds │ │ │ └── Main.stdout.check │ │ ├── 05-DataPAP │ │ │ ├── Main.ds │ │ │ └── Main.stdout.check │ │ ├── 06-SuperShadow │ │ │ ├── Main.ds │ │ │ └── Main.stdout.check │ │ ├── 07-BoxRunDelayed │ │ │ └── Main.stdout.check │ │ ├── 08-BoxRunArg │ │ │ ├── Main.ds │ │ │ ├── Main.stdout.check │ │ │ └── Things.ds │ │ ├── 10-Lists │ │ │ └── Main.ds │ │ ├── 20-Arity │ │ │ └── Main.ds │ │ ├── 30-LiftLetRec │ │ │ └── Main.ds │ │ └── 31-ParamAnnot │ │ │ └── Main.ds │ ├── 80-Runtime │ │ └── 01-Collect │ │ │ └── Main.ds │ ├── 90-Ghc │ │ └── 01-TypeCheck │ │ │ ├── 001-where │ │ │ └── Test.ds │ │ │ ├── 002-if │ │ │ └── Test.ds │ │ │ ├── 003-tuple-mod │ │ │ └── Test.ds │ │ │ ├── 004-if-x │ │ │ └── Test.ds │ │ │ ├── 005-patterns-mod │ │ │ └── Test.ds │ │ │ ├── 006-infinite │ │ │ └── Test.ds │ │ │ ├── 007-cons │ │ │ └── Test.ds │ │ │ ├── 008-bool │ │ │ └── Test.ds │ │ │ ├── 009-tuple-mod │ │ │ └── Test.ds │ │ │ ├── 018-where │ │ │ └── Test.ds │ │ │ └── 020-where-broken-skip │ │ │ └── Test.ds │ └── Broken-skip │ │ ├── Test.dcx │ │ └── Test.dsx │ └── 02-base │ ├── 01-Data │ └── 01-Text │ │ ├── Main.ds │ │ └── Main.stdout.check │ ├── 02-Codec │ └── 01-Json │ │ ├── Main.ds │ │ └── Main.stdout.check │ ├── 03-System │ ├── 01-IO │ │ ├── Main.ds │ │ ├── Main.stdout.check │ │ ├── test-cr.txt │ │ ├── test-nonewline.txt │ │ └── test-simple.txt │ ├── 02-Reflect │ │ ├── Color.ds │ │ ├── Main.ds │ │ └── Main.stdout.check │ ├── 03-Info │ │ ├── Main.ds │ │ └── Main.stdout.check │ └── 04-Hash │ │ ├── Main.ds │ │ └── Main.stdout.check │ ├── 04-Control │ └── 01-Exception │ │ ├── 01-Error │ │ ├── Main.ds │ │ └── Main.stdout.check │ │ ├── 02-TryCatch │ │ ├── Main.ds │ │ └── Main.stdout.check │ │ ├── 03-TryNested │ │ ├── Main.ds │ │ └── Main.stdout.check │ │ └── 04-HandlerThrows │ │ ├── Main.ds │ │ └── Main.stdout.check │ ├── 05-Debug │ └── 01-Trace │ │ ├── Main.ds │ │ └── Main.stdout.check │ └── 06-Math │ └── 01-Sha256 │ └── Main.ds ├── ddc-spec ├── Readme.md ├── error │ └── 01-ErrorExp │ │ ├── 01-ExportUndefined │ │ ├── Test.ds │ │ └── Test.error.check │ │ ├── 02-ExportDuplicate │ │ ├── Test.ds │ │ └── Test.error.check │ │ ├── 03-ExportMismatch │ │ ├── Main.dcs │ │ └── Main.error.check │ │ ├── 04-ImportDuplicate │ │ ├── Test.ds │ │ └── Test.error.check │ │ ├── 05-ImportCapNotEffect │ │ ├── Test.ds │ │ └── Test.error.check │ │ ├── 06-ImportCapNotData │ │ ├── Test.ds │ │ └── Test.error.check │ │ ├── 07-UndefinedVar │ │ ├── Test.ds │ │ └── Test.error.check │ │ ├── 08-UndefinedCtor │ │ ├── Test.ds │ │ └── Test.error.check │ │ ├── 10-AppNotFun │ │ ├── Test.ds │ │ └── Test.error.check │ │ ├── 11-AppCannotInferPoly │ │ ├── Test.ds │ │ └── Test.error.check │ │ ├── 12-AbsShadow │ │ ├── Main.dct │ │ └── Main.error.check │ │ ├── 13-AbsParamUnannotated │ │ └── Test.dct │ │ ├── 14-AbsNotPure │ │ ├── Test.ds │ │ └── Test.error.check │ │ ├── 15-AbsBindBadKind │ │ ├── Test.ds │ │ └── Test.error.check │ │ ├── 20-RecRebound │ │ ├── Test.ds │ │ └── Test.error.check │ │ ├── 21-RecMissingAnnot │ │ ├── Main.dcs │ │ └── Main.error.check │ │ ├── 22-RecNotLambda │ │ ├── Main.dcs │ │ └── Main.error.check │ │ ├── 23-PrivateNotRegion │ │ ├── Test.ds │ │ └── Test.error.check │ │ ├── 24-PrivateRebound │ │ ├── Main.dcs │ │ └── Main.error.check │ │ ├── 25-PrivateEscape │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 26-PrivateWitnessInvalid │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 27-PrivateWitnessConflict │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 28-PrivateWitnessOther │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 40-CaseNotAlgebraic │ │ ├── Test.ds │ │ └── Test.error.check │ │ ├── 41-CaseNoAlternatives │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 42-CaseNonExhaustive │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 43-CaseNonExhaustiveLarge │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 44-CaseOverlapping │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 45-CaseTooManyBinders │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 46-CaseFieldTypeMismatch │ │ ├── Main.dct │ │ └── Main.error.check │ │ ├── 50-RunNotSusp │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 51-RunNotSupported │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 52-RunCannotInfer │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 53-ProjectCannot │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 54-ProjectNoField │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 55-ProjectTooManyCtors │ │ ├── Main.ds │ │ └── Main.error.check │ │ ├── 56-ProjectTooManyArgs │ │ ├── Main.ds │ │ └── Main.error.check │ │ └── Readme.md └── source │ └── 01-Tetra │ └── 01-Syntax │ ├── 01-Module │ ├── 01-Export │ │ ├── 01-Simple │ │ │ └── Test.ds │ │ ├── 02-Multiple │ │ │ └── Test.ds │ │ └── 03-Many │ │ │ └── Test.ds │ └── 02-Import │ │ ├── 01-Simple │ │ ├── ImportMe.ds │ │ └── Test.ds │ │ ├── 02-Multiple │ │ └── Test.ds │ │ └── 03-Foreign │ │ ├── Main.ds │ │ └── Main.stdout.check │ ├── 02-Decl │ ├── Main.ds │ └── Main.stdout.check │ ├── 03-Types │ └── Main.ds │ ├── 04-Guards │ ├── Main.ds │ └── Main.stdout.check │ ├── 05-Term │ └── Main.ds │ ├── 06-Abs │ ├── Main.ds │ └── Main.stdout.check │ ├── 07-Binding │ ├── Main.ds │ └── Main.stdout.check │ ├── 08-Matching │ └── Main.ds │ └── 09-Effects │ └── Main.ds ├── smr-regress ├── 01-Simple │ └── Main.smr └── 02-Combinate │ └── Main.smr └── unit └── 1-CoreLLVM ├── Main.hs └── Main.stdout.check /.gitignore: -------------------------------------------------------------------------------- 1 | *.a 2 | *.s 3 | *.o 4 | *.o-boot 5 | *.so 6 | *.dylib 7 | *.hi 8 | *.hi-boot 9 | *.di 10 | *.ll 11 | *.tgz 12 | *.ddc.c 13 | *.ddc.h 14 | *.dep 15 | *.bin 16 | *.sms 17 | Main 18 | .DS_Store 19 | _darcs 20 | war.results 21 | war.failed 22 | war-std 23 | war-opt 24 | Main.dump* 25 | doc 26 | log 27 | tmp 28 | bin 29 | dist 30 | make/config-override.mk 31 | make/deps 32 | packages/ddc-alpha/src/Config/Config.hs 33 | packages/ddc-alpha/src/Source/Lexer.hs 34 | packages/ddc-alpha/src/Source/Plate/Trans.hs 35 | .cabal-sandbox 36 | cabal.sandbox.config 37 | war-llvm 38 | war-llvmo 39 | war-viac 40 | war-viaco 41 | tags 42 | packages/smr-core/doc/build 43 | -------------------------------------------------------------------------------- /.mailmap: -------------------------------------------------------------------------------- 1 | Ben Lippmeier 2 | Ben Lippmeier 3 | Ben Lippmeier 4 | Erik de Castro Lopo 5 | Amos Robinson 6 | Thomas Bereknyei 7 | Tran Ma 8 | Kyle Van Berendonck 9 | Chris Eidhof 10 | 11 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | The Disciplined Disciple Compiler License (MIT style) 3 | 4 | Copyrite (K) 2007-2017 The Disciplined Disciple Compiler Strike Force 5 | All rights reversed. 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in 15 | all copies or substantial portions of the Software. 16 | -------------------------------------------------------------------------------- 17 | -------------------------------------------------------------------------------- /bin/.README: -------------------------------------------------------------------------------- 1 | The build system creates executable files in this directory. 2 | -------------------------------------------------------------------------------- /doc/notes/ddc/design/Collections.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | Collections 4 | ~~~~~~~~~~~ 5 | 6 | Using lists as the default collection is bad news. We want a way of specifying a literal sequence of values that isn't bound to cons-lists. We also want to avoid [] for lists, because this is used for type application in the core language. 7 | 8 | data List a = Nil | Cons a (List a) 9 | 10 | 11 | Sequences 12 | ~~~~~~~~~ 13 | 14 | Defining sequences as functions 15 | 16 | data Seq a = Seq Int (Int -> a) 17 | 18 | Outfix sugar: 19 | 20 | type {a} = Seq Int 21 | 22 | {} : {a} 23 | {1} : {Int} 24 | {1, 2, 3} : {Int} 25 | 26 | 27 | Initializers 28 | ~~~~~~~~~~~~ 29 | 30 | For other concrete data types, prefix the sequence with a builder function. 31 | 32 | list {1, 2, 3} 33 | 34 | set {1, 2, 3} 35 | 36 | tree {<1, "foo">, <2, "bar">, <3, "baz">} 37 | 38 | Haskell Syntax: 39 | tree [(1, "foo"), (2, "bar"), (3, "baz")] 40 | 41 | -------------------------------------------------------------------------------- /doc/notes/ddc/design/Documentation.txt: -------------------------------------------------------------------------------- 1 | 2 | Documentation 3 | ~~~~~~~~~~~~~ 4 | 5 | Docs should be stored in interface files so that the REPL can access them, 6 | similarly to database REPLs. 7 | 8 | :describe fac 9 | fac (x: Nat): Nat 10 | Compute the factorial of 'x'. 11 | 12 | :describe more fac 13 | fac (x: Nat): Nat 14 | Compute the factorial of 'x' 15 | Example fac 10 = ... 16 | 17 | 18 | -------------------------------------------------------------------------------- /doc/notes/ddc/design/ExistentialRegions.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | Existential Regions 4 | ~~~~~~~~~~~~~~~~~~~ 5 | 6 | The type of this function from the runtime system works in practice, 7 | but is morally wrong. 8 | 9 | ddcGetBoxed: [r1 r2: Region]. Ptr# r1 Obj -> Nat# -> Ptr# r2 Obj 10 | 11 | Given a boxed object that contains pointers to other objects, we read one of 12 | the pointers. At the Salt level we won't know what the real region for 'r2' 13 | is supposed to be. 14 | 15 | If we passed runtime region handles then we could imagine that the function 16 | takes the handle bound to 'r2' and checks that the returned pointer is really 17 | for the associated region, and throw an exception otherwise, but we don't 18 | do this in practice. 19 | 20 | The type really wants to be: 21 | 22 | ddcGetBoxed: ∀(r1: Region). Ptr# r1 Obj -> Nat# -> (∃(r2: Region). Ptr# r2 Obj) 23 | 24 | but we don't support existential regions. Maybe we should. 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /doc/notes/ddc/design/Shimmer.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | -- Convert shimmer code to and from AST form, 5 | -- using reflect and reify operator. 6 | #smr-meta-reflect 7 | #smr-meta-reify 8 | 9 | %smr-exp-rsym 10 | %smr-exp-rprm 11 | %smr-exp-rmac 12 | %smr-exp-rset 13 | 14 | %smr-exp-xref 15 | %smr-exp-xapp 16 | 17 | 18 | -- Allow matching directly on the expression ast. 19 | #smr-exp-abs (#list ..) exp 20 | 21 | #match (#smr-meta-reify1 xx) 22 | (#smr-exp-abs #o #o) 23 | $ \names xBody. ... 24 | 25 | 26 | -- Reflect parts of the implementation as meta-functions 27 | #smr-meta-step 28 | #smr-meta-size 29 | 30 | #smr-meta-parse 31 | #smr-meta-lex 32 | 33 | should be able to load and parse a file in itself, 34 | then match directly on the AST, 35 | call meta-fun to convert to LLVM, compile, 36 | then execute that code. 37 | End up with plugin architecture / generative. 38 | Keep adding stuff to this interface, 39 | so eventually can use shimmer meta-functions to parse then type-check 40 | the source code. Doing it this way will force all ASTs to be shimmer compatible. 41 | -------------------------------------------------------------------------------- /doc/sphinx/discus/Makefile: -------------------------------------------------------------------------------- 1 | # Minimal makefile for Sphinx documentation 2 | # 3 | 4 | # You can set these variables from the command line. 5 | SPHINXOPTS = 6 | SPHINXBUILD = sphinx-build 7 | SPHINXPROJ = Discus 8 | SOURCEDIR = source 9 | BUILDDIR = build 10 | 11 | # Put it first so that "make" without argument is like "make help". 12 | help: 13 | @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) 14 | 15 | .PHONY: help Makefile 16 | 17 | # Catch-all target: route all unknown targets to Sphinx using the new 18 | # "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). 19 | %: Makefile 20 | @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) -------------------------------------------------------------------------------- /doc/sphinx/discus/source/_static/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/discus-lang/ddc/2baa1b4e2d43b6b02135257677671a83cb7384ac/doc/sphinx/discus/source/_static/.keep -------------------------------------------------------------------------------- /doc/sphinx/discus/source/_templates/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/discus-lang/ddc/2baa1b4e2d43b6b02135257677671a83cb7384ac/doc/sphinx/discus/source/_templates/.keep -------------------------------------------------------------------------------- /doc/sphinx/discus/source/logo/discus-512x512.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/discus-lang/ddc/2baa1b4e2d43b6b02135257677671a83cb7384ac/doc/sphinx/discus/source/logo/discus-512x512.jpg -------------------------------------------------------------------------------- /doc/sphinx/discus/source/section/02-Specification.rst: -------------------------------------------------------------------------------- 1 | 2 | Specification 3 | ============= 4 | 5 | 6 | .. toctree:: 7 | :maxdepth: 3 8 | :caption: Specification: 9 | 10 | ../specification/01-Source.rst 11 | ../specification/02-Core.rst 12 | -------------------------------------------------------------------------------- /doc/sphinx/discus/source/section/03-Release.rst: -------------------------------------------------------------------------------- 1 | 2 | 3 | Release Notes 4 | ============= 5 | 6 | .. toctree:: 7 | :maxdepth: 1 8 | :caption: Releases: 9 | 10 | ../release/ddc-0.5.1.rst 11 | ../release/ddc-0.4.3.rst 12 | ../release/ddc-0.4.2.rst 13 | ../release/ddc-0.4.1.rst 14 | ../release/ddc-0.3.2.rst 15 | ../release/ddc-0.3.1.rst 16 | -------------------------------------------------------------------------------- /doc/sphinx/discus/source/specification/01-Source.rst: -------------------------------------------------------------------------------- 1 | 2 | Source Language 3 | =============== 4 | 5 | .. toctree:: 6 | :maxdepth: 1 7 | :caption: Source Language: 8 | 9 | ../specification/source/01-Concrete.rst 10 | 11 | -------------------------------------------------------------------------------- /doc/sphinx/discus/source/specification/02-Core.rst: -------------------------------------------------------------------------------- 1 | 2 | Core Languages 3 | ============== 4 | 5 | .. toctree:: 6 | :maxdepth: 1 7 | :caption: Core Language: 8 | 9 | ../specification/core/01-Concrete.rst 10 | ../specification/core/02-Statics.rst 11 | ../specification/core/03-CoreDiscus.rst 12 | ../specification/core/04-CoreSalt.rst 13 | ../specification/core/05-Shimmer.rst 14 | 15 | -------------------------------------------------------------------------------- /doc/sphinx/discus/source/theme/static/haiku-mod.css: -------------------------------------------------------------------------------- 1 | 2 | @import url("haiku.css"); 3 | 4 | 5 | body { 6 | font-family: "DejaVu Sans", Arial, Helvetica, sans-serif; 7 | } 8 | 9 | code { 10 | background-color: initial; 11 | font-family: "Lucida Console", monospace; 12 | font-size: 1.0em; 13 | } 14 | 15 | 16 | pre { 17 | border-color: initial; 18 | border-style: initial; 19 | border-width: initial; 20 | background-color: white; 21 | 22 | margin: 0 0 12px 0; 23 | padding: 0.8em; 24 | font-family: "Monaco", monospace; 25 | font-size: 0.8em; 26 | } 27 | 28 | h2 { 29 | font-weight: bold; 30 | } -------------------------------------------------------------------------------- /doc/sphinx/discus/source/theme/theme.conf: -------------------------------------------------------------------------------- 1 | 2 | [theme] 3 | inherit = haiku 4 | stylesheet = haiku-mod.css 5 | pygments_style = pygments.css -------------------------------------------------------------------------------- /doc/sphinx/shimmer/Makefile: -------------------------------------------------------------------------------- 1 | # Minimal makefile for Sphinx documentation 2 | # 3 | 4 | # You can set these variables from the command line. 5 | SPHINXOPTS = 6 | SPHINXBUILD = sphinx-build 7 | SPHINXPROJ = Shimmer 8 | SOURCEDIR = source 9 | BUILDDIR = build 10 | 11 | # Put it first so that "make" without argument is like "make help". 12 | help: 13 | @$(SPHINXBUILD) -M help "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) 14 | 15 | .PHONY: help Makefile 16 | 17 | # Catch-all target: route all unknown targets to Sphinx using the new 18 | # "make mode" option. $(O) is meant as a shortcut for $(SPHINXOPTS). 19 | %: Makefile 20 | @$(SPHINXBUILD) -M $@ "$(SOURCEDIR)" "$(BUILDDIR)" $(SPHINXOPTS) $(O) -------------------------------------------------------------------------------- /doc/sphinx/shimmer/build/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/discus-lang/ddc/2baa1b4e2d43b6b02135257677671a83cb7384ac/doc/sphinx/shimmer/build/.keep -------------------------------------------------------------------------------- /doc/sphinx/shimmer/source/_static/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/discus-lang/ddc/2baa1b4e2d43b6b02135257677671a83cb7384ac/doc/sphinx/shimmer/source/_static/.keep -------------------------------------------------------------------------------- /doc/sphinx/shimmer/source/_templates/.keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/discus-lang/ddc/2baa1b4e2d43b6b02135257677671a83cb7384ac/doc/sphinx/shimmer/source/_templates/.keep -------------------------------------------------------------------------------- /doc/sphinx/shimmer/source/section/examples/00-Intro.smr: -------------------------------------------------------------------------------- 1 | 2 | @list-case xx alt-nil alt-cons 3 | = #match xx %list-nil alt-nil 4 | (#match xx (%list-cons #o #o) alt-cons 5 | %fail); 6 | 7 | @list-range a b 8 | = #if (#nat-gt a b) 9 | %list-nil 10 | (%list-cons a (@list-range (#nat-add a #nat-1) b)); 11 | 12 | @list-foldl f z xx 13 | = @list-case xx z (\x. \xs. @list-foldl f (f z x) xs); 14 | -------------------------------------------------------------------------------- /doc/sphinx/shimmer/source/section/examples/01-Lambda.smr: -------------------------------------------------------------------------------- 1 | 2 | @example-1 = (\x. x x) %turtle; 3 | @example-2 = (\f. \x. f (f x)) (\x. x x) %turtle; 4 | 5 | -------------------------------------------------------------------------------- /doc/sphinx/shimmer/source/section/examples/02-NoNameCapture.smr: -------------------------------------------------------------------------------- 1 | 2 | @example-1 = (\y. (\x. \y. x) y); 3 | @example-2 = (\y. (\x. \y. \y. x) y); 4 | -------------------------------------------------------------------------------- /doc/sphinx/shimmer/source/section/examples/03-ChurchEncoding.smr: -------------------------------------------------------------------------------- 1 | 2 | @true x y = x; 3 | @false x y = y; 4 | @if a b c = a b c; 5 | 6 | @zero = \s. \z. z; 7 | @succ n = \s. \z. s (n s z); 8 | @one = @succ @zero; 9 | @two = @succ @one; 10 | @three = @succ @two; 11 | @four = @succ @three; 12 | 13 | @is-zero n = n (\x. @false) @true; 14 | 15 | @pair m n = \b. @if b m n; 16 | @pair-fst p = p @true; 17 | @pair-snd p = p @false; 18 | @pair-zero = @pair @zero @zero; 19 | @pair-succ p = @pair (@pair-snd p) (@succ (@pair-snd p)); 20 | 21 | @pred n = @pair-fst (n @pair-succ @pair-zero); 22 | @add m n = \s. \z. m s (n s z); 23 | @sub m n = n @pred m; 24 | @mul m n = \z. n (m z); 25 | 26 | @fac n 27 | = @if (@is-zero n) 28 | @one 29 | (@mul n (@fac (@sub n @one))); 30 | -------------------------------------------------------------------------------- /doc/sphinx/shimmer/source/section/examples/04-PrimitiveNats.smr: -------------------------------------------------------------------------------- 1 | 2 | @nat-fac n 3 | = #if (#nat-eq #nat-0 n) 4 | #nat-1 5 | (#nat-mul n (@nat-fac (#nat-sub n #nat-1))); 6 | -------------------------------------------------------------------------------- /doc/sphinx/shimmer/source/section/examples/05-Fixpoints.smr: -------------------------------------------------------------------------------- 1 | 2 | @fix f 3 | = (\x. f (x x)) (\x. f (x x)); 4 | 5 | @nat-fac-fixed 6 | = @fix (\self. \n. 7 | #if (#nat-eq #nat-0 n) 8 | #nat-1 9 | (#nat-mul n (self (#nat-sub n #nat-1)))); 10 | -------------------------------------------------------------------------------- /doc/syntax/Haskell/Comments.tmPreferences: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | name 6 | Comments 7 | scope 8 | source.haskell 9 | settings 10 | 11 | shellVariables 12 | 13 | 14 | name 15 | TM_COMMENT_START_2 16 | value 17 | {- 18 | 19 | 20 | name 21 | TM_COMMENT_END_2 22 | value 23 | -} 24 | 25 | 26 | name 27 | TM_COMMENT_START 28 | value 29 | -- 30 | 31 | 32 | 33 | uuid 34 | E3994307-4D9E-44D6-832E-52C244F1CDF3 35 | 36 | 37 | -------------------------------------------------------------------------------- /make/build.mk: -------------------------------------------------------------------------------- 1 | 2 | include make/config.mk 3 | include make/config/options.mk 4 | include make/config/target.mk 5 | include make/config/flavour.mk 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /make/config/goop/getArch.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Get the name of the cpu. 4 | cpu=`uname -m` 5 | 6 | # Normalise the name of the architecture we're on. 7 | case "$cpu" in 8 | i?86) echo "x86" 9 | ;; 10 | x86_64) 11 | echo "x86_64" 12 | ;; 13 | ppc64) 14 | echo "ppc" 15 | ;; 16 | *) 17 | echo "unknown" 18 | ;; 19 | esac 20 | 21 | -------------------------------------------------------------------------------- /make/deps/.README: -------------------------------------------------------------------------------- 1 | The build system write make file dependencies into this directory. 2 | -------------------------------------------------------------------------------- /make/rules.mk: -------------------------------------------------------------------------------- 1 | # Default make rules. 2 | include make/build.mk 3 | include make/config/target.mk 4 | 5 | %.hs : %.x 6 | @echo "* Preprocessing $<" 7 | @alex -g $< 8 | 9 | 10 | # This ':' is equivalent to 'true', but much faster. Strange. 11 | %.hi : %.o 12 | @: 13 | 14 | 15 | %.dep : %.c 16 | @echo "* Dependencies for $<" 17 | @gcc $(GCC_FLAGS) -MM $< -MT $(patsubst %.dep,%.o,$@) -o $@ 18 | 19 | 20 | %.o : %.c 21 | @echo "* Compiling $<" 22 | @gcc $(GCC_FLAGS) -c $< -o $@ 23 | 24 | 25 | %.o : %.dcl bin/ddc 26 | @echo "* Compiling $<" 27 | @bin/ddc -c $< 28 | 29 | 30 | %.o : %.dcs bin/ddc 31 | @echo "* Compiling $<" 32 | @bin/ddc -infer -c $< 33 | 34 | -------------------------------------------------------------------------------- /make/targets/bin-smr.mk: -------------------------------------------------------------------------------- 1 | # Shimmer executable. 2 | 3 | smr-main_src_ds_all = \ 4 | $(shell find src/s2/base -name "*.ds" -follow) \ 5 | $(shell find src/s2/smr-core/src -name "*.ds" -follow) 6 | 7 | # Link smr execurable. 8 | smr-main_obj = $(patsubst %.hs,%.o,$(smr-main_src_ds_all)) 9 | 10 | # Build smr executable. 11 | bin/smr : $(smr-main_obj) src/s2/ddc-runtime/build/libddc-runtime.a bin/ddc 12 | @echo "* Building smr" 13 | @bin/ddc --make src/s2/smr-core/src/Main.ds -o bin/smr 14 | 15 | -------------------------------------------------------------------------------- /make/targets/clean.mk: -------------------------------------------------------------------------------- 1 | 2 | # -- clean up everything 3 | .PHONY : clean 4 | clean : clean-war clean-runtime 5 | @echo "* Cleaning leftovers" 6 | @find . \ 7 | -name "*.o" \ 8 | -o -name "*.o-boot" \ 9 | -o -name "*.so" \ 10 | -o -name "*.dylib" \ 11 | -o -name "*.hi" \ 12 | -o -name "*.hi-boot" \ 13 | -o -name "*.hcr" \ 14 | -o -name "*.td" \ 15 | -o -name "*.ti" \ 16 | -o -name "*.deps" \ 17 | -o -name "*.deps.inc" \ 18 | -o -name "*.vo" \ 19 | -o -name "*.glob" \ 20 | -follow \ 21 | | grep -v "\.cabal-sandbox" \ 22 | | xargs -n 1 rm -f 23 | 24 | @rm -rf packages/*/dist 25 | @rm -rf src/*/dist 26 | 27 | @rm -f doc/haddock/* 28 | @rm -f doc/haddock-core/* 29 | @rm -f bin/* \ 30 | make/Makefile.deps.bak 31 | -------------------------------------------------------------------------------- /make/targets/libs.mk: -------------------------------------------------------------------------------- 1 | 2 | # -- Clean the base libraries. 3 | .PHONY : clean-libs 4 | clean-libs : 5 | @echo "* Cleaning libs" 6 | @find src/s2 \ 7 | -name "*.di" \ 8 | -o -name "*.o" \ 9 | -follow \ 10 | | xargs -n 1 rm -f 11 | 12 | .PHONY : libs 13 | libs: bin/ddc 14 | @bin/ddc -build src/s2/base/base.build 15 | -------------------------------------------------------------------------------- /make/targets/setup.mk: -------------------------------------------------------------------------------- 1 | 2 | # Print the packages needed to build DDC. 3 | .PHONY : show-pkgs 4 | show-pkgs : 5 | @echo $(DDC_PACKAGES) \ 6 | | sed 's/-hide-all-packages //;s/-package //g;s/base //g;s/directory //;s/array //;s/containers //' 7 | 8 | 9 | # Install prerequisite cabal packages. 10 | .PHONY : setup 11 | setup : 12 | @echo "* Installing prerequisite cabal packages..." 13 | @$(DEPS_INSTALLER) v1-update 14 | @$(DEPS_INSTALLER) v1-install \ 15 | text mtl stm json \ 16 | parsec-3.1.13.0 \ 17 | inchworm-1.1.1.2 \ 18 | shimmer-0.1.3.4 \ 19 | buildbox-2.2.1.2 \ 20 | cryptohash-sha256-0.11.101.0 21 | 22 | -------------------------------------------------------------------------------- /make/targets/tarball.mk: -------------------------------------------------------------------------------- 1 | # Make a tarball for distribution 2 | 3 | srcdir := $(shell pwd) 4 | datestamp := $(shell date "+%Y%m%d") 5 | dateseconds := $(shell date "+%s") 6 | tmpdir = ddc-head-$(dateseconds) 7 | tarname = $(srcdir)/ddc-head-$(datestamp).tgz 8 | 9 | .PHONY : tarball 10 | tarball : 11 | @echo "* Creating current tarball" 12 | @mkdir /tmp/$(tmpdir) 13 | @cd /tmp/$(tmpdir) && darcs get $(srcdir) ddc-head && tar zcf $(tarname) ddc-head 14 | @rm -rf /tmp/$(tmpdir) 15 | @chmod g+w,a+r $(tarname) 16 | @echo "* Tarball is :" $(tarname) 17 | -------------------------------------------------------------------------------- /src/s1/ddc-build/DDC/Build/Pipeline.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | -- | A pipeline is an abstraction of a single compiler pass. 3 | -- 4 | -- NOTE: The Haddock documentation on pipeline constructors is missing 5 | -- because Haddock does not support commenting GADTs. 6 | -- See the source code for documentation. 7 | -- 8 | module DDC.Build.Pipeline 9 | ( -- * Errors 10 | Error(..) 11 | 12 | -- * Source code 13 | , PipeText (..) 14 | , pipeText 15 | 16 | -- * Generic Core modules 17 | , PipeCore (..) 18 | , pipeCore 19 | 20 | -- * Core Flow modules 21 | , PipeFlow (..) 22 | , pipeFlow 23 | 24 | -- * Core Machine modules 25 | , PipeMachine (..) 26 | , pipeMachine 27 | 28 | -- * Emitting output 29 | , Sink (..) 30 | , pipeSink) 31 | where 32 | import DDC.Build.Pipeline.Text 33 | import DDC.Build.Pipeline.Core 34 | import DDC.Build.Pipeline.Sink 35 | import DDC.Build.Pipeline.Error 36 | 37 | -------------------------------------------------------------------------------- /src/s1/ddc-build/DDC/Build/Pipeline/Sink.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_HADDOCK hide #-} 2 | module DDC.Build.Pipeline.Sink 3 | ( Sink(..) 4 | , pipeSink) 5 | where 6 | import DDC.Build.Pipeline.Error 7 | 8 | -- | What to do with program text. 9 | data Sink 10 | -- | Drop it on the floor. 11 | = SinkDiscard 12 | 13 | -- | Emit it to stdout. 14 | | SinkStdout 15 | 16 | -- | Write it to this file. 17 | | SinkFile FilePath 18 | deriving (Show) 19 | 20 | 21 | -- | Emit a string to the given `Sink`. 22 | pipeSink :: String -> Sink -> IO [Error] 23 | pipeSink !str !tg 24 | = case tg of 25 | SinkDiscard 26 | -> do return [] 27 | 28 | SinkStdout 29 | -> do putStrLn str 30 | return [] 31 | 32 | SinkFile path 33 | -> do writeFile path str 34 | return [] 35 | -------------------------------------------------------------------------------- /src/s1/ddc-build/DDC/Build/Platform.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Build.Platform 3 | ( -- * Platform 4 | Platform (..) 5 | , staticFileExtensionOfPlatform 6 | , sharedFileExtensionOfPlatform 7 | 8 | -- * Architecture 9 | , Arch (..) 10 | , archPointerWidth 11 | 12 | -- * Os 13 | , Os (..) 14 | 15 | -- * Host platform determination 16 | , Error (..) 17 | , determineHostPlatform 18 | , determineHostArch 19 | , determineHostOs 20 | , determineHostLlvmVersion 21 | , determineHostLlvmBinPath ) 22 | where 23 | import DDC.Build.Platform.Base 24 | import DDC.Build.Platform.Determine 25 | import DDC.Build.Platform.Error 26 | -------------------------------------------------------------------------------- /src/s1/ddc-build/DDC/Build/Spec.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Build.Spec 3 | ( Spec (..) 4 | , Component (..) 5 | , Error (..) 6 | , parseBuildSpec 7 | , specFieldsLibrary) 8 | where 9 | import DDC.Build.Spec.Base 10 | import DDC.Build.Spec.Parser 11 | 12 | -------------------------------------------------------------------------------- /src/s1/ddc-build/DDC/Build/Spec/Check.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_HADDOCK hide #-} 2 | module DDC.Build.Spec.Check 3 | (Error(..)) 4 | where 5 | 6 | -- | Errors that can appear in a Build Spec file. 7 | data Error 8 | = ErrorUnrecognisedField 9 | { errorField :: String 10 | , errorValue :: String } 11 | deriving Show 12 | -------------------------------------------------------------------------------- /src/s1/ddc-build/LICENSE: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | The Disco Discus Compiler License (MIT style) 3 | 4 | Copyrite (K) 2007-2018 The Disco Discus Compiler Strike Force 5 | All rights reversed. 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in 15 | all copies or substantial portions of the Software. 16 | -------------------------------------------------------------------------------- 17 | -------------------------------------------------------------------------------- /src/s1/ddc-build/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /src/s1/ddc-core-discus/LICENSE: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | The Disco Discus Compiler License (MIT style) 3 | 4 | Copyrite (K) 2007-2018 The Disco Discus Compiler Strike Force 5 | All rights reversed. 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in 15 | all copies or substantial portions of the Software. 16 | -------------------------------------------------------------------------------- 17 | -------------------------------------------------------------------------------- /src/s1/ddc-core-discus/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /src/s1/ddc-core-flow/DDC/Core/Flow/Context.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Flow.Context 3 | ( module DDC.Core.Flow.Context.Base 4 | , module DDC.Core.Flow.Context.FillPath ) 5 | where 6 | import DDC.Core.Flow.Context.Base 7 | import DDC.Core.Flow.Context.FillPath 8 | -------------------------------------------------------------------------------- /src/s1/ddc-core-flow/DDC/Core/Flow/Exp.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Flow.Exp 3 | ( module DDC.Core.Flow.Exp.Simple.Exp 4 | , KindEnvF, TypeEnvF 5 | , TypeF 6 | , ModuleF 7 | , ExpF 8 | , CastF 9 | , LetsF 10 | , AltF 11 | , PatF 12 | , WitnessF 13 | , BoundF 14 | , BindF) 15 | where 16 | import DDC.Core.Module 17 | import DDC.Core.Flow.Prim 18 | import DDC.Core.Flow.Exp.Simple.Exp 19 | import DDC.Core.Flow.Exp.Simple.Collect () 20 | import DDC.Type.Env (Env) 21 | 22 | type KindEnvF = Env Name 23 | type TypeEnvF = Env Name 24 | 25 | type TypeF = Type Name 26 | 27 | type ModuleF = Module () Name 28 | type ExpF = Exp () Name 29 | type CastF = Cast () Name 30 | type LetsF = Lets () Name 31 | type AltF = Alt () Name 32 | type PatF = Pat Name 33 | type WitnessF = Witness () Name 34 | 35 | type BoundF = Bound Name 36 | type BindF = Bind Name 37 | 38 | 39 | -------------------------------------------------------------------------------- /src/s1/ddc-core-flow/DDC/Core/Flow/Prim/KiConFlow.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Flow.Prim.KiConFlow 3 | ( readKiConFlow 4 | , kRate 5 | , kProc ) 6 | where 7 | import DDC.Core.Flow.Prim.Base 8 | import DDC.Core.Flow.Exp.Simple.Exp 9 | import DDC.Data.Pretty 10 | import Control.DeepSeq 11 | 12 | 13 | instance NFData KiConFlow where 14 | rnf !_ = () 15 | 16 | 17 | instance Pretty KiConFlow where 18 | ppr con 19 | = case con of 20 | KiConFlowRate -> text "Rate" 21 | KiConFlowProc -> text "Proc" 22 | 23 | 24 | -- | Read a kind constructor name. 25 | readKiConFlow :: String -> Maybe KiConFlow 26 | readKiConFlow str 27 | = case str of 28 | "Rate" -> Just $ KiConFlowRate 29 | "Proc" -> Just $ KiConFlowProc 30 | _ -> Nothing 31 | 32 | 33 | -- Compounds ------------------------------------------------------------------ 34 | kRate = TCon (TyConBound (NameKiConFlow KiConFlowRate)) 35 | kProc = TCon (TyConBound (NameKiConFlow KiConFlowProc)) 36 | -------------------------------------------------------------------------------- /src/s1/ddc-core-flow/DDC/Core/Flow/Process.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Flow.Process 3 | ( Process (..) 4 | 5 | , Operator (..)) 6 | where 7 | import DDC.Core.Flow.Process.Process 8 | import DDC.Core.Flow.Process.Operator 9 | import DDC.Core.Flow.Process.Pretty () 10 | -------------------------------------------------------------------------------- /src/s1/ddc-core-flow/DDC/Core/Flow/Transform/Rates/Clusters.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module DDC.Core.Flow.Transform.Rates.Clusters 3 | (cluster) 4 | where 5 | 6 | #if DDC_FLOW_HAVE_LINEAR_SOLVER 7 | import DDC.Core.Flow.Transform.Rates.Clusters.Linear 8 | 9 | cluster = solve_linear 10 | 11 | #else 12 | import DDC.Core.Flow.Transform.Rates.Clusters.Greedy 13 | 14 | cluster = cluster_greedy 15 | 16 | #endif 17 | 18 | -------------------------------------------------------------------------------- /src/s1/ddc-core-flow/DDC/Core/Flow/Transform/Schedule.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Flow.Transform.Schedule 3 | ( scheduleScalar 4 | 5 | -- * Scheduling process kernels 6 | , scheduleKernel 7 | , Error (..) 8 | , Lifting (..)) 9 | where 10 | import DDC.Core.Flow.Transform.Schedule.Kernel 11 | import DDC.Core.Flow.Transform.Schedule.Scalar 12 | 13 | 14 | -------------------------------------------------------------------------------- /src/s1/ddc-core-flow/LICENSE: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | The Disco Discus Compiler License (MIT style) 3 | 4 | Copyrite (K) 2007-2018 The Disco Discus Compiler Strike Force 5 | All rights reversed. 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in 15 | all copies or substantial portions of the Software. 16 | -------------------------------------------------------------------------------- 17 | -------------------------------------------------------------------------------- /src/s1/ddc-core-flow/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /src/s1/ddc-core-llvm/DDC/Llvm/Analysis/Children.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Llvm.Analysis.Children 3 | ( Children (..) 4 | , annotChildrenOfGraph 5 | , annotChildrenOfNode 6 | , childrenOfNode) 7 | where 8 | import DDC.Llvm.Syntax 9 | import DDC.Llvm.Graph 10 | import Data.Set (Set) 11 | import qualified Data.Map as Map 12 | 13 | 14 | -- | The children of a node are the other nodes this one might branch to. 15 | data Children 16 | = Children (Set Label) 17 | 18 | 19 | -- | Annotate a graph with the children of each node. 20 | annotChildrenOfGraph 21 | :: Graph a -> Graph (a, Children) 22 | 23 | annotChildrenOfGraph (Graph entry nodes) 24 | = Graph entry 25 | $ Map.map annotChildrenOfNode nodes 26 | 27 | 28 | -- | Annotate a node with its children. 29 | annotChildrenOfNode 30 | :: Node a -> Node (a, Children) 31 | 32 | annotChildrenOfNode node@(Node label instrs annot) 33 | = Node label instrs 34 | $ (annot, Children $ childrenOfNode node) 35 | 36 | -------------------------------------------------------------------------------- /src/s1/ddc-core-llvm/DDC/Llvm/Write.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Llvm.Write 3 | ( Config (..), Version 4 | , configOfVersion 5 | , configOfHandle 6 | , module DDC.Data.Write) 7 | where 8 | import DDC.Llvm.Write.Base 9 | import DDC.Llvm.Write.Attr () 10 | import DDC.Llvm.Write.Exp () 11 | import DDC.Llvm.Write.Function () 12 | import DDC.Llvm.Write.Instr () 13 | import DDC.Llvm.Write.Metadata () 14 | import DDC.Llvm.Write.Module () 15 | import DDC.Llvm.Write.Prim () 16 | import DDC.Llvm.Write.Type () 17 | import DDC.Data.Write 18 | 19 | 20 | -------------------------------------------------------------------------------- /src/s1/ddc-core-llvm/LICENSE: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | The Disco Discus Compiler License (MIT style) 3 | 4 | Copyrite (K) 2007-2018 The Disco Discus Compiler Strike Force 5 | All rights reversed. 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in 15 | all copies or substantial portions of the Software. 16 | -------------------------------------------------------------------------------- 17 | -------------------------------------------------------------------------------- /src/s1/ddc-core-llvm/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /src/s1/ddc-core-machine/DDC/Core/Machine.hs: -------------------------------------------------------------------------------- 1 | 2 | -- | Disciple Core Flow is a Domain Specific Language (DSL) for writing first 3 | -- order data flow programs. 4 | -- 5 | module DDC.Core.Machine 6 | ( -- * Language profile 7 | profile 8 | 9 | -- * Names 10 | , Name (..) 11 | , KiConMachine (..) 12 | , TyConMachine (..) 13 | , OpMachine (..) 14 | 15 | -- * Name Parsing 16 | , readName 17 | 18 | -- * Program Lexing 19 | , lexModuleString 20 | , lexExpString 21 | 22 | -- * Processes 23 | , Process (..) 24 | , Network (..) 25 | , slurpNetworks 26 | , fuseNetwork 27 | ) 28 | 29 | where 30 | import DDC.Core.Machine.Prim 31 | import DDC.Core.Machine.Profile 32 | import DDC.Core.Machine.Process 33 | -------------------------------------------------------------------------------- /src/s1/ddc-core-machine/DDC/Core/Machine/Process.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Machine.Process 3 | ( Label (..) 4 | , Channel (..) 5 | , ChannelType (..) 6 | , BlockNext (..) 7 | , Block (..) 8 | , Process (..) 9 | , Network (..) 10 | , SlurpError (..) 11 | , slurpNetworks 12 | , fuseNetwork 13 | ) 14 | where 15 | import DDC.Core.Machine.Process.Base 16 | import DDC.Core.Machine.Process.Slurp 17 | import DDC.Core.Machine.Process.Fuse 18 | 19 | 20 | -------------------------------------------------------------------------------- /src/s1/ddc-core-machine/LICENSE: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | The Disco Discus Compiler License (MIT style) 3 | 4 | Copyrite (K) 2007-2018 The Disco Discus Compiler Strike Force 5 | All rights reversed. 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in 15 | all copies or substantial portions of the Software. 16 | -------------------------------------------------------------------------------- 17 | -------------------------------------------------------------------------------- /src/s1/ddc-core-machine/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /src/s1/ddc-core-salt/LICENSE: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | The Disco Discus Compiler License (MIT style) 3 | 4 | Copyrite (K) 2007-2018 The Disco Discus Compiler Strike Force 5 | All rights reversed. 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in 15 | all copies or substantial portions of the Software. 16 | -------------------------------------------------------------------------------- 17 | -------------------------------------------------------------------------------- /src/s1/ddc-core-salt/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Core/Check/Error/ErrorData.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_HADDOCK hide #-} 2 | module DDC.Core.Check.Error.ErrorData 3 | (ErrorData(..)) 4 | where 5 | import DDC.Core.Exp 6 | 7 | 8 | -- | Things that can go wrong when checking data type definitions. 9 | data ErrorData n 10 | -- | A duplicate data type constructor name. 11 | = ErrorDataDupTypeName 12 | { errorDataDupTypeName :: n } 13 | 14 | -- | A duplicate data constructor name. 15 | | ErrorDataDupCtorName 16 | { errorDataCtorName :: n } 17 | 18 | -- | A data constructor with the wrong result type. 19 | | ErrorDataWrongResult 20 | { errorDataCtorName :: n 21 | , errorDataCtorResultActual :: Type n 22 | , errorDataCtorResultExpected :: Type n } 23 | deriving Show 24 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Core/Check/Error/ErrorDataMessage.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_HADDOCK hide #-} 2 | module DDC.Core.Check.Error.ErrorDataMessage where 3 | import DDC.Core.Check.Error.ErrorData 4 | import DDC.Core.Codec.Text.Pretty 5 | 6 | instance (Eq n, Show n, Pretty n) 7 | => Pretty (ErrorData n) where 8 | ppr = ppr' 9 | 10 | ppr' (ErrorDataDupTypeName n) 11 | = vcat [ text "Duplicate data type definition." 12 | , text " A constructor with name: " % ppr n 13 | , text " is already defined." ] 14 | 15 | ppr' (ErrorDataDupCtorName n) 16 | = vcat [ text "Duplicate data constructor definition." 17 | , text " A constructor with name: " % ppr n 18 | , text " is already defined." ] 19 | 20 | ppr' (ErrorDataWrongResult n tActual tExpected) 21 | = vcat [ text "Invalid result type for data constructor." 22 | , text " The data constructor: " % ppr n 23 | , text " has result type: " % ppr tActual 24 | , text " but the enclosing type is: " % ppr tExpected ] 25 | 26 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Core/Check/Judge/Type/Witness.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_HADDOCK hide #-} 2 | module DDC.Core.Check.Judge.Type.Witness 3 | -- (checkWit) 4 | where 5 | -- import DDC.Core.Check.Judge.Witness 6 | -- import DDC.Core.Check.Judge.Type.Base 7 | -- import qualified DDC.Type.Sum as Sum 8 | 9 | {- 10 | checkWit :: Checker a n 11 | checkWit !table !ctx _mode _demand 12 | (XWitness a w1) 13 | = do let config = tableConfig table 14 | 15 | -- Check the witness. 16 | (w1', t1) <- checkWitnessM config ctx w1 17 | let w1TEC = reannotate fromAnT w1' 18 | 19 | returnX a 20 | (\z -> XWitness z w1TEC) 21 | t1 22 | (Sum.empty kEffect) 23 | ctx 24 | 25 | checkWit _ _ _ _ _ 26 | = error "ddc-core.checkWit: no match" 27 | -} -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Core/Codec/Text/Lexer/Token/Index.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Codec.Text.Lexer.Token.Index 3 | (scanIndex) 4 | where 5 | import Text.Lexer.Inchworm.Char as I 6 | import qualified Data.Char as Char 7 | 8 | 9 | -- | Scan a deBruijn index. 10 | scanIndex :: Scanner IO Location [Char] (Range Location, Int) 11 | scanIndex 12 | = I.munchPred Nothing matchIndex acceptIndex 13 | where 14 | matchIndex 0 '^' = True 15 | matchIndex 0 _ = False 16 | matchIndex _ c = Char.isDigit c 17 | 18 | acceptIndex ('^': xs) 19 | | not $ null xs = return (read xs) 20 | acceptIndex _ = Nothing 21 | 22 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Core/Collect.hs: -------------------------------------------------------------------------------- 1 | 2 | -- | Collecting sets of variables and constructors. 3 | module DDC.Core.Collect 4 | ( -- * Free Variables 5 | freeT, freeVarsT 6 | , freeX 7 | 8 | -- * Bounds and Binds 9 | , collectBound 10 | , collectBinds 11 | 12 | -- * Abstract Binding Structures 13 | , BindTree (..) 14 | , BindWay (..) 15 | , BoundLevel (..) 16 | , BindStruct (..) 17 | 18 | -- * Support 19 | , Support (..) 20 | , SupportX (..)) 21 | where 22 | import DDC.Core.Collect.FreeX 23 | import DDC.Core.Collect.FreeT 24 | import DDC.Core.Collect.BindStruct 25 | import DDC.Core.Collect.Support 26 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Core/Exp.hs: -------------------------------------------------------------------------------- 1 | 2 | -- | Abstract syntax for the Disciple core language. 3 | module DDC.Core.Exp 4 | ( module DDC.Core.Exp.Annot.Exp ) 5 | where 6 | import DDC.Core.Exp.Annot.Exp 7 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Core/Exp/Annot/AnT.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Exp.Annot.AnT 3 | (AnT (..)) 4 | where 5 | import DDC.Type.Exp 6 | import DDC.Data.Pretty 7 | import Control.DeepSeq 8 | import Data.Typeable 9 | 10 | 11 | -- | The type checker for witnesses adds this annotation to every node in the, 12 | -- giving the type of each component of the witness. 13 | --- 14 | -- NOTE: We want to leave the components lazy so that the checker 15 | -- doesn't actualy need to produce the type components if they're 16 | -- not needed. 17 | data AnT a n 18 | = AnT 19 | { annotType :: (Type n) 20 | , annotTail :: a } 21 | deriving (Show, Typeable) 22 | 23 | 24 | instance (NFData a, NFData n) => NFData (AnT a n) where 25 | rnf !an 26 | = rnf (annotType an) 27 | `seq` rnf (annotTail an) 28 | 29 | 30 | instance Pretty (AnT a n) where 31 | ppr _ = string "AnT" 32 | 33 | 34 | 35 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Core/Exp/Literal.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Exp.Literal 3 | ( Literal (..)) 4 | where 5 | import Data.Text (Text) 6 | 7 | 8 | -- | Types of literal values known to the compiler. 9 | -- 10 | -- Note that literals are embedded in the name type of each fragment 11 | -- rather than in the expression itself so that fragments can 12 | -- choose which types of literals they support. 13 | -- 14 | data Literal 15 | = LInt Integer 16 | | LNat Integer 17 | | LSize Integer 18 | | LWord Integer Int 19 | | LFloat Double (Maybe Int) 20 | | LChar Char 21 | | LString Text 22 | deriving (Eq, Show) 23 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Core/Exp/WiCon.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Exp.WiCon 3 | ( WiCon (..)) 4 | where 5 | import DDC.Type.Exp 6 | import DDC.Type.Sum () 7 | import Control.DeepSeq 8 | 9 | 10 | -- | Witness constructors. 11 | data WiCon n 12 | -- | Witness constructors defined in the environment. 13 | -- In the interpreter we use this to hold runtime capabilities. 14 | -- The attached type must be closed. 15 | = WiConBound !(Bound n) !(Type n) 16 | deriving (Show, Eq) 17 | 18 | 19 | instance NFData n => NFData (WiCon n) where 20 | rnf wi 21 | = case wi of 22 | WiConBound u t -> rnf u `seq` rnf t 23 | 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Core/Interface/Store.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Interface.Store 3 | ( -- * Types 4 | Store (..) 5 | , Meta (..) 6 | , Interface (..) 7 | , TyConThing (..) 8 | , Error (..) 9 | 10 | -- * Construction 11 | , new, addInterface 12 | 13 | -- * Fetching Data 14 | , getMeta 15 | , getModuleNames 16 | , lookupInterface 17 | , fetchInterface 18 | , fetchModuleTransitiveDeps 19 | 20 | -- * Name Resolution 21 | , kindOfTyConThing 22 | , resolveModuleTransitiveDeps 23 | , resolveTyConThing 24 | , resolveDataCtor 25 | , resolveValueName 26 | , resolveValueByResultTyCon) 27 | where 28 | import DDC.Core.Interface.Store.Base 29 | import DDC.Core.Interface.Store.Construct 30 | import DDC.Core.Interface.Store.Fetch 31 | import DDC.Core.Interface.Store.Resolve 32 | 33 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Core/Simplifier.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Simplifier 3 | ( -- * Simplifier Specifications 4 | Simplifier(..) 5 | 6 | -- * Transform Specifications 7 | , Transform(..) 8 | , InlinerTemplates 9 | , NamedRewriteRules 10 | 11 | -- * Transform Results 12 | , TransformResult(..) 13 | , TransformInfo(..) 14 | , resultDone 15 | 16 | -- * Application 17 | , applySimplifier 18 | , applySimplifierX) 19 | where 20 | import DDC.Core.Simplifier.Apply 21 | import DDC.Core.Simplifier.Base 22 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Core/Transform/Rename.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Transform.Rename 3 | ( Rename(..) 4 | 5 | -- * Substitution states 6 | , Sub(..) 7 | 8 | -- * Binding stacks 9 | , BindStack(..) 10 | , pushBind 11 | , pushBinds 12 | , substBound 13 | 14 | -- * Rewriting binding occurences 15 | , bind1, bind1s, bind0, bind0s 16 | 17 | -- * Rewriting bound occurences 18 | , use1, use0) 19 | where 20 | import DDC.Core.Exp.Annot.Exp 21 | import DDC.Type.Transform.Rename 22 | 23 | 24 | instance Rename (Witness a) where 25 | renameWith sub ww 26 | = let down x = renameWith x 27 | in case ww of 28 | WVar a u -> WVar a (use0 sub u) 29 | WCon a c -> WCon a c 30 | WApp a w1 w2 -> WApp a (down sub w1) (down sub w2) 31 | WType a t -> WType a (down sub t) 32 | 33 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Data/Canned.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Data.Canned 3 | (Canned(..)) 4 | where 5 | 6 | -- | This function has a show instance that prints \"CANNED\" for any contained 7 | -- type. We use it to wrap functional fields in data types that we still want 8 | -- to derive Show instances for. 9 | data Canned a 10 | = Canned a 11 | 12 | instance Show (Canned a) where 13 | show _ = "CANNED" 14 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Data/Name.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Data.Name 3 | ( StringName (..) 4 | , CompoundName (..)) 5 | where 6 | 7 | class StringName n where 8 | -- | Produce a flat string from a name. 9 | -- The resulting string should be re-lexable as a bindable name. 10 | stringName :: n -> String 11 | 12 | 13 | -- | Compound names can be extended to create new names. 14 | -- This is useful when generating fresh names during program transformation. 15 | class CompoundName n where 16 | -- | Build a new name based on the given one. 17 | extendName :: n -> String -> n 18 | 19 | -- | Build a new name from the given string. 20 | newVarName :: String -> n 21 | 22 | -- | Split the extension string from a name. 23 | splitName :: n -> Maybe (n, String) 24 | 25 | 26 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Type/Bind.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Type.Bind 3 | (getBindType) 4 | where 5 | import DDC.Type.Exp 6 | 7 | 8 | -- | Lookup the type of a bound thing from the binder stack. 9 | -- The binder stack contains the binders of all the `TForall`s we've 10 | -- entered under so far. 11 | getBindType :: Eq n => [Bind n] -> Bound n -> Maybe (Int, Type n) 12 | getBindType bs' u' 13 | = go 0 u' bs' 14 | where go n u (BName n1 t : bs) 15 | | UName n2 <- u 16 | , n1 == n2 = Just (n, t) 17 | 18 | | otherwise = go (n + 1) u bs 19 | 20 | go n (UIx i) (BAnon t : bs) 21 | | i < 0 = Nothing 22 | | i == 0 = Just (n, t) 23 | | otherwise = go (n + 1) (UIx (i - 1)) bs 24 | 25 | go n u (BAnon _ : bs) 26 | | otherwise = go (n + 1) u bs 27 | 28 | go n u (BNone _ : bs) 29 | = go (n + 1) u bs 30 | 31 | go _ _ [] = Nothing 32 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Type/Exp.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Type.Exp 3 | ( -- * Types, Kinds, and Sorts 4 | Type (..) 5 | , Kind, Sort 6 | , Region, Effect, Closure 7 | , TypeSum (..), TyConHash(..), TypeSumVarCon(..) 8 | , TyCon (..) 9 | , SoCon (..) 10 | , KiCon (..) 11 | , TwCon (..) 12 | , TcCon (..) 13 | , Binder (..) 14 | , Bind (..) 15 | , Bound (..)) 16 | where 17 | import DDC.Type.Exp.Simple.Exp 18 | import DDC.Type.Exp.Simple.NFData () 19 | 20 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Type/Exp/Simple/Subsumes.hs: -------------------------------------------------------------------------------- 1 | module DDC.Type.Exp.Simple.Subsumes 2 | (subsumesT) 3 | where 4 | import DDC.Type.Exp.Simple.Equiv 5 | import DDC.Type.Exp.Simple.Predicates 6 | import DDC.Type.Exp.Simple.Exp 7 | import DDC.Core.Env.EnvT (EnvT) 8 | import qualified DDC.Type.Sum as Sum 9 | 10 | 11 | -- | Check whether the first type subsumes the second. 12 | -- 13 | -- Both arguments are converted to sums, and we check that every 14 | -- element of the second sum is equivalent to an element in the first. 15 | -- 16 | -- This only works for well formed types of effect and closure kind. 17 | -- Other types will yield `False`. 18 | subsumesT :: Ord n => EnvT n -> Kind n -> Type n -> Type n -> Bool 19 | subsumesT env k t1 t2 20 | | isEffectKind k 21 | , ts1 <- Sum.singleton k $ crushEffect env t1 22 | , ts2 <- Sum.singleton k $ crushEffect env t2 23 | = and $ [ Sum.elem t ts1 | t <- Sum.toList ts2 ] 24 | 25 | | otherwise 26 | = False 27 | -------------------------------------------------------------------------------- /src/s1/ddc-core/DDC/Version.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Version where 3 | 4 | splash :: String 5 | splash = "The Disco Discus Compiler, version " ++ version 6 | 7 | version :: String 8 | version = "0.5.1" 9 | -------------------------------------------------------------------------------- /src/s1/ddc-core/LICENSE: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | The Disco Discus Compiler License (MIT style) 3 | 4 | Copyrite (K) 2007-2018 The Disco Discus Compiler Strike Force 5 | All rights reversed. 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in 15 | all copies or substantial portions of the Software. 16 | -------------------------------------------------------------------------------- 17 | -------------------------------------------------------------------------------- /src/s1/ddc-core/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /src/s1/ddc-driver/DDC/Driver/Dump.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Driver.Dump 3 | (dump) 4 | where 5 | import DDC.Driver.Config 6 | import DDC.Driver.Interface.Source 7 | import DDC.Build.Pipeline 8 | import System.FilePath 9 | import Data.Maybe 10 | 11 | 12 | -- | If the Dump mode is set 13 | -- then produce a SinkFile to write a module to a file, 14 | -- otherwise produce SinkDiscard to drop it on the floor. 15 | dump :: Config -> Source -> String -> Sink 16 | dump config source dumpFile 17 | | configDump config 18 | = let outputDir 19 | | SourceFile filePath <- source 20 | = fromMaybe (takeDirectory filePath) 21 | (configOutputDir config) 22 | 23 | | otherwise 24 | = fromMaybe "." 25 | (configOutputDir config) 26 | 27 | in SinkFile $ outputDir dumpFile 28 | 29 | | otherwise 30 | = SinkDiscard 31 | -------------------------------------------------------------------------------- /src/s1/ddc-driver/DDC/Driver/LSP/Protocol/Data/Base.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Driver.LSP.Protocol.Data.Base where 3 | 4 | type DocumentUri = String 5 | -------------------------------------------------------------------------------- /src/s1/ddc-driver/DDC/Driver/LSP/Protocol/Pack.hs: -------------------------------------------------------------------------------- 1 | module DDC.Driver.LSP.Protocol.Pack 2 | ( Pack(..) 3 | , packs 4 | , jobj 5 | , J.JSValue(..) 6 | , module Data.Maybe) 7 | where 8 | import qualified Text.JSON as J 9 | import Data.Maybe 10 | 11 | 12 | class Pack a where 13 | pack :: a -> J.JSValue 14 | 15 | instance Pack () where 16 | pack _ = J.JSNull 17 | 18 | instance Pack Bool where 19 | pack = J.JSBool 20 | 21 | instance Pack String where 22 | pack = J.JSString . J.toJSString 23 | 24 | instance Pack Int where 25 | pack i = J.JSRational False (toRational i) 26 | 27 | packs :: Pack a => [a] -> J.JSValue 28 | packs xs = J.JSArray $ map pack xs 29 | 30 | jobj = J.JSObject . J.toJSObject 31 | 32 | -------------------------------------------------------------------------------- /src/s1/ddc-driver/DDC/Driver/Output.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Driver.Output 3 | ( outDoc, outDocLn 4 | , outStr, outStrLn 5 | , chatStrLn) 6 | where 7 | import DDC.Data.Pretty 8 | 9 | 10 | -- | Output a document to the console. 11 | outDoc :: Doc -> IO () 12 | outDoc doc 13 | = putDoc RenderIndent doc 14 | 15 | -- | Output a document and newline to the console. 16 | outDocLn :: Doc -> IO () 17 | outDocLn doc 18 | = putDocLn RenderIndent doc 19 | 20 | 21 | -- | Output a string to the console. 22 | outStr :: String -> IO () 23 | outStr str 24 | = putStr str 25 | 26 | 27 | -- | Output a string and newline to the console. 28 | outStrLn :: String -> IO () 29 | outStrLn str 30 | = putStrLn str 31 | 32 | 33 | -- | Output chatty 'ok' type responses. 34 | -- These are only displayed in the Interactive and Batch interfaces. 35 | chatStrLn :: String -> IO () 36 | chatStrLn str 37 | = putStrLn str 38 | -------------------------------------------------------------------------------- /src/s1/ddc-driver/LICENSE: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | The Disco Discus Compiler License (MIT style) 3 | 4 | Copyrite (K) 2007-2018 The Disco Discus Compiler Strike Force 5 | All rights reversed. 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in 15 | all copies or substantial portions of the Software. 16 | -------------------------------------------------------------------------------- 17 | -------------------------------------------------------------------------------- /src/s1/ddc-driver/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /src/s1/ddc-source-discus/DDC/Source/Discus/Convert/Base.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_HADDOCK hide #-} 2 | module DDC.Source.Discus.Convert.Base 3 | ( ConvertM 4 | , SP 5 | 6 | , module DDC.Type.Universe 7 | , module DDC.Source.Discus.Convert.Error 8 | , module DDC.Data.SourcePos) 9 | where 10 | import DDC.Type.Universe 11 | import DDC.Source.Discus.Convert.Error 12 | import DDC.Data.SourcePos 13 | 14 | 15 | type ConvertM a x 16 | = Either (ErrorConvert a) x 17 | 18 | 19 | type SP = SourcePos 20 | 21 | 22 | -------------------------------------------------------------------------------- /src/s1/ddc-source-discus/DDC/Source/Discus/Exp/Type/Predicates.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_HADDOCK hide #-} 2 | 3 | -- | Predicates on type expressions. 4 | module DDC.Source.Discus.Exp.Type.Predicates 5 | (isAtomT) 6 | where 7 | import DDC.Source.Discus.Exp.Type.Base 8 | 9 | 10 | -- | Check whether a type is a `TVar` or `TCon`. 11 | isAtomT :: GType l -> Bool 12 | isAtomT tt 13 | = case tt of 14 | TAnnot _ t -> isAtomT t 15 | TCon{} -> True 16 | TVar{} -> True 17 | _ -> False -------------------------------------------------------------------------------- /src/s1/ddc-source-discus/LICENSE: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | The Disco Discus Compiler License (MIT style) 3 | 4 | Copyrite (K) 2007-2018 The Disco Discus Compiler Strike Force 5 | All rights reversed. 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in 15 | all copies or substantial portions of the Software. 16 | -------------------------------------------------------------------------------- 17 | -------------------------------------------------------------------------------- /src/s1/ddc-source-discus/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /src/s1/ddc-tools/LICENSE: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | The Disco Discus Compiler License (MIT style) 3 | 4 | Copyrite (K) 2007-2018 The Disco Discus Compiler Strike Force 5 | All rights reversed. 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in 15 | all copies or substantial portions of the Software. 16 | -------------------------------------------------------------------------------- 17 | -------------------------------------------------------------------------------- /src/s1/ddc-tools/src/ddc-war/DDC/War/Create/Way.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.War.Create.Way 3 | (Way(..)) 4 | where 5 | 6 | 7 | -- | A way to build the test. 8 | -- This holds extra options to pass to the program. 9 | data Way 10 | = Way 11 | { wayName :: String 12 | , wayOptsComp :: [String] 13 | , wayOptsRun :: [String] } 14 | deriving (Eq, Ord, Show) 15 | 16 | -------------------------------------------------------------------------------- /src/s1/ddc-tools/src/ddc-war/DDC/War/Driver.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDC.War.Driver 3 | (module DDC.War.Driver.Base) 4 | where 5 | import DDC.War.Driver.Base 6 | -------------------------------------------------------------------------------- /src/s1/ddc-tools/src/ddc-war/LICENSE: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | The Disco Discus Compiler License (MIT style) 3 | 4 | Copyrite (K) 2007-2018 The Disco Discus Compiler Strike Force 5 | All rights reversed. 6 | 7 | Permission is hereby granted, free of charge, to any person obtaining a copy 8 | of this software and associated documentation files (the "Software"), to deal 9 | in the Software without restriction, including without limitation the rights 10 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 11 | copies of the Software, and to permit persons to whom the Software is 12 | furnished to do so, subject to the following conditions: 13 | 14 | The above copyright notice and this permission notice shall be included in 15 | all copies or substantial portions of the Software. 16 | -------------------------------------------------------------------------------- 17 | -------------------------------------------------------------------------------- /src/s1/ddc-tools/src/ddci-tetra/DDCI/Tetra/Command/Parse.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDCI.Tetra.Command.Parse 3 | (cmdParse) 4 | where 5 | import DDCI.Tetra.State 6 | import DDC.Driver.Interface.Source 7 | import DDC.Data.Pretty 8 | import DDC.Source.Discus.Lexer 9 | import DDC.Source.Discus.Parser 10 | import DDC.Source.Discus.Pretty () 11 | import qualified DDC.Core.Codec.Text.Lexer as C 12 | import qualified DDC.Control.Parser as BP 13 | 14 | 15 | cmdParse :: State -> Source -> String -> IO () 16 | cmdParse _state source str 17 | = goLex 18 | where goLex 19 | = let tokens = lexModuleString (nameOfSource source) 1 str 20 | in goParse tokens 21 | 22 | goParse tokens 23 | = case BP.runTokenParser 24 | C.describeToken (nameOfSource source) 25 | pModule tokens of 26 | Left err -> error $ show err 27 | Right mm 28 | -> do putStrLn (renderIndent $ ppr mm) 29 | -------------------------------------------------------------------------------- /src/s1/ddc-tools/src/ddci-tetra/DDCI/Tetra/Input.hs: -------------------------------------------------------------------------------- 1 | 2 | module DDCI.Tetra.Input 3 | ( InputState (..) 4 | , Input (..) 5 | , readInput 6 | , eatLine) 7 | where 8 | import DDCI.Tetra.State 9 | import DDCI.Tetra.Command 10 | import DDC.Driver.Interface.Input 11 | 12 | 13 | -- Eating input lines. 14 | eatLine :: State 15 | -> InputState Command 16 | -> String 17 | -> IO (State, InputState Command) 18 | 19 | eatLine state inputState chunk 20 | = do (inputState', mCmdLine) 21 | <- inputLine (stateInterface state) inputState chunk 22 | 23 | case mCmdLine of 24 | Nothing 25 | -> return (state, inputState') 26 | 27 | Just (source, Nothing, line) 28 | -> do state' <- handleCommand state CommandHelp source line 29 | return (state', inputState') 30 | 31 | Just (source, Just cmd, line) 32 | -> do state' <- handleCommand state cmd source line 33 | return (state', inputState') 34 | 35 | -------------------------------------------------------------------------------- /src/s2/base/Class/Bits.ds: -------------------------------------------------------------------------------- 1 | 2 | module Class.Bits 3 | export 4 | { shl; shr; band; bor; bxor 5 | } 6 | where 7 | 8 | 9 | -- | Dictionary for bitwise operators. 10 | data Bits (a: Data) where 11 | Bits : (a -> a -> a) -- shl 12 | -> (a -> a -> a) -- shr 13 | -> (a -> a -> a) -- band 14 | -> (a -> a -> a) -- bor 15 | -> (a -> a -> a) -- bxor 16 | -> Bits a 17 | 18 | 19 | -- | Left shift. 20 | shl {(Bits shl' _ _ _ _): Bits a} (x y: a): a 21 | = shl' x y 22 | 23 | 24 | -- | Right shift. 25 | shr {(Bits _ shr' _ _ _): Bits a} (x y: a): a 26 | = shr' x y 27 | 28 | 29 | -- | Bitwise and. 30 | band {(Bits _ _ band' _ _): Bits a} (x y: a): a 31 | = band' x y 32 | 33 | 34 | -- | Bitwise or. 35 | bor {(Bits _ _ _ bor' _): Bits a} (x y: a): a 36 | = bor' x y 37 | 38 | 39 | -- | Bitwise xor. 40 | bxor {(Bits _ _ _ _ bxor'): Bits a} (x y: a): a 41 | = bxor' x y 42 | -------------------------------------------------------------------------------- /src/s2/base/Class/Functor.ds: -------------------------------------------------------------------------------- 1 | 2 | module Class.Functor 3 | export fmap 4 | where 5 | 6 | 7 | -- | Class of collection types that can be mapped over. 8 | data Functor (f: Data -> Data) where 9 | Functor 10 | : ({@a b: Data} -> (a -> b) -> f a -> f b) -- fmap 11 | -> Functor f 12 | 13 | 14 | -- | Apply a function to values of type 'a' in the input collection. 15 | fmap {@f: Data -> Data} {@a b: Data} 16 | {(Functor fmap') : Functor f} 17 | (f: a -> b) 18 | (x: f a) 19 | = fmap' f x 20 | -------------------------------------------------------------------------------- /src/s2/base/Class/Pretty.ds: -------------------------------------------------------------------------------- 1 | 2 | module Class.Pretty 3 | export {ppr; pretty_Unit; pretty_Text; pretty_Tuple } 4 | import Data.Text 5 | import Data.Function 6 | 7 | where 8 | 9 | 10 | -- | Pretty printer dictionary. 11 | data Pretty (a: Data) where 12 | Pretty : (a -> Text) -> Pretty a 13 | 14 | 15 | -- | Pretty print a thing as a text string. 16 | ppr {(Pretty ppr'): Pretty a} (x: a): Text 17 | = ppr' x 18 | 19 | 20 | -- | Pretty printer for Unit values. 21 | pretty_Unit: Pretty Unit 22 | = Pretty $ \xx -> "()" 23 | 24 | 25 | -- | Pretty printer for Text values. 26 | -- ISSUE #381: Escape non-printable characters in base Show library. 27 | pretty_Text: Pretty Text 28 | = Pretty $ λxx -> textOfChar '"' % xx % textOfChar '"' 29 | 30 | 31 | -- | Pretty printer for tuples. 32 | pretty_Tuple {Pretty a} {Pretty b}: Pretty (a, b) 33 | = Pretty $ λ(x, y) -> "(" % ppr x % "," % ppr y % ")" 34 | -------------------------------------------------------------------------------- /src/s2/base/Codec/Json.ds: -------------------------------------------------------------------------------- 1 | 2 | module Codec.Json 3 | export parseJson; parseJsonPrefix 4 | show_JsonParseError; show_JsonParseContext 5 | pretty_Json 6 | 7 | import Codec.Json.Base 8 | import Codec.Json.State 9 | import Codec.Json.Pretty 10 | import Codec.Json.Parser 11 | where 12 | 13 | 14 | -------------------------------------------------------------------------------- /src/s2/base/Codec/Json/Base.ds: -------------------------------------------------------------------------------- 1 | 2 | module Codec.Json.Base 3 | import Data.List 4 | where 5 | 6 | 7 | data Json where 8 | JsonNull : Json 9 | JsonBool : Bool -> Json 10 | JsonString : Text -> Json 11 | JsonNumber : Float64 -> Json 12 | JsonList : List Json -> Json 13 | JsonObject : List (Text, Json) -> Json 14 | 15 | -------------------------------------------------------------------------------- /src/s2/base/Data/Array.ds: -------------------------------------------------------------------------------- 1 | 2 | module Data.Array 3 | import Data.Array.Base 4 | import Data.Array.Fun 5 | import Data.Array.Bulk 6 | import Data.Array.Store 7 | 8 | -------------------------------------------------------------------------------- /src/s2/base/Data/CompactRegion.ds: -------------------------------------------------------------------------------- 1 | module Data.CompactRegion 2 | export { allocCR; storeCR; deleteCR } 3 | import Data.Numeric 4 | 5 | import foreign boxed type 6 | CR : Region -> Data 7 | 8 | import foreign c value 9 | 10 | ddcPrimCompactRegionAlloc : {@r : Region} -> Nat -> S (Alloc r) (CR r) 11 | ddcPrimCompactRegionStore : {@r : Region} -> {@a: Data} -> CR r-> a -> S (Write r) a 12 | ddcPrimCompactRegionMarkDead : {@r : Region} -> CR r -> S (Write r) Unit 13 | 14 | where 15 | 16 | 17 | allocCR {@r : Region} 18 | (x : Nat) 19 | : S (Alloc r) (CR r) 20 | = ddcPrimCompactRegionAlloc {@r} x 21 | 22 | storeCR {@r : Region} {@a: Data} 23 | (cr : CR r) (x: a) 24 | : S (Write r) a 25 | = ddcPrimCompactRegionStore {@r} cr x 26 | 27 | deleteCR {@r : Region} 28 | (x : CR r) 29 | : S (Write r) Unit 30 | = ddcPrimCompactRegionMarkDead {@r} x 31 | -------------------------------------------------------------------------------- /src/s2/base/Data/Function.ds: -------------------------------------------------------------------------------- 1 | 2 | module Data.Function 3 | export { function_Category; apply } 4 | import Class.Category 5 | where 6 | 7 | 8 | -- | Apply a function to its argument. 9 | -- The operator '$' is desugared to applications of this function. 10 | apply {@a b: Data} (f: a -> b) (x: a): b 11 | = f x 12 | 13 | 14 | -- | Category dictionary for functions. 15 | function_Category: Category (->) 16 | = Category (\x -> x) (\f g x -> f (g x)) 17 | 18 | -------------------------------------------------------------------------------- /src/s2/base/Data/Map.ds: -------------------------------------------------------------------------------- 1 | 2 | module Data.Map 3 | export {show_map} 4 | import Data.Map.Base 5 | import Data.Map.Fun 6 | import Data.Map.Tree 7 | import Data.List 8 | import Class.Show 9 | where 10 | 11 | 12 | -- | Show instance for Generic Finite Maps. 13 | show_map {Show key} {Show elem}: Show (Map rep key elem) 14 | = Show sh 15 | where 16 | sh mp 17 | | map_size mp == 0 18 | = "(_)" 19 | 20 | | otherwise 21 | = parens 22 | $ foldl (%) "" 23 | $ intersperse ", " 24 | $ reverse 25 | $ map_foldKeys mp (\k e x -> Cons (show k %% ":=" %% show e) x) Nil 26 | 27 | -------------------------------------------------------------------------------- /src/s2/base/Data/Numeric/Addr.ds: -------------------------------------------------------------------------------- 1 | 2 | module Data.Numeric.Addr 3 | export 4 | { eq_Addr; ord_Addr; 5 | } 6 | import Class.Numeric 7 | import Class.Eq 8 | import Class.Ord 9 | where 10 | 11 | type Addr = Addr# 12 | 13 | 14 | -- | Eq dictionary for Addr. 15 | eq_Addr: Eq Addr 16 | = Eq eq' neq' 17 | where eq' a b = eq# {@Addr#} a b 18 | neq' a b = neq# {@Addr#} a b 19 | 20 | 21 | -- | Ord dictionary for Addr. 22 | ord_Addr: Ord Addr 23 | = Ord compare' 24 | where compare' n1 n2 25 | | gt# {@Addr#} n1 n2 = GT 26 | | lt# {@Addr#} n1 n2 = LT 27 | | otherwise = EQ 28 | 29 | -------------------------------------------------------------------------------- /src/s2/base/Data/Numeric/Bool.ds: -------------------------------------------------------------------------------- 1 | 2 | module Data.Numeric.Bool 3 | export 4 | { not; and; or; xor; 5 | when; unless; 6 | } 7 | where 8 | 9 | type Bool = Bool# 10 | 11 | 12 | -- | Boolean NOT. 13 | not (x: Bool): Bool 14 | = if x then False 15 | else True 16 | 17 | 18 | -- | Boolean AND. 19 | and (x y: Bool): Bool 20 | = if x then y 21 | else False 22 | 23 | 24 | -- | Boolean OR. 25 | or (x y: Bool): Bool 26 | = if x then True 27 | else y 28 | 29 | 30 | -- | Boolean XOR 31 | xor (x y: Bool): Bool 32 | = if x then (if y then False else True) 33 | else (if y then True else False) 34 | 35 | 36 | -- | Execute a computation when the predicate is true. 37 | when (p: Bool) (comp: S eff Unit): S eff Unit 38 | = if p then run comp 39 | else () 40 | 41 | 42 | -- | Execute a computation when the predicate is false. 43 | unless (p: Bool) (comp: S eff Unit): S eff Unit 44 | = if p then () 45 | else run comp 46 | 47 | -------------------------------------------------------------------------------- /src/s2/base/Data/Text.ds: -------------------------------------------------------------------------------- 1 | 2 | module Data.Text 3 | export textLit; paste; pastes; parens 4 | text_foldl 5 | textOfChar; textOfWord8; textOfVector 6 | eq_char; eq_text 7 | 8 | -- from Data.Text.Char 9 | isDigit; isUpper; isLower; isSpace 10 | 11 | import Data.Text.Base 12 | import Data.Text.List 13 | import Data.Text.Char 14 | import Data.Text.Operator 15 | import Data.Text.Show 16 | import Data.Text.Parse 17 | import Data.Text.Stream 18 | import Data.Text.Escape 19 | import Data.Text.Numeric 20 | import Class.Eq 21 | where 22 | 23 | 24 | -- | Eq dictionary for Char. 25 | eq_char: Eq Char 26 | = Eq eq' neq' 27 | where eq' x1 x2 = eqChar x1 x2 28 | neq' x1 x2 = not (eqChar x1 x2) 29 | 30 | 31 | -- | Eq dictionary for Text. 32 | eq_text: Eq Text 33 | = Eq eq' neq' 34 | where eq' x1 x2 = eqText x1 x2 35 | neq' x1 x2 = not (eqText x1 x2) 36 | -------------------------------------------------------------------------------- /src/s2/base/Prelude/Data.ds: -------------------------------------------------------------------------------- 1 | -- | Prelude with numeric and simple data types. 2 | module Prelude.Data 3 | import Prelude.Numeric 4 | import Data.Array 5 | import Data.Function 6 | import Data.List 7 | import Data.Maybe 8 | import Data.Either 9 | import Data.Ref 10 | import Data.Text 11 | import Data.Tuple -------------------------------------------------------------------------------- /src/s2/base/Prelude/Numeric.ds: -------------------------------------------------------------------------------- 1 | -- | Prelude with numeric types. 2 | module Prelude.Numeric 3 | import Class.Eq 4 | import Class.Ord 5 | import Class.Numeric 6 | import Data.Numeric.Bool 7 | import Data.Numeric.Nat 8 | import Data.Numeric.Int 9 | import Data.Numeric.Word8 10 | import Data.Numeric.Word16 11 | import Data.Numeric.Word32 12 | import Data.Numeric.Word64 13 | where 14 | 15 | -------------------------------------------------------------------------------- /src/s2/base/System/IO/File.ds: -------------------------------------------------------------------------------- 1 | 2 | module System.IO.File 3 | export 4 | { file_read 5 | } 6 | import Data.Text 7 | import Data.Text.Base 8 | import System.IO.Console 9 | import System.Posix.Stdlib 10 | 11 | 12 | import foreign c value 13 | ddcPrimFileRead : Nat# -> S File (Vector# RegionText Word8#) 14 | ddcVectorGuts : {@r: Region} -> Vector# r Word8 -> Nat# 15 | 16 | where 17 | 18 | 19 | -- | TODO: wrap code to get the flat vector for FFI in a nicer way. 20 | file_read (tx: Text): S File Text 21 | = box TextVec $ ddcPrimFileRead (ddcVectorGuts (textVectorOfText tx)) 22 | 23 | -------------------------------------------------------------------------------- /src/s2/base/System/Posix/Errno.ds: -------------------------------------------------------------------------------- 1 | 2 | module System.Posix.Errno 3 | export errno_get 4 | export errno_showMessage 5 | 6 | import Data.Numeric.Int 7 | import Data.Function 8 | import Data.Text 9 | 10 | import foreign abstract type 11 | -- | Effect of reading or writing the global C errno variable. 12 | Errno : Effect 13 | 14 | import foreign c value 15 | 16 | -- TODO: boxing transform messes up when return type is (S Errno Int#) 17 | -- the Int# here is converted to (U# Int#), but at the use site 18 | -- it is still Int#. 19 | ddcPrimErrnoGet : Unit -> Int# 20 | 21 | ddcPrimErrnoShowMessage : Int# -> TextVec 22 | 23 | where 24 | 25 | 26 | -- | Get the value of the global 'errno' variable. 27 | errno_get: S Errno Int 28 | = box weakeff Errno in ddcPrimErrnoGet () 29 | 30 | 31 | -- | Show the message for the given errno value. 32 | errno_showMessage (errno: Int): Text 33 | = TextVec $ ddcPrimErrnoShowMessage errno 34 | 35 | 36 | -------------------------------------------------------------------------------- /src/s2/base/System/Posix/Stdio.ds: -------------------------------------------------------------------------------- 1 | 2 | module System.Posix.Stdio 3 | where 4 | 5 | 6 | 7 | -------------------------------------------------------------------------------- /src/s2/base/System/Posix/Unistd.ds: -------------------------------------------------------------------------------- 1 | 2 | module System.Posix.Unistd 3 | export usleep 4 | 5 | import foreign abstract type 6 | -- | Effect of actions that put the current process to sleep. 7 | Sleep : Effect 8 | 9 | import foreign c value 10 | -- | Sleep until either the given number of microseconds have elapsed or a 11 | -- signal is delivered to the process. The actual time slept may be longer 12 | -- due to system latencies and possible limitations in the timer resolution 13 | -- of the hardware. 14 | usleep : Nat# -> S Sleep Int# 15 | 16 | -------------------------------------------------------------------------------- /src/s2/ddc-core/DDC/Core/Codec/SExp/Lexer/Token.ds: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Codec.SExp.Lexer.Token 3 | export show_token 4 | import Class.Show 5 | import Data.Text 6 | where 7 | 8 | 9 | data Token where 10 | KBra : Token 11 | KKet : Token 12 | KWord : Text -> Token 13 | KString : Text -> Token 14 | 15 | 16 | show_token 17 | = Show $ \t 18 | -> case t of 19 | KBra -> "KBra" 20 | KKet -> "KKet" 21 | KWord t -> parens ("KWord" %% show t) 22 | KString t -> parens ("KString" %% show t) 23 | 24 | 25 | -------------------------------------------------------------------------------- /src/s2/ddc-core/DDC/Core/Codec/SExp/Parser.ds: -------------------------------------------------------------------------------- 1 | 2 | module DDC.Core.Codec.SExp.Parser 3 | import Class.Show 4 | import Data.Text 5 | import Data.Ref 6 | where 7 | 8 | 9 | 10 | 11 | -------------------------------------------------------------------------------- /src/s2/ddc-runtime/build/.README: -------------------------------------------------------------------------------- 1 | The build system creates library binaries in this directory. 2 | -------------------------------------------------------------------------------- /src/s2/ddc-runtime/salt/runtime64/primitive/Numeric.dcs: -------------------------------------------------------------------------------- 1 | 2 | module Runtime.Prim.Numeric 3 | 4 | export foreign c value 5 | ddcPrimMakeInt : [r1: Region]. Int# -> Ptr# r1 Obj 6 | 7 | import foreign c value 8 | ddcSmallAlloc : [r1: Region]. Word32# -> Nat# -> Ptr# r1 Obj 9 | ddcSmallPayload : [r1: Region]. Ptr# r1 Obj -> Ptr# r1 Word8# 10 | 11 | with letrec 12 | 13 | 14 | ddcPrimMakeInt [r1: Region] (i: Int#): Ptr# r1 Obj 15 | = do -- CAREFUL: The '5' here is a magic numer info table index. 16 | -- Which is set in Info.dcs for the Int primitive type. 17 | obj = ddcSmallAlloc (truncate# 5#) 1# 18 | poke# (castPtr# (ddcSmallPayload obj)) i 19 | obj 20 | -------------------------------------------------------------------------------- /src/s2/ddc-runtime/sea/runtime/Hook.h: -------------------------------------------------------------------------------- 1 | // Hooks defined in the base library that can be called back on by the runtime 2 | // system and the definition of primitive operators. 3 | #pragma once 4 | #include "runtime/Types.h" 5 | 6 | // The top-level effect handler. 7 | // ddcHookHandleTopLevel {@e: Effect} (comp: S e Unit): S (Console + e) Unit 8 | extern Obj* ddcHookHandleTopLevel(Obj* comp); 9 | 10 | // Throw a System File exception. 11 | extern Obj* ddcHookErrorSystemFile(int errno_value, Obj* txt); 12 | 13 | // Throw a System Network exception. 14 | extern Obj* ddcHookErrorSystmeNetwork(int errno_value, Obj* txt); 15 | 16 | -------------------------------------------------------------------------------- /src/s2/ddc-runtime/sea/runtime/Types.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | #include 3 | 4 | // Boolean type. 5 | typedef int bool_t; 6 | 7 | // An unsigned natural number. 8 | // Used for object sizes and field counts. 9 | // Big enough to represent the number of allocatable bytes. 10 | typedef size_t nat_t; 11 | 12 | // Define int_t to make things look consistent. 13 | typedef int int_t; 14 | 15 | // Generic address type. 16 | // #ifdef because Cygwin already defines it. 17 | #ifndef __addr_t_defined 18 | typedef uint8_t* addr_t; 19 | #endif 20 | 21 | // A constructor tag. 22 | typedef uint32_t tag_t; 23 | 24 | // A UTF8 string. 25 | typedef char string_t; 26 | 27 | // Floating point types. 28 | typedef float float32_t; 29 | typedef double float64_t; 30 | 31 | 32 | // Object 33 | // A General Object. 34 | // All objects contain the tag and format field as the first 32-bit word. 35 | // The following is a supertype of the others. 36 | typedef struct 37 | { uint32_t tagFormat; 38 | } Obj; 39 | 40 | -------------------------------------------------------------------------------- /src/s2/ddc-runtime/sea/runtime/primitive/Error.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "runtime/Primitive.h" 5 | 6 | 7 | // Abort the program due to an inexhaustive case match. 8 | // 9 | // When desugaring guards, if the compiler cannot determine that 10 | // the guards are exhaustive then a call to this function is 11 | // inserted as a default case. 12 | // 13 | Obj* ddcPrimErrorDefault(string_t* source, uint32_t line) 14 | { fprintf ( stderr 15 | , "\nDDC runtime error: inexhaustive case match.\n at: %s:%" PRId32 "\n" 16 | , source, line); 17 | exit(1); 18 | return 0; 19 | } 20 | -------------------------------------------------------------------------------- /src/s2/smr-core/src/SMR/Core/Exp.ds: -------------------------------------------------------------------------------- 1 | 2 | module SMR.Core.Exp 3 | import SMR.Core.Exp.Base 4 | import SMR.Core.Exp.Compounds 5 | import SMR.Core.Exp.Eq 6 | import SMR.Core.Exp.Push 7 | import SMR.Core.Exp.Show 8 | import SMR.Core.Exp.Train 9 | where 10 | 11 | -------------------------------------------------------------------------------- /src/s2/smr-core/src/SMR/Core/Step/Base.ds: -------------------------------------------------------------------------------- 1 | 2 | module SMR.Core.Step.Base 3 | where 4 | 5 | -- | Evaluation strength. 6 | data StepStrength where 7 | StepStrength 8 | : Bool -- ^ Reduce under lambdas. 9 | -> Bool -- ^ Reduce args when head is not an abs. 10 | -> StepStrength 11 | 12 | 13 | -- | Evaluation context. 14 | data StepContext (s p: Data) where 15 | StepContext 16 | : List (p, PrimEval s p) -- ^ Primitive operator evaluators. 17 | -> List (Decl s p) -- ^ Top-level declarations. 18 | -> StepContext s p 19 | 20 | 21 | -- | Describe the result of an evaluation. 22 | data Result where 23 | ResultDone : Result 24 | ResultError : Text -> Result 25 | 26 | 27 | -------------------------------------------------------------------------------- /src/s2/smr-core/src/SMR/Prim/Op.ds: -------------------------------------------------------------------------------- 1 | 2 | module SMR.Prim.Op 3 | export makePrimOps 4 | import SMR.Prim.Op.Bool 5 | import SMR.Prim.Op.Comb 6 | import SMR.Prim.Op.List 7 | import SMR.Prim.Op.Match 8 | import SMR.Prim.Op.Nat 9 | import SMR.Prim.Op.Smr 10 | where 11 | 12 | 13 | -- | Make a list of primitive operator evaluators. 14 | makePrimOps {eqs: Eq s} (_: Unit): List (PrimEval s Prim) 15 | = append (makePrimOpsBool ()) 16 | $ append (makePrimOpsComb ()) 17 | $ append (makePrimOpsList ()) 18 | $ append (makePrimOpsMatch {eqs} ()) 19 | $ append (makePrimOpsNat ()) 20 | $ append (makePrimOpsSmr ()) 21 | $ Nil 22 | 23 | 24 | -------------------------------------------------------------------------------- /src/s2/smr-core/src/SMR/Prim/Op/List.ds: -------------------------------------------------------------------------------- 1 | 2 | module SMR.Prim.Op.List 3 | export makePrimOpsList 4 | import SMR.Prim.Op.Base 5 | where 6 | 7 | 8 | makePrimOpsList (_: Unit): List (PrimEval s Prim) 9 | = Cons primOpListCons 10 | $ Cons primOpListNil 11 | $ Nil 12 | 13 | 14 | primOpListCons: PrimEval s Prim 15 | = PrimEval (PrimOp "list-cons") "primitive list constructor" 16 | (Cons Val (Cons Val Nil)) fn' 17 | where fn' _ = Nothing 18 | 19 | 20 | primOpListNil: PrimEval s Prim 21 | = PrimEval (PrimOp "list-nil") "primitive empty list" 22 | Nil fn' 23 | where fn' _ = Nothing 24 | 25 | -------------------------------------------------------------------------------- /test/ddc-broken/99-skip/01-Records/Main.stdout.check: -------------------------------------------------------------------------------- 1 | Records tests 2 | fooish barish 3 | barish fooish 4 | 12 5 | (Circle (Point 1 2) 27) 6 | (Line (Point 1 2) (Point 3 4)) 7 | 5 8 | -------------------------------------------------------------------------------- /test/ddc-broken/99-skip/10-LLVM-phi/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | module Test 3 | import Data.Numeric 4 | where 5 | 6 | -- TODO: This fails with an LLVM code gen issue. 7 | 8 | -- PHINode should have one entry for each predecessor of its parent basic block! 9 | -- %_v61.x53 = phi %s.Obj* [ %_v64.alt, %l65.alt ] 10 | 11 | loop (vec: Vector# r Nat#): S (Read r + e) Nat# 12 | = go (vectorLength# vec) 0 0 13 | where 14 | go len acc ix 15 | | ix >= len = box weakeff Read r + e in acc 16 | | otherwise = go len (acc + vectorRead# vec ix) (ix + 1) 17 | 18 | 19 | -------------------------------------------------------------------------------- /test/ddc-broken/99-skip/20-Effect-local/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | module Test 3 | import Data.Numeric 4 | where 5 | 6 | -- TOOD: demonstrates failure of type inference as the first 7 | -- alternnative does not have any effects. 8 | 9 | loop (vec: Vector# r Nat#): S (Read r + e) Nat# 10 | = go (vectorLength# vec) 0 0 11 | where 12 | go len acc ix 13 | | ix >= len = acc 14 | | otherwise = go len (acc + vectorRead# vec ix) (ix + 1) 15 | -------------------------------------------------------------------------------- /test/ddc-broken/Readme.md: -------------------------------------------------------------------------------- 1 | 2 | DDC Broken Tests 3 | ================ 4 | 5 | The tests in this directory are all broken, and none of them should work. These are either tests exercising known bugs, or things that used to work but have been deprecated or disabled for now. 6 | 7 | -------------------------------------------------------------------------------- /test/ddc-demo/Readme.md: -------------------------------------------------------------------------------- 1 | 2 | DDC Demos 3 | ========= 4 | 5 | The tests in this directory are complete small programs that demonstrate how the language can be used. They should me small enough, and interesting enough that one could present them in a conference talk. Only put interesting programs here. Tests which just check for edge cases and regressions should go in ddc-regress instead. Tests that systematically exercise language features should go in ddc-spec instead. 6 | 7 | -------------------------------------------------------------------------------- /test/ddc-demo/core/Discus/00-Hello/Main.dct: -------------------------------------------------------------------------------- 1 | 2 | -- Hello world as a single module Disciple Core Tetra program. 3 | -- This shows how to define enough stuff to print to the console. 4 | module Main 5 | 6 | -- Export the main entry point to C land. 7 | export value 8 | Main.main : Unit -> S Console Unit 9 | 10 | -- Define the console effect, which is the one we'll use to 11 | -- classify actions that write to the console. 12 | import foreign abstract type 13 | Console : Effect 14 | 15 | -- Import primitive IO function from the runtime system. 16 | import foreign c value 17 | ddcPrimStdoutPutString : TextLit# -> S Console Void# 18 | 19 | with letrec 20 | 21 | 22 | -- Main function. 23 | -- We take a unit value and give one back. 24 | main (u: Unit): S Console Unit 25 | = box do 26 | -- Run the action. 27 | -- This returns a Void# result, so we can't return it from 28 | -- the main function directly. 29 | run ddcPrimStdoutPutString "Hello World\n"# 30 | 31 | -- Might as well return the unit value we were given. 32 | u 33 | -------------------------------------------------------------------------------- /test/ddc-demo/core/Discus/00-Hello/Main.stdout.check: -------------------------------------------------------------------------------- 1 | Hello World 2 | -------------------------------------------------------------------------------- /test/ddc-demo/core/Discus/01-Factorial/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 1 2 | -------------------------------------------------------------------------------- /test/ddc-demo/core/Discus/02-Lists/Main.stdout.check: -------------------------------------------------------------------------------- 1 | Range 2 | 1 3 | 2 4 | 3 5 | 4 6 | 5 7 | Doubled 8 | 2 9 | 4 10 | 6 11 | 8 12 | 10 13 | Reversed 14 | 5 15 | 4 16 | 3 17 | 2 18 | 1 19 | -------------------------------------------------------------------------------- /test/ddc-demo/core/Salt/00-Hello/Main.dcs: -------------------------------------------------------------------------------- 1 | 2 | -- Ye'olde Hello World programme, 3 | -- written in Disciple Core Salt, which is our lowest level 4 | -- intermediate language. 5 | module Main 6 | 7 | -- Export the main entry point. 8 | export foreign c value 9 | main : [r1: Region]. Nat# -> Ptr# r1 Word8# -> Int# 10 | 11 | -- Primitive show functions are defined in the runtime system. 12 | import foreign c value 13 | ddcInit : Nat# -> Nat# -> Unit 14 | ddcPrimStdoutPutTextLit : TextLit# -> Void# 15 | 16 | with letrec 17 | 18 | -- Ye'olde Hello World programme. 19 | main [r1: Region] (argc: Nat#) (argv: Ptr# r1 Word8#): Int# 20 | = do 21 | -- Initialize the runtime system. 22 | ddcInit 4096# 0# 23 | 24 | -- Print the greeting. 25 | ddcPrimStdoutPutTextLit "Hello World\n"# 26 | 27 | -- Return successfully. 28 | 0i# -------------------------------------------------------------------------------- /test/ddc-demo/core/Salt/00-Hello/Main.stdout.check: -------------------------------------------------------------------------------- 1 | Hello World 2 | -------------------------------------------------------------------------------- /test/ddc-demo/core/Salt/01-Factorial/Main.stdout.check: -------------------------------------------------------------------------------- 1 | fac_rec 10 = 3628800 2 | fac_acc 10 = 3628800 3 | -------------------------------------------------------------------------------- /test/ddc-demo/core/Salt/02-Boxing/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 3628800 2 | -------------------------------------------------------------------------------- /test/ddc-demo/core/Salt/03-CRHello/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 3628800 -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/00-Hello/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import System.IO.Console 4 | 5 | where 6 | 7 | main () 8 | = do writel "hello world" 9 | writel "Καλημέρα κόσμε" 10 | writel "こんにちは 世界" 11 | writel "হ্যালো বিশ্ব" 12 | writel "世界，你好!" 13 | 14 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/10-Defib/00-Integer/Main.stdout.check: -------------------------------------------------------------------------------- 1 | fac 15 = 1307674368000 2 | ack 3 4 = 125 3 | gcd 100 28 = 4 4 | tak 12 8 4 = 9 5 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/10-Defib/01-Exp3_8/Main.stdout.check: -------------------------------------------------------------------------------- 1 | exp 3 6 = 729 2 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/10-Defib/02-Backpatch/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 120 2 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/10-Defib/03-Primes/01-Array/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 7919 2 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/10-Defib/05-SKI/Main.stdout.check: -------------------------------------------------------------------------------- 1 | two = ((S ((S (K S)) ((S (K K)) I))) ((S ((S (K S)) ((S (K K)) I))) (K I))) 2 | two' = (s (s z)) 3 | three = ((S ((S (K S)) ((S (K K)) I))) ((S ((S (K S)) ((S (K K)) I))) ((S ((S (K S)) ((S (K K)) I))) (K I)))) 4 | three' = (s (s (s z))) 5 | plus = ((S ((S (K S)) ((S (K K)) ((S (K S)) ((S (K (S (K S)))) ((S (K (S (K K)))) ((S ((S (K S)) ((S (K K)) I))) (K I)))))))) (K ((S ((S (K S)) ((S (K (S (K S)))) ((S (K (S (K K)))) ((S ((S (K S)) ((S (K K)) I))) (K I)))))) (K (K I))))) 6 | five' = (s (s (s (s (s z))))) 7 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/10-Defib/06-NormEval/Main.stdout.check: -------------------------------------------------------------------------------- 1 | (Succ (Succ (Succ (Succ (Succ Zero))))) 2 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/20-Types/01-Freezing/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 101 2 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/20-Types/02-Update/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | In binding 'ref' 5 | test/ddc-demo/source/Discus/20-Types/02-Update/Main.ds:17:1 6 | Impure Spec abstraction 7 | has effect: Alloc r 8 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/30-Library/01-Data/02-List/01-Basic/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | -- Demonstration of list combinators and combining commutable effects. 3 | module Main 4 | import Data.Numeric.Nat 5 | import Data.Function; Data.Maybe; Data.List 6 | import Data.Ref 7 | import Class.Show 8 | import System.IO.Console 9 | where 10 | 11 | 12 | main () 13 | = private r with { Alloc r; Read r; Write r } in 14 | do 15 | -- Create a demo list. 16 | xx = enumFromTo 0 100 17 | 18 | -- Select only the even elements 19 | xx' = filter (λ(x: Nat) -> rem# x 2 == 0) xx 20 | 21 | -- Mutable reference to hold list length. 22 | ref = allocRef {@r} {@Nat} 0 23 | 24 | -- Eat the list, updating the mutable counter while printing 25 | -- the elements to the console. 26 | forS xx' (λ(x: Nat) -> 27 | do writeRef ref ((readRef ref) + 1) 28 | writel (show x)) 29 | 30 | -- Print out the final list length. 31 | writel $ show (readRef ref) 32 | 33 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/30-Library/01-Data/02-List/01-Basic/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 0 2 | 2 3 | 4 4 | 6 5 | 8 6 | 10 7 | 12 8 | 14 9 | 16 10 | 18 11 | 20 12 | 22 13 | 24 14 | 26 15 | 28 16 | 30 17 | 32 18 | 34 19 | 36 20 | 38 21 | 40 22 | 42 23 | 44 24 | 46 25 | 48 26 | 50 27 | 52 28 | 54 29 | 56 30 | 58 31 | 60 32 | 62 33 | 64 34 | 66 35 | 68 36 | 70 37 | 72 38 | 74 39 | 76 40 | 78 41 | 80 42 | 82 43 | 84 44 | 86 45 | 88 46 | 90 47 | 92 48 | 94 49 | 96 50 | 98 51 | 100 52 | 51 53 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/30-Library/01-Data/02-List/02-Reverse/Main.ds: -------------------------------------------------------------------------------- 1 | module Main 2 | import Data.Maybe; Data.List; Data.Numeric.Nat 3 | import Class.Show 4 | import System.IO.Console 5 | where 6 | 7 | -- Reverse the elements of a list, using an accumulator. 8 | reverseAcc (xx: List a): List a 9 | = reverseAcc2 Nil xx 10 | 11 | reverseAcc2 (acc xx: List a): List a 12 | = case xx of 13 | Nil -> acc 14 | Cons x xs -> reverseAcc2 (Cons x acc) xs 15 | 16 | 17 | dumpListNat (xx: List Nat): S Console Unit 18 | = case xx of 19 | Nil -> () 20 | Cons x xs 21 | -> do writel (show x) 22 | dumpListNat xs 23 | 24 | 25 | main () 26 | = do xs1 = replicate 5 100 27 | xs2 = enumFromTo 10 20 28 | zs = append xs1 xs2 29 | dumpListNat (reverseAcc zs) 30 | 31 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/30-Library/01-Data/02-List/02-Reverse/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 20 2 | 19 3 | 18 4 | 17 5 | 16 6 | 15 7 | 14 8 | 13 9 | 12 10 | 11 11 | 10 12 | 100 13 | 100 14 | 100 15 | 100 16 | 100 17 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/30-Library/01-Data/03-Map/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | -- Demo of the Data.Map library. 3 | module Main 4 | import Data.Numeric.Nat 5 | import Data.Map.Tree 6 | import System.IO.Console 7 | import Class.Show 8 | where 9 | 10 | 11 | main () 12 | = do -- A test list. 13 | list1 = Cons (T2 40 "red") 14 | (Cons (T2 20 "green") 15 | (Cons (T2 10 "blue") 16 | (Cons (T2 22 "purple") Nil))) 17 | 18 | mp = mapTree_fromList list1 19 | list1' = mapTree_toList mp 20 | 21 | -- Show the lists. 22 | writel $ show list1 23 | writel $ show list1' 24 | 25 | -- Show the structure of the map. 26 | writel $ show mp 27 | 28 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/30-Library/01-Data/03-Map/Main.stdout.check: -------------------------------------------------------------------------------- 1 | (Cons (T2 40 "red") (Cons (T2 20 "green") (Cons (T2 10 "blue") (Cons (T2 22 "purple") Nil)))) 2 | (Cons (T2 10 "blue") (Cons (T2 20 "green") (Cons (T2 22 "purple") (Cons (T2 40 "red") Nil)))) 3 | (Bin 4 20 "green" (Bin 1 10 "blue" Tip Tip) (Bin 2 40 "red" (Bin 1 22 "purple" Tip Tip) Tip)) 4 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/30-Library/01-Data/04-Stream/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 55 2 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/30-Library/01-Data/05-Array/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import System.IO.Console 4 | import Class.Show 5 | import Data.Numeric.Nat 6 | import Data.Function 7 | import Data.Array.Store 8 | where 9 | 10 | 11 | main () 12 | = mutable r in 13 | do arr = arrayStore_alloc {@r} 10 0 14 | arrayStore_write arr 5 100 15 | writel $ show (array_index arr 5) 16 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/30-Library/01-Data/06-Vector/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import System.IO.Console 4 | import Class.Show 5 | import Data.Numeric.Nat 6 | import Data.Function 7 | where 8 | 9 | 10 | main () 11 | = mutable r in 12 | do vec = vectorAlloc# {@r} 100 13 | writel $ "length = " % show (vectorLength# vec) 14 | 15 | vectorWrite# vec 99 27 16 | writel $ "value = " % show (vectorRead# vec 99) 17 | 18 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/30-Library/01-Data/07-CR/02-HitLimit/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import System.IO.Console 4 | import Class.Show 5 | import Data.Numeric 6 | import Data.Function 7 | import Data.CompactRegion 8 | where 9 | 10 | -- The compact region will automatically 11 | -- extends itself when no sufficient memory left in that compact region 12 | -- This demos a region with 1024 bytes avaliable, then self-extends to a larger chunk of memory 13 | hitLimit {@r: Region} (cr: CR r) (acc: Nat): S (Write r + Console) Nat 14 | = case (acc < 2048) of 15 | True -> do 16 | val = storeCR cr acc 17 | writel (show val) 18 | hitLimit cr (acc + 1) 19 | False -> acc 20 | 21 | 22 | main () 23 | = private r with { Alloc r; Read r; Write r } in 24 | do 25 | cr = allocCR {@r} 1024 26 | acc = hitLimit cr 0 27 | deleteCR cr 28 | 29 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/30-Library/02-Math/01-Combinations/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import Math.Combinations 4 | import Class.Show 5 | import System.IO.Console 6 | import Data.Numeric.Nat 7 | import Data.Function 8 | where 9 | 10 | 11 | main () 12 | = do writel $ "factorial 10 = " % show (factorial 10) 13 | writel $ "choose 20 3 = " % show (choose 20 3) 14 | 15 | writel $ "chooseMany 10 [5, 2, 3] = " 16 | % show (chooseMany 10 (Cons 5 (Cons 2 (Cons 3 Nil)))) 17 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/50-System/01-Process/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import System.Posix.Stdlib 4 | import System.IO.Console 5 | where 6 | 7 | 8 | main () 9 | = do writel "derp" 10 | case stdlib_mkstemp "/tmp/tempXXXXX" of 11 | Nothing -> writel "cannot create temp file" 12 | Just file -> do 13 | writel file 14 | code = stdlib_system "ls" 15 | () 16 | 17 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/80-Rosetta/100_doors/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 1 Open 2 | 4 Open 3 | 9 Open 4 | 16 Open 5 | 25 Open 6 | 36 Open 7 | 49 Open 8 | 64 Open 9 | 81 Open 10 | 100 Open 11 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/80-Rosetta/9_billion_names/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 1 2 | 1 3 | 1 1 4 | 1 1 1 5 | 1 2 1 1 6 | 1 2 2 1 1 7 | 1 3 3 2 1 1 8 | 1 3 4 3 2 1 1 9 | 1 4 5 5 3 2 1 1 10 | 1 4 7 6 5 3 2 1 1 11 | 1 5 8 9 7 5 3 2 1 1 12 | 1 5 10 11 10 7 5 3 2 1 1 13 | 1 6 12 15 13 11 7 5 3 2 1 1 14 | 1 6 14 18 18 14 11 7 5 3 2 1 1 15 | 1 7 16 23 23 20 15 11 7 5 3 2 1 1 16 | 1 7 19 27 30 26 21 15 11 7 5 3 2 1 1 17 | 1 8 21 34 37 35 28 22 15 11 7 5 3 2 1 1 18 | 1 8 24 39 47 44 38 29 22 15 11 7 5 3 2 1 1 19 | 1 9 27 47 57 58 49 40 30 22 15 11 7 5 3 2 1 1 20 | 1 9 30 54 70 71 65 52 41 30 22 15 11 7 5 3 2 1 1 21 | 1 10 33 64 84 90 82 70 54 42 30 22 15 11 7 5 3 2 1 1 22 | 1255 23 | 2552338241 24 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/80-Rosetta/AlmostPrime/Main.stdout.check: -------------------------------------------------------------------------------- 1 | k = 1: 2 3 5 7 11 13 17 19 23 29 2 | k = 2: 4 6 9 10 14 15 21 22 25 26 3 | k = 3: 8 12 18 20 27 28 30 42 44 45 4 | k = 4: 16 24 36 40 54 56 60 81 84 88 5 | k = 5: 32 48 72 80 108 112 120 162 168 176 6 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/80-Rosetta/GrayCode/Main.stdout.check: -------------------------------------------------------------------------------- 1 | x grey x' 2 | 00000 00000 00000 3 | 00001 00001 00001 4 | 00010 00011 00010 5 | 00011 00010 00011 6 | 00100 00110 00100 7 | 00101 00111 00101 8 | 00110 00101 00110 9 | 00111 00100 00111 10 | 01000 01100 01000 11 | 01001 01101 01001 12 | 01010 01111 01010 13 | 01011 01110 01011 14 | 01100 01010 01100 15 | 01101 01011 01101 16 | 01110 01001 01110 17 | 01111 01000 01111 18 | 10000 11000 10000 19 | 10001 11001 10001 20 | 10010 11011 10010 21 | 10011 11010 10011 22 | 10100 11110 10100 23 | 10101 11111 10101 24 | 10110 11101 10110 25 | 10111 11100 10111 26 | 11000 10100 11000 27 | 11001 10101 11001 28 | 11010 10111 11010 29 | 11011 10110 11011 30 | 11100 10010 11100 31 | 11101 10011 11101 32 | 11110 10001 11110 33 | 11111 10000 11111 34 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/90-Language/01-Lambda/Lambda/Exp/Base.ds: -------------------------------------------------------------------------------- 1 | 2 | module Lambda.Exp.Base 3 | export 4 | { show_Exp; 5 | show_Subst; 6 | } 7 | import Class.Show 8 | import Data.Text 9 | import Data.Tuple 10 | where 11 | 12 | 13 | -- | Represent names as text. 14 | type Name = Text 15 | 16 | 17 | -- | Untyped lambda calculus expressions. 18 | data Exp 19 | = XVar Name 20 | | XAbs Subst Name Exp 21 | | XApp Exp Exp 22 | 23 | 24 | data Subst 25 | = Subst (List (Name, Exp)) 26 | 27 | 28 | show_Exp: Show Exp 29 | = Show $ λxx 30 | -> case xx of 31 | XVar n 32 | -> parens $ "XVar" %% show n 33 | 34 | XAbs ss n x 35 | -> parens $ "XAbs" %% show ss %% show n %% show x 36 | 37 | XApp x1 x2 38 | -> parens $ "XApp" %% show x1 %% show x2 39 | 40 | 41 | show_Subst: Show Subst 42 | = Show $ λxx 43 | -> case xx of 44 | Subst ls 45 | -> parens $ "Subst" %% show ls 46 | 47 | -------------------------------------------------------------------------------- /test/ddc-demo/source/Discus/90-Language/01-Lambda/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import Lambda.Source.Parser 4 | import Lambda.Source.Lexer 5 | import Lambda.Eval.Step 6 | import Lambda.Exp.Pretty 7 | import Lambda.Exp.Base 8 | import Lambda.Exp 9 | import Class.Show 10 | import Data.Tuple 11 | import Data.Text.List 12 | import Data.Text 13 | import System.IO.Console 14 | where 15 | 16 | 17 | main () 18 | = do cs = charListOfText "(\\x. x) (\\foo. bar foo) (\\y. y)" 19 | ts = lexTokens cs 20 | 21 | case parseExp ts of 22 | Nothing 23 | -> writel "parse error" 24 | 25 | Just xx 26 | -> do writel $ show xx 27 | writel $ show (step xx) 28 | writel $ pprExp xx 29 | 30 | -------------------------------------------------------------------------------- /test/ddc-regress/Readme.md: -------------------------------------------------------------------------------- 1 | 2 | DDC Regression Tests 3 | ==================== 4 | 5 | The tests in this directory aim to cover all language features and edge cases in the project, as well as ensure that bugs that are fixed do not get reintroduced. 6 | 7 | Specification tests do not go here. Specification tests are more about explaining to someone new to the project how all the features work. For specification tests the focus is more on explanation than coverage. 8 | 9 | -------------------------------------------------------------------------------- /test/ddc-regress/core/01-ddci-core/Test.dcx: -------------------------------------------------------------------------------- 1 | 2 | -- #309: Don't assume :eval fragment after :set lang. 3 | -- The flow fragment doesn't have an evaluator. 4 | :set lang Flow 5 | :eval 0 6 | 7 | -------------------------------------------------------------------------------- /test/ddc-regress/core/01-ddci-core/Test.stdout.check: -------------------------------------------------------------------------------- 1 | 2 | -- #309: Don't assume :eval fragment after :set lang. 3 | -- The flow fragment doesn't have an evaluator. 4 | ok 5 | unknown command. 6 | use :? for help. 7 | 8 | -------------------------------------------------------------------------------- /test/ddc-regress/core/02-Salt/10-Primitive/Test.dcx: -------------------------------------------------------------------------------- 1 | 2 | -- See if we've managed to changed modes. 3 | :set lang Salt 4 | :check add# 5 | 6 | -- Type constructors 7 | :kind Nat# 8 | :kind Int# 9 | :kind Word32# 10 | 11 | -- Error: invalid type constructors 12 | :kind Word# 13 | :kind Int32# 14 | :kind Int65# 15 | 16 | 17 | -- Check types of tailcallN# prims. 18 | :check tailcall0# 19 | 20 | :check tailcall1# 21 | 22 | :check tailcall4# 23 | 24 | 25 | -- Literals 26 | :check 42# 27 | 28 | :check -5i# 29 | 30 | :check 96i# 31 | 32 | :check 42w8# 33 | 34 | :check 42w16# 35 | 36 | :check 42w32# 37 | 38 | :check 42w64# 39 | 40 | :check TAG42# 41 | 42 | -- Error: lex error 43 | -- no negative naturals 44 | :check -42# 45 | 46 | -- no unboxed literals in this fragment. 47 | :check 42w32 48 | 49 | -- Error: not a valid bit width 50 | :check 42w42# 51 | 52 | -- Binary literals 53 | :check 0b0100w32# 54 | 55 | :check 0b10000000w8# 56 | 57 | -- Error: Binary literal is wider than word size. 58 | :check 0b100000000w8# 59 | 60 | -------------------------------------------------------------------------------- /test/ddc-regress/core/02-Salt/13-Offside/Test.dcs: -------------------------------------------------------------------------------- 1 | 2 | module Runtime with letrec 3 | 4 | -- | Get the constructor tag of an object. 5 | getTag (obj : Ptr# rT Obj) : Tag# 6 | = do ptr = castPtr# [rT] [Word32#] [Obj] obj 7 | header = peek# ptr 8 | tag32 = shr# header 8w32# 9 | promote# [Tag#] [Word32#] tag32 10 | -------------------------------------------------------------------------------- /test/ddc-regress/core/02-Salt/40-Standalone/40-Factorial/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 3628800 2 | -------------------------------------------------------------------------------- /test/ddc-regress/core/02-Salt/40-Standalone/41-Normalise/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 3628800 2 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/10-Syntax/10-Type/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Tetra 2 | 3 | 4 | -- Parse kind function operator. 5 | -- This needs to be fully applied to have a sort. 6 | :sort (->) Data Data 7 | 8 | 9 | -- Parse witness implication operator. 10 | -- This needs to be fully applied to have a sort. 11 | :kind [r : Region]. (=>) (Const r) Int# 12 | 13 | 14 | -- Parse type function operator. 15 | :kind (->) 16 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/10-Syntax/10-Type/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | 3 | 4 | -- Parse kind function operator. 5 | -- This needs to be fully applied to have a sort. 6 | Data -> Data :: Comp 7 | 8 | 9 | -- Parse witness implication operator. 10 | -- This needs to be fully applied to have a sort. 11 | [r: Region].Const r => Int# :: Data 12 | 13 | 14 | -- Parse type function operator. 15 | (->) :: Data -> Data -> Data 16 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/10-Syntax/11-Data/Test.dcx: -------------------------------------------------------------------------------- 1 | 2 | :set lang Tetra 3 | 4 | -- Check that type and value name spaces are distinct. 5 | :load.. 6 | module Test 7 | data Foo where 8 | Foo : Foo 9 | Bar : Foo 10 | with letrec 11 | foo (x : Foo) : Foo 12 | = case x of 13 | Foo -> Bar 14 | Bar -> Bar 15 | ;; 16 | 17 | 18 | -- Error: undefined data constructor Foo 19 | :load.. 20 | module Test 21 | data Foo where 22 | Bar : Foo 23 | with letrec 24 | foo (x : Foo) : Foo 25 | = case x of 26 | Foo -> Bar 27 | ;; 28 | 29 | 30 | -- ISSUE #303: Allow builtin type names to be reused as data constructor names. 31 | -- It might be best to leave this as unsupported, at least until we 32 | -- come across a good reason to change it. 33 | :load.. 34 | module Test 35 | data Foo where 36 | Region : Foo 37 | Effect : Foo 38 | with letrec 39 | foo (x : Foo) : Foo 40 | = case x of 41 | Region -> Effect 42 | Effect -> Region 43 | ;; 44 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/10-Syntax/11-Data/Test.stdout.check: -------------------------------------------------------------------------------- 1 | 2 | ok 3 | 4 | -- Check that type and value name spaces are distinct. 5 | module Test 6 | data Foo where { 7 | Foo : Foo; 8 | Bar : Foo; 9 | } 10 | with 11 | letrec { 12 | foo: Foo -> Foo 13 | = λ(x: Foo). 14 | case x of { 15 | Foo 16 | -> Bar; 17 | Bar 18 | -> Bar 19 | } 20 | } 21 | 22 | 23 | -- Error: undefined data constructor Foo 24 | Error in transformed module. 25 | in stage CoreLoad 26 | in pipe PipeCoreCheck/Check 27 | :25:4 28 | Undefined data constructor: Foo 29 | 30 | 31 | -- ISSUE #303: Allow builtin type names to be reused as data constructor names. 32 | -- It might be best to leave this as unsupported, at least until we 33 | -- come across a good reason to change it. 34 | Error loading module 35 | Parse error in "" (line 36, column 9) 36 | Unexpected constructor "Region". 37 | Expected a variable. 38 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/10-Syntax/20-Lambda/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Tetra 2 | 3 | -- Simple lambda abstraction 4 | :check \(x : Unit). x 5 | 6 | 7 | -- Lambda with multiple binders of the same type. 8 | :check /\(r1 r2 r3 : Region). \(x: Int#). x 9 | 10 | 11 | -- Lambda with multiple binders after the same lambda token. 12 | :check /\(r1 : Region) (r2 : Region). \(x : Int#). x 13 | 14 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/10-Syntax/20-Lambda/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | 3 | -- Simple lambda abstraction 4 | λ(x: Unit). x 5 | :*: Unit -> Unit 6 | :!: Pure 7 | 8 | 9 | -- Lambda with multiple binders of the same type. 10 | Λ(r1 r2 r3: Region). 11 | λ(x: Int#). x 12 | :*: [r1 r2 r3: Region].Int# -> Int# 13 | :!: Pure 14 | 15 | 16 | -- Lambda with multiple binders after the same lambda token. 17 | Λ(r1 r2: Region). 18 | λ(x: Int#). x 19 | :*: [r1 r2: Region].Int# -> Int# 20 | :!: Pure 21 | 22 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/11-Parser/10-Errors/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Tetra 2 | 3 | -- Error: Junk ? symbol in program. 4 | :check.. 5 | letrec { 6 | fac (acc : Nat#) (n : Nat#) : Nat# 7 | = case n of { 8 | 0# -> acc; 9 | 1# -> acc; ? 10 | _ -> fac (mul# [Nat#] acc n) 11 | (sub# [Nat#] n 1#) 12 | } 13 | } in fac 1# 5#;; 14 | 15 | 16 | -- Error: Like above, but ensure the line number has advanced 17 | -- between interpreter commands. 18 | :check ( ?? ) 19 | 20 | 21 | -- Ok: should allow variable named 'inc'. 22 | :check let inc = () in inc 23 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/11-Parser/10-Errors/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | 3 | -- Error: Junk ? symbol in program. 4 | While parsing. 5 | Parse error in "" (line 9, column 25) 6 | Unexpected variable "?". 7 | 8 | 9 | -- Error: Like above, but ensure the line number has advanced 10 | -- between interpreter commands. 11 | When checking expression. 12 | :18:5 13 | Undefined value variable: ? 14 | 15 | 16 | -- Ok: should allow variable named 'inc'. 17 | let inc: Unit 18 | = () in 19 | inc 20 | :*: Unit 21 | :!: Pure 22 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/11-Parser/20-MixForall/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Tetra 2 | 3 | -- It may seem strange to have a type lambda *after* a value lambda, but transforms can produce this 4 | -- and it can be pretty printed, so we should be able to parse it. 5 | :check.. 6 | letrec { 7 | foo : Nat# -> [a : Data]. a -> Nat# 8 | = \(n : Nat#). 9 | /\(a : Data). 10 | \(o : a). 11 | n 12 | } 13 | in () 14 | ;; 15 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/11-Parser/20-MixForall/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | 3 | -- It may seem strange to have a type lambda *after* a value lambda, but transforms can produce this 4 | -- and it can be pretty printed, so we should be able to parse it. 5 | letrec { 6 | foo: Nat# -> [a: Data].a -> Nat# 7 | = λ(n: Nat#). 8 | Λ(a: Data). 9 | λ(o: a). n 10 | } in 11 | () 12 | :*: Unit 13 | :!: Pure 14 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/11-Parser/T289-UnmatchedBraces/Main.dct: -------------------------------------------------------------------------------- 1 | 2 | -- This module contains an extra misplaced close brace 3 | -- which the offside rule code needs to give a sensible error for. 4 | -- 5 | -- The point here is that the offside rule inserts a synthetic open 6 | -- brace after the 'do' but there is a manifest user-written one after it. 7 | 8 | module Main 9 | export Main.main : [r : Region]. Nat# -> Ptr# r Word8# -> Int#; 10 | with letrec 11 | 12 | main [e: Effect] : Unit -> S e Unit 13 | = do } 0i# 14 | 15 | 16 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/11-Parser/T289-UnmatchedBraces/Main.error.check: -------------------------------------------------------------------------------- 1 | Error loading module 2 | Parse error in "test/ddc-regress/core/03-Discus/11-Parser/T289-UnmatchedBraces/Main.dct" (line 13, column 9) 3 | Unexpected closing brace. 4 | Expected a binder. 5 | Expected an expression. 6 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/12-Pretty/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Tetra 2 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/12-Pretty/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/21-Kinding/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Tetra 2 | 3 | 4 | -- Error: sorts don't have a higher classification 5 | :kind Prop 6 | 7 | 8 | -- Error: sorts don't have a higher classification 9 | :sort Prop 10 | 11 | 12 | -- Error: can't sort-check the naked kind function, 13 | -- because its sort depends on how it's instantiated, 14 | -- and we don't have sort polymorphism. 15 | :sort (->) 16 | 17 | 18 | -- Error: body of a forall must have data or witness kind. 19 | :kind [r : Region]. Read r 20 | 21 | 22 | -- Error: witness implication is invalid. 23 | :kind [r : Region]. r => TextLit# 24 | 25 | 26 | -- Error: witness implication is invalid. 27 | :kind [r : Region]. r => Mutable r 28 | 29 | 30 | -- Error: invalid kind for type sum. 31 | :kind [r : Region]. (Const + Const) 32 | 33 | 34 | -- #242 Error: Unexpected constructor (). 35 | :kind [r : Region]. (() + ()) 36 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/22-Typing/01-Names/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Tetra 2 | 3 | -- Error: Type varaible not in environment. 4 | :kind a 5 | 6 | 7 | -- Error: Type constructor not in environment. 8 | :kind Whatever 9 | 10 | 11 | -- Error: Data constructor not in environment. 12 | :type Whatever 13 | 14 | 15 | -- Error: Type constructor used as a data constructor. 16 | :type Unit 17 | 18 | 19 | -- Error: Data constructor used as a type constructor. 20 | :kind () 21 | 22 | 23 | -- Error: Type variable used as a value variable. 24 | :check (/\(a : Data). \(x : a). a) 25 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/22-Typing/01-Names/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | 3 | -- Error: Type varaible not in environment. 4 | When checking type. 5 | Undefined type variable: a 6 | 7 | 8 | -- Error: Type constructor not in environment. 9 | When checking type. 10 | Undefined type constructor: Whatever 11 | 12 | 13 | -- Error: Data constructor not in environment. 14 | When checking expression. 15 | :12:3 16 | Undefined data constructor: Whatever 17 | 18 | 19 | -- Error: Type constructor used as a data constructor. 20 | While parsing. 21 | Parse error in "" (line 1, column 1) 22 | Unexpected constructor "Unit". 23 | Expected an expression. 24 | 25 | 26 | -- Error: Data constructor used as a type constructor. 27 | While parsing. 28 | Parse error in "" (line 20, column 3) 29 | Unexpected . 30 | Expected a type. 31 | 32 | 33 | -- Error: Type variable used as a value variable. 34 | When checking expression. 35 | :24:28 36 | Undefined value variable: a 37 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/22-Typing/02-Let/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Tetra 2 | 3 | -- Ok: let expression with explicit type annotation. 4 | :check let x : Int# = 5# in x 5 | 6 | 7 | -- Ok: let expression with no type annotation. 8 | :check let x = 5# in x 9 | 10 | 11 | -- Error: let binder has incorrect type annotation. 12 | :check let x : Int# = () in x 13 | 14 | 15 | -- Error: binding must have data kind. 16 | :check.. 17 | \(e1 : Effect). 18 | let e2 : Effect = e1 19 | in () 20 | ;; 21 | 22 | 23 | -- Error: binding must have data kind. 24 | :check.. 25 | \(e1 : Effect). 26 | letrec { e2 : Effect = e1 } 27 | in () 28 | ;; 29 | 30 | 31 | -- Error: body must have data kind. 32 | :check.. 33 | \(e1:Effect). 34 | let x : Unit = () 35 | in e1 36 | ;; 37 | 38 | 39 | -- Error: body must have data kind. 40 | :check.. 41 | \(e1 : Effect). 42 | letrec { foo (x : Unit) : Unit = () } 43 | in e1 44 | ;; 45 | 46 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/22-Typing/11-Application/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Tetra 2 | :set Synth 3 | 4 | -- This was causing a type error, because the types aren't alpha equivalent. 5 | :load.. 6 | module Test with letrec 7 | f = /\(a : Data). \(v : a). v 8 | 9 | com = \(g : [^ : Data]. ^0 -> ^0). g 0i# 10 | 11 | uuse (_ : Nat#) = com f 12 | ;; 13 | 14 | 15 | :load.. 16 | module Test with letrec 17 | f = /\(a : Data). \(v : a). v 18 | 19 | com = \(g : [b : Data]. b -> b). g 0i# 20 | 21 | uuse (_ : Nat#) = com f 22 | ;; 23 | 24 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/22-Typing/11-Application/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | ok 3 | 4 | -- This was causing a type error, because the types aren't alpha equivalent. 5 | module Test with 6 | letrec { 7 | f: [a: Data].a -> a 8 | = Λ(a: Data). 9 | λ(v: a). v; 10 | 11 | com: ([^: Data].^0 -> ^0) -> Int# 12 | = λ(g: [^: Data].^0 -> ^0). g [Int#] 0i#; 13 | 14 | uuse: Nat# -> Int# 15 | = λ(_: Nat#). com f 16 | } 17 | 18 | 19 | module Test with 20 | letrec { 21 | f: [a: Data].a -> a 22 | = Λ(a: Data). 23 | λ(v: a). v; 24 | 25 | com: ([b: Data].b -> b) -> Int# 26 | = λ(g: [b: Data].b -> b). g [Int#] 0i#; 27 | 28 | uuse: Nat# -> Int# 29 | = λ(_: Nat#). com f 30 | } 31 | 32 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/22-Typing/31-Records/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Tetra 2 | 3 | -- Check kinds of primitive record type constructors. 4 | :kind ()# 5 | :kind (x)# 6 | :kind (x,y)# 7 | :kind (x,y,z)# 8 | :kind (x,x,x)# 9 | 10 | :kind (x,y,z)# Nat# 11 | :kind (x,y,z)# Nat# Bool# 12 | 13 | 14 | -- Check types of primitive record data constructors. 15 | :type ()# 16 | :type (x)# 17 | :type (x,y)# 18 | :type (x,y,z)# 19 | :type (x,x,x)# 20 | 21 | :type (x)# [Nat#] 3# 22 | :type (x,y)# [Nat#] [Bool#] 3# True# 23 | 24 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/22-Typing/31-Records/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | 3 | -- Check kinds of primitive record type constructors. 4 | ()# :: Data 5 | (x)# :: Data -> Data 6 | (x,y)# :: Data -> Data -> Data 7 | (x,y,z)# :: Data -> Data -> Data -> Data 8 | (x,x,x)# :: Data -> Data -> Data -> Data 9 | 10 | (x,y,z)# Nat# :: Data -> Data -> Data 11 | (x,y,z)# Nat# Bool# :: Data -> Data 12 | 13 | 14 | -- Check types of primitive record data constructors. 15 | ()# :: ()# 16 | (x)# :: [^: Data].^0 -> (x)# ^0 17 | (x,y)# :: [^ ^: Data].^1 -> ^0 -> (x,y)# ^1 ^0 18 | (x,y,z)# :: [^ ^ ^: Data].^2 -> ^1 -> ^0 -> (x,y,z)# ^2 ^1 ^0 19 | (x,x,x)# :: [^ ^ ^: Data].^2 -> ^1 -> ^0 -> (x,x,x)# ^2 ^1 ^0 20 | 21 | (x)# [Nat#] 3# :: (x)# Nat# 22 | (x,y)# [Nat#] [Bool#] 3# True# :: (x,y)# Nat# Bool# 23 | 24 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/22-Typing/40-Module/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Tetra 2 | 3 | 4 | -- Main module exports main function of the correct type. 5 | :load.. 6 | module Main 7 | export Main.main : Unit -> S Pure Unit 8 | with letrec 9 | main (x : Unit) : S Pure Unit 10 | = box () 11 | ;; 12 | 13 | 14 | -- Error: No main function. 15 | :load.. 16 | module Main 17 | export Main.blerk : Unit -> S Pure Unit 18 | with letrec 19 | blerk (x : Unit) : S Pure Unit 20 | = box () 21 | ;; 22 | 23 | 24 | -- Error: Main function has invalid type. 25 | :load.. 26 | module Main 27 | export Main.main : Nat# -> Nat# -> S Pure Unit 28 | with letrec 29 | main (x y : Nat#) : S Pure Unit 30 | = box () 31 | ;; 32 | 33 | 34 | -- Error: duplicate export of name. 35 | -- #295: Check for duplicate exported names in module parser. 36 | :load.. 37 | module Main 38 | export Main.main : Unit -> S Pure Unit 39 | export Main.main : Unit -> S Pure Unit 40 | with letrec 41 | main (x : Unit) : S Pure Unit 42 | = box () 43 | ;; 44 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/22-Typing/T253-RedefinedTopBind/Main.dct: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | export Main.main : [e: Effect]. Unit -> S e Unit 4 | with letrec 5 | 6 | main [e: Effect] (u: Unit): Unit 7 | = u 8 | 9 | main [e: Effect] (u: Unit): Unit 10 | = u 11 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/22-Typing/T253-RedefinedTopBind/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage CoreLoad 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-regress/core/03-Discus/22-Typing/T253-RedefinedTopBind/Main.dct:4:6 5 | Redefined binder 'main: [e: Effect].Unit -> Unit' in letrec. 6 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/23-Fragment/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Tetra 2 | 3 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/23-Fragment/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | 3 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/50-Transform/21-Eta/Test.dcx: -------------------------------------------------------------------------------- 1 | :set Synth 2 | :set trans Eta 3 | :trans.. 4 | let fun = /\(c : Data). \(v : c). v in 5 | let something = \(f : [d : Data]. d -> d). f [Unit] () in 6 | something fun 7 | ;; 8 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/50-Transform/21-Eta/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | ok 3 | let fun: [c: Data].c -> c 4 | = Λ(c: Data). 5 | λ(v: c). v in 6 | let something: ([d: Data].d -> d) -> Unit 7 | = λ(f: [d: Data].d -> d). f [Unit] () in 8 | something 9 | (Λ(^: Data). 10 | λ(^: ^0). fun [^0] ^0) 11 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/50-Transform/30-Snip/Test.dcx: -------------------------------------------------------------------------------- 1 | 2 | :set lang Tetra 3 | :set trans Snip 4 | :set +Indent 5 | 6 | 7 | -- Snip identity function. 8 | :trans (\(x : Unit). x) () 9 | 10 | 11 | -- Snip identify function with indices. 12 | :trans (\(^ : Unit). ^0) () 13 | 14 | 15 | -- Snip primitive operator. 16 | :trans add# [Nat#] 1# 2# 17 | 18 | 19 | -- Snip nested applications 20 | :trans add# [Nat#] (add# [Nat#] 1# 2#) (add# [Nat#] 3# 4#) 21 | 22 | 23 | -- Snip scrutinee of case expression. 24 | :trans.. 25 | (\(u:Unit). 26 | case add# [Nat#] 1# 2# of { 27 | 0# -> 1#; 28 | _ -> add# [Nat#] 3# 4# 29 | }) ();; 30 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/50-Transform/30-Snip/Test.stdout.check: -------------------------------------------------------------------------------- 1 | 2 | ok 3 | ok 4 | ok 5 | 6 | 7 | -- Snip identity function. 8 | let ^: Unit -> Unit 9 | = λ(x: Unit). x in 10 | ^0 () 11 | 12 | 13 | -- Snip identify function with indices. 14 | let ^: Unit -> Unit 15 | = λ(^: Unit). ^0 in 16 | ^0 () 17 | 18 | 19 | -- Snip primitive operator. 20 | add# [Nat#] 1# 2# 21 | 22 | 23 | -- Snip nested applications 24 | let ^: Nat# 25 | = add# [Nat#] 1# 2# in 26 | let ^: Nat# 27 | = add# [Nat#] 3# 4# in 28 | add# [Nat#] ^1 ^0 29 | 30 | 31 | -- Snip scrutinee of case expression. 32 | let ^: Unit -> Nat# 33 | = λ(u: Unit). 34 | let ^: Nat# 35 | = add# [Nat#] 1# 2# in 36 | case ^0 of { 37 | 0# 38 | -> 1#; 39 | _ 40 | -> add# [Nat#] 3# 4# 41 | } in 42 | ^0 () 43 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/50-Transform/70-FoldCase/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Flow 2 | :set trans Snip; Flatten; Namify; FoldCase 3 | 4 | -- Test simple case. 5 | :trans.. 6 | let c = T2# [Nat#] [Nat#] (add# [Nat#] 2# 1#) 3# in 7 | case c of { T2# x y -> add# [Nat#] x y } 8 | ;; 9 | -------------------------------------------------------------------------------- /test/ddc-regress/core/03-Discus/50-Transform/70-FoldCase/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | ok 3 | 4 | -- Test simple case. 5 | let x0: Nat# 6 | = add# [Nat#] 2# 1# in 7 | let c: Tuple2# Nat# Nat# 8 | = T2# [Nat#] [Nat#] x0 3# in 9 | let x: Nat# 10 | = x0 in 11 | let y: Nat# 12 | = 3# in 13 | add# [Nat#] x y 14 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/10-Load/10-Reduce/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Flow 2 | :set Synth 3 | 4 | 5 | -- Single series being eaten by two consumers. 6 | :load.. 7 | module Test with letrec 8 | test [p : Proc] [k : Rate] 9 | (u1 u2 : Ref# Int#) 10 | (elems : Series# p k Int#) : Process# p k 11 | = pjoin# (sreduce# u1 add# 0i# elems) 12 | (sreduce# u2 mul# 1i# elems) 13 | ;; 14 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/10-Load/10-Reduce/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | ok 3 | 4 | 5 | -- Single series being eaten by two consumers. 6 | module Test with 7 | letrec { 8 | test: [p: Proc].[k: Rate].Ref# Int# -> Ref# Int# -> Series# p k Int# -> Process# p k 9 | = Λ(p: Proc).Λ(k: Rate). 10 | λ(u1 u2: Ref# Int#).λ(elems: Series# p k Int#). 11 | pjoin# [p] [k] 12 | (sreduce# [p] [k] [Int#] u1 (add# [Int#]) 0i# elems) 13 | (sreduce# [p] [k] [Int#] u2 (mul# [Int#]) 1i# elems) 14 | } 15 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/11-Typing/Test.dcx: -------------------------------------------------------------------------------- 1 | 2 | :set Synth 3 | :set lang Flow 4 | 5 | -- This was once triggering an inferencer bug, 6 | -- due to having some type args, but not all of them. 7 | :load.. 8 | module Test with letrec 9 | test [p : Proc] [k : Rate] (n : RateNat# k) 10 | (v : Vector# Float32#) 11 | (s1 : Series# p k Float32#) (s2 : Series# p k Float32#) 12 | : Process# p k 13 | = do 14 | s2 = smap2# (mul# [Float32#]) s1 s2 15 | sfill# [p] [k] [Float32#] v s2 16 | ;; 17 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/11-Typing/Test.stdout.check: -------------------------------------------------------------------------------- 1 | 2 | ok 3 | ok 4 | 5 | -- This was once triggering an inferencer bug, 6 | -- due to having some type args, but not all of them. 7 | module Test with 8 | letrec { 9 | test: [p: Proc].[k: Rate].RateNat# k -> Vector# Float32# -> Series# p k Float32# -> Series# p k Float32# -> Process# p k 10 | = Λ(p: Proc).Λ(k: Rate). 11 | λ(n: RateNat# k).λ(v: Vector# Float32#).λ(s1 s2: Series# p k Float32#). 12 | let s2: Series# p k Float32# 13 | = smap2# [p] [k] [Float32#] [Float32#] [Float32#] (mul# [Float32#]) s1 s2 in 14 | sfill# [p] [k] [Float32#] v s2 15 | } 16 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/20-Prep/10-Fold/Test.dcx: -------------------------------------------------------------------------------- 1 | 2 | :set lang Flow 3 | 4 | -- Two folds over the same input series. 5 | :flow-prep.. 6 | module Test with letrec 7 | test [p : Proc] [k : Rate] 8 | (u1 u2 : Ref# Int#) 9 | (elems : Series# p k Int#) 10 | : Process# p k 11 | = pjoin# [p] [k] 12 | (sreduce# [p] [k] [Int#] u1 (add# [Int#]) 0i# elems) 13 | (sreduce# [p] [k] [Int#] u2 (mul# [Int#]) 1i# elems) 14 | ;; 15 | 16 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/20-Prep/10-Fold/Test.stdout.check: -------------------------------------------------------------------------------- 1 | 2 | ok 3 | 4 | -- Two folds over the same input series. 5 | module Test with 6 | letrec { 7 | test: [p: Proc].[k: Rate].Ref# Int# -> Ref# Int# -> Series# p k Int# -> Process# p k 8 | = Λ(p: Proc).Λ(k: Rate). 9 | λ(u1 u2: Ref# Int#).λ(elems: Series# p k Int#). 10 | let x3: Process# p k 11 | = sreduce# [p] [k] [Int#] u1 12 | (λ(x0 x1: Int#). add# [Int#] x0 x1) 0i# elems in 13 | let x7: Process# p k 14 | = sreduce# [p] [k] [Int#] u2 15 | (λ(x4 x5: Int#). mul# [Int#] x4 x5) 1i# elems in 16 | let x8: Process# p k 17 | = pjoin# [p] [k] x3 x7 in 18 | x8 19 | } 20 | 21 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/20-Prep/20-Eta/Test.dcx: -------------------------------------------------------------------------------- 1 | 2 | -- Check eta expansion is working. 3 | :set lang Flow 4 | :set trans Eta 5 | :load.. 6 | module Test 7 | import value Foo.f : Int# -> Int# -> Int# 8 | with letrec 9 | ffold [p : Proc] [k : Rate] 10 | (o : Ref# Int#) 11 | (s : Series# p k Int#) 12 | : Process# p k 13 | = sreduce# [p] [k] [Int#] o f 0i# s 14 | ;; 15 | 16 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/20-Prep/20-Eta/Test.stdout.check: -------------------------------------------------------------------------------- 1 | 2 | -- Check eta expansion is working. 3 | ok 4 | ok 5 | module Test 6 | import value Foo.f : Int# -> Int# -> Int#; 7 | with 8 | letrec { 9 | ffold: [p: Proc].[k: Rate].Ref# Int# -> Series# p k Int# -> Process# p k 10 | = Λ(p: Proc).Λ(k: Rate). 11 | λ(o: Ref# Int#).λ(s: Series# p k Int#). 12 | sreduce# [p] [k] [Int#] o 13 | (λ(^ ^: Int#). f ^1 ^0) 0i# s 14 | } 15 | 16 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/30-Scalar/11-Fill/Test.dcx: -------------------------------------------------------------------------------- 1 | :set Synth 2 | :set SuppressLetTypes 3 | 4 | -- | Single map over input series, writing into existing vector. 5 | :flow-lower.. 6 | module Test with letrec 7 | test [p : Proc] [k : Rate] (v : Vector# Int#) 8 | (s : RateVec# k Int#) : Process# p k 9 | = sfill# v (smap# (\x. add# (mul# x 2i#) 1i#) (series# s)) 10 | ;; 11 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/30-Scalar/11-Fill/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | ok 3 | 4 | -- | Single map over input series, writing into existing vector. 5 | module Test with 6 | letrec { 7 | test: [p: Proc].[k: Rate].Vector# Int# -> RateVec# k Int# -> Unit 8 | = Λ(p: Proc).Λ(k: Rate). 9 | λ(v: Vector# Int#).λ(s: RateVec# k Int#). 10 | let v$buf 11 | = vbuf# [Int#] v in 12 | let x3 13 | = series# [p] [k] [Int#] s in 14 | let x2 15 | = loop# [k] 16 | (λ(x0: Nat#). 17 | let x3$elem 18 | = next# [Int#] [p] [k] x3 x0 in 19 | let x4 = mul# [Int#] x3$elem 2i# in 20 | let x4$elem 21 | = add# [Int#] x4 1i# in 22 | let x1 23 | = vwrite# [Int#] v$buf x0 x4$elem in 24 | ()) in 25 | () 26 | } 27 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/30-Scalar/60-Generate/Test.dcx: -------------------------------------------------------------------------------- 1 | :set Synth 2 | :set SuppressLetTypes 3 | 4 | 5 | -- Single generate output 6 | :flow-lower.. 7 | module Test with letrec 8 | gen [p : Proc] [k : Rate] 9 | (v : Vector# Nat#) 10 | : Process# p k 11 | = let s : Series# p k Nat# = sgenerate# (mul# 2#) 12 | in sfill# v s 13 | ;; 14 | 15 | -- Generate, then map 16 | :flow-lower.. 17 | module Test with letrec 18 | gen [p : Proc] [k : Rate] 19 | (v : Vector# Nat#) 20 | : Process# p k 21 | = let s : Series# p k Nat# = sgenerate# (mul# 2#) in 22 | let t = smap# (add# 1#) s in 23 | sfill# v t 24 | ;; 25 | 26 | -- Generate in the presence of other Series 27 | :flow-lower.. 28 | module Test with letrec 29 | gen [p : Proc] [k : Rate] 30 | (s1: Series# p k Nat#) 31 | (v : Vector# Nat#) 32 | : Process# p k 33 | = let s2: Series# p k Nat# = sgenerate# (mul# 2#) in 34 | let t = smap2# (add#) s1 s2 in 35 | sfill# v t 36 | ;; 37 | 38 | 39 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/80-Rate/10-Fold/Test.dcx: -------------------------------------------------------------------------------- 1 | :set Synth 2 | 3 | 4 | -- Simple fold over a vector 5 | :flow-rate.. 6 | module Test with letrec 7 | test (u1 : Vector# Int#) 8 | : Int# 9 | = vreduce# add# 0i# u1 10 | ;; 11 | 12 | 13 | -- Two folds over same vector 14 | :flow-rate.. 15 | module Test with letrec 16 | test (u1 : Vector# Int#) 17 | : Int# 18 | = add# (vreduce# add# 0i# u1) (vreduce# mul# 1i# u1) 19 | ;; 20 | 21 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/80-Rate/11-Generate/Test.dcx: -------------------------------------------------------------------------------- 1 | :set Synth 2 | 3 | 4 | -- Just a generate 5 | :flow-rate.. 6 | module Test with letrec 7 | test (sz: Nat#) 8 | : Vector# Nat# 9 | = vgenerate# sz (add# 1#) 10 | ;; 11 | 12 | 13 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/80-Rate/11-Generate/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | 3 | 4 | -- Just a generate 5 | module Test with 6 | letrec { 7 | x2$runproc$process: [x2$'$k: Rate].Vector# Nat# -> [x2$PROC: Proc].Unit -> Process# x2$PROC x2$'$k 8 | = Λ(x2$'$k: Rate). 9 | λ(x2: Vector# Nat#). 10 | Λ(x2$PROC: Proc). 11 | λ(_: Unit). 12 | let x2$s: Series# x2$PROC x2$'$k Nat# 13 | = sgenerate# [x2$PROC] [x2$'$k] [Nat#] 14 | (λ(x0: Nat#). add# [Nat#] 1# x0) in 15 | let x2$proc: Process# x2$PROC x2$'$k 16 | = sfill# [x2$PROC] [x2$'$k] [Nat#] x2 x2$s in 17 | x2$proc; 18 | 19 | test: Nat# -> Vector# Nat# 20 | = λ(sz: Nat#). 21 | let x2: Vector# Nat# 22 | = vnew# [Nat#] sz in 23 | let x2$runproc: Unit 24 | = ratify0# [Unit] sz 25 | (Λ(x2$'$k: Rate). 26 | runProcess# [x2$'$k] (x2$runproc$process [x2$'$k] x2)) in 27 | x2 28 | } 29 | 30 | 31 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/80-Rate/20-Normalise/Test.dcx: -------------------------------------------------------------------------------- 1 | :set Synth 2 | 3 | 4 | -- Normalise - sum, then map. Requires two kernels 5 | :flow-rate.. 6 | module Test with letrec 7 | test (u1 : Vector# Int#) 8 | : Vector# Int# 9 | = do 10 | n = vreduce# add# 0i# u1 11 | vmap# (\x. div# x n) u1 12 | ;; 13 | 14 | 15 | -- Normalise with extra reduce 16 | :flow-rate.. 17 | module Test with letrec 18 | test (u1 : Vector# Int#) 19 | : Tuple2# (Vector# Int#) Int# 20 | = do 21 | n = vreduce# add# 0i# u1 22 | xs = vmap# (\x. div# x n) u1 23 | y = vreduce# mul# 1i# u1 24 | T2# xs y 25 | ;; 26 | 27 | 28 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/80-Rate/30-Map2/Test.dcx: -------------------------------------------------------------------------------- 1 | :set Synth 2 | 3 | 4 | -- Simple map2 5 | :flow-rate.. 6 | module Test with letrec 7 | test (u1 u2 : Vector# Int#) : Vector# Int# 8 | = vmap2# add# u1 u2 9 | ;; 10 | 11 | 12 | -- Different vector types 13 | :flow-rate.. 14 | module Test with letrec 15 | test (us : Vector# Int#) (vs : Vector# Float32#) : Vector# Float32# 16 | = vmap2# (\u v. v) us vs 17 | ;; 18 | 19 | 20 | -- Some other ops thrown in. Two processes, 'fs' and 'zs' are manifest 21 | :flow-rate.. 22 | module Test with letrec 23 | test (us : Vector# Int#) (vs : Vector# Float32#) (z : Float32#) : Vector# Float32# 24 | = do us' = vmap# (\u. u) us 25 | fs = vmap2# (\u v. v) us' vs 26 | f = vreduce# add# z fs 27 | zs = vmap3# (\u v ff. add# ff f) us vs fs 28 | zs 29 | ;; 30 | 31 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/80-Rate/60-MinManifest/Test.dcx: -------------------------------------------------------------------------------- 1 | :set Synth 2 | 3 | 4 | -- Two possible schedules, but should be one with only one manifest array (ys) 5 | :flow-rate.. 6 | module Test with letrec 7 | test (us : Vector# Int#) : Vector# Int# 8 | = do xs = vmap# (add# 1i#) us 9 | y = vreduce# add# 0i# us 10 | ys = vmap# (add# y) xs 11 | ys 12 | ;; 13 | 14 | 15 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/80-Rate/80-Gather/Test.dcx: -------------------------------------------------------------------------------- 1 | :set Synth 2 | :set lang Flow 3 | 4 | :flow-rate.. 5 | module Test with letrec 6 | test (orig : Vector# Int#) (ix : Vector# Nat#) 7 | = do flub = vgather# orig ix 8 | flub 9 | ;; 10 | 11 | :flow-rate.. 12 | module Test with letrec 13 | test (orig : Vector# Int#) (ix : Vector# Nat#) 14 | = do len = vlength# orig 15 | ix' = vfilter# (gt# len) ix 16 | flub = vgather# orig ix' 17 | flub 18 | ;; 19 | 20 | 21 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/80-Rate/91-Weird/Test.dcx: -------------------------------------------------------------------------------- 1 | :set Synth 2 | 3 | -- I don't remember the details, but something strange with forwarding was going on here 4 | :flow-rate.. 5 | module Test with 6 | letrec 7 | foo (m : Vector# Nat#) (i : Nat#) 8 | = let y = add# [Nat#] 1# (add# [Nat#] 2# 1#) in 9 | let x = add# [Nat#] y y in 10 | vmap# (add# x) (vgenerate# i (add# y)) 11 | ;; 12 | 13 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/90-ToTetra-skip/10-Simple/Test.dcx: -------------------------------------------------------------------------------- 1 | :set Synth 2 | :set lang Flow 3 | 4 | -- Simple fold over a vector 5 | :flow-tetra.. 6 | module Test with 7 | letrec 8 | 9 | test (u1 : Vector# Int#) 10 | : Int# 11 | = vreduce# add# 0i# u1 12 | 13 | ;; 14 | 15 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/90-ToTetra-skip/20-OutVector/Main.dcf: -------------------------------------------------------------------------------- 1 | module Main 2 | export { 3 | main : Unit -> Unit; 4 | } 5 | import type { 6 | rT : Region; 7 | } 8 | import foreign c value { 9 | showInt : Int# -> Ptr# rT String#; 10 | showNat : Nat# -> Ptr# rT String#; 11 | putStrLn : Ptr# rT String# -> Unit; 12 | } 13 | with letrec 14 | 15 | external (vs : Vector# Nat#) 16 | = vs 17 | 18 | test (sz : Nat#) 19 | = do xs = vgenerate# sz (add# 1#) 20 | xs' = external xs 21 | y = vreduce# add# 0# xs' 22 | ys = vfilter# (lt# 5#) xs' 23 | z = vreduce# add# y ys 24 | T2# z ys 25 | 26 | main (_ : Unit) 27 | = do res = test 10# 28 | case res of 29 | T2# i v 30 | -> do putStrLn (showNat i) 31 | putStrLn (showNat (vlength# v)) 32 | () 33 | 34 | 35 | -------------------------------------------------------------------------------- /test/ddc-regress/core/04-Flow/Broken-skip/Test.dcx: -------------------------------------------------------------------------------- 1 | :set SuppressLetTypes 2 | :set Synth 3 | 4 | -- Fuse reps with indices. 5 | :flow-lower.. 6 | module Test with letrec 7 | test [k1 : Rate] 8 | (lens : Series# k1 Nat#) (things : Series# k1 Nat#) 9 | (v : Vector# Nat#) 10 | : Process# 11 | = smkSegd# lens 12 | (/\(k2 : Rate). \(segd : Segd# k1 k2). 13 | do s2 = sindices# segd 14 | s3 = sreps# segd things 15 | s4 = smap2# add# s2 s3 16 | sfill# v s4) 17 | ;; 18 | -------------------------------------------------------------------------------- /test/ddc-regress/core/05-Machine/01-Primitive/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Machine 2 | 3 | -- Primitive kinds 4 | :sort Static 5 | :sort Data 6 | 7 | -- Machine type constructors 8 | :kind Stream# 9 | :kind Source# 10 | :kind Sink# 11 | :kind Process# 12 | 13 | -- Tuple type constructors 14 | :kind Tuple1# 15 | :kind Tuple2# 16 | 17 | 18 | -- Primitive operators 19 | :type stream_0_1# 20 | :type process_0_1# 21 | 22 | :type stream_1_1# 23 | :type process_1_1# 24 | 25 | :type stream_2_2# 26 | :type process_2_2# 27 | 28 | :type /\(in1 out1 : Data). stream_1_1# [in1] [out1] 29 | :type /\(in1 out1 out2 : Data). stream_1_2# [in1] [out1] [out2] 30 | 31 | 32 | :type pull# 33 | :type push# 34 | :type drop# 35 | 36 | :type T1# 37 | :type T2# 38 | -------------------------------------------------------------------------------- /test/ddc-regress/core/05-Machine/02-MapCombinator/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Machine 2 | :set PrettyUseLetCase 3 | :set Synth 4 | :set trans Forward; BetaLets; SnipOver; Flatten; Namify 5 | 6 | :load.. 7 | module Map 8 | with letrec 9 | 10 | map [a b : Data] (f : a -> b) (as : Stream# a) : Tuple1# (Stream# b) 11 | = stream_1_1# (\inp out. letrec 12 | p1 = pull# inp p2 13 | p2 v = push# out (f v) p3 14 | p3 = drop# inp p1 15 | in p1) as 16 | 17 | mapmap [a b c : Data] (f : a -> b) (g : b -> c) xs 18 | = letcase T1# ys = map f xs 19 | in letcase T1# zs = map g ys 20 | in T1# zs 21 | 22 | exec [a b c : Data] (f : a -> b) (g : b -> c) (ins : Source# a) (outs : Sink# c) 23 | = process_1_1# (mapmap f g) ins outs 24 | ;; 25 | -------------------------------------------------------------------------------- /test/ddc-regress/core/05-Machine/20-Slurp/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | ok 3 | ok 4 | 5 | [(exec: Source# a0 -> Sink# c0 -> Process#,Network 6 | inputs: [xs] 7 | outputs: [zs] 8 | Process 9 | init: p1 10 | blocks: 11 | p1 = pull# xs v p2 12 | p2 = push# ys (f0 v) p3 13 | p3 = drop# xs p1 14 | channels: 15 | xs = Input 16 | ys = Output 17 | Process 18 | init: p1 19 | blocks: 20 | p1 = pull# ys v p2 21 | p2 = push# zs (g0 v) p3 22 | p3 = drop# ys p1 23 | channels: 24 | ys = Input 25 | zs = Output)] 26 | 27 | 28 | [(exec: Source# int -> Sink# int -> Process#,Network 29 | inputs: [xs] 30 | outputs: [ys] 31 | Process 32 | init: p_pre 33 | blocks: 34 | p_again = pull# xs v' (p_join {v=v}) 35 | p_drop = drop# xs (p_start {v=v}) 36 | p_join = (p_drop {v=plus v v'}) 37 | p_pre = pull# xs v p_start 38 | p_start = push# ys v (p_again {v=v}) 39 | channels: 40 | xs = Input 41 | ys = Output)] 42 | -------------------------------------------------------------------------------- /test/ddc-regress/core/05-Machine/30-Fused/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Machine 2 | :set PrettyUseLetCase 3 | :set Synth 4 | 5 | :machine-fused.. 6 | module Map 7 | 8 | import foreign abstract type 9 | a0 : Data 10 | b0 : Data 11 | c0 : Data 12 | 13 | import value 14 | Base.f0 : a0 -> b0 15 | Base.g0 : b0 -> c0 16 | 17 | export Map.exec : Source# a0 -> Sink# c0 -> Process# 18 | 19 | with 20 | let map [a b : Data] (f : a -> b) (as : Stream# a) : Tuple1# (Stream# b) 21 | = stream_1_1# (\inp out. letrec 22 | p1 = pull# inp p2 23 | p2 v = push# out (f v) p3 24 | p3 = drop# inp p1 25 | in p1) as 26 | 27 | mapmap xs 28 | = letcase T1# ys = map f0 xs 29 | in letcase T1# zs = map g0 ys 30 | in T1# zs 31 | 32 | exec = process_1_1# mapmap 33 | ;; 34 | 35 | -------------------------------------------------------------------------------- /test/ddc-regress/core/05-Machine/30-Fused/Test.stdout.check: -------------------------------------------------------------------------------- 1 | ok 2 | ok 3 | ok 4 | 5 | [(exec: Source# a0 -> Sink# c0 -> Process#,Network 6 | inputs: [xs] 7 | outputs: [zs] 8 | Process 9 | init: p1__p1_ 10 | blocks: 11 | p1__p1_ = pull# xs v p2__p1_ 12 | p1__p1_ys_is_pending = (p1__p2_ys_is_have {v=ys$_buf}) 13 | p1__p2_ys_is_have = push# zs (g0 v) p1__p3_ys_is_have 14 | p1__p3_ys_is_have = p1__p1_ 15 | p2__p1_ = push# ys (f0 v) (p3__p1_ys_is_pending {ys$_buf=f0 v}) 16 | p3__p1_ys_is_pending = drop# xs p1__p1_ys_is_pending 17 | channels: 18 | xs = Input 19 | ys = Output 20 | zs = Output)] 21 | 22 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/21-Guards/01-InexhBindGuards/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import Class.Show 4 | import Data.Maybe 5 | import Data.Function 6 | import Data.Numeric 7 | import System.IO.Console 8 | where 9 | 10 | 11 | -- | The first guard is inexhaustive, and will cause a runtime 12 | -- error if x /= 0. 13 | derp (x: Nat#): Nat# 14 | | x == 0 = 10 15 | 16 | main () 17 | = do 18 | writel $ showNat (derp 0) 19 | writel $ showNat (derp 1) 20 | 21 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/21-Guards/01-InexhBindGuards/Main.runerror.check: -------------------------------------------------------------------------------- 1 | 2 | DDC runtime error: inexhaustive case match. 3 | at: test/ddc-main/70-SourceTetra/21-Guards/01-InexhBindGuards/Main.ds:12 4 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/21-Guards/02-InexhAltGuards/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import Class.Show 4 | import Data.Maybe 5 | import Data.Function 6 | import Data.Numeric 7 | import System.IO.Console 8 | where 9 | 10 | 11 | -- | The first guard is inexhaustive, and will cause a runtime 12 | -- error if x /= 0. 13 | derp (mx: Maybe Nat#): Nat# 14 | = case mx of 15 | Just x 16 | | x == 0 -> 10 17 | 18 | Nothing -> 20 19 | 20 | 21 | main (_: Unit): S Console Unit 22 | = box do 23 | writel $ showNat (derp (Just 0)) 24 | writel $ showNat (derp (Just 1)) -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/21-Guards/02-InexhAltGuards/Main.runerror.check: -------------------------------------------------------------------------------- 1 | 2 | DDC runtime error: inexhaustive case match. 3 | at: test/ddc-main/70-SourceTetra/21-Guards/02-InexhAltGuards/Main.ds:12 4 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/21-Guards/03-CombinedAnon/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import Class.Show 4 | import System.IO.Console 5 | import Data.Function 6 | import Data.Numeric 7 | where 8 | 9 | -- This is an edge-case in pattern matching desugaring. 10 | -- When we have consecutive clauses where a particular parameter for 11 | -- the first view is an wildcard then the desugarer needs to introduce 12 | -- a new variable name to bind the argument. 13 | derp _ 0 = 1 14 | derp 1 _ = 2 15 | derp _ _ = 3 16 | 17 | 18 | main () 19 | = writel $ showNat (derp 1 0) -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/21-Guards/03-CombinedAnon/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 1 2 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/30-Data/21-NameClash/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | -- Test using a pattern where the same named is used in multiple left-hand 3 | -- sides. This used to fail due to a bug in the LLVM code generator. 4 | module Main 5 | import Data.Numeric 6 | import Class.Show 7 | import System.IO.Console 8 | where 9 | 10 | data Thing where 11 | One : Nat# -> Thing 12 | Two : Bool# -> Thing 13 | 14 | thing (x : Thing) : Nat# 15 | = case x of 16 | One n -> n 17 | Two n -> if n then 0 else 1 18 | 19 | main (_ : Unit) : S Console Unit 20 | = do 21 | writel (showNat (thing (One 5))) 22 | writel (showNat (thing (Two False))) 23 | writel (showNat (thing (Two True))) -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/30-Data/30-Vector/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import Class.Show 4 | import Data.Numeric 5 | import Data.Text 6 | import System.IO.Console 7 | where 8 | 9 | 10 | -- Check that the vector primitives work for single byte elements. 11 | -- At one stage the 'length' field was being written with the wrong 12 | -- word size. 13 | main () 14 | = private r with {Read r; Write r; Alloc r} in 15 | do 16 | vec = vectorAlloc# {@r} {@Word8#} 4 17 | vectorWrite# vec 3 27w8 18 | vectorWrite# vec 0 0w8 19 | writel (showNat (promote# (vectorRead# vec 3))) 20 | writel (showNat (promote# (vectorLength# vec))) 21 | 22 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/30-Data/30-Vector/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 27 2 | 4 3 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/40-Infer/02-Loop/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | data Moar (a : Data) where 5 | Moar : a -> Moar a 6 | 7 | x = Moar x 8 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/40-Infer/02-Loop/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | Cannot construct infinite type. 5 | ?1 = Moar ?1 6 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/40-Infer/10-ListPoly/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import System.IO.Console 4 | where 5 | 6 | 7 | -- | Standard Cons-lists. 8 | data List (a: Data) where 9 | Nil : List a 10 | Cons : a -> List a -> List a 11 | 12 | 13 | ident (xx: List a): List a 14 | = go xx 15 | where go Nil = Nil 16 | go (Cons x xs) = Cons x (go xs) 17 | 18 | main () 19 | = box () 20 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/40-Infer/20-MetaVar/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | -- This will fail the compilance check because the type of the 5 | -- parameter is unconstrained and we don't do type generalization. 6 | foo x = x 7 | 8 | main = () 9 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/40-Infer/20-MetaVar/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | :1:1 5 | Ambigous type 6 | 7 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/40-Infer/T419-ExplicitDictionaries/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | module Test 3 | import Data.Numeric 4 | import Data.List 5 | where 6 | 7 | data Dict where 8 | Dict : Dict 9 | 10 | fooNat (x: Nat): Nat 11 | = x 12 | 13 | fooDictNat {Dict} (x: Nat): Nat 14 | = x 15 | 16 | -- Expliciator needs to run to insert an automatic implicit argument 17 | -- for 'fooDictNat', so that the list is assigned the type 18 | -- List (Nat -> Nat) instead of List (Dict ~> Nat -> Nat), 19 | -- as that does not match the type of the second element. 20 | thing {Dict} (x: Nat): List (Nat -> Nat) 21 | = Cons fooDictNat (Cons fooNat Nil) 22 | 23 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/41-Modules/01-ExportFun/Main.ds: -------------------------------------------------------------------------------- 1 | -- Check that we can import a higher order function from another module. 2 | -- The code generator needs to use the arity information in the interface file. 3 | module Main 4 | import Module 5 | import Data.Numeric 6 | import Class.Show 7 | import System.IO.Console 8 | where 9 | 10 | 11 | main (_: Unit): S Console Unit 12 | = do writel (showNat (addThing1 2 3)) 13 | writel (showNat (addThing2 2 3)) 14 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/41-Modules/01-ExportFun/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 5 2 | 5 3 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/41-Modules/01-ExportFun/Module.ds: -------------------------------------------------------------------------------- 1 | -- Check that we can export a higher order function from a module. 2 | -- The arity information ends up in the interface file. 3 | module Module 4 | export addThing1; addThing2 5 | import Class.Show 6 | import Data.Numeric 7 | where 8 | 9 | 10 | addThing1 (n: Nat#): Nat# -> Nat# 11 | = add n 12 | 13 | 14 | addThing2 (n m: Nat#): Nat# 15 | = add n m 16 | 17 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/61-ToLLVM/T412-DoubleBackslash/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import System.IO.Console 4 | where 5 | 6 | main () 7 | = do writel "slash\\slash" 8 | writel "space\ space" 9 | writel "2slash\\\\2slash" 10 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/61-ToLLVM/T412-DoubleBackslash/Main.stdout.check: -------------------------------------------------------------------------------- 1 | slash\slash 2 | space\ space 3 | 2slash\\2slash 4 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/01-BoxRun/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 2 2 | 4 3 | 7 4 | 11 5 | 2 6 | 4 7 | 7 8 | 11 9 | 2 10 | 2 11 | 4 12 | 7 13 | 11 14 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/02-AppOver/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | -- Test over-application. 3 | -- Calling supers with more args than their arity. 4 | module Main 5 | import Data.Numeric 6 | import Class.Show 7 | import System.IO.Console 8 | where 9 | 10 | 11 | -- Super that returns a functional value. 12 | test (n : Nat#) : Nat# -> Nat# 13 | = λ(x : Nat#) -> x + n 14 | 15 | -- Over-applied super from the same module. 16 | test2 (x : Nat#) : Nat# -> Nat# 17 | = λ(y : Nat#) -> test x y 18 | 19 | -- Over-applied super from an imported module. 20 | test3 (n : Nat#) : Nat# -> Nat# 21 | = add n 22 | 23 | 24 | main (_ : Unit) : S Console Unit 25 | = do writel (showNat (test 2 3)) 26 | writel (showNat (test2 2 3)) 27 | writel (showNat (test3 2 3)) 28 | 29 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/03-AppUnder/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | -- Test under-application. 3 | -- Calling supers with less args than their arity. 4 | module Main 5 | import Data.Numeric 6 | import Class.Show 7 | import System.IO.Console 8 | where 9 | 10 | 11 | add3 (x1 x2 x3: Nat#): Nat# 12 | = x1 + x2 + x3 13 | 14 | derp1 (x1: Nat#) : Nat# -> Nat# 15 | = add3 x1 x1 16 | 17 | derp2 (x1 x2: Nat#) : Nat# 18 | = derp1 x1 x2 19 | 20 | main (_ : Unit) : S Console Unit 21 | = box do 22 | run writel (showNat (derp2 1 2)) 23 | 24 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/03-AppUnder/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 4 2 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/04-AppMono/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | -- Test under-application. 3 | -- Calling supers with less args than their arity. 4 | module Main 5 | import Data.Numeric 6 | import Class.Show 7 | import System.IO.Console 8 | where 9 | 10 | data Thing where 11 | MkThing : (Nat# -> Nat#) -> Thing 12 | 13 | runThing (t: Thing) (x: Nat#): Nat# 14 | = case t of 15 | MkThing f -> f x 16 | 17 | add1 (x: Nat#): Nat# 18 | = x + 1 19 | 20 | main (_ : Unit): S Console Unit 21 | = box do 22 | run writel (showNat (runThing (MkThing add1) 2)) 23 | 24 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/04-AppMono/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 3 2 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/05-DataPAP/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | -- Check partial application of data constructor. 3 | module Main 4 | import Data.Numeric 5 | import Class.Show 6 | import System.IO.Console 7 | where 8 | 9 | 10 | data Derp where 11 | Derp : Nat# -> Nat# -> Derp 12 | 13 | 14 | underp (d: Derp): Nat# 15 | = case d of 16 | Derp x y -> x + y 17 | 18 | 19 | main () 20 | = do 21 | x = Derp 5 22 | writel (showNat (underp (x 6))) -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/05-DataPAP/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 11 2 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/06-SuperShadow/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | -- We have a top-level super named 'add2', but also a locally bound variable 3 | -- with the same name. During Tetra -> Salt conversion the curry transform 4 | -- needs to call the right one. 5 | module Main 6 | import Data.Numeric 7 | import Class.Show 8 | import System.IO.Console 9 | where 10 | 11 | data Foo where 12 | MkFoo : (Nat# -> Nat# -> Nat#) -> Foo 13 | 14 | add2 (x y: Nat#): Nat# 15 | = x + y + 100 16 | 17 | 18 | add3 (x y z: Nat#): Nat# 19 | = x + y + z 20 | 21 | 22 | thing1 (add2: Nat# -> Nat# -> Nat#): S Console Unit 23 | = writel (showNat (add2 1 2)) 24 | 25 | 26 | thing2 (_: Unit): S Console Unit 27 | = do 28 | add2 = add3 5 29 | writel (showNat (add2 1 2)) 30 | 31 | 32 | thing3 (f: Foo): S Console Unit 33 | = box case f of 34 | MkFoo add2 -> run writel (showNat (add2 1 2)) 35 | 36 | 37 | main (_: Unit): S Console Unit 38 | = do 39 | thing1 (add3 2) 40 | thing2 () 41 | () 42 | 43 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/06-SuperShadow/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 5 2 | 8 3 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/07-BoxRunDelayed/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 6 2 | hello 3 | world 4 | aloha 5 | konbanwa 6 | konnichiwa 7 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/08-BoxRunArg/Main.stdout.check: -------------------------------------------------------------------------------- 1 | derp = 2508 2 | marmot 3 | beep1 4 | beep2 5 | derp = 2508 6 | marmot 7 | beep1 8 | beep2 9 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/08-BoxRunArg/Things.ds: -------------------------------------------------------------------------------- 1 | 2 | module Things 3 | export defnord; nat1; text1; fnord1; comp1 4 | import Data.Numeric 5 | import Class.Show 6 | import System.IO.Console 7 | where 8 | 9 | -- A polymorphic value type. 10 | data Fnord (a: Data) where 11 | Fnord : Fnord a 12 | 13 | -- Consume a fnord. 14 | defnord (x: Fnord a): Nat# 15 | = 42 + nat1 16 | 17 | -- A monomorphic CAF. 18 | nat1 = 777 19 | 20 | -- Another monomporphic CAF. 21 | text1 = "marmot" 22 | 23 | -- A polymorphic CAF. 24 | fnord1 {@a: Data} 25 | = Fnord {@a} 26 | 27 | -- A suspended computation as a CAF. 28 | comp1 = writel "beep1" 29 | 30 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/20-Arity/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import Data.List 4 | import Data.Numeric 5 | import Class.Show 6 | import System.IO.Console 7 | where 8 | 9 | main () 10 | = private r with { Alloc r; Read r } in 11 | do writel (showNat 5) 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/62-Lambdas/30-LiftLetRec/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | -- | Check that we can lambda lift local letrecs. 3 | module Main 4 | import Data.Maybe 5 | import Data.Text 6 | import System.IO.Console 7 | where 8 | 9 | 10 | data Ordering where 11 | LT : Ordering 12 | GT : Ordering 13 | EQ : Ordering 14 | 15 | 16 | data Ord (k: Data) where 17 | Ord : (k -> k -> Ordering) -> Ord k 18 | 19 | type Size = Nat 20 | 21 | data TestMap (k a: Data) where 22 | Bin2 : Size -> k -> a -> TestMap k a -> TestMap k a -> TestMap k a 23 | Tip2 : TestMap k a 24 | 25 | 26 | map_lookup ((Ord compare): Ord k) (kx: k) (mp: TestMap k a): Maybe a 27 | = go kx mp 28 | where 29 | go _ Tip2 30 | = Nothing {@a} 31 | 32 | go k (Bin2 _ kx x l r) 33 | = case compare k kx of 34 | LT -> go k l 35 | GT -> go k r 36 | EQ -> Just x 37 | 38 | 39 | main () 40 | = writel "dummy" -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/80-Runtime/01-Collect/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import Data.Ref 4 | import System.IO.Console 5 | 6 | import foreign c value 7 | ddcPerformGC : Unit -> Unit 8 | ddcTraceObj : {@a: Data} -> Bool# -> Bool# -> a -> a 9 | 10 | where 11 | 12 | -- Allocate a simple object and perform a single GC cycle. 13 | -- We don't have an 'expected output' file for this because 14 | -- the object pointers will be different on different platforms 15 | -- and even between different runs. 16 | main (_ : Unit) 17 | = private r with { Alloc r; Read r; Write r } in 18 | do 19 | -- Allocate a reference to a a small object. 20 | writel "* Before GC" 21 | ref = allocRef {@r} 93 22 | ddcTraceObj True True ref 23 | 24 | writel "* Doing GC" 25 | ddcPerformGC () 26 | 27 | writel "* After GC" 28 | ddcTraceObj True True ref 29 | 30 | writel "* Done" 31 | () 32 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/90-Ghc/01-TypeCheck/001-where/Test.ds: -------------------------------------------------------------------------------- 1 | module Test 2 | import Data.Numeric 3 | where 4 | 5 | a x = y + 2 where y = x + 3 6 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/90-Ghc/01-TypeCheck/002-if/Test.ds: -------------------------------------------------------------------------------- 1 | module Test 2 | import Data.Numeric 3 | where 4 | 5 | b = if True then 1 else 2 6 | 7 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/90-Ghc/01-TypeCheck/003-tuple-mod/Test.ds: -------------------------------------------------------------------------------- 1 | module Test 2 | import Data.Numeric 3 | import Data.Tuple 4 | where 5 | 6 | -- this is supposed to test monomorphism restriction, which we don't have. 7 | -- mod: can't use pattern at top level of decl. 8 | f: {@a b: Data} -> (a, b) -> (Nat, Nat) 9 | f c@(d, e) = if True then (1, 2) else (1, 3) 10 | 11 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/90-Ghc/01-TypeCheck/004-if-x/Test.ds: -------------------------------------------------------------------------------- 1 | module Test 2 | import Prelude.Numeric 3 | where 4 | 5 | f x = case x of 6 | True -> True 7 | False -> x 8 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/90-Ghc/01-TypeCheck/005-patterns-mod/Test.ds: -------------------------------------------------------------------------------- 1 | module Test 2 | import Prelude.Data 3 | where 4 | 5 | -- mod: extra signature, tuple syntax. 6 | g: {@a: Data} -> (List Nat, a) -> Nat 7 | g (Cons x z, y) = x 8 | g (x, y) = 2 -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/90-Ghc/01-TypeCheck/006-infinite/Test.ds: -------------------------------------------------------------------------------- 1 | module Test 2 | import Prelude.Data 3 | where 4 | 5 | h = Cons 1 h 6 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/90-Ghc/01-TypeCheck/007-cons/Test.ds: -------------------------------------------------------------------------------- 1 | module Test 2 | import Data.List 3 | where 4 | 5 | j = 2 6 | k = Cons 1 (Cons j l) 7 | l = Cons 0 k 8 | m = j + j 9 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/90-Ghc/01-TypeCheck/008-bool/Test.ds: -------------------------------------------------------------------------------- 1 | module Test 2 | import Prelude.Numeric 3 | where 4 | 5 | n True = 1 6 | n False = 0 7 | 8 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/90-Ghc/01-TypeCheck/009-tuple-mod/Test.ds: -------------------------------------------------------------------------------- 1 | module Test 2 | import Data.List 3 | where 4 | 5 | -- mod: tuple syntax 6 | o (T2 True x) = x 7 | o (T2 False y) = y + 1 8 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/90-Ghc/01-TypeCheck/018-where/Test.ds: -------------------------------------------------------------------------------- 1 | module Test 2 | import Prelude.Numeric 3 | where 4 | 5 | -- mod: We need to swap the order of bindings as they're not lazy. 6 | w = a where y = 2 7 | a = y 8 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/90-Ghc/01-TypeCheck/020-where-broken-skip/Test.ds: -------------------------------------------------------------------------------- 1 | module Test 2 | import Prelude.Data 3 | where 4 | 5 | -- mod: type signature. 6 | -- broken: where expressions should be recursive 7 | f : [a: Data]. a -> List a 8 | f x = a where a = Cons x a -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/Broken-skip/Test.dcx: -------------------------------------------------------------------------------- 1 | :set lang Tetra 2 | :set Dump 3 | 4 | -------------------------------------------------------------------------------- /test/ddc-regress/source/01-Discus/Broken-skip/Test.dsx: -------------------------------------------------------------------------------- 1 | 2 | -- Effectful List map with implicit effect management. 3 | :to-core.. 4 | module Test where 5 | data List (a : Data) where 6 | Nil : List a 7 | Cons : a -> List a -> List a 8 | 9 | mapS [a b : Data] [e : Effect] 10 | (f : a -> S e b) (xx : List a) : S e (List b) 11 | = case xx of 12 | Nil -> Nil 13 | Cons x xs -> Cons (f x) (mapS f xs) 14 | ;; 15 | 16 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/02-Codec/01-Json/Main.stdout.check: -------------------------------------------------------------------------------- 1 | null 2 | true 3 | false 4 | "hello world" 5 | 1234'f64 6 | -1234'f64 7 | 1234567'f64 8 | 1234567891'f64 9 | 1234.567'f64 10 | -1234.567'f64 11 | 10006.99430671'f64 12 | 12345670'f64 13 | 12345670'f64 14 | 1.234567e-05'f64 15 | [] 16 | [true] 17 | [true,false,true] 18 | [true,123456'f64,true,"derp"] 19 | {} 20 | {"one":[true,false,27.123'f64,true],"two":{"three":null}} 21 | {"one":{"three":[true,false,27'f64,true],"two":{"three":null}}} 22 | [["funding","BTC",0.1'f64,null],["funding","USD",10000.001'f64,0'f64,null]] 23 | ([1234'f64],"trailingjunk") 24 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/03-System/01-IO/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import Data.Text.Base 4 | import System.IO.File 5 | import System.IO.Console 6 | where 7 | 8 | 9 | -- dirBase = "test/ddc-regress/source/02-base/03-System/01-IO" 10 | 11 | main (_: Unit) 12 | = do 13 | txSimple = file_read "test/ddc-regress/source/02-base/03-System/01-IO/test-simple.txt" 14 | writel "-----" 15 | write txSimple 16 | writel "-----" 17 | 18 | txNoNewline = file_read "test/ddc-regress/source/02-base/03-System/01-IO/test-nonewline.txt" 19 | writel "-----" 20 | write txNoNewline 21 | writel "-----" 22 | 23 | txCR = file_read "test/ddc-regress/source/02-base/03-System/01-IO/test-cr.txt" 24 | writel "-----" 25 | write txCR 26 | writel "-----" 27 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/03-System/01-IO/Main.stdout.check: -------------------------------------------------------------------------------- 1 | ----- 2 | here is 3 | a file for 4 | the test program 5 | 6 | to read 7 | 8 | ----- 9 | ----- 10 | here is 11 | a file for 12 | 13 | the test program 14 | but with no newline on the end 15 | 16 | of the file----- 17 | ----- 18 | HTTP/1.1 200 OK 19 | Server: cloudflare 20 | 21 | [["funding","USD",100.1234,0,null],["funding","XMR",100.4321,0,null]]----- 22 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/03-System/01-IO/test-cr.txt: -------------------------------------------------------------------------------- 1 | HTTP/1.1 200 OK 2 | Server: cloudflare 3 | 4 | [["funding","USD",100.1234,0,null],["funding","XMR",100.4321,0,null]] -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/03-System/01-IO/test-nonewline.txt: -------------------------------------------------------------------------------- 1 | here is 2 | a file for 3 | 4 | the test program 5 | but with no newline on the end 6 | 7 | of the file -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/03-System/01-IO/test-simple.txt: -------------------------------------------------------------------------------- 1 | here is 2 | a file for 3 | the test program 4 | 5 | to read 6 | 7 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/03-System/02-Reflect/Color.ds: -------------------------------------------------------------------------------- 1 | 2 | module Color where 3 | 4 | data Color where 5 | Red : Color 6 | Green : Color 7 | Blue : Color 8 | Light : Color -> Color 9 | Dark : Color -> Color 10 | Blend : Color -> Color -> Color 11 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/03-System/02-Reflect/Main.stdout.check: -------------------------------------------------------------------------------- 1 | Unit: () 2 | True: True 3 | False: False 4 | Nat: 5 5 | Int: -5 6 | Word8: 42'w8 7 | Word16: 42'w16 8 | Word32: 42'w32 9 | Word64: 42'w64 10 | Float32: 321.122986'f32 11 | Float64: 123.456'f64 12 | Addr: 0x4d2'a 13 | Text Lit: "foo" 14 | Text Vec: "bar" 15 | Text App: "foo bar" 16 | X: Main.XOne 17 | X: (Main.XWrap Main.XOne) 18 | X: (Main.XWrap (Main.XUnit ())) 19 | List: (Data.List.Cons 2 (Data.List.Cons 3 (Data.List.Cons 4 Data.List.Nil))) 20 | Thunk: DDC.printr 21 | Thunk: (DDC.mainZdllZdlLZdl0 5) 22 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/03-System/03-Info/Main.stdout.check: -------------------------------------------------------------------------------- 1 | moduleName = Some.Module1 2 | ctorName = CtorNameBaz 3 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/04-Control/01-Exception/01-Error/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import System.IO.Console 4 | import Control.Exception 5 | where 6 | 7 | main () 8 | = error "so sorry" 9 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/04-Control/01-Exception/01-Error/Main.stdout.check: -------------------------------------------------------------------------------- 1 | *** Error: so sorry 2 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/04-Control/01-Exception/02-TryCatch/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import Data.Text 4 | import Control.Exception 5 | import System.IO.Console 6 | where 7 | 8 | -- Throw an exception and handle it with a custom handler. 9 | main () 10 | = try (box error "not likely") 11 | $ \ex -> case ex of 12 | ExceptionError msg 13 | -> writel $ "failed as " % msg 14 | _ -> writel $ "failed for some other reason" 15 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/04-Control/01-Exception/02-TryCatch/Main.stdout.check: -------------------------------------------------------------------------------- 1 | failed as not likely 2 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/04-Control/01-Exception/03-TryNested/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import Control.Exception 4 | import System.IO.Console 5 | where 6 | 7 | -- Test nested exception handlers. 8 | -- All but level3 re-throws, so the handlers 3, 4, and 5 should be executed. 9 | main () 10 | = level1 (level2 (level3 (level4 (level5 (box error "inside"))))) 11 | 12 | level1 thing 13 | = try thing $ \ex 14 | -> do writel "handler level 1" 15 | throw ex 16 | 17 | level2 thing 18 | = try thing $ \ex 19 | -> do writel "handler level 2" 20 | throw ex 21 | 22 | level3 thing 23 | = try thing $ \ex 24 | -> do writel "handler level 3" 25 | -- doesn't throw. 26 | 27 | level4 thing 28 | = try thing $ \ex 29 | -> do writel "handler level 4" 30 | throw ex 31 | 32 | level5 thing 33 | = try thing $ \ex 34 | -> do writel "handler level 5" 35 | throw ex 36 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/04-Control/01-Exception/03-TryNested/Main.stdout.check: -------------------------------------------------------------------------------- 1 | handler level 5 2 | handler level 4 3 | handler level 3 4 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/04-Control/01-Exception/04-HandlerThrows/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import Control.Exception 4 | import System.IO.Console 5 | where 6 | 7 | -- Test exception handler throwing an exception. 8 | main () 9 | = try (box error "not likely") 10 | $ \ex -> case ex of 11 | ExceptionError msg 12 | -> error "it's still broken" 13 | _ -> writel $ "failed for some other reason" 14 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/04-Control/01-Exception/04-HandlerThrows/Main.stdout.check: -------------------------------------------------------------------------------- 1 | *** Error: it's still broken 2 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/05-Debug/01-Trace/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import System.IO.Console 4 | import Class.Show 5 | import Data.List 6 | 7 | import Debug.Trace 8 | where 9 | 10 | 11 | -- Test tracing of concrete values. 12 | fac : Nat -> Nat 13 | fac 0 = 1 14 | fac x = x * trace (fac (x - 1)) 15 | 16 | 17 | -- Test tracing of abstract values. 18 | -- The implementation of 'trace' shows the abstract 'a' values 19 | -- using generic reification. 20 | length' : {@a: Data} -> List a -> Nat 21 | length' Nil = 0 22 | length' (Cons x xs) = trace (1 + length' (trace xs)) 23 | 24 | 25 | main () 26 | = do printl $ fac 10 27 | printl $ length' (Cons "a" (Cons "b" (Cons "c" Nil))) 28 | 29 | -------------------------------------------------------------------------------- /test/ddc-regress/source/02-base/05-Debug/01-Trace/Main.stdout.check: -------------------------------------------------------------------------------- 1 | * trace: 1 2 | * trace: 1 3 | * trace: 2 4 | * trace: 6 5 | * trace: 24 6 | * trace: 120 7 | * trace: 720 8 | * trace: 5040 9 | * trace: 40320 10 | * trace: 362880 11 | 3628800 12 | * trace: (Data.List.Cons "b" (Data.List.Cons "c" Data.List.Nil)) 13 | * trace: (Data.List.Cons "c" Data.List.Nil) 14 | * trace: Data.List.Nil 15 | * trace: 1 16 | * trace: 2 17 | * trace: 3 18 | 3 19 | -------------------------------------------------------------------------------- /test/ddc-spec/Readme.md: -------------------------------------------------------------------------------- 1 | 2 | DDC Specification Tests 3 | ======================= 4 | 5 | The tests in this directory aim to systematically exercise every feature described in the language specification. The tests are organized in the same order as the features are described in the specification, so that it's easy to verify that we've got them all. These tests should be written so that someone new to the language can scan through to understand how the syntax and features work. We focus on explanation of features rather than making sure we've covered every edge case. 6 | 7 | Regression tests do not go here. Regression tests are more of a mixed bag of things that want to check to ensure that bugs do not get reintroduced. For regression tests the focus is more on coverage than explanation. 8 | 9 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/01-ExportUndefined/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | -- ISSUE #408: No source locations for import and export errors. 3 | module Test 4 | export foo 5 | where 6 | 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/01-ExportUndefined/Test.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | Exported name 'foo' is undefined. 5 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/02-ExportDuplicate/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | -- ISSUE #408: No source locations for import and export errors. 3 | module Test 4 | export foo 5 | export foo 6 | where 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/02-ExportDuplicate/Test.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | Duplicate exported name 'foo'. 5 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/03-ExportMismatch/Main.dcs: -------------------------------------------------------------------------------- 1 | 2 | -- ISSUE #408: No source locations for import and export errors. 3 | 4 | -- Ye'olde Hello World programme, 5 | module Main 6 | 7 | -- Export the main entry point. 8 | -- Exported type does not match defined type. 9 | export Main.main : [r1: Region]. Int# 10 | 11 | -- Primitive show functions are defined in the runtime system. 12 | import foreign c value 13 | ddcInit : Nat# -> Unit 14 | ddcPrimStdoutPutTextLit : TextLit# -> Void# 15 | 16 | with letrec 17 | 18 | -- Ye'olde Hello World programme. 19 | main [r1: Region] (argc: Nat#) (argv: Ptr# r1 Word8#): Int# 20 | = do 21 | -- Initialize the runtime system. 22 | ddcInit 4096# 23 | 24 | -- Print the greeting. 25 | ddcPrimStdoutPutTextLit "Hello World\n"# 26 | 27 | -- Return successfully. 28 | 0i# -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/03-ExportMismatch/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage CoreLoad 3 | in pipe PipeCoreCheck/Check 4 | Type of exported name does not match type of definition. 5 | with binding: main 6 | type of export: [r1: Region].Int# 7 | type of definition: [r1: Region].Nat# -> Ptr# r1 Word8# -> Int# 8 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/04-ImportDuplicate/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | -- ISSUE #408: No source locations for import and export errors. 3 | module Test 4 | 5 | import foreign c value 6 | foo : Nat# -> Nat# 7 | 8 | import foreign c value 9 | foo : Word32# -> Nat# 10 | 11 | where 12 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/04-ImportDuplicate/Test.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | Duplicate imported name 'foo'. 5 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/05-ImportCapNotEffect/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | -- ISSUE #408: No source locations for import and export errors. 3 | module Test 4 | 5 | import foreign c value 6 | derp : Read 7 | 8 | where 9 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/05-ImportCapNotEffect/Test.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | Kind mismatch. 5 | Expected kind: Data 6 | does not match inferred kind: Region -> Effect 7 | 8 | with: Read 9 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/06-ImportCapNotData/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | -- ISSUE #408: No source locations for import and export errors. 3 | module Test 4 | 5 | import foreign abstract capability 6 | derp : Nat# 7 | 8 | where 9 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/06-ImportCapNotData/Test.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | Kind mismatch. 5 | Expected kind: Effect 6 | does not match inferred kind: Data 7 | 8 | with: Nat# 9 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/07-UndefinedVar/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | module Test where 3 | 4 | f x = y 5 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/07-UndefinedVar/Test.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/07-UndefinedVar/Test.ds:4:1 5 | Undefined value variable: y 6 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/08-UndefinedCtor/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | module Test where 3 | 4 | foo = Bar 5 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/08-UndefinedCtor/Test.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/08-UndefinedCtor/Test.ds:4:1 5 | Undefined data constructor: Bar 6 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/10-AppNotFun/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | module Test 3 | where 4 | 5 | f: Nat# 6 | = 5 7 | 8 | g = f 5 9 | 10 | 11 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/10-AppNotFun/Test.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/10-AppNotFun/Test.ds:8:1 5 | Cannot apply non-function 6 | of type: Nat# 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/11-AppCannotInferPoly/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | module Test where 3 | 4 | -- Cannot infer polymorphic type of 'g'. 5 | f g x = g {@Nat} x -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/11-AppCannotInferPoly/Test.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/11-AppCannotInferPoly/Test.ds:5:1 5 | Cannot infer the type of a polymorphic expression. 6 | Please supply type annotations to constrain the functional 7 | part to have a quantified type. 8 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/12-AbsShadow/Main.dct: -------------------------------------------------------------------------------- 1 | 2 | -- Check detection of shadowed type variables. 3 | -- We need to do this in Core as when compiling Source the binders 4 | -- are automatically freshened. 5 | module Test with letrec 6 | 7 | f = Λ(a: Data). Λ(a: Data). 5# 8 | 9 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/12-AbsShadow/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage CoreLoad 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/12-AbsShadow/Main.dct:7:17 5 | Cannot shadow variable. 6 | binder: a: Data 7 | is already in the environment. 8 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/13-AbsParamUnannotated/Test.dct: -------------------------------------------------------------------------------- 1 | 2 | -- Function abstraction without a type annotation. 3 | -- In recon mode they all need to be annoated. 4 | module Test with letrec 5 | 6 | f: Nat# -> Nat# = λx. x 7 | 8 | 9 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/14-AbsNotPure/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | module Test 3 | import System.IO.Console 4 | where 5 | 6 | f {@a: Data} = run writel "derp" 7 | 8 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/14-AbsNotPure/Test.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/14-AbsNotPure/Test.ds:6:1 5 | Impure Spec abstraction 6 | has effect: Console 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/15-AbsBindBadKind/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | module Test where 3 | 4 | f {@r: Region} (x: Read r) = 4 5 | 6 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/15-AbsBindBadKind/Test.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/15-AbsBindBadKind/Test.ds:4:1 5 | Function parameter has invalid kind. 6 | The function parameter: Read r 7 | has kind: Effect 8 | but it must be: Data or Witness 9 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/20-RecRebound/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | module Test where 3 | 4 | f 5 | = rec x = 5 6 | y = 6 7 | x = 7 8 | in x 9 | 10 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/20-RecRebound/Test.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/20-RecRebound/Test.ds:4:1 5 | Redefined binder 'x: ?' in letrec. 6 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/21-RecMissingAnnot/Main.dcs: -------------------------------------------------------------------------------- 1 | 2 | -- Letrecs must have annotations when checking in Recon mode. 3 | -- ISSUE #388 No source locations when compliance checker fails. 4 | module Test with letrec 5 | 6 | f x = x 7 | 8 | 9 | 10 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/21-RecMissingAnnot/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage CoreLoad 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/21-RecMissingAnnot/Main.dcs:4:18 5 | Ambigous type 6 | 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/22-RecNotLambda/Main.dcs: -------------------------------------------------------------------------------- 1 | 2 | module Main with letrec 3 | 4 | f = 5# -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/22-RecNotLambda/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage CoreLoad 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/22-RecNotLambda/Main.dcs:2:18 5 | Letrec can only bind lambda abstractions. 6 | This is not one: 5# 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/23-PrivateNotRegion/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | 3 | module Test where 4 | 5 | -- NOTE: We also have a ErrorLetRegionsNotRegion message, 6 | -- but the concrete grammar doesn't provide any way to exercise it. 7 | 8 | -- ISSUE #409: No source locations for kind mismatch errors. 9 | -- 10 | foo {@a: Data} () 11 | = extend a using r in () 12 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/23-PrivateNotRegion/Test.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | Kind mismatch. 5 | Expected kind: Region 6 | does not match inferred kind: Data 7 | 8 | with: a 9 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/24-PrivateRebound/Main.dcs: -------------------------------------------------------------------------------- 1 | 2 | module Test with letrec 3 | 4 | foo [r: Region] (x: Unit) 5 | = private r in () 6 | 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/24-PrivateRebound/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage CoreLoad 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/24-PrivateRebound/Main.dcs:5:4 5 | Region variables shadow existing ones. 6 | Region variables: r: Region 7 | are already in environment 8 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/25-PrivateEscape/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main 3 | import Data.Ref 4 | where 5 | 6 | 7 | foo = private r in allocRef {@r} 5 8 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/25-PrivateEscape/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/25-PrivateEscape/Main.ds:7:1 5 | Region variables escape scope of private. 6 | The region variables: r: Region 7 | is free in the body type: S (Alloc r) (Ref r Nat#) 8 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/26-PrivateWitnessInvalid/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | foo = private r with {Nat#} in () 5 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/26-PrivateWitnessInvalid/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/26-PrivateWitnessInvalid/Main.ds:4:1 5 | Invalid witness type with private. 6 | The witness: x$Sx100: Nat# 7 | cannot be created with a private 8 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/27-PrivateWitnessConflict/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | -- In an older version of the language we use 'Mutable' and 'Const' 5 | -- witnesses instead of 'Read' and 'Write' capabilities. 6 | -- The type checker support is still present. 7 | foo = private r with {Mutable r; Const r} in () 8 | 9 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/27-PrivateWitnessConflict/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/27-PrivateWitnessConflict/Main.ds:7:1 5 | Conflicting witness types with private. 6 | Witness binding: x$Sx100: Mutable r 7 | conflicts with: x$Sx101: Const r 8 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/28-PrivateWitnessOther/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | foo {@r1: Region} () 5 | = private r2 with {Write r1} in () 6 | 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/28-PrivateWitnessOther/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/28-PrivateWitnessOther/Main.ds:4:1 5 | Witness type is not for bound regions. 6 | private binds: r2 7 | but witness type is: x$Sx100: Write r1 8 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/40-CaseNotAlgebraic/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | module Test 3 | 4 | import foreign abstract type 5 | Foo : Data 6 | 7 | where 8 | 9 | -- ISSUE #410: Check for case on foreign abstract data. 10 | f (x: Foo) 11 | = case x of 12 | y -> 5 13 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/40-CaseNotAlgebraic/Test.error.check: -------------------------------------------------------------------------------- 1 | Fragment violation when converting Discus module to Salt module. 2 | Module is malformed. 3 | Invalid type constructor application Foo 4 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/41-CaseNoAlternatives/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | foo = case 4 of {} 5 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/41-CaseNoAlternatives/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/41-CaseNoAlternatives/Main.ds:4:1 5 | Case expression does not have any alternatives. 6 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/42-CaseNonExhaustive/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | data Foo where 5 | Bar : Foo 6 | Baz : Foo 7 | 8 | foo (x: Foo) 9 | = case x of 10 | Bar -> 5 11 | 12 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/42-CaseNonExhaustive/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/42-CaseNonExhaustive/Main.ds:8:1 5 | Case alternatives are non-exhaustive. 6 | Constructors not matched: Baz 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/43-CaseNonExhaustiveLarge/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | foo (x: Nat#) 5 | = case x of 6 | 0 -> True 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/43-CaseNonExhaustiveLarge/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/43-CaseNonExhaustiveLarge/Main.ds:4:1 5 | Case alternatives are non-exhaustive. 6 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/44-CaseOverlapping/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | foo (x: Nat#) 5 | = case x of 6 | 0 -> True 7 | 0 -> False 8 | _ -> False 9 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/44-CaseOverlapping/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/44-CaseOverlapping/Main.ds:4:1 5 | Case alternatives are overlapping. 6 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/45-CaseTooManyBinders/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | data Foo where 5 | Foo : Nat# -> Foo 6 | 7 | 8 | foo (x: Foo) 9 | = case foo of 10 | Foo x y -> x + y 11 | 12 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/45-CaseTooManyBinders/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/45-CaseTooManyBinders/Main.ds:8:1 5 | Pattern has more binders than there are fields in the constructor. 6 | Contructor: Foo 7 | has: 1 fields 8 | but there are: 2 binders in the pattern 9 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/46-CaseFieldTypeMismatch/Main.dct: -------------------------------------------------------------------------------- 1 | 2 | -- ISSUE #411: Allow types of pattern binders to be specified in source language. 3 | module Main 4 | 5 | data Foo where 6 | Foo : Nat# -> Foo 7 | 8 | with letrec 9 | 10 | foo (x: Foo): Bool# 11 | = case x of 12 | Foo (x: Bool#) -> True 13 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/46-CaseFieldTypeMismatch/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage CoreLoad 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/46-CaseFieldTypeMismatch/Main.dct:11:4 5 | Annotation on pattern variable does not match type of field. 6 | Annotation type: Bool# 7 | Field type: Nat# 8 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/50-RunNotSusp/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | foo (x: Nat#) 5 | = run x 6 | 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/50-RunNotSusp/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/50-RunNotSusp/Main.ds:4:1 5 | Expression to run is not a suspension. 6 | Type: Nat# 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/51-RunNotSupported/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | foo 5 | = private r with {Read r} in 6 | do let f () = box (weakeff Write r in ()) 7 | run f () 8 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/51-RunNotSupported/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/51-RunNotSupported/Main.ds:4:1 5 | Effect of computation not supported by context. 6 | Effect: Write r 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/52-RunCannotInfer/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | foo x = run x 5 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/52-RunCannotInfer/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/52-RunCannotInfer/Main.ds:4:1 5 | Cannot infer type of suspended computation. 6 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/53-ProjectCannot/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | main () 5 | = ().derp 6 | 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/53-ProjectCannot/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/53-ProjectCannot/Main.ds:4:1 5 | Cannot project field 'derp' 6 | from value of type: Unit 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/54-ProjectNoField/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | main () 5 | = [x = 5].y 6 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/54-ProjectNoField/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/54-ProjectNoField/Main.ds:4:1 5 | Field 'y' is not in record 6 | of type: R# {x: Nat#} 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/55-ProjectTooManyCtors/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | main () = (5).derp 5 | 6 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/55-ProjectTooManyCtors/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/55-ProjectTooManyCtors/Main.ds:4:1 5 | Field 'derp' cannot be extracted automatically 6 | as the data type has too many constructors. 7 | type is: Nat# 8 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/56-ProjectTooManyArgs/Main.ds: -------------------------------------------------------------------------------- 1 | 2 | module Main where 3 | 4 | data Foo = Foo Int [x: Int, y: Text] 5 | 6 | foo (f: Foo) = f.x 7 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/56-ProjectTooManyArgs/Main.error.check: -------------------------------------------------------------------------------- 1 | Error in transformed module. 2 | in stage SourceLoadText 3 | in pipe PipeCoreCheck/Check 4 | test/ddc-spec/error/01-ErrorExp/56-ProjectTooManyArgs/Main.ds:6:1 5 | Field 'x' cannot be extracted automatically 6 | as the data constructor has too many arguments. 7 | type is: Foo 8 | -------------------------------------------------------------------------------- /test/ddc-spec/error/01-ErrorExp/Readme.md: -------------------------------------------------------------------------------- 1 | 2 | DDC Error Message Tests 3 | ======================= 4 | 5 | The tests in this directory systematically cause each reportable type error message to be reported. We want to check that information such as the source locations is not lost during development. The possible error messages are defined in DDC.Core.Check.Error.ErrorExp. 6 | 7 | The tests here do not try to check for every possible problem that can *result* in an error message being reported, as a specific message can be generated at multiple points in the type checker implementation. 8 | 9 | 10 | -------------------------------------------------------------------------------- /test/ddc-spec/source/01-Tetra/01-Syntax/01-Module/01-Export/01-Simple/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | -- Demonstrate single export clause in module header. 3 | module Test 4 | export foo 5 | where 6 | 7 | foo = 5 8 | 9 | -------------------------------------------------------------------------------- /test/ddc-spec/source/01-Tetra/01-Syntax/01-Module/01-Export/02-Multiple/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | -- Demonstrate multiple module export clauses in module header. 3 | module Test 4 | export foo 5 | export bar 6 | export baz 7 | where 8 | 9 | foo = 2 10 | bar = 3 11 | baz = 4 -------------------------------------------------------------------------------- /test/ddc-spec/source/01-Tetra/01-Syntax/01-Module/01-Export/03-Many/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | -- Demonstrate multiple export clauses with multiple binding names 3 | -- in module header. 4 | module Test 5 | export { foo; bar } 6 | export baz 7 | where 8 | 9 | foo = 2 10 | bar = 3 11 | baz = 4 -------------------------------------------------------------------------------- /test/ddc-spec/source/01-Tetra/01-Syntax/01-Module/02-Import/01-Simple/ImportMe.ds: -------------------------------------------------------------------------------- 1 | 2 | module ImportMe 3 | export foo 4 | where 5 | 6 | foo = 5 7 | -------------------------------------------------------------------------------- /test/ddc-spec/source/01-Tetra/01-Syntax/01-Module/02-Import/01-Simple/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | -- Demonstrate importing a module and re-exporting one of the values. 3 | module Test 4 | export bar 5 | import ImportMe 6 | where 7 | 8 | bar = foo 9 | -------------------------------------------------------------------------------- /test/ddc-spec/source/01-Tetra/01-Syntax/01-Module/02-Import/02-Multiple/Test.ds: -------------------------------------------------------------------------------- 1 | 2 | -- Demonstrate importing multiple modules from the base library and using them 3 | -- to define new values. We also demonstrate that the braced list syntax can be 4 | -- used in both the export and import lists. 5 | module Test 6 | export 7 | { foo; 8 | bar; 9 | } 10 | export baz; 11 | import 12 | { Data.Numeric.Nat; 13 | Data.Numeric.Bool; 14 | Class.Numeric 15 | } 16 | where 17 | 18 | foo = 1 + 2 19 | bar = True ∨ False 20 | baz = True ∧ False 21 | -------------------------------------------------------------------------------- /test/ddc-spec/source/01-Tetra/01-Syntax/01-Module/02-Import/03-Foreign/Main.stdout.check: -------------------------------------------------------------------------------- 1 | hello 2 | before 3 | after 4 | -------------------------------------------------------------------------------- /test/ddc-spec/source/01-Tetra/01-Syntax/02-Decl/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 11 2 | 20 3 | 6 4 | 10 5 | 20 6 | 3 7 | -------------------------------------------------------------------------------- /test/ddc-spec/source/01-Tetra/01-Syntax/04-Guards/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 5 2 | 5 3 | 5 4 | 5 5 | -------------------------------------------------------------------------------- /test/ddc-spec/source/01-Tetra/01-Syntax/06-Abs/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 20 2 | 20 3 | 20 4 | 5 5 | 11 6 | 11 7 | 3 8 | 3 9 | 3 10 | -------------------------------------------------------------------------------- /test/ddc-spec/source/01-Tetra/01-Syntax/07-Binding/Main.stdout.check: -------------------------------------------------------------------------------- 1 | 5 2 | 5 3 | 5 4 | 6 5 | 0 6 | 0 7 | derp 8 | 11 9 | (Just 13) 10 | Nothing 11 | red 12 | green 13 | blue 14 | (Just 0) 15 | hello 16 | 11 17 | 15 18 | -------------------------------------------------------------------------------- /test/smr-regress/02-Combinate/Main.smr: -------------------------------------------------------------------------------- 1 | 2 | 3 | -- Harness -------------------------------------------------------------------- 4 | @test !tag ~xRun ~xExpected ~testNext 5 | = ##seq (##run (#smr-eval-no xRun)) $ \!xResult 6 | . #if (#smr-equal xResult xExpected) 7 | testNext 8 | (%fail tag xResult xExpected); 9 | 10 | @combinate 11 | = #smr-combinate-ski #S #K #I #B #C #Sp #Bs #Cp; 12 | 13 | 14 | -- Tests ---------------------------------------------------------------------- 15 | 16 | @main 17 | = @test %combinate-twice 18 | (@combinate $ ##box (\f x. f (f x))) 19 | (#S #B #I) 20 | 21 | $ @test %combinate-thrice 22 | (@combinate $ ##box (\f x. f (f (f x)))) 23 | (#S (#S #Bs #I) #I) 24 | 25 | $ @test %combinate-y 26 | (@combinate $ ##box (\f. (\x. f (x x)) (\x. f (x x)))) 27 | (#S (#C #B $ #S #I #I) $ #C #B $ #S #I #I) 28 | 29 | $ %success; 30 | 31 | -------------------------------------------------------------------------------- /test/unit/1-CoreLLVM/Main.stdout.check: -------------------------------------------------------------------------------- 1 | === prop_trans_closure_correct on test/unit/1-CoreLLVM/war-std/Main.hs:42 === 2 | +++ OK, passed 100 tests. 3 | === prop_alias_safety on test/unit/1-CoreLLVM/war-std/Main.hs:56 === 4 | +++ OK, passed 100 tests. 5 | --------------------------------------------------------------------------------