├── .envrc
├── .github
└── workflows
│ ├── lint-haskell.yml
│ └── wasm-calc-haskell.yml
├── .gitignore
├── Makefile
├── README.md
├── cabal.project
├── cabal.project.freeze
├── flake.lock
├── flake.nix
├── malloc.wasm
├── renovate.json
├── swagger.config.json
├── wasm-calc1
├── .gitignore
├── CHANGELOG.md
├── app
│ └── Main.hs
├── src
│ ├── Calc.hs
│ └── Calc
│ │ ├── ExprUtils.hs
│ │ ├── Interpreter.hs
│ │ ├── Parser.hs
│ │ ├── Parser
│ │ ├── Expr.hs
│ │ ├── Primitives.hs
│ │ ├── Shared.hs
│ │ └── Types.hs
│ │ ├── Repl.hs
│ │ ├── Types.hs
│ │ ├── Types
│ │ ├── Annotation.hs
│ │ ├── Expr.hs
│ │ └── Prim.hs
│ │ └── Wasm
│ │ ├── FromExpr.hs
│ │ ├── Run.hs
│ │ └── Types.hs
├── test
│ ├── Main.hs
│ └── Test
│ │ ├── Interpreter
│ │ └── InterpreterSpec.hs
│ │ ├── Parser
│ │ └── ParserSpec.hs
│ │ └── Wasm
│ │ └── WasmSpec.hs
└── wasm-calc1.cabal
├── wasm-calc10
├── .gitignore
├── CHANGELOG.md
├── app
│ └── Main.hs
├── src
│ ├── Calc.hs
│ └── Calc
│ │ ├── Ability
│ │ ├── Check.hs
│ │ └── Error.hs
│ │ ├── Build.hs
│ │ ├── Dependencies.hs
│ │ ├── ExprUtils.hs
│ │ ├── Linearity.hs
│ │ ├── Linearity
│ │ ├── Decorate.hs
│ │ ├── Error.hs
│ │ ├── Types.hs
│ │ └── Validate.hs
│ │ ├── Module.hs
│ │ ├── Parser.hs
│ │ ├── Parser
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── Identifier.hs
│ │ ├── Import.hs
│ │ ├── Module.hs
│ │ ├── Pattern.hs
│ │ ├── Primitives.hs
│ │ ├── Shared.hs
│ │ ├── Type.hs
│ │ └── Types.hs
│ │ ├── PrettyPrint.hs
│ │ ├── Repl.hs
│ │ ├── SourceSpan.hs
│ │ ├── Test.hs
│ │ ├── TypeUtils.hs
│ │ ├── Typecheck.hs
│ │ ├── Typecheck
│ │ ├── Elaborate.hs
│ │ ├── Error.hs
│ │ ├── Error
│ │ │ ├── PatternMatchError.hs
│ │ │ └── TypeError.hs
│ │ ├── Generalise.hs
│ │ ├── Helpers.hs
│ │ ├── Infer.hs
│ │ ├── Patterns.hs
│ │ ├── Patterns
│ │ │ ├── Annihilate.hs
│ │ │ ├── Generate.hs
│ │ │ └── Validate.hs
│ │ ├── Substitute.hs
│ │ ├── Types.hs
│ │ └── Unify.hs
│ │ ├── Types.hs
│ │ ├── Types
│ │ ├── Ability.hs
│ │ ├── Annotation.hs
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── FunctionName.hs
│ │ ├── Global.hs
│ │ ├── Identifier.hs
│ │ ├── Import.hs
│ │ ├── Memory.hs
│ │ ├── Module.hs
│ │ ├── ModuleAnnotations.hs
│ │ ├── Op.hs
│ │ ├── Pattern.hs
│ │ ├── Prim.hs
│ │ ├── Test.hs
│ │ ├── Type.hs
│ │ └── TypeVar.hs
│ │ ├── Utils.hs
│ │ ├── Wasm.hs
│ │ └── Wasm
│ │ ├── Allocator.hs
│ │ ├── FromExpr.hs
│ │ ├── FromExpr
│ │ ├── Drops.hs
│ │ ├── Expr.hs
│ │ ├── Helpers.hs
│ │ ├── Module.hs
│ │ ├── Patterns.hs
│ │ ├── Patterns
│ │ │ ├── Paths.hs
│ │ │ └── Predicates.hs
│ │ └── Types.hs
│ │ ├── Run.hs
│ │ ├── ToWasm.hs
│ │ ├── ToWasm
│ │ ├── Expr.hs
│ │ ├── Helpers.hs
│ │ ├── Module.hs
│ │ └── Types.hs
│ │ └── WriteModule.hs
├── static
│ ├── .gitignore
│ ├── malloc.calc
│ └── malloc.wasm
├── test
│ ├── Main.hs
│ ├── Test
│ │ ├── Ability
│ │ │ └── AbilitySpec.hs
│ │ ├── Helpers.hs
│ │ ├── Linearity
│ │ │ └── LinearitySpec.hs
│ │ ├── Parser
│ │ │ └── ParserSpec.hs
│ │ ├── PrettyPrint
│ │ │ └── PrettyPrintSpec.hs
│ │ ├── RunNode.hs
│ │ ├── Typecheck
│ │ │ ├── PatternsSpec.hs
│ │ │ └── TypecheckSpec.hs
│ │ └── Wasm
│ │ │ ├── FromWasmSpec.hs
│ │ │ └── WasmSpec.hs
│ ├── js
│ │ └── test.mjs
│ └── static
│ │ ├── bigfunction.calc
│ │ ├── drawing.calc
│ │ └── noalloc.calc
└── wasm-calc10.cabal
├── wasm-calc11
├── .gitignore
├── CHANGELOG.md
├── app
│ └── Main.hs
├── demo
│ ├── .gitignore
│ ├── README.md
│ ├── draw.calc
│ └── draw.html
├── src
│ ├── Calc.hs
│ └── Calc
│ │ ├── Ability
│ │ ├── Check.hs
│ │ └── Error.hs
│ │ ├── Build.hs
│ │ ├── Build
│ │ ├── Format.hs
│ │ ├── Print.hs
│ │ └── Steps.hs
│ │ ├── Dependencies.hs
│ │ ├── ExprUtils.hs
│ │ ├── Linearity.hs
│ │ ├── Linearity
│ │ ├── Decorate.hs
│ │ ├── Error.hs
│ │ ├── Types.hs
│ │ └── Validate.hs
│ │ ├── Module.hs
│ │ ├── Parser.hs
│ │ ├── Parser
│ │ ├── Data.hs
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── Identifier.hs
│ │ ├── Import.hs
│ │ ├── Module.hs
│ │ ├── Pattern.hs
│ │ ├── Primitives.hs
│ │ ├── Shared.hs
│ │ ├── Type.hs
│ │ └── Types.hs
│ │ ├── PrettyPrint.hs
│ │ ├── Repl.hs
│ │ ├── SourceSpan.hs
│ │ ├── Test.hs
│ │ ├── TypeUtils.hs
│ │ ├── Typecheck.hs
│ │ ├── Typecheck
│ │ ├── Elaborate.hs
│ │ ├── Error.hs
│ │ ├── Error
│ │ │ ├── PatternMatchError.hs
│ │ │ └── TypeError.hs
│ │ ├── Generalise.hs
│ │ ├── Helpers.hs
│ │ ├── Infer.hs
│ │ ├── Patterns.hs
│ │ ├── Patterns
│ │ │ ├── Annihilate.hs
│ │ │ ├── Generate.hs
│ │ │ └── Validate.hs
│ │ ├── Substitute.hs
│ │ ├── Types.hs
│ │ └── Unify.hs
│ │ ├── Types.hs
│ │ ├── Types
│ │ ├── Ability.hs
│ │ ├── Annotation.hs
│ │ ├── Constructor.hs
│ │ ├── Data.hs
│ │ ├── DataName.hs
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── FunctionName.hs
│ │ ├── Global.hs
│ │ ├── Identifier.hs
│ │ ├── Import.hs
│ │ ├── Memory.hs
│ │ ├── Module.hs
│ │ ├── ModuleAnnotations.hs
│ │ ├── Op.hs
│ │ ├── Pattern.hs
│ │ ├── Prim.hs
│ │ ├── Test.hs
│ │ ├── Type.hs
│ │ └── TypeVar.hs
│ │ ├── Utils.hs
│ │ ├── Wasm.hs
│ │ └── Wasm
│ │ ├── Allocator.hs
│ │ ├── FromExpr.hs
│ │ ├── FromExpr
│ │ ├── Drops.hs
│ │ ├── Expr.hs
│ │ ├── Helpers.hs
│ │ ├── Module.hs
│ │ ├── Patterns.hs
│ │ ├── Patterns
│ │ │ ├── Paths.hs
│ │ │ └── Predicates.hs
│ │ └── Types.hs
│ │ ├── Run.hs
│ │ ├── ToWasm.hs
│ │ ├── ToWasm
│ │ ├── Expr.hs
│ │ ├── Helpers.hs
│ │ ├── Module.hs
│ │ └── Types.hs
│ │ └── WriteModule.hs
├── static
│ ├── .gitignore
│ ├── malloc-new.wat
│ ├── malloc-old.wasm
│ ├── malloc.calc
│ └── malloc.wasm
├── test
│ ├── Main.hs
│ ├── Test
│ │ ├── Ability
│ │ │ └── AbilitySpec.hs
│ │ ├── Helpers.hs
│ │ ├── Linearity
│ │ │ └── LinearitySpec.hs
│ │ ├── Parser
│ │ │ └── ParserSpec.hs
│ │ ├── PrettyPrint
│ │ │ └── PrettyPrintSpec.hs
│ │ ├── RunNode.hs
│ │ ├── Typecheck
│ │ │ ├── PatternsSpec.hs
│ │ │ └── TypecheckSpec.hs
│ │ └── Wasm
│ │ │ ├── FromWasmSpec.hs
│ │ │ └── WasmSpec.hs
│ ├── js
│ │ └── test.mjs
│ └── static
│ │ ├── bigfunction.calc
│ │ ├── datatypes.calc
│ │ ├── drawing.calc
│ │ ├── noalloc.calc
│ │ ├── smalltypecheck.calc
│ │ └── typecheck.calc
└── wasm-calc11.cabal
├── wasm-calc12
├── .gitignore
├── CHANGELOG.md
├── app
│ └── Main.hs
├── demo
│ ├── .gitignore
│ ├── README.md
│ ├── draw.calc
│ └── draw.html
├── src
│ ├── Calc.hs
│ └── Calc
│ │ ├── Ability
│ │ ├── Check.hs
│ │ └── Error.hs
│ │ ├── Build.hs
│ │ ├── Build
│ │ ├── Format.hs
│ │ ├── Print.hs
│ │ └── Steps.hs
│ │ ├── Dependencies.hs
│ │ ├── ExprUtils.hs
│ │ ├── Linearity.hs
│ │ ├── Linearity
│ │ ├── Decorate.hs
│ │ ├── Error.hs
│ │ ├── Helpers.hs
│ │ ├── Types.hs
│ │ └── Validate.hs
│ │ ├── Module.hs
│ │ ├── Parser.hs
│ │ ├── Parser
│ │ ├── Data.hs
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── Identifier.hs
│ │ ├── Import.hs
│ │ ├── Module.hs
│ │ ├── Pattern.hs
│ │ ├── Primitives.hs
│ │ ├── Shared.hs
│ │ ├── Type.hs
│ │ └── Types.hs
│ │ ├── PrettyPrint.hs
│ │ ├── Repl.hs
│ │ ├── SourceSpan.hs
│ │ ├── Test.hs
│ │ ├── TypeUtils.hs
│ │ ├── Typecheck.hs
│ │ ├── Typecheck
│ │ ├── Elaborate.hs
│ │ ├── Error.hs
│ │ ├── Error
│ │ │ ├── PatternMatchError.hs
│ │ │ └── TypeError.hs
│ │ ├── Generalise.hs
│ │ ├── Helpers.hs
│ │ ├── Infer.hs
│ │ ├── Patterns.hs
│ │ ├── Patterns
│ │ │ ├── Annihilate.hs
│ │ │ ├── Generate.hs
│ │ │ └── Validate.hs
│ │ ├── Substitute.hs
│ │ ├── Types.hs
│ │ └── Unify.hs
│ │ ├── Types.hs
│ │ ├── Types
│ │ ├── Ability.hs
│ │ ├── Annotation.hs
│ │ ├── Constructor.hs
│ │ ├── Data.hs
│ │ ├── DataName.hs
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── FunctionName.hs
│ │ ├── Global.hs
│ │ ├── Identifier.hs
│ │ ├── Import.hs
│ │ ├── Memory.hs
│ │ ├── Module.hs
│ │ ├── ModuleAnnotations.hs
│ │ ├── Op.hs
│ │ ├── Pattern.hs
│ │ ├── Prim.hs
│ │ ├── Test.hs
│ │ ├── Type.hs
│ │ └── TypeVar.hs
│ │ ├── Utils.hs
│ │ ├── Wasm.hs
│ │ └── Wasm
│ │ ├── Allocator.hs
│ │ ├── FromExpr.hs
│ │ ├── FromExpr
│ │ ├── Drops.hs
│ │ ├── Expr.hs
│ │ ├── Helpers.hs
│ │ ├── Module.hs
│ │ ├── Patterns.hs
│ │ ├── Patterns
│ │ │ ├── Paths.hs
│ │ │ └── Predicates.hs
│ │ └── Types.hs
│ │ ├── Run.hs
│ │ ├── ToWasm.hs
│ │ ├── ToWasm
│ │ ├── Expr.hs
│ │ ├── Helpers.hs
│ │ ├── Module.hs
│ │ └── Types.hs
│ │ └── WriteModule.hs
├── static
│ ├── .gitignore
│ ├── malloc-new.wat
│ ├── malloc-old.wasm
│ ├── malloc.calc
│ └── malloc.wasm
├── test
│ ├── Main.hs
│ ├── Test
│ │ ├── Ability
│ │ │ └── AbilitySpec.hs
│ │ ├── Helpers.hs
│ │ ├── Linearity
│ │ │ └── LinearitySpec.hs
│ │ ├── Parser
│ │ │ └── ParserSpec.hs
│ │ ├── PrettyPrint
│ │ │ └── PrettyPrintSpec.hs
│ │ ├── RunNode.hs
│ │ ├── Typecheck
│ │ │ ├── PatternsSpec.hs
│ │ │ └── TypecheckSpec.hs
│ │ └── Wasm
│ │ │ ├── FromWasmSpec.hs
│ │ │ └── WasmSpec.hs
│ ├── js
│ │ └── test.mjs
│ └── static
│ │ ├── bigfunction.calc
│ │ ├── datatypes.calc
│ │ ├── drawing.calc
│ │ ├── lambda.calc
│ │ ├── lambda2.calc
│ │ ├── lambda3.calc
│ │ ├── lambda4.calc
│ │ ├── map.calc
│ │ ├── nice.calc
│ │ ├── noalloc.calc
│ │ └── smalltypecheck.calc
└── wasm-calc12.cabal
├── wasm-calc13
├── .gitignore
├── CHANGELOG.md
├── app
│ └── Main.hs
├── demo
│ ├── .gitignore
│ ├── README.md
│ ├── draw.calc
│ └── draw.html
├── src
│ ├── Calc.hs
│ └── Calc
│ │ ├── Ability
│ │ ├── Check.hs
│ │ └── Error.hs
│ │ ├── Build.hs
│ │ ├── Build
│ │ ├── Format.hs
│ │ ├── Print.hs
│ │ └── Steps.hs
│ │ ├── Dependencies.hs
│ │ ├── ExprUtils.hs
│ │ ├── Linearity.hs
│ │ ├── Linearity
│ │ ├── Decorate.hs
│ │ ├── Error.hs
│ │ ├── Helpers.hs
│ │ ├── Types.hs
│ │ └── Validate.hs
│ │ ├── Module.hs
│ │ ├── Parser.hs
│ │ ├── Parser
│ │ ├── Data.hs
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── Identifier.hs
│ │ ├── Import.hs
│ │ ├── Module.hs
│ │ ├── Pattern.hs
│ │ ├── Primitives.hs
│ │ ├── Shared.hs
│ │ ├── Type.hs
│ │ └── Types.hs
│ │ ├── PrettyPrint.hs
│ │ ├── Repl.hs
│ │ ├── SourceSpan.hs
│ │ ├── Test.hs
│ │ ├── TypeUtils.hs
│ │ ├── Typecheck.hs
│ │ ├── Typecheck
│ │ ├── Elaborate.hs
│ │ ├── Error.hs
│ │ ├── Error
│ │ │ ├── PatternMatchError.hs
│ │ │ └── TypeError.hs
│ │ ├── Generalise.hs
│ │ ├── Helpers.hs
│ │ ├── Infer.hs
│ │ ├── Patterns.hs
│ │ ├── Patterns
│ │ │ ├── Annihilate.hs
│ │ │ ├── Generate.hs
│ │ │ └── Validate.hs
│ │ ├── Substitute.hs
│ │ ├── Types.hs
│ │ └── Unify.hs
│ │ ├── Types.hs
│ │ ├── Types
│ │ ├── Ability.hs
│ │ ├── Annotation.hs
│ │ ├── Constructor.hs
│ │ ├── Data.hs
│ │ ├── DataName.hs
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── FunctionName.hs
│ │ ├── Global.hs
│ │ ├── Identifier.hs
│ │ ├── Import.hs
│ │ ├── Memory.hs
│ │ ├── Module.hs
│ │ ├── ModuleAnnotations.hs
│ │ ├── Op.hs
│ │ ├── Pattern.hs
│ │ ├── Prim.hs
│ │ ├── Test.hs
│ │ ├── Type.hs
│ │ └── TypeVar.hs
│ │ ├── Utils.hs
│ │ ├── Wasm.hs
│ │ └── Wasm
│ │ ├── Allocator.hs
│ │ ├── FromExpr.hs
│ │ ├── FromExpr
│ │ ├── Drops.hs
│ │ ├── Expr.hs
│ │ ├── Helpers.hs
│ │ ├── Module.hs
│ │ ├── Patterns.hs
│ │ ├── Patterns
│ │ │ ├── Paths.hs
│ │ │ └── Predicates.hs
│ │ └── Types.hs
│ │ ├── Run.hs
│ │ ├── ToWasm.hs
│ │ ├── ToWasm
│ │ ├── Expr.hs
│ │ ├── Helpers.hs
│ │ ├── Module.hs
│ │ └── Types.hs
│ │ └── WriteModule.hs
├── static
│ ├── .gitignore
│ ├── malloc-new.wat
│ ├── malloc-old.wasm
│ ├── malloc.calc
│ └── malloc.wasm
├── test
│ ├── Main.hs
│ ├── Test
│ │ ├── Ability
│ │ │ └── AbilitySpec.hs
│ │ ├── Helpers.hs
│ │ ├── Linearity
│ │ │ └── LinearitySpec.hs
│ │ ├── Parser
│ │ │ └── ParserSpec.hs
│ │ ├── PrettyPrint
│ │ │ └── PrettyPrintSpec.hs
│ │ ├── RunNode.hs
│ │ ├── Typecheck
│ │ │ ├── PatternsSpec.hs
│ │ │ └── TypecheckSpec.hs
│ │ └── Wasm
│ │ │ ├── FromWasmSpec.hs
│ │ │ └── WasmSpec.hs
│ ├── js
│ │ └── test.mjs
│ └── static
│ │ ├── bigfunction.calc
│ │ ├── datatypes.calc
│ │ ├── drawing.calc
│ │ ├── lambda.calc
│ │ ├── lambda2.calc
│ │ ├── lambda3.calc
│ │ ├── lambda4.calc
│ │ ├── map.calc
│ │ ├── nice.calc
│ │ ├── noalloc.calc
│ │ └── smalltypecheck.calc
└── wasm-calc13.cabal
├── wasm-calc2
├── .gitignore
├── CHANGELOG.md
├── app
│ └── Main.hs
├── src
│ ├── Calc.hs
│ └── Calc
│ │ ├── ExprUtils.hs
│ │ ├── Interpreter.hs
│ │ ├── Parser.hs
│ │ ├── Parser
│ │ ├── Expr.hs
│ │ ├── Primitives.hs
│ │ ├── Shared.hs
│ │ ├── Type.hs
│ │ └── Types.hs
│ │ ├── Repl.hs
│ │ ├── SourceSpan.hs
│ │ ├── TypeUtils.hs
│ │ ├── Typecheck
│ │ ├── Elaborate.hs
│ │ └── Error.hs
│ │ ├── Types.hs
│ │ ├── Types
│ │ ├── Annotation.hs
│ │ ├── Expr.hs
│ │ ├── Prim.hs
│ │ └── Type.hs
│ │ └── Wasm
│ │ ├── FromExpr.hs
│ │ ├── Run.hs
│ │ └── Types.hs
├── test
│ ├── Main.hs
│ └── Test
│ │ ├── Interpreter
│ │ └── InterpreterSpec.hs
│ │ ├── Parser
│ │ └── ParserSpec.hs
│ │ ├── Typecheck
│ │ └── TypecheckSpec.hs
│ │ └── Wasm
│ │ └── WasmSpec.hs
└── wasm-calc2.cabal
├── wasm-calc3
├── .gitignore
├── CHANGELOG.md
├── app
│ └── Main.hs
├── src
│ ├── Calc.hs
│ └── Calc
│ │ ├── ExprUtils.hs
│ │ ├── Interpreter.hs
│ │ ├── Parser.hs
│ │ ├── Parser
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── Identifier.hs
│ │ ├── Module.hs
│ │ ├── Primitives.hs
│ │ ├── Shared.hs
│ │ ├── Type.hs
│ │ └── Types.hs
│ │ ├── Repl.hs
│ │ ├── SourceSpan.hs
│ │ ├── TypeUtils.hs
│ │ ├── Typecheck
│ │ ├── Elaborate.hs
│ │ ├── Error.hs
│ │ └── Types.hs
│ │ ├── Types.hs
│ │ ├── Types
│ │ ├── Annotation.hs
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── FunctionName.hs
│ │ ├── Identifier.hs
│ │ ├── Module.hs
│ │ ├── Prim.hs
│ │ └── Type.hs
│ │ └── Wasm
│ │ ├── FromExpr.hs
│ │ ├── Run.hs
│ │ ├── ToWasm.hs
│ │ └── Types.hs
├── static
│ └── runtime.c
├── test
│ ├── Main.hs
│ └── Test
│ │ ├── Interpreter
│ │ └── InterpreterSpec.hs
│ │ ├── Parser
│ │ └── ParserSpec.hs
│ │ ├── Typecheck
│ │ └── TypecheckSpec.hs
│ │ └── Wasm
│ │ └── WasmSpec.hs
└── wasm-calc3.cabal
├── wasm-calc4
├── .gitignore
├── CHANGELOG.md
├── app
│ └── Main.hs
├── src
│ ├── Calc.hs
│ └── Calc
│ │ ├── ExprUtils.hs
│ │ ├── Interpreter.hs
│ │ ├── Parser.hs
│ │ ├── Parser
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── Identifier.hs
│ │ ├── Module.hs
│ │ ├── Pattern.hs
│ │ ├── Primitives.hs
│ │ ├── Shared.hs
│ │ ├── Type.hs
│ │ └── Types.hs
│ │ ├── Repl.hs
│ │ ├── SourceSpan.hs
│ │ ├── TypeUtils.hs
│ │ ├── Typecheck
│ │ ├── Elaborate.hs
│ │ ├── Error.hs
│ │ └── Types.hs
│ │ ├── Types.hs
│ │ ├── Types
│ │ ├── Annotation.hs
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── FunctionName.hs
│ │ ├── Identifier.hs
│ │ ├── Module.hs
│ │ ├── Prim.hs
│ │ └── Type.hs
│ │ ├── Utils.hs
│ │ └── Wasm
│ │ ├── Allocator.hs
│ │ ├── FromExpr.hs
│ │ ├── Helpers.hs
│ │ ├── Run.hs
│ │ ├── ToWasm.hs
│ │ └── Types.hs
├── static
│ └── bump-allocator.wat
├── test
│ ├── Main.hs
│ └── Test
│ │ ├── Helpers.hs
│ │ ├── Interpreter
│ │ └── InterpreterSpec.hs
│ │ ├── Parser
│ │ └── ParserSpec.hs
│ │ ├── Typecheck
│ │ └── TypecheckSpec.hs
│ │ └── Wasm
│ │ └── WasmSpec.hs
└── wasm-calc4.cabal
├── wasm-calc5
├── .gitignore
├── CHANGELOG.md
├── app
│ └── Main.hs
├── src
│ ├── Calc.hs
│ └── Calc
│ │ ├── ExprUtils.hs
│ │ ├── Interpreter.hs
│ │ ├── Parser.hs
│ │ ├── Parser
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── Identifier.hs
│ │ ├── Module.hs
│ │ ├── Pattern.hs
│ │ ├── Primitives.hs
│ │ ├── Shared.hs
│ │ ├── Type.hs
│ │ └── Types.hs
│ │ ├── Repl.hs
│ │ ├── SourceSpan.hs
│ │ ├── TypeUtils.hs
│ │ ├── Typecheck
│ │ ├── Elaborate.hs
│ │ ├── Error.hs
│ │ ├── Generalise.hs
│ │ ├── Helpers.hs
│ │ ├── Substitute.hs
│ │ └── Types.hs
│ │ ├── Types.hs
│ │ ├── Types
│ │ ├── Annotation.hs
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── FunctionName.hs
│ │ ├── Identifier.hs
│ │ ├── Module.hs
│ │ ├── Prim.hs
│ │ ├── Type.hs
│ │ └── TypeVar.hs
│ │ ├── Utils.hs
│ │ └── Wasm
│ │ ├── Allocator.hs
│ │ ├── FromExpr.hs
│ │ ├── Helpers.hs
│ │ ├── Run.hs
│ │ ├── ToWasm.hs
│ │ └── Types.hs
├── static
│ └── bump-allocator.wat
├── test
│ ├── Main.hs
│ └── Test
│ │ ├── Helpers.hs
│ │ ├── Interpreter
│ │ └── InterpreterSpec.hs
│ │ ├── Parser
│ │ └── ParserSpec.hs
│ │ ├── Typecheck
│ │ └── TypecheckSpec.hs
│ │ └── Wasm
│ │ └── WasmSpec.hs
└── wasm-calc5.cabal
├── wasm-calc6
├── .gitignore
├── CHANGELOG.md
├── app
│ └── Main.hs
├── src
│ ├── Calc.hs
│ └── Calc
│ │ ├── ExprUtils.hs
│ │ ├── Interpreter.hs
│ │ ├── Linearity.hs
│ │ ├── Linearity
│ │ ├── Error.hs
│ │ ├── Types.hs
│ │ └── Validate.hs
│ │ ├── Parser.hs
│ │ ├── Parser
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── Identifier.hs
│ │ ├── Module.hs
│ │ ├── Pattern.hs
│ │ ├── Primitives.hs
│ │ ├── Shared.hs
│ │ ├── Type.hs
│ │ └── Types.hs
│ │ ├── Repl.hs
│ │ ├── SourceSpan.hs
│ │ ├── TypeUtils.hs
│ │ ├── Typecheck.hs
│ │ ├── Typecheck
│ │ ├── Elaborate.hs
│ │ ├── Error.hs
│ │ ├── Generalise.hs
│ │ ├── Helpers.hs
│ │ ├── Substitute.hs
│ │ └── Types.hs
│ │ ├── Types.hs
│ │ ├── Types
│ │ ├── Annotation.hs
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── FunctionName.hs
│ │ ├── Identifier.hs
│ │ ├── Module.hs
│ │ ├── Pattern.hs
│ │ ├── Prim.hs
│ │ ├── Type.hs
│ │ └── TypeVar.hs
│ │ ├── Utils.hs
│ │ └── Wasm
│ │ ├── Allocator.hs
│ │ ├── FromExpr.hs
│ │ ├── Helpers.hs
│ │ ├── Patterns.hs
│ │ ├── Run.hs
│ │ ├── ToWasm.hs
│ │ └── Types.hs
├── static
│ └── bump-allocator.wat
├── test
│ ├── Main.hs
│ └── Test
│ │ ├── Helpers.hs
│ │ ├── Interpreter
│ │ └── InterpreterSpec.hs
│ │ ├── Linearity
│ │ └── LinearitySpec.hs
│ │ ├── Parser
│ │ └── ParserSpec.hs
│ │ ├── Typecheck
│ │ └── TypecheckSpec.hs
│ │ └── Wasm
│ │ └── WasmSpec.hs
└── wasm-calc6.cabal
├── wasm-calc7
├── .gitignore
├── CHANGELOG.md
├── app
│ └── Main.hs
├── demo
│ ├── .gitignore
│ ├── README.md
│ ├── draw.calc
│ └── draw.html
├── src
│ ├── Calc.hs
│ └── Calc
│ │ ├── Build.hs
│ │ ├── ExprUtils.hs
│ │ ├── Linearity.hs
│ │ ├── Linearity
│ │ ├── Error.hs
│ │ ├── Types.hs
│ │ └── Validate.hs
│ │ ├── Parser.hs
│ │ ├── Parser
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── Identifier.hs
│ │ ├── Import.hs
│ │ ├── Module.hs
│ │ ├── Pattern.hs
│ │ ├── Primitives.hs
│ │ ├── Shared.hs
│ │ ├── Type.hs
│ │ └── Types.hs
│ │ ├── PrettyPrint.hs
│ │ ├── Repl.hs
│ │ ├── SourceSpan.hs
│ │ ├── TypeUtils.hs
│ │ ├── Typecheck.hs
│ │ ├── Typecheck
│ │ ├── Elaborate.hs
│ │ ├── Error.hs
│ │ ├── Generalise.hs
│ │ ├── Helpers.hs
│ │ ├── Substitute.hs
│ │ └── Types.hs
│ │ ├── Types.hs
│ │ ├── Types
│ │ ├── Annotation.hs
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── FunctionName.hs
│ │ ├── Identifier.hs
│ │ ├── Import.hs
│ │ ├── Module.hs
│ │ ├── Op.hs
│ │ ├── Pattern.hs
│ │ ├── Prim.hs
│ │ ├── Type.hs
│ │ └── TypeVar.hs
│ │ ├── Utils.hs
│ │ ├── Wasm.hs
│ │ └── Wasm
│ │ ├── Allocator.hs
│ │ ├── FromExpr.hs
│ │ ├── Helpers.hs
│ │ ├── Patterns.hs
│ │ ├── Run.hs
│ │ ├── ToWasm.hs
│ │ ├── Types.hs
│ │ └── WriteModule.hs
├── static
│ └── bump-allocator.wat
├── test
│ ├── Main.hs
│ ├── Test
│ │ ├── Helpers.hs
│ │ ├── Linearity
│ │ │ └── LinearitySpec.hs
│ │ ├── Parser
│ │ │ └── ParserSpec.hs
│ │ ├── PrettyPrint
│ │ │ └── PrettyPrintSpec.hs
│ │ ├── RunNode.hs
│ │ ├── Typecheck
│ │ │ └── TypecheckSpec.hs
│ │ └── Wasm
│ │ │ └── WasmSpec.hs
│ ├── js
│ │ └── test.mjs
│ └── static
│ │ ├── bigfunction.calc
│ │ └── drawing.calc
└── wasm-calc7.cabal
├── wasm-calc8
├── .gitignore
├── CHANGELOG.md
├── app
│ └── Main.hs
├── demo
│ ├── .gitignore
│ ├── README.md
│ ├── draw.calc
│ └── draw.html
├── src
│ ├── Calc.hs
│ └── Calc
│ │ ├── Build.hs
│ │ ├── ExprUtils.hs
│ │ ├── Linearity.hs
│ │ ├── Linearity
│ │ ├── Error.hs
│ │ ├── Types.hs
│ │ └── Validate.hs
│ │ ├── Parser.hs
│ │ ├── Parser
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── Identifier.hs
│ │ ├── Import.hs
│ │ ├── Module.hs
│ │ ├── Pattern.hs
│ │ ├── Primitives.hs
│ │ ├── Shared.hs
│ │ ├── Type.hs
│ │ └── Types.hs
│ │ ├── PrettyPrint.hs
│ │ ├── Repl.hs
│ │ ├── SourceSpan.hs
│ │ ├── TypeUtils.hs
│ │ ├── Typecheck.hs
│ │ ├── Typecheck
│ │ ├── Elaborate.hs
│ │ ├── Error.hs
│ │ ├── Generalise.hs
│ │ ├── Helpers.hs
│ │ ├── Infer.hs
│ │ ├── Substitute.hs
│ │ ├── Types.hs
│ │ └── Unify.hs
│ │ ├── Types.hs
│ │ ├── Types
│ │ ├── Annotation.hs
│ │ ├── Expr.hs
│ │ ├── Function.hs
│ │ ├── FunctionName.hs
│ │ ├── Global.hs
│ │ ├── Identifier.hs
│ │ ├── Import.hs
│ │ ├── Memory.hs
│ │ ├── Module.hs
│ │ ├── Op.hs
│ │ ├── Pattern.hs
│ │ ├── Prim.hs
│ │ ├── Type.hs
│ │ └── TypeVar.hs
│ │ ├── Utils.hs
│ │ ├── Wasm.hs
│ │ └── Wasm
│ │ ├── Allocator.hs
│ │ ├── FromExpr
│ │ ├── Expr.hs
│ │ ├── Helpers.hs
│ │ ├── Patterns.hs
│ │ └── Types.hs
│ │ ├── Run.hs
│ │ ├── ToWasm
│ │ ├── Expr.hs
│ │ ├── Helpers.hs
│ │ ├── Module.hs
│ │ └── Types.hs
│ │ └── WriteModule.hs
├── static
│ ├── bump-allocator.wat
│ └── malloc.wat
├── test
│ ├── Main.hs
│ ├── Test
│ │ ├── Helpers.hs
│ │ ├── Linearity
│ │ │ └── LinearitySpec.hs
│ │ ├── Parser
│ │ │ └── ParserSpec.hs
│ │ ├── PrettyPrint
│ │ │ └── PrettyPrintSpec.hs
│ │ ├── RunNode.hs
│ │ ├── Typecheck
│ │ │ └── TypecheckSpec.hs
│ │ └── Wasm
│ │ │ └── WasmSpec.hs
│ ├── js
│ │ └── test.mjs
│ └── static
│ │ ├── bigfunction.calc
│ │ └── drawing.calc
└── wasm-calc8.cabal
└── wasm-calc9
├── .gitignore
├── CHANGELOG.md
├── app
└── Main.hs
├── src
├── Calc.hs
└── Calc
│ ├── Ability
│ ├── Check.hs
│ └── Error.hs
│ ├── Build.hs
│ ├── Dependencies.hs
│ ├── ExprUtils.hs
│ ├── Linearity.hs
│ ├── Linearity
│ ├── Error.hs
│ ├── Types.hs
│ └── Validate.hs
│ ├── Parser.hs
│ ├── Parser
│ ├── Expr.hs
│ ├── Function.hs
│ ├── Identifier.hs
│ ├── Import.hs
│ ├── Module.hs
│ ├── Pattern.hs
│ ├── Primitives.hs
│ ├── Shared.hs
│ ├── Type.hs
│ └── Types.hs
│ ├── PrettyPrint.hs
│ ├── Repl.hs
│ ├── SourceSpan.hs
│ ├── Test.hs
│ ├── TypeUtils.hs
│ ├── Typecheck.hs
│ ├── Typecheck
│ ├── Elaborate.hs
│ ├── Error.hs
│ ├── Generalise.hs
│ ├── Helpers.hs
│ ├── Infer.hs
│ ├── Substitute.hs
│ ├── Types.hs
│ └── Unify.hs
│ ├── Types.hs
│ ├── Types
│ ├── Ability.hs
│ ├── Annotation.hs
│ ├── Expr.hs
│ ├── Function.hs
│ ├── FunctionName.hs
│ ├── Global.hs
│ ├── Identifier.hs
│ ├── Import.hs
│ ├── Memory.hs
│ ├── Module.hs
│ ├── ModuleAnnotations.hs
│ ├── Op.hs
│ ├── Pattern.hs
│ ├── Prim.hs
│ ├── Test.hs
│ ├── Type.hs
│ └── TypeVar.hs
│ ├── Utils.hs
│ ├── Wasm.hs
│ └── Wasm
│ ├── Allocator.hs
│ ├── FromExpr.hs
│ ├── FromExpr
│ ├── Drops.hs
│ ├── Expr.hs
│ ├── Helpers.hs
│ ├── Module.hs
│ ├── Patterns.hs
│ └── Types.hs
│ ├── Run.hs
│ ├── ToWasm.hs
│ ├── ToWasm
│ ├── Expr.hs
│ ├── Helpers.hs
│ ├── Module.hs
│ └── Types.hs
│ └── WriteModule.hs
├── static
├── .gitignore
├── malloc.calc
└── malloc.wasm
├── test
├── Main.hs
├── Test
│ ├── Ability
│ │ └── AbilitySpec.hs
│ ├── Helpers.hs
│ ├── Linearity
│ │ └── LinearitySpec.hs
│ ├── Parser
│ │ └── ParserSpec.hs
│ ├── PrettyPrint
│ │ └── PrettyPrintSpec.hs
│ ├── RunNode.hs
│ ├── Typecheck
│ │ └── TypecheckSpec.hs
│ └── Wasm
│ │ ├── FromWasmSpec.hs
│ │ └── WasmSpec.hs
├── js
│ └── test.mjs
└── static
│ ├── bigfunction.calc
│ ├── drawing.calc
│ └── noalloc.calc
└── wasm-calc9.cabal
/.envrc:
--------------------------------------------------------------------------------
1 | use flake . --impure -j auto --print-build-logs
2 |
--------------------------------------------------------------------------------
/.github/workflows/lint-haskell.yml:
--------------------------------------------------------------------------------
1 | name: Haskell - lint
2 |
3 | on:
4 | push:
5 | branches:
6 | - trunk
7 |
8 | pull_request:
9 | branches:
10 | - trunk
11 |
12 | jobs:
13 | ormolu:
14 | runs-on: ubuntu-latest
15 | steps:
16 | - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4
17 | - uses: haskell-actions/run-ormolu@v14
18 |
19 | hlint:
20 | runs-on: ubuntu-latest
21 | steps:
22 | - uses: actions/checkout@b4ffde65f46336ab88eb53be808477a3936bae11 # v4
23 |
24 | - name: "Set up HLint"
25 | uses: rwe/actions-hlint-setup@v1
26 | with:
27 | version: "3.6.1"
28 |
29 | - name: "Run HLint"
30 | uses: rwe/actions-hlint-run@v2
31 | with:
32 | fail-on: warning
33 |
34 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle/
2 | .direnv/
3 |
4 | .stack-work/
5 | *~
6 | store/*.json
7 | result
8 | result/
9 |
10 | # output by benchmarks
11 | benchmarks/performance.*
12 |
13 | .mimsa/
14 | swagger.json
15 | environment.json
16 |
17 | store_data/
18 | file_volume/
19 |
20 | ./file-volume/
21 | ./git/
22 | .DS_Store
23 |
--------------------------------------------------------------------------------
/cabal.project:
--------------------------------------------------------------------------------
1 | packages:
2 | wasm-calc1/wasm-calc1.cabal,
3 | wasm-calc2/wasm-calc2.cabal,
4 | wasm-calc3/wasm-calc3.cabal,
5 | wasm-calc4/wasm-calc4.cabal,
6 | wasm-calc5/wasm-calc5.cabal,
7 | wasm-calc6/wasm-calc6.cabal,
8 | wasm-calc7/wasm-calc7.cabal,
9 | wasm-calc8/wasm-calc8.cabal,
10 | wasm-calc9/wasm-calc9.cabal,
11 | wasm-calc10/wasm-calc10.cabal,
12 | wasm-calc11/wasm-calc11.cabal,
13 | wasm-calc12/wasm-calc12.cabal,
14 | wasm-calc13/wasm-calc13.cabal
15 |
16 | with-compiler: ghc-9.6.5
17 |
18 | package diagnose
19 | flags: +megaparsec-compat
20 |
21 | allow-newer: all
22 |
--------------------------------------------------------------------------------
/malloc.wasm:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/danieljharvey/wasm-calc/aa3b58a049d37192528afc441c01f9642fa3f731/malloc.wasm
--------------------------------------------------------------------------------
/renovate.json:
--------------------------------------------------------------------------------
1 | {
2 | "extends": [
3 | "config:base"
4 | ]
5 | }
6 |
--------------------------------------------------------------------------------
/swagger.config.json:
--------------------------------------------------------------------------------
1 | { "apiPackage": "mimsa-api", "modelPackage": "mimsa-types", "supportsES6": true, "withSeparateModelsAndApi": true, "npmName": "mimsa-types" }
2 |
--------------------------------------------------------------------------------
/wasm-calc1/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle
2 | .direnv
3 |
--------------------------------------------------------------------------------
/wasm-calc1/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Revision history for nix-basic
2 |
3 | ## 0.1.0.0 -- YYYY-mm-dd
4 |
5 | * First version. Released on an unsuspecting world.
6 |
--------------------------------------------------------------------------------
/wasm-calc1/app/Main.hs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Calc (repl)
4 |
5 | main :: IO ()
6 | main = repl
7 |
--------------------------------------------------------------------------------
/wasm-calc1/src/Calc.hs:
--------------------------------------------------------------------------------
1 | module Calc
2 | ( module Calc.Types,
3 | module Calc.Parser,
4 | module Calc.ExprUtils,
5 | module Calc.Interpreter,
6 | module Calc.Repl,
7 | )
8 | where
9 |
10 | import Calc.ExprUtils
11 | import Calc.Interpreter
12 | import Calc.Parser
13 | import Calc.Repl
14 | import Calc.Types
15 |
--------------------------------------------------------------------------------
/wasm-calc1/src/Calc/ExprUtils.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE RankNTypes #-}
2 |
3 | module Calc.ExprUtils
4 | ( mapOuterExprAnnotation,
5 | mapExpr,
6 | )
7 | where
8 |
9 | import Calc.Types
10 |
11 | -- | modify the outer annotation of an expression
12 | -- useful for adding line numbers during parsing
13 | mapOuterExprAnnotation :: (ann -> ann) -> Expr ann -> Expr ann
14 | mapOuterExprAnnotation f expr' =
15 | case expr' of
16 | EInfix ann a b c -> EInfix (f ann) a b c
17 | EPrim ann a -> EPrim (f ann) a
18 |
19 | mapExpr :: (Expr ann -> Expr ann) -> Expr ann -> Expr ann
20 | mapExpr f (EInfix ann op a b) = EInfix ann op (f a) (f b)
21 | mapExpr _ (EPrim ann a) = EPrim ann a
22 |
--------------------------------------------------------------------------------
/wasm-calc1/src/Calc/Interpreter.hs:
--------------------------------------------------------------------------------
1 | module Calc.Interpreter (interpret) where
2 |
3 | import Calc.Types
4 |
5 | interpretInfix ::
6 | (Monad m) =>
7 | ann ->
8 | Op ->
9 | Expr ann ->
10 | Expr ann ->
11 | m (Expr ann)
12 | interpretInfix ann OpAdd (EPrim _ a) (EPrim _ b) =
13 | pure $ EPrim ann (a + b)
14 | interpretInfix ann OpSubtract (EPrim _ a) (EPrim _ b) =
15 | pure $ EPrim ann (a - b)
16 | interpretInfix ann OpMultiply (EPrim _ a) (EPrim _ b) =
17 | pure $ EPrim ann (a * b)
18 | interpretInfix ann op a b = do
19 | iA <- interpret a
20 | iB <- interpret b
21 | interpretInfix ann op iA iB
22 |
23 | -- | just keep reducing the thing until the smallest thing
24 | interpret ::
25 | ( Monad m
26 | ) =>
27 | Expr ann ->
28 | m (Expr ann)
29 | interpret (EPrim ann p) = pure (EPrim ann p)
30 | interpret (EInfix ann op a b) =
31 | interpretInfix ann op a b
32 |
--------------------------------------------------------------------------------
/wasm-calc1/src/Calc/Parser/Expr.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Parser.Expr (exprParser) where
4 |
5 | import Calc.Parser.Primitives
6 | import Calc.Parser.Shared
7 | import Calc.Parser.Types
8 | import Calc.Types.Annotation
9 | import Calc.Types.Expr
10 | import Control.Monad.Combinators.Expr
11 | import Data.Text
12 | import Text.Megaparsec
13 |
14 | exprParser :: Parser (Expr Annotation)
15 | exprParser = addLocation (makeExprParser exprPart table) > "expression"
16 |
17 | exprPart :: Parser (Expr Annotation)
18 | exprPart =
19 | inBrackets (addLocation exprParser)
20 | <|> primParser
21 | > "term"
22 |
23 | table :: [[Operator Parser (Expr Annotation)]]
24 | table =
25 | [ [binary "*" (EInfix mempty OpMultiply)],
26 | [ binary "+" (EInfix mempty OpAdd),
27 | binary "-" (EInfix mempty OpSubtract)
28 | ]
29 | ]
30 |
31 | binary :: Text -> (a -> a -> a) -> Operator Parser a
32 | binary name f = InfixL (f <$ stringLiteral name)
33 |
--------------------------------------------------------------------------------
/wasm-calc1/src/Calc/Parser/Primitives.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Parser.Primitives
4 | ( primParser,
5 | intParser,
6 | )
7 | where
8 |
9 | import Calc.Parser.Shared
10 | import Calc.Parser.Types
11 | import Calc.Types.Expr
12 | import Data.Functor (($>))
13 | import Text.Megaparsec.Char
14 | import qualified Text.Megaparsec.Char.Lexer as L
15 |
16 | ----
17 |
18 | intParser :: Parser Int
19 | intParser =
20 | L.signed (string "" $> ()) L.decimal
21 |
22 | primParser :: Parser ParserExpr
23 | primParser = myLexeme $ addLocation (EPrim mempty <$> intParser)
24 |
--------------------------------------------------------------------------------
/wasm-calc1/src/Calc/Parser/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Types
2 | ( Parser,
3 | ParseErrorType,
4 | ParserExpr,
5 | )
6 | where
7 |
8 | import Calc.Types.Annotation
9 | import Calc.Types.Expr
10 | import Data.Text (Text)
11 | import Data.Void
12 | import Text.Megaparsec
13 |
14 | type Parser = Parsec Void Text
15 |
16 | type ParseErrorType = ParseErrorBundle Text Void
17 |
18 | type ParserExpr = Expr Annotation
19 |
--------------------------------------------------------------------------------
/wasm-calc1/src/Calc/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Types
2 | ( module Calc.Types.Annotation,
3 | module Calc.Types.Expr,
4 | module Calc.Types.Prim,
5 | )
6 | where
7 |
8 | import Calc.Types.Annotation
9 | import Calc.Types.Expr
10 | import Calc.Types.Prim
11 |
--------------------------------------------------------------------------------
/wasm-calc1/src/Calc/Types/Annotation.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Annotation
4 | ( Annotation (..),
5 | )
6 | where
7 |
8 | -- | `Annotation` is used to track source code location
9 | -- it is added to parts of `Expr` during parsing and used to
10 | -- make errors nicer
11 | data Annotation = Location Int Int
12 | deriving stock (Eq, Ord, Show)
13 |
14 | -- | when combining two `Annotation`, take the first one
15 | instance Semigroup Annotation where
16 | a <> _ = a
17 |
18 | -- | Default to an empty `Annotation`
19 | instance Monoid Annotation where
20 | mempty = Location 0 0
21 |
--------------------------------------------------------------------------------
/wasm-calc1/src/Calc/Types/Expr.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveTraversable #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 |
4 | module Calc.Types.Expr (Expr (..), Op (..)) where
5 |
6 | data Expr ann
7 | = EPrim ann Int
8 | | EInfix ann Op (Expr ann) (Expr ann)
9 | deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable)
10 |
11 | data Op = OpAdd | OpMultiply | OpSubtract
12 | deriving stock (Eq, Ord, Show)
13 |
--------------------------------------------------------------------------------
/wasm-calc1/src/Calc/Types/Prim.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Prim
4 | ( Prim (..),
5 | )
6 | where
7 |
8 | newtype Prim
9 | = PInt Integer
10 | deriving stock (Eq, Ord, Show)
11 |
--------------------------------------------------------------------------------
/wasm-calc1/src/Calc/Wasm/Run.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Wasm.Run (runWasm) where
4 |
5 | import qualified Language.Wasm as Wasm
6 | import qualified Language.Wasm.Interpreter as Wasm
7 |
8 | runWasm :: Wasm.Module -> IO (Maybe [Wasm.Value])
9 | runWasm wasmModule = do
10 | case Wasm.validate wasmModule of
11 | Right validModule -> do
12 | (result, store) <- Wasm.instantiate Wasm.emptyStore mempty validModule
13 | case result of
14 | Right moduleInstance ->
15 | Wasm.invokeExport store moduleInstance "main" mempty
16 | Left e -> error e
17 | Left e -> do
18 | print wasmModule
19 | error $ "invalid module: " <> show e
20 |
--------------------------------------------------------------------------------
/wasm-calc1/src/Calc/Wasm/Types.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Wasm.Types (Type (..), Module (..), Function (..)) where
4 |
5 | import Calc.Types.Expr
6 |
7 | data Type ann = I32
8 | deriving stock (Eq, Ord, Show)
9 |
10 | newtype Module ann = Module
11 | { -- | the functions themselves, their index comes from the list placement
12 | modFunctions :: [Function ann]
13 | }
14 | deriving stock (Eq, Ord, Show)
15 |
16 | data Function ann = Function
17 | { fnName :: String,
18 | fnExpr :: Expr ann,
19 | fnPublic :: Bool,
20 | fnArgs :: [Type ann],
21 | fnReturnType :: Type ann
22 | }
23 | deriving stock (Eq, Ord, Show)
24 |
--------------------------------------------------------------------------------
/wasm-calc1/test/Main.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import Test.Hspec
4 | import qualified Test.Interpreter.InterpreterSpec
5 | import qualified Test.Parser.ParserSpec
6 | import qualified Test.Wasm.WasmSpec
7 |
8 | main :: IO ()
9 | main = hspec $ do
10 | Test.Parser.ParserSpec.spec
11 | Test.Interpreter.InterpreterSpec.spec
12 | Test.Wasm.WasmSpec.spec
13 |
--------------------------------------------------------------------------------
/wasm-calc10/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle
2 | .direnv
3 |
--------------------------------------------------------------------------------
/wasm-calc10/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Revision history for nix-basic
2 |
3 | ## 0.1.0.0 -- YYYY-mm-dd
4 |
5 | * First version. Released on an unsuspecting world.
6 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc.hs:
--------------------------------------------------------------------------------
1 | module Calc
2 | ( module Calc.Types,
3 | module Calc.Build,
4 | module Calc.Parser,
5 | module Calc.ExprUtils,
6 | module Calc.Repl,
7 | module Calc.Wasm,
8 | module Calc.PrettyPrint,
9 | )
10 | where
11 |
12 | import Calc.Build
13 | import Calc.ExprUtils
14 | import Calc.Parser
15 | import Calc.PrettyPrint
16 | import Calc.Repl
17 | import Calc.Types
18 | import Calc.Wasm
19 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Linearity.hs:
--------------------------------------------------------------------------------
1 | module Calc.Linearity
2 | ( module Calc.Linearity.Types,
3 | module Calc.Linearity.Error,
4 | module Calc.Linearity.Validate,
5 | )
6 | where
7 |
8 | import Calc.Linearity.Error
9 | import Calc.Linearity.Types
10 | import Calc.Linearity.Validate
11 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Parser/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Types
2 | ( Parser,
3 | ParseErrorType,
4 | ParserExpr,
5 | ParserType,
6 | ParserFunction,
7 | ParserModule,
8 | ParserPattern,
9 | )
10 | where
11 |
12 | import Calc.Types.Annotation
13 | import Calc.Types.Expr
14 | import Calc.Types.Function
15 | import Calc.Types.Module
16 | import Calc.Types.Pattern
17 | import Calc.Types.Type
18 | import Data.Text (Text)
19 | import Data.Void
20 | import Text.Megaparsec
21 |
22 | type Parser = Parsec Void Text
23 |
24 | type ParseErrorType = ParseErrorBundle Text Void
25 |
26 | type ParserExpr = Expr Annotation
27 |
28 | type ParserType = Type Annotation
29 |
30 | type ParserFunction = Function Annotation
31 |
32 | type ParserModule = [ModuleItem Annotation]
33 |
34 | type ParserPattern = Pattern Annotation
35 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Typecheck.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck
2 | ( module Calc.Typecheck.Error,
3 | module Calc.Typecheck.Helpers,
4 | module Calc.Typecheck.Elaborate,
5 | module Calc.Typecheck.Types,
6 | module Calc.Typecheck.Infer,
7 | )
8 | where
9 |
10 | import Calc.Typecheck.Elaborate
11 | import Calc.Typecheck.Error
12 | import Calc.Typecheck.Helpers
13 | import Calc.Typecheck.Infer
14 | import Calc.Typecheck.Types
15 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Typecheck/Error.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Error
2 | ( module Calc.Typecheck.Error.TypeError,
3 | module Calc.Typecheck.Error.PatternMatchError,
4 | )
5 | where
6 |
7 | import Calc.Typecheck.Error.PatternMatchError
8 | import Calc.Typecheck.Error.TypeError
9 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Typecheck/Patterns.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Patterns
2 | ( module Calc.Typecheck.Patterns.Annihilate,
3 | module Calc.Typecheck.Patterns.Validate,
4 | module Calc.Typecheck.Patterns.Generate,
5 | )
6 | where
7 |
8 | import Calc.Typecheck.Patterns.Annihilate
9 | import Calc.Typecheck.Patterns.Generate
10 | import Calc.Typecheck.Patterns.Validate
11 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Typecheck/Substitute.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Substitute (substitute) where
2 |
3 | import Calc.TypeUtils
4 | import Calc.Types.Type
5 | import qualified Data.HashMap.Strict as HM
6 | import Data.Maybe (fromMaybe)
7 | import GHC.Natural
8 |
9 | substitute ::
10 | HM.HashMap Natural (Type ann) ->
11 | Type ann ->
12 | Type ann
13 | substitute subs oldTy@(TUnificationVar _ nat) =
14 | fromMaybe oldTy (HM.lookup nat subs)
15 | substitute subs other =
16 | mapType (substitute subs) other
17 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Types/Ability.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE OverloadedStrings #-}
4 |
5 | module Calc.Types.Ability where
6 |
7 | import Calc.Types.Function
8 | import Calc.Types.Identifier
9 | import Prettyprinter ((<+>))
10 | import qualified Prettyprinter as PP
11 |
12 | -- | things that our functions might do
13 | data Ability ann
14 | = AllocateMemory ann
15 | | CallImportedFunction ann FunctionName
16 | | MutateGlobal ann Identifier
17 | deriving stock (Eq, Ord, Show, Functor)
18 |
19 | instance PP.Pretty (Ability ann) where
20 | pretty (AllocateMemory _) =
21 | "Allocating memory"
22 | pretty (CallImportedFunction _ fnName) =
23 | "Calling imported function" <+> PP.dquotes (PP.pretty fnName)
24 | pretty (MutateGlobal _ ident) =
25 | "Mutate global" <+> PP.dquotes (PP.pretty ident)
26 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Types/Annotation.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Annotation
4 | ( Annotation (..),
5 | )
6 | where
7 |
8 | -- | `Annotation` is used to track source code location
9 | -- it is added to parts of `Expr` during parsing and used to
10 | -- make errors nicer
11 | data Annotation = Location Int Int
12 | deriving stock (Eq, Ord, Show)
13 |
14 | -- | when combining two `Annotation`, combine to make one big annotation
15 | instance Semigroup Annotation where
16 | (Location start end) <> (Location start' end') =
17 | Location (min start start') (max end end')
18 |
19 | -- | Default to an empty `Annotation`
20 | instance Monoid Annotation where
21 | mempty = Location 0 0
22 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Types/FunctionName.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.FunctionName
5 | ( FunctionName (..),
6 | )
7 | where
8 |
9 | import Data.Hashable
10 | import Data.String
11 | import Data.Text (Text)
12 | import qualified Data.Text as T
13 | import qualified Prettyprinter as PP
14 |
15 | newtype FunctionName = FunctionName Text
16 | deriving newtype (Eq, Ord, Show, Hashable)
17 |
18 | instance IsString FunctionName where
19 | fromString = FunctionName . T.pack
20 |
21 | instance PP.Pretty FunctionName where
22 | pretty (FunctionName fn) = PP.pretty fn
23 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Types/Memory.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE NamedFieldPuns #-}
4 | {-# LANGUAGE OverloadedStrings #-}
5 |
6 | module Calc.Types.Memory (Memory (..)) where
7 |
8 | import Calc.Types.Identifier
9 | import GHC.Natural
10 | import Prettyprinter ((<+>))
11 | import qualified Prettyprinter as PP
12 |
13 | data Memory ann
14 | = LocalMemory {lmAnn :: ann, lmLimit :: Natural}
15 | | ImportedMemory
16 | { imAnn :: ann,
17 | imExternalModule :: Identifier,
18 | imExternalMemoryName :: Identifier,
19 | imLimit :: Natural
20 | }
21 | deriving stock (Eq, Ord, Show, Functor)
22 |
23 | instance PP.Pretty (Memory ann) where
24 | pretty (LocalMemory {lmLimit}) =
25 | "memory" <+> PP.pretty lmLimit
26 | pretty (ImportedMemory {imExternalModule, imExternalMemoryName, imLimit}) =
27 | "import" <+> PP.pretty imExternalModule <> "." <> PP.pretty imExternalMemoryName <+> "as memory" <+> PP.pretty imLimit
28 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Types/ModuleAnnotations.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.ModuleAnnotations (ModuleAnnotations (..)) where
4 |
5 | import Calc.Types
6 | import qualified Data.Map.Strict as M
7 |
8 | data ModuleAnnotations ann = ModuleAnnotations
9 | { maFunctions :: M.Map FunctionName ann,
10 | maTests :: M.Map Identifier ann
11 | }
12 | deriving stock (Eq, Ord, Show)
13 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Types/Op.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE OverloadedStrings #-}
3 |
4 | module Calc.Types.Op (Op (..)) where
5 |
6 | import qualified Prettyprinter as PP
7 |
8 | data Op
9 | = OpAdd
10 | | OpMultiply
11 | | OpSubtract
12 | | OpEquals
13 | | OpGreaterThan
14 | | OpGreaterThanOrEqualTo
15 | | OpLessThan
16 | | OpLessThanOrEqualTo
17 | | OpAnd
18 | | OpOr
19 | deriving stock (Eq, Ord, Show)
20 |
21 | -- how to print `Op` values
22 | instance PP.Pretty Op where
23 | pretty OpAdd = "+"
24 | pretty OpMultiply = "*"
25 | pretty OpSubtract = "-"
26 | pretty OpEquals = "=="
27 | pretty OpGreaterThan = ">"
28 | pretty OpGreaterThanOrEqualTo = ">="
29 | pretty OpLessThan = "<"
30 | pretty OpLessThanOrEqualTo = "<="
31 | pretty OpAnd = "&&"
32 | pretty OpOr = "||"
33 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Types/Prim.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Prim
4 | ( Prim (..),
5 | )
6 | where
7 |
8 | import Data.Word
9 | import qualified Prettyprinter as PP
10 |
11 | data Prim
12 | = PIntLit Word64 -- a polymorphic int literal, we don't know what size
13 | | PFloatLit Double -- a polymorphic float literal, we don't know what size
14 | | PBool Bool
15 | deriving stock (Eq, Ord, Show)
16 |
17 | instance PP.Pretty Prim where
18 | pretty (PIntLit i) = PP.pretty i
19 | pretty (PFloatLit f) = PP.pretty f
20 | pretty (PBool b) = PP.pretty b
21 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Types/Test.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE NamedFieldPuns #-}
4 | {-# LANGUAGE OverloadedStrings #-}
5 |
6 | module Calc.Types.Test where
7 |
8 | import Calc.Types.Expr
9 | import Calc.Types.Identifier
10 | import Prettyprinter ((<+>))
11 | import qualified Prettyprinter as PP
12 |
13 | data Test ann = Test
14 | { tesAnn :: ann,
15 | tesName :: Identifier,
16 | tesExpr :: Expr ann
17 | }
18 | deriving stock (Eq, Ord, Show, Functor)
19 |
20 | -- when on multilines, indent by `i`, if not then nothing
21 | indentMulti :: Integer -> PP.Doc style -> PP.Doc style
22 | indentMulti i doc =
23 | PP.flatAlt (PP.indent (fromIntegral i) doc) doc
24 |
25 | instance PP.Pretty (Test ann) where
26 | pretty (Test {tesName, tesExpr}) =
27 | "test"
28 | <+> PP.pretty tesName
29 | <+> "="
30 | <+> PP.line
31 | <> indentMulti 2 (PP.pretty tesExpr)
32 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Types/TypeVar.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.TypeVar (TypeVar (..), safeMkTypeVar) where
5 |
6 | import qualified Data.Char as Ch
7 | import Data.Hashable
8 | import Data.String
9 | import Data.Text (Text)
10 | import qualified Data.Text as T
11 | import qualified Prettyprinter as PP
12 |
13 | newtype TypeVar = TypeVar Text
14 | deriving newtype (Eq, Ord, Show, Hashable)
15 |
16 | instance IsString TypeVar where
17 | fromString = TypeVar . T.pack
18 |
19 | instance PP.Pretty TypeVar where
20 | pretty (TypeVar ident) = PP.pretty ident
21 |
22 | validTypeVar :: Text -> Bool
23 | validTypeVar a =
24 | T.length a > 0
25 | && T.filter Ch.isAlphaNum a == a
26 | && not (Ch.isDigit (T.head a))
27 | && Ch.isLower (T.head a)
28 |
29 | safeMkTypeVar :: Text -> Maybe TypeVar
30 | safeMkTypeVar a =
31 | if validTypeVar a
32 | then Just (TypeVar a)
33 | else Nothing
34 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Wasm.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm (module Calc.Wasm.WriteModule) where
2 |
3 | import Calc.Wasm.WriteModule
4 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Wasm/Allocator.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE TemplateHaskell #-}
2 |
3 | module Calc.Wasm.Allocator (moduleWithAllocator) where
4 |
5 | import qualified Data.ByteString as B
6 | import Data.FileEmbed
7 | import qualified Language.Wasm as Wasm
8 |
9 | -- these are saved in a file that is included in compilation
10 | allocatorSource :: B.ByteString
11 | allocatorSource =
12 | $(makeRelativeToProject "static/malloc.wasm" >>= embedFile)
13 |
14 | -- we have an allocator, we need to import it
15 | moduleWithAllocator :: Wasm.Module
16 | moduleWithAllocator = case Wasm.decode allocatorSource of
17 | Right mod' -> mod'
18 | Left e -> error (show e)
19 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Wasm/FromExpr.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.FromExpr (module Calc.Wasm.FromExpr.Types, module Calc.Wasm.FromExpr.Module) where
2 |
3 | import Calc.Wasm.FromExpr.Module
4 | import Calc.Wasm.FromExpr.Types
5 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Wasm/FromExpr/Patterns.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.FromExpr.Patterns
2 | ( module Calc.Wasm.FromExpr.Patterns.Paths,
3 | module Calc.Wasm.FromExpr.Patterns.Predicates,
4 | )
5 | where
6 |
7 | import Calc.Wasm.FromExpr.Patterns.Paths
8 | import Calc.Wasm.FromExpr.Patterns.Predicates
9 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Wasm/Run.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Wasm.Run (runWasm) where
4 |
5 | import Calc.Utils
6 | import qualified Data.Text.Lazy as TL
7 | import qualified Language.Wasm as Wasm
8 | import qualified Language.Wasm.Interpreter as Wasm
9 |
10 | runWasm :: TL.Text -> Wasm.Module -> IO (Maybe [Wasm.Value])
11 | runWasm startFunctionName wasmModule = do
12 | case Wasm.validate wasmModule of
13 | Right validModule -> do
14 | (result, store) <- Wasm.instantiate Wasm.emptyStore mempty validModule
15 | case result of
16 | Right moduleInstance ->
17 | Wasm.invokeExport store moduleInstance startFunctionName mempty
18 | Left e -> error $ "Error instantiating wasm module: " <> show e
19 | Left e ->
20 | error $
21 | "invalid module: "
22 | <> show e
23 | <> "\n\n"
24 | <> prettyShow wasmModule
25 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Wasm/ToWasm.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.ToWasm
2 | ( module Calc.Wasm.ToWasm.Module,
3 | module Calc.Wasm.ToWasm.Types,
4 | module Calc.Wasm.ToWasm.Helpers,
5 | )
6 | where
7 |
8 | import Calc.Wasm.ToWasm.Helpers
9 | import Calc.Wasm.ToWasm.Module
10 | import Calc.Wasm.ToWasm.Types
11 |
--------------------------------------------------------------------------------
/wasm-calc10/src/Calc/Wasm/WriteModule.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.WriteModule (printModule, writeModule) where
2 |
3 | import qualified Data.ByteString as BS
4 | import qualified Language.Wasm.Binary as Wasm
5 | import qualified Language.Wasm.Structure as Wasm
6 |
7 | -- | in which we write some actual files somewhere for lols
8 | writeModule :: FilePath -> Wasm.Module -> IO ()
9 | writeModule path wasmMod = do
10 | let bs = Wasm.dumpModule wasmMod
11 | BS.writeFile path bs
12 |
13 | -- | in which we output to stdout
14 | printModule :: Wasm.Module -> IO ()
15 | printModule = BS.putStr . Wasm.dumpModule
16 |
--------------------------------------------------------------------------------
/wasm-calc10/static/.gitignore:
--------------------------------------------------------------------------------
1 | # we don't want to commit this
2 | malloc-new.wasm
3 |
--------------------------------------------------------------------------------
/wasm-calc10/static/malloc.wasm:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/danieljharvey/wasm-calc/aa3b58a049d37192528afc441c01f9642fa3f731/wasm-calc10/static/malloc.wasm
--------------------------------------------------------------------------------
/wasm-calc10/test/Main.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import qualified Test.Ability.AbilitySpec
4 | import Test.Hspec
5 | import qualified Test.Linearity.LinearitySpec
6 | import qualified Test.Parser.ParserSpec
7 | import qualified Test.PrettyPrint.PrettyPrintSpec
8 | import qualified Test.Typecheck.PatternsSpec
9 | import qualified Test.Typecheck.TypecheckSpec
10 | import qualified Test.Wasm.FromWasmSpec
11 | import qualified Test.Wasm.WasmSpec
12 |
13 | main :: IO ()
14 | main = hspec $ do
15 | Test.Ability.AbilitySpec.spec
16 | Test.Parser.ParserSpec.spec
17 | Test.PrettyPrint.PrettyPrintSpec.spec
18 | Test.Linearity.LinearitySpec.spec
19 | Test.Typecheck.TypecheckSpec.spec
20 | Test.Typecheck.PatternsSpec.spec
21 | Test.Wasm.WasmSpec.spec
22 | Test.Wasm.FromWasmSpec.spec
23 |
--------------------------------------------------------------------------------
/wasm-calc10/test/js/test.mjs:
--------------------------------------------------------------------------------
1 | // this file is used in tests to check imports work correctly
2 | import fs from "fs/promises";
3 |
4 | const filename = process.argv[2];
5 | const wasmBytes = await fs.readFile(filename);
6 |
7 | async function go() {
8 | const imports = {
9 | console : {log : a => console.log(a)},
10 | env : {memory : new WebAssembly.Memory({initial : 1})}
11 | };
12 |
13 | const {instance} = await WebAssembly.instantiate(wasmBytes, imports);
14 | const {test} = instance.exports;
15 |
16 | return test()
17 | }
18 |
19 | go()
20 |
--------------------------------------------------------------------------------
/wasm-calc10/test/static/bigfunction.calc:
--------------------------------------------------------------------------------
1 | function big(
2 | a: Int32,
3 | b: Int32,
4 | c: Int32,
5 | d: Int32,
6 | e: Int32,
7 | f: Int32,
8 | g: Int32,
9 | h: Int32
10 | ) -> Int32 {
11 | if 1 then
12 | 2
13 | else
14 | {
15 | let a: Int8 = 100;
16 | if 3 then
17 | 4
18 | else
19 | if 5 then
20 | 6
21 | else
22 | if 7 then 8 else if 9 then 10 else 11
23 | }
24 | }
--------------------------------------------------------------------------------
/wasm-calc10/test/static/noalloc.calc:
--------------------------------------------------------------------------------
1 | function [noglobalmutate noallocate noimports] add(
2 | a: Int8, b: Int8
3 | ) -> Int8 { a + b}
4 |
5 | function id(a: a) -> a { a}
6 |
7 | export function test(index: Int8) -> Int8 {
8 | let a: Box(Int8) = Box(1);
9 | let b: Box(Int8) = Box(2);
10 | let (Box(c),Box(d)) = (id(a),id(b));
11 | add(c, d)
12 | }
13 |
14 | function patternMatch(
15 | tuple: (Boolean,Boolean,Int8)
16 | ) -> Int8 {
17 | case tuple {
18 | (True,False,c) -> { c },
19 | (False,True,c) -> { 1 - c },
20 | _ -> 0
21 | }
22 | }
--------------------------------------------------------------------------------
/wasm-calc11/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle
2 | .direnv
3 |
--------------------------------------------------------------------------------
/wasm-calc11/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Revision history for nix-basic
2 |
3 | ## 0.1.0.0 -- YYYY-mm-dd
4 |
5 | * First version. Released on an unsuspecting world.
6 |
--------------------------------------------------------------------------------
/wasm-calc11/demo/.gitignore:
--------------------------------------------------------------------------------
1 | # ignore compiler wasm files
2 | *.wasm
3 |
--------------------------------------------------------------------------------
/wasm-calc11/demo/README.md:
--------------------------------------------------------------------------------
1 | # demo
2 |
3 | This is a small demo that runs in the browser, passing a `draw` function into a
4 | WASM module.
5 |
6 | To open it in a browser, run `serve .` and navigate to
7 | `localhost:3000/draw.html`.
8 |
9 | To change the file and see results, run `watchexec -w ./**/*.calc make
10 | run-build-drawing-demo-7`. This will watch all `.calc` files and recompile on file changes.
11 |
12 | You will need to reload the browser after each change.
13 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc.hs:
--------------------------------------------------------------------------------
1 | module Calc
2 | ( module Calc.Types,
3 | module Calc.Build,
4 | module Calc.Parser,
5 | module Calc.ExprUtils,
6 | module Calc.Repl,
7 | module Calc.Wasm,
8 | module Calc.PrettyPrint,
9 | )
10 | where
11 |
12 | import Calc.Build
13 | import Calc.ExprUtils
14 | import Calc.Parser
15 | import Calc.PrettyPrint
16 | import Calc.Repl
17 | import Calc.Types
18 | import Calc.Wasm
19 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Build/Print.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE FlexibleContexts #-}
2 | {-# LANGUAGE FlexibleInstances #-}
3 | {-# LANGUAGE MultiParamTypeClasses #-}
4 |
5 | module Calc.Build.Print (printBuildError) where
6 |
7 | import Calc.Build.Steps
8 | import Control.Monad.IO.Class
9 | import qualified Data.Text.IO as T
10 | import qualified Error.Diagnose as Diag
11 |
12 | printBuildError :: (MonadIO m) => BuildError -> m ()
13 | printBuildError (BuildDiagnostic diag) =
14 | Diag.printDiagnostic
15 | Diag.stderr
16 | Diag.WithUnicode
17 | (Diag.TabSize 4)
18 | Diag.defaultStyle
19 | diag
20 | printBuildError (BuildMessage msg) =
21 | liftIO (T.hPutStrLn Diag.stderr msg)
22 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Linearity.hs:
--------------------------------------------------------------------------------
1 | module Calc.Linearity
2 | ( module Calc.Linearity.Types,
3 | module Calc.Linearity.Error,
4 | module Calc.Linearity.Validate,
5 | )
6 | where
7 |
8 | import Calc.Linearity.Error
9 | import Calc.Linearity.Types
10 | import Calc.Linearity.Validate
11 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Parser/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Types
2 | ( Parser,
3 | ParseErrorType,
4 | ParserExpr,
5 | ParserType,
6 | ParserFunction,
7 | ParserModule,
8 | ParserPattern,
9 | ParserData,
10 | )
11 | where
12 |
13 | import Calc.Types.Annotation
14 | import Calc.Types.Data
15 | import Calc.Types.Expr
16 | import Calc.Types.Function
17 | import Calc.Types.Module
18 | import Calc.Types.Pattern
19 | import Calc.Types.Type
20 | import Data.Text (Text)
21 | import Data.Void
22 | import Text.Megaparsec
23 |
24 | type Parser = Parsec Void Text
25 |
26 | type ParseErrorType = ParseErrorBundle Text Void
27 |
28 | type ParserExpr = Expr Annotation
29 |
30 | type ParserType = Type Annotation
31 |
32 | type ParserFunction = Function Annotation
33 |
34 | type ParserModule = [ModuleItem Annotation]
35 |
36 | type ParserPattern = Pattern Annotation
37 |
38 | type ParserData = Data Annotation
39 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/PrettyPrint.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE FlexibleContexts #-}
2 | {-# LANGUAGE FlexibleInstances #-}
3 | {-# LANGUAGE MultiParamTypeClasses #-}
4 |
5 | module Calc.PrettyPrint
6 | ( prettyPrint,
7 | )
8 | where
9 |
10 | import Calc.Build.Format
11 | import Calc.Build.Print
12 | import Calc.Build.Steps
13 | import Control.Monad.IO.Class
14 | import Data.Functor (($>))
15 | import qualified Data.Text as T
16 | import System.Exit
17 |
18 | prettyPrint :: FilePath -> IO ()
19 | prettyPrint filePath =
20 | liftIO $ doPrettyPrint filePath >>= exitWith
21 |
22 | doPrettyPrint :: (MonadIO m) => FilePath -> m ExitCode
23 | doPrettyPrint filePath = do
24 | input <- liftIO (readFile filePath)
25 | case parseModuleStep (T.pack input) of
26 | Left buildError -> printBuildError buildError $> ExitFailure 1
27 | Right parsedModule -> do
28 | formatAndSave filePath (T.pack input) parsedModule
29 | pure ExitSuccess
30 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Typecheck.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck
2 | ( module Calc.Typecheck.Error,
3 | module Calc.Typecheck.Helpers,
4 | module Calc.Typecheck.Elaborate,
5 | module Calc.Typecheck.Types,
6 | module Calc.Typecheck.Infer,
7 | )
8 | where
9 |
10 | import Calc.Typecheck.Elaborate
11 | import Calc.Typecheck.Error
12 | import Calc.Typecheck.Helpers
13 | import Calc.Typecheck.Infer
14 | import Calc.Typecheck.Types
15 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Typecheck/Error.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Error
2 | ( module Calc.Typecheck.Error.TypeError,
3 | module Calc.Typecheck.Error.PatternMatchError,
4 | )
5 | where
6 |
7 | import Calc.Typecheck.Error.PatternMatchError
8 | import Calc.Typecheck.Error.TypeError
9 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Typecheck/Patterns.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Patterns
2 | ( module Calc.Typecheck.Patterns.Annihilate,
3 | module Calc.Typecheck.Patterns.Validate,
4 | module Calc.Typecheck.Patterns.Generate,
5 | )
6 | where
7 |
8 | import Calc.Typecheck.Patterns.Annihilate
9 | import Calc.Typecheck.Patterns.Generate
10 | import Calc.Typecheck.Patterns.Validate
11 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Typecheck/Substitute.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Substitute (substitute) where
2 |
3 | import Calc.TypeUtils
4 | import Calc.Types.Type
5 | import qualified Data.HashMap.Strict as HM
6 | import Data.Maybe (fromMaybe)
7 | import GHC.Natural
8 |
9 | substitute ::
10 | HM.HashMap Natural (Type ann) ->
11 | Type ann ->
12 | Type ann
13 | substitute subs oldTy@(TUnificationVar _ nat) =
14 | fromMaybe oldTy (HM.lookup nat subs)
15 | substitute subs other =
16 | mapType (substitute subs) other
17 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Types/Ability.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE OverloadedStrings #-}
4 |
5 | module Calc.Types.Ability where
6 |
7 | import Calc.Types.Function
8 | import Calc.Types.Identifier
9 | import Prettyprinter ((<+>))
10 | import qualified Prettyprinter as PP
11 |
12 | -- | things that our functions might do
13 | data Ability ann
14 | = AllocateMemory ann
15 | | CallImportedFunction ann FunctionName
16 | | MutateGlobal ann Identifier
17 | deriving stock (Eq, Ord, Show, Functor)
18 |
19 | instance PP.Pretty (Ability ann) where
20 | pretty (AllocateMemory _) =
21 | "Allocating memory"
22 | pretty (CallImportedFunction _ fnName) =
23 | "Calling imported function" <+> PP.dquotes (PP.pretty fnName)
24 | pretty (MutateGlobal _ ident) =
25 | "Mutate global" <+> PP.dquotes (PP.pretty ident)
26 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Types/Annotation.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Annotation
4 | ( Annotation (..),
5 | )
6 | where
7 |
8 | -- | `Annotation` is used to track source code location
9 | -- it is added to parts of `Expr` during parsing and used to
10 | -- make errors nicer
11 | data Annotation = Location Int Int
12 | deriving stock (Eq, Ord, Show)
13 |
14 | -- | when combining two `Annotation`, combine to make one big annotation
15 | instance Semigroup Annotation where
16 | (Location start end) <> (Location start' end') =
17 | Location (min start start') (max end end')
18 |
19 | -- | Default to an empty `Annotation`
20 | instance Monoid Annotation where
21 | mempty = Location 0 0
22 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Types/DataName.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.DataName (DataName (..)) where
5 |
6 | import Calc.Types.Constructor
7 | import qualified Prettyprinter as PP
8 |
9 | newtype DataName = DataName Constructor
10 | deriving newtype (Eq, Ord, Show, PP.Pretty)
11 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Types/FunctionName.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.FunctionName
5 | ( FunctionName (..),
6 | )
7 | where
8 |
9 | import Data.Hashable
10 | import Data.String
11 | import Data.Text (Text)
12 | import qualified Data.Text as T
13 | import qualified Prettyprinter as PP
14 |
15 | newtype FunctionName = FunctionName Text
16 | deriving newtype (Eq, Ord, Show, Hashable)
17 |
18 | instance IsString FunctionName where
19 | fromString = FunctionName . T.pack
20 |
21 | instance PP.Pretty FunctionName where
22 | pretty (FunctionName fn) = PP.pretty fn
23 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Types/Memory.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE NamedFieldPuns #-}
4 | {-# LANGUAGE OverloadedStrings #-}
5 |
6 | module Calc.Types.Memory (Memory (..)) where
7 |
8 | import Calc.Types.Identifier
9 | import GHC.Natural
10 | import Prettyprinter ((<+>))
11 | import qualified Prettyprinter as PP
12 |
13 | data Memory ann
14 | = LocalMemory {lmAnn :: ann, lmLimit :: Natural}
15 | | ImportedMemory
16 | { imAnn :: ann,
17 | imExternalModule :: Identifier,
18 | imExternalMemoryName :: Identifier,
19 | imLimit :: Natural
20 | }
21 | deriving stock (Eq, Ord, Show, Functor)
22 |
23 | instance PP.Pretty (Memory ann) where
24 | pretty (LocalMemory {lmLimit}) =
25 | "memory" <+> PP.pretty lmLimit
26 | pretty (ImportedMemory {imExternalModule, imExternalMemoryName, imLimit}) =
27 | "import" <+> PP.pretty imExternalModule <> "." <> PP.pretty imExternalMemoryName <+> "as memory" <+> PP.pretty imLimit
28 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Types/ModuleAnnotations.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.ModuleAnnotations (ModuleAnnotations (..)) where
4 |
5 | import Calc.Types
6 | import qualified Data.Map.Strict as M
7 |
8 | data ModuleAnnotations ann = ModuleAnnotations
9 | { maFunctions :: M.Map FunctionName ann,
10 | maTests :: M.Map Identifier ann
11 | }
12 | deriving stock (Eq, Ord, Show)
13 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Types/Op.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE OverloadedStrings #-}
3 |
4 | module Calc.Types.Op (Op (..)) where
5 |
6 | import qualified Prettyprinter as PP
7 |
8 | data Op
9 | = OpAdd
10 | | OpMultiply
11 | | OpSubtract
12 | | OpEquals
13 | | OpGreaterThan
14 | | OpGreaterThanOrEqualTo
15 | | OpLessThan
16 | | OpLessThanOrEqualTo
17 | | OpAnd
18 | | OpOr
19 | | OpRemainder
20 | deriving stock (Eq, Ord, Show)
21 |
22 | -- how to print `Op` values
23 | instance PP.Pretty Op where
24 | pretty OpAdd = "+"
25 | pretty OpMultiply = "*"
26 | pretty OpSubtract = "-"
27 | pretty OpEquals = "=="
28 | pretty OpGreaterThan = ">"
29 | pretty OpGreaterThanOrEqualTo = ">="
30 | pretty OpLessThan = "<"
31 | pretty OpLessThanOrEqualTo = "<="
32 | pretty OpAnd = "&&"
33 | pretty OpOr = "||"
34 | pretty OpRemainder = "%"
35 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Types/Prim.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Prim
4 | ( Prim (..),
5 | )
6 | where
7 |
8 | import Data.Word
9 | import qualified Prettyprinter as PP
10 |
11 | data Prim
12 | = PIntLit Word64 -- a polymorphic int literal, we don't know what size
13 | | PFloatLit Double -- a polymorphic float literal, we don't know what size
14 | | PBool Bool
15 | deriving stock (Eq, Ord, Show)
16 |
17 | instance PP.Pretty Prim where
18 | pretty (PIntLit i) = PP.pretty i
19 | pretty (PFloatLit f) = PP.pretty f
20 | pretty (PBool b) = PP.pretty b
21 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Types/Test.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE NamedFieldPuns #-}
4 | {-# LANGUAGE OverloadedStrings #-}
5 |
6 | module Calc.Types.Test where
7 |
8 | import Calc.Types.Expr
9 | import Calc.Types.Identifier
10 | import Calc.Utils
11 | import Prettyprinter ((<+>))
12 | import qualified Prettyprinter as PP
13 |
14 | data Test ann = Test
15 | { tesAnn :: ann,
16 | tesName :: Identifier,
17 | tesExpr :: Expr ann
18 | }
19 | deriving stock (Eq, Ord, Show, Functor)
20 |
21 | instance PP.Pretty (Test ann) where
22 | pretty (Test {tesName, tesExpr}) =
23 | "test"
24 | <+> PP.pretty tesName
25 | <+> "="
26 | <+> PP.line
27 | <> indentMulti 2 (PP.pretty tesExpr)
28 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Types/TypeVar.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.TypeVar (TypeVar (..), safeMkTypeVar) where
5 |
6 | import qualified Data.Char as Ch
7 | import Data.Hashable
8 | import Data.String
9 | import Data.Text (Text)
10 | import qualified Data.Text as T
11 | import qualified Prettyprinter as PP
12 |
13 | newtype TypeVar = TypeVar Text
14 | deriving newtype (Eq, Ord, Show, Hashable)
15 |
16 | instance IsString TypeVar where
17 | fromString = TypeVar . T.pack
18 |
19 | instance PP.Pretty TypeVar where
20 | pretty (TypeVar ident) = PP.pretty ident
21 |
22 | validTypeVar :: Text -> Bool
23 | validTypeVar a =
24 | T.length a > 0
25 | && T.filter Ch.isAlphaNum a == a
26 | && not (Ch.isDigit (T.head a))
27 | && Ch.isLower (T.head a)
28 |
29 | safeMkTypeVar :: Text -> Maybe TypeVar
30 | safeMkTypeVar a =
31 | if validTypeVar a
32 | then Just (TypeVar a)
33 | else Nothing
34 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Wasm.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm (module Calc.Wasm.WriteModule) where
2 |
3 | import Calc.Wasm.WriteModule
4 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Wasm/Allocator.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE TemplateHaskell #-}
2 |
3 | module Calc.Wasm.Allocator (moduleWithAllocator) where
4 |
5 | import qualified Data.ByteString as B
6 | import Data.FileEmbed
7 | import qualified Language.Wasm as Wasm
8 |
9 | -- these are saved in a file that is included in compilation
10 | allocatorSource :: B.ByteString
11 | allocatorSource =
12 | $(makeRelativeToProject "static/malloc.wasm" >>= embedFile)
13 |
14 | -- we have an allocator, we need to import it
15 | moduleWithAllocator :: Wasm.Module
16 | moduleWithAllocator = case Wasm.decode allocatorSource of
17 | Right mod' -> mod'
18 | Left e -> error (show e)
19 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Wasm/FromExpr.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.FromExpr (module Calc.Wasm.FromExpr.Types, module Calc.Wasm.FromExpr.Module) where
2 |
3 | import Calc.Wasm.FromExpr.Module
4 | import Calc.Wasm.FromExpr.Types
5 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Wasm/FromExpr/Patterns.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.FromExpr.Patterns
2 | ( module Calc.Wasm.FromExpr.Patterns.Paths,
3 | module Calc.Wasm.FromExpr.Patterns.Predicates,
4 | )
5 | where
6 |
7 | import Calc.Wasm.FromExpr.Patterns.Paths
8 | import Calc.Wasm.FromExpr.Patterns.Predicates
9 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Wasm/Run.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Wasm.Run (runWasm) where
4 |
5 | import Calc.Utils
6 | import qualified Data.Text.Lazy as TL
7 | import qualified Language.Wasm as Wasm
8 | import qualified Language.Wasm.Interpreter as Wasm
9 |
10 | runWasm :: TL.Text -> Wasm.Module -> IO (Maybe [Wasm.Value])
11 | runWasm startFunctionName wasmModule = do
12 | case Wasm.validate wasmModule of
13 | Right validModule -> do
14 | (result, store) <- Wasm.instantiate Wasm.emptyStore mempty validModule
15 | case result of
16 | Right moduleInstance ->
17 | Wasm.invokeExport store moduleInstance startFunctionName mempty
18 | Left e -> error $ "Error instantiating wasm module: " <> show e
19 | Left e ->
20 | error $
21 | "invalid module: "
22 | <> show e
23 | <> "\n\n"
24 | <> prettyShow wasmModule
25 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Wasm/ToWasm.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.ToWasm
2 | ( module Calc.Wasm.ToWasm.Module,
3 | module Calc.Wasm.ToWasm.Types,
4 | module Calc.Wasm.ToWasm.Helpers,
5 | )
6 | where
7 |
8 | import Calc.Wasm.ToWasm.Helpers
9 | import Calc.Wasm.ToWasm.Module
10 | import Calc.Wasm.ToWasm.Types
11 |
--------------------------------------------------------------------------------
/wasm-calc11/src/Calc/Wasm/WriteModule.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.WriteModule (printModule, writeModule) where
2 |
3 | import qualified Data.ByteString as BS
4 | import qualified Language.Wasm.Binary as Wasm
5 | import qualified Language.Wasm.Structure as Wasm
6 |
7 | -- | in which we write some actual files somewhere for lols
8 | writeModule :: FilePath -> Wasm.Module -> IO ()
9 | writeModule path wasmMod = do
10 | let bs = Wasm.dumpModule wasmMod
11 | BS.writeFile path bs
12 |
13 | -- | in which we output to stdout
14 | printModule :: Wasm.Module -> IO ()
15 | printModule = BS.putStr . Wasm.dumpModule
16 |
--------------------------------------------------------------------------------
/wasm-calc11/static/.gitignore:
--------------------------------------------------------------------------------
1 | # generated malloc file, don't keep
2 | malloc-new.wasm
3 |
--------------------------------------------------------------------------------
/wasm-calc11/static/malloc-new.wat:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/danieljharvey/wasm-calc/aa3b58a049d37192528afc441c01f9642fa3f731/wasm-calc11/static/malloc-new.wat
--------------------------------------------------------------------------------
/wasm-calc11/static/malloc-old.wasm:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/danieljharvey/wasm-calc/aa3b58a049d37192528afc441c01f9642fa3f731/wasm-calc11/static/malloc-old.wasm
--------------------------------------------------------------------------------
/wasm-calc11/static/malloc.wasm:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/danieljharvey/wasm-calc/aa3b58a049d37192528afc441c01f9642fa3f731/wasm-calc11/static/malloc.wasm
--------------------------------------------------------------------------------
/wasm-calc11/test/Main.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import qualified Test.Ability.AbilitySpec
4 | import Test.Hspec
5 | import qualified Test.Linearity.LinearitySpec
6 | import qualified Test.Parser.ParserSpec
7 | import qualified Test.PrettyPrint.PrettyPrintSpec
8 | import qualified Test.Typecheck.PatternsSpec
9 | import qualified Test.Typecheck.TypecheckSpec
10 | import qualified Test.Wasm.FromWasmSpec
11 | import qualified Test.Wasm.WasmSpec
12 |
13 | main :: IO ()
14 | main = hspec $ do
15 | Test.Ability.AbilitySpec.spec
16 | Test.Parser.ParserSpec.spec
17 | Test.PrettyPrint.PrettyPrintSpec.spec
18 | Test.Linearity.LinearitySpec.spec
19 | Test.Typecheck.TypecheckSpec.spec
20 | Test.Typecheck.PatternsSpec.spec
21 | Test.Wasm.WasmSpec.spec
22 | Test.Wasm.FromWasmSpec.spec
23 |
--------------------------------------------------------------------------------
/wasm-calc11/test/js/test.mjs:
--------------------------------------------------------------------------------
1 | // this file is used in tests to check imports work correctly
2 | import fs from "fs/promises";
3 |
4 | const filename = process.argv[2];
5 | const wasmBytes = await fs.readFile(filename);
6 |
7 | async function go() {
8 | const imports = {
9 | console : {log : a => console.log(a)},
10 | env : {memory : new WebAssembly.Memory({initial : 1})}
11 | };
12 |
13 | const {instance} = await WebAssembly.instantiate(wasmBytes, imports);
14 | const {test} = instance.exports;
15 |
16 | return test()
17 | }
18 |
19 | go()
20 |
--------------------------------------------------------------------------------
/wasm-calc11/test/static/bigfunction.calc:
--------------------------------------------------------------------------------
1 | function big(
2 | a: Int32,
3 | b: Int32,
4 | c: Int32,
5 | d: Int32,
6 | e: Int32,
7 | f: Int32,
8 | g: Int32,
9 | h: Int32
10 | ) -> Int32 {
11 | if True then
12 | 2
13 | else
14 | {
15 | let a: Int8 = 100;
16 | if False then
17 | 4
18 | else
19 | if True then
20 | 6
21 | else
22 | if True then 8 else if False then 10 else 11
23 | }
24 | }
--------------------------------------------------------------------------------
/wasm-calc11/test/static/datatypes.calc:
--------------------------------------------------------------------------------
1 | type Colour
2 | = Blue
3 | | Green
4 | | Red
5 |
6 | type Maybe
7 | = Just(a)
8 | | Nothing
9 |
10 | type Either
11 | = Left(e)
12 | | Right(a)
13 |
14 | type These
15 | = That(b)
16 | | These(a, b)
17 | | This(a)
18 |
19 | type Expr
20 | = EBool(ann, Boolean)
21 | | EInt(ann, Int32)
22 |
23 | type List
24 | = Cons(a, List(a))
25 | | Nil
26 |
27 | function matchList() -> Boolean {
28 | let list = Cons(True, Cons(False, Cons(True, Nil)));
29 | case list {
30 | Cons(a, Cons(b, Cons(c, Nil))) -> a && b && c,
31 | _ -> False
32 | }
33 | }
34 |
35 | function listId(list: List(a)) -> List(a) { list}
36 |
37 | function nextColour(colour: Colour) -> Colour {
38 | case colour { Red -> Green, Green -> Blue, Blue -> Red }
39 | }
--------------------------------------------------------------------------------
/wasm-calc11/test/static/noalloc.calc:
--------------------------------------------------------------------------------
1 | function [noglobalmutate noallocate noimports] add(
2 | a: Int8, b: Int8
3 | ) -> Int8 { a + b}
4 |
5 | function id(a: a) -> a { a}
6 |
7 | export function test(index: Int8) -> Int8 {
8 | let a: Box(Int8) = Box(1);
9 | let b: Box(Int8) = Box(2);
10 | let (Box(c), Box(d)) = (id(a), id(b));
11 | add(c, d)
12 | }
--------------------------------------------------------------------------------
/wasm-calc11/test/static/smalltypecheck.calc:
--------------------------------------------------------------------------------
1 | type Result
2 | = Left(e)
3 | | Right(a)
4 |
5 | type Type
6 | = TBoolean
7 | | TInt
8 |
9 | type Expr
10 | = EBoolean(ann, Boolean)
11 | | EInt(ann, Int32)
12 |
13 | type Unit
14 | = Unit
15 |
16 | type Error
17 | = OhNo
18 |
19 | function typecheck(expr: Expr(Unit)) -> Result(
20 | Error, Expr(Type)
21 | ) {
22 | case expr {
23 | EInt(_, i) -> Right(EInt(TInt, i)),
24 | EBoolean(_, b) -> Right(EBoolean(TBoolean, b))
25 | }
26 | }
--------------------------------------------------------------------------------
/wasm-calc12/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle
2 | .direnv
3 |
--------------------------------------------------------------------------------
/wasm-calc12/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Revision history for nix-basic
2 |
3 | ## 0.1.0.0 -- YYYY-mm-dd
4 |
5 | * First version. Released on an unsuspecting world.
6 |
--------------------------------------------------------------------------------
/wasm-calc12/demo/.gitignore:
--------------------------------------------------------------------------------
1 | # ignore compiler wasm files
2 | *.wasm
3 |
--------------------------------------------------------------------------------
/wasm-calc12/demo/README.md:
--------------------------------------------------------------------------------
1 | # demo
2 |
3 | This is a small demo that runs in the browser, passing a `draw` function into a
4 | WASM module.
5 |
6 | To open it in a browser, run `serve .` and navigate to
7 | `localhost:3000/draw.html`.
8 |
9 | To change the file and see results, run `watchexec -w ./**/*.calc make
10 | run-build-drawing-demo-7`. This will watch all `.calc` files and recompile on file changes.
11 |
12 | You will need to reload the browser after each change.
13 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc.hs:
--------------------------------------------------------------------------------
1 | module Calc
2 | ( module Calc.Types,
3 | module Calc.Build,
4 | module Calc.Parser,
5 | module Calc.ExprUtils,
6 | module Calc.Repl,
7 | module Calc.Wasm,
8 | module Calc.PrettyPrint,
9 | )
10 | where
11 |
12 | import Calc.Build
13 | import Calc.ExprUtils
14 | import Calc.Parser
15 | import Calc.PrettyPrint
16 | import Calc.Repl
17 | import Calc.Types
18 | import Calc.Wasm
19 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Build/Print.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE FlexibleContexts #-}
2 | {-# LANGUAGE FlexibleInstances #-}
3 | {-# LANGUAGE MultiParamTypeClasses #-}
4 |
5 | module Calc.Build.Print (printBuildError) where
6 |
7 | import Calc.Build.Steps
8 | import Control.Monad.IO.Class
9 | import qualified Data.Text.IO as T
10 | import qualified Error.Diagnose as Diag
11 |
12 | printBuildError :: (MonadIO m) => BuildError -> m ()
13 | printBuildError (BuildDiagnostic diag) =
14 | Diag.printDiagnostic
15 | Diag.stderr
16 | Diag.WithUnicode
17 | (Diag.TabSize 4)
18 | Diag.defaultStyle
19 | diag
20 | printBuildError (BuildMessage msg) =
21 | liftIO (T.hPutStrLn Diag.stderr msg)
22 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Linearity.hs:
--------------------------------------------------------------------------------
1 | module Calc.Linearity
2 | ( module Calc.Linearity.Types,
3 | module Calc.Linearity.Error,
4 | module Calc.Linearity.Validate,
5 | )
6 | where
7 |
8 | import Calc.Linearity.Error
9 | import Calc.Linearity.Types
10 | import Calc.Linearity.Validate
11 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Parser/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Types
2 | ( Parser,
3 | ParseErrorType,
4 | ParserExpr,
5 | ParserType,
6 | ParserFunction,
7 | ParserModule,
8 | ParserPattern,
9 | ParserData,
10 | )
11 | where
12 |
13 | import Calc.Types.Annotation
14 | import Calc.Types.Data
15 | import Calc.Types.Expr
16 | import Calc.Types.Function
17 | import Calc.Types.Module
18 | import Calc.Types.Pattern
19 | import Calc.Types.Type
20 | import Data.Text (Text)
21 | import Data.Void
22 | import Text.Megaparsec
23 |
24 | type Parser = Parsec Void Text
25 |
26 | type ParseErrorType = ParseErrorBundle Text Void
27 |
28 | type ParserExpr = Expr Annotation
29 |
30 | type ParserType = Type Annotation
31 |
32 | type ParserFunction = Function Annotation
33 |
34 | type ParserModule = [ModuleItem Annotation]
35 |
36 | type ParserPattern = Pattern Annotation
37 |
38 | type ParserData = Data Annotation
39 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/PrettyPrint.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE FlexibleContexts #-}
2 | {-# LANGUAGE FlexibleInstances #-}
3 | {-# LANGUAGE MultiParamTypeClasses #-}
4 |
5 | module Calc.PrettyPrint
6 | ( prettyPrint,
7 | )
8 | where
9 |
10 | import Calc.Build.Format
11 | import Calc.Build.Print
12 | import Calc.Build.Steps
13 | import Control.Monad.IO.Class
14 | import Data.Functor (($>))
15 | import qualified Data.Text as T
16 | import System.Exit
17 |
18 | prettyPrint :: FilePath -> IO ()
19 | prettyPrint filePath =
20 | liftIO $ doPrettyPrint filePath >>= exitWith
21 |
22 | doPrettyPrint :: (MonadIO m) => FilePath -> m ExitCode
23 | doPrettyPrint filePath = do
24 | input <- liftIO (readFile filePath)
25 | case parseModuleStep (T.pack input) of
26 | Left buildError -> printBuildError buildError $> ExitFailure 1
27 | Right parsedModule -> do
28 | formatAndSave filePath (T.pack input) parsedModule
29 | pure ExitSuccess
30 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Typecheck.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck
2 | ( module Calc.Typecheck.Error,
3 | module Calc.Typecheck.Helpers,
4 | module Calc.Typecheck.Elaborate,
5 | module Calc.Typecheck.Types,
6 | module Calc.Typecheck.Infer,
7 | )
8 | where
9 |
10 | import Calc.Typecheck.Elaborate
11 | import Calc.Typecheck.Error
12 | import Calc.Typecheck.Helpers
13 | import Calc.Typecheck.Infer
14 | import Calc.Typecheck.Types
15 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Typecheck/Error.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Error
2 | ( module Calc.Typecheck.Error.TypeError,
3 | module Calc.Typecheck.Error.PatternMatchError,
4 | )
5 | where
6 |
7 | import Calc.Typecheck.Error.PatternMatchError
8 | import Calc.Typecheck.Error.TypeError
9 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Typecheck/Patterns.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Patterns
2 | ( module Calc.Typecheck.Patterns.Annihilate,
3 | module Calc.Typecheck.Patterns.Validate,
4 | module Calc.Typecheck.Patterns.Generate,
5 | )
6 | where
7 |
8 | import Calc.Typecheck.Patterns.Annihilate
9 | import Calc.Typecheck.Patterns.Generate
10 | import Calc.Typecheck.Patterns.Validate
11 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Typecheck/Substitute.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Substitute (substitute) where
2 |
3 | import Calc.TypeUtils
4 | import Calc.Types.Type
5 | import qualified Data.HashMap.Strict as HM
6 | import Data.Maybe (fromMaybe)
7 | import GHC.Natural
8 |
9 | substitute ::
10 | HM.HashMap Natural (Type ann) ->
11 | Type ann ->
12 | Type ann
13 | substitute subs oldTy@(TUnificationVar _ nat) =
14 | fromMaybe oldTy (HM.lookup nat subs)
15 | substitute subs other =
16 | mapType (substitute subs) other
17 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Types/Ability.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE OverloadedStrings #-}
4 |
5 | module Calc.Types.Ability where
6 |
7 | import Calc.Types.Function
8 | import Calc.Types.Identifier
9 | import Prettyprinter ((<+>))
10 | import qualified Prettyprinter as PP
11 |
12 | -- | things that our functions might do
13 | data Ability ann
14 | = AllocateMemory ann
15 | | CallImportedFunction ann FunctionName
16 | | MutateGlobal ann Identifier
17 | deriving stock (Eq, Ord, Show, Functor)
18 |
19 | instance PP.Pretty (Ability ann) where
20 | pretty (AllocateMemory _) =
21 | "Allocating memory"
22 | pretty (CallImportedFunction _ fnName) =
23 | "Calling imported function" <+> PP.dquotes (PP.pretty fnName)
24 | pretty (MutateGlobal _ ident) =
25 | "Mutate global" <+> PP.dquotes (PP.pretty ident)
26 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Types/Annotation.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Annotation
4 | ( Annotation (..),
5 | )
6 | where
7 |
8 | -- | `Annotation` is used to track source code location
9 | -- it is added to parts of `Expr` during parsing and used to
10 | -- make errors nicer
11 | data Annotation = Location Int Int
12 | deriving stock (Eq, Ord, Show)
13 |
14 | -- | when combining two `Annotation`, combine to make one big annotation
15 | instance Semigroup Annotation where
16 | (Location start end) <> (Location start' end') =
17 | Location (min start start') (max end end')
18 |
19 | -- | Default to an empty `Annotation`
20 | instance Monoid Annotation where
21 | mempty = Location 0 0
22 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Types/DataName.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.DataName (DataName (..)) where
5 |
6 | import Calc.Types.Constructor
7 | import qualified Prettyprinter as PP
8 |
9 | newtype DataName = DataName Constructor
10 | deriving newtype (Eq, Ord, Show, PP.Pretty)
11 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Types/FunctionName.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.FunctionName
5 | ( FunctionName (..),
6 | )
7 | where
8 |
9 | import Data.Hashable
10 | import Data.String
11 | import Data.Text (Text)
12 | import qualified Data.Text as T
13 | import qualified Prettyprinter as PP
14 |
15 | newtype FunctionName = FunctionName Text
16 | deriving newtype (Eq, Ord, Show, Hashable)
17 |
18 | instance IsString FunctionName where
19 | fromString = FunctionName . T.pack
20 |
21 | instance PP.Pretty FunctionName where
22 | pretty (FunctionName fn) = PP.pretty fn
23 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Types/Memory.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE NamedFieldPuns #-}
4 | {-# LANGUAGE OverloadedStrings #-}
5 |
6 | module Calc.Types.Memory (Memory (..)) where
7 |
8 | import Calc.Types.Identifier
9 | import GHC.Natural
10 | import Prettyprinter ((<+>))
11 | import qualified Prettyprinter as PP
12 |
13 | data Memory ann
14 | = LocalMemory {lmAnn :: ann, lmLimit :: Natural}
15 | | ImportedMemory
16 | { imAnn :: ann,
17 | imExternalModule :: Identifier,
18 | imExternalMemoryName :: Identifier,
19 | imLimit :: Natural
20 | }
21 | deriving stock (Eq, Ord, Show, Functor)
22 |
23 | instance PP.Pretty (Memory ann) where
24 | pretty (LocalMemory {lmLimit}) =
25 | "memory" <+> PP.pretty lmLimit
26 | pretty (ImportedMemory {imExternalModule, imExternalMemoryName, imLimit}) =
27 | "import" <+> PP.pretty imExternalModule <> "." <> PP.pretty imExternalMemoryName <+> "as memory" <+> PP.pretty imLimit
28 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Types/ModuleAnnotations.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.ModuleAnnotations (ModuleAnnotations (..)) where
4 |
5 | import Calc.Types
6 | import qualified Data.Map.Strict as M
7 |
8 | data ModuleAnnotations ann = ModuleAnnotations
9 | { maFunctions :: M.Map FunctionName ann,
10 | maTests :: M.Map Identifier ann
11 | }
12 | deriving stock (Eq, Ord, Show)
13 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Types/Op.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE OverloadedStrings #-}
3 |
4 | module Calc.Types.Op (Op (..)) where
5 |
6 | import qualified Prettyprinter as PP
7 |
8 | data Op
9 | = OpAdd
10 | | OpMultiply
11 | | OpSubtract
12 | | OpEquals
13 | | OpGreaterThan
14 | | OpGreaterThanOrEqualTo
15 | | OpLessThan
16 | | OpLessThanOrEqualTo
17 | | OpAnd
18 | | OpOr
19 | | OpRemainder
20 | deriving stock (Eq, Ord, Show)
21 |
22 | -- how to print `Op` values
23 | instance PP.Pretty Op where
24 | pretty OpAdd = "+"
25 | pretty OpMultiply = "*"
26 | pretty OpSubtract = "-"
27 | pretty OpEquals = "=="
28 | pretty OpGreaterThan = ">"
29 | pretty OpGreaterThanOrEqualTo = ">="
30 | pretty OpLessThan = "<"
31 | pretty OpLessThanOrEqualTo = "<="
32 | pretty OpAnd = "&&"
33 | pretty OpOr = "||"
34 | pretty OpRemainder = "%"
35 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Types/Prim.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Prim
4 | ( Prim (..),
5 | )
6 | where
7 |
8 | import Data.Word
9 | import qualified Prettyprinter as PP
10 |
11 | data Prim
12 | = PIntLit Word64 -- a polymorphic int literal, we don't know what size
13 | | PFloatLit Double -- a polymorphic float literal, we don't know what size
14 | | PBool Bool
15 | deriving stock (Eq, Ord, Show)
16 |
17 | instance PP.Pretty Prim where
18 | pretty (PIntLit i) = PP.pretty i
19 | pretty (PFloatLit f) = PP.pretty f
20 | pretty (PBool b) = PP.pretty b
21 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Types/Test.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE NamedFieldPuns #-}
4 | {-# LANGUAGE OverloadedStrings #-}
5 |
6 | module Calc.Types.Test where
7 |
8 | import Calc.Types.Expr
9 | import Calc.Types.Identifier
10 | import Calc.Utils
11 | import Prettyprinter ((<+>))
12 | import qualified Prettyprinter as PP
13 |
14 | data Test ann = Test
15 | { tesAnn :: ann,
16 | tesName :: Identifier,
17 | tesExpr :: Expr ann
18 | }
19 | deriving stock (Eq, Ord, Show, Functor)
20 |
21 | instance PP.Pretty (Test ann) where
22 | pretty (Test {tesName, tesExpr}) =
23 | "test"
24 | <+> PP.pretty tesName
25 | <+> "="
26 | <+> PP.line
27 | <> indentMulti 2 (PP.pretty tesExpr)
28 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Types/TypeVar.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.TypeVar (TypeVar (..), safeMkTypeVar) where
5 |
6 | import qualified Data.Char as Ch
7 | import Data.Hashable
8 | import Data.String
9 | import Data.Text (Text)
10 | import qualified Data.Text as T
11 | import qualified Prettyprinter as PP
12 |
13 | newtype TypeVar = TypeVar Text
14 | deriving newtype (Eq, Ord, Show, Hashable)
15 |
16 | instance IsString TypeVar where
17 | fromString = TypeVar . T.pack
18 |
19 | instance PP.Pretty TypeVar where
20 | pretty (TypeVar ident) = PP.pretty ident
21 |
22 | validTypeVar :: Text -> Bool
23 | validTypeVar a =
24 | T.length a > 0
25 | && T.filter Ch.isAlphaNum a == a
26 | && not (Ch.isDigit (T.head a))
27 | && Ch.isLower (T.head a)
28 |
29 | safeMkTypeVar :: Text -> Maybe TypeVar
30 | safeMkTypeVar a =
31 | if validTypeVar a
32 | then Just (TypeVar a)
33 | else Nothing
34 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Wasm.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm (module Calc.Wasm.WriteModule) where
2 |
3 | import Calc.Wasm.WriteModule
4 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Wasm/Allocator.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE TemplateHaskell #-}
2 |
3 | module Calc.Wasm.Allocator (moduleWithAllocator) where
4 |
5 | import qualified Data.ByteString as B
6 | import Data.FileEmbed
7 | import qualified Language.Wasm as Wasm
8 |
9 | -- these are saved in a file that is included in compilation
10 | allocatorSource :: B.ByteString
11 | allocatorSource =
12 | $(makeRelativeToProject "static/malloc.wasm" >>= embedFile)
13 |
14 | -- we have an allocator, we need to import it
15 | moduleWithAllocator :: Wasm.Module
16 | moduleWithAllocator = case Wasm.decode allocatorSource of
17 | Right mod' -> mod'
18 | Left e -> error (show e)
19 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Wasm/FromExpr.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.FromExpr (module Calc.Wasm.FromExpr.Types, module Calc.Wasm.FromExpr.Module) where
2 |
3 | import Calc.Wasm.FromExpr.Module
4 | import Calc.Wasm.FromExpr.Types
5 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Wasm/FromExpr/Patterns.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.FromExpr.Patterns
2 | ( module Calc.Wasm.FromExpr.Patterns.Paths,
3 | module Calc.Wasm.FromExpr.Patterns.Predicates,
4 | )
5 | where
6 |
7 | import Calc.Wasm.FromExpr.Patterns.Paths
8 | import Calc.Wasm.FromExpr.Patterns.Predicates
9 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Wasm/Run.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Wasm.Run (runWasm) where
4 |
5 | import Calc.Utils
6 | import qualified Data.Text.Lazy as TL
7 | import qualified Language.Wasm as Wasm
8 | import qualified Language.Wasm.Interpreter as Wasm
9 |
10 | runWasm :: TL.Text -> Wasm.Module -> IO (Maybe [Wasm.Value])
11 | runWasm startFunctionName wasmModule = do
12 | case Wasm.validate wasmModule of
13 | Right validModule -> do
14 | (result, store) <- Wasm.instantiate Wasm.emptyStore mempty validModule
15 | case result of
16 | Right moduleInstance ->
17 | Wasm.invokeExport store moduleInstance startFunctionName mempty
18 | Left e -> error $ "Error instantiating wasm module: " <> show e
19 | Left e ->
20 | error $
21 | "invalid module: "
22 | <> show e
23 | <> "\n\n"
24 | <> prettyShow wasmModule
25 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Wasm/ToWasm.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.ToWasm
2 | ( module Calc.Wasm.ToWasm.Module,
3 | module Calc.Wasm.ToWasm.Types,
4 | module Calc.Wasm.ToWasm.Helpers,
5 | )
6 | where
7 |
8 | import Calc.Wasm.ToWasm.Helpers
9 | import Calc.Wasm.ToWasm.Module
10 | import Calc.Wasm.ToWasm.Types
11 |
--------------------------------------------------------------------------------
/wasm-calc12/src/Calc/Wasm/WriteModule.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.WriteModule (printModule, writeModule) where
2 |
3 | import qualified Data.ByteString as BS
4 | import qualified Language.Wasm.Binary as Wasm
5 | import qualified Language.Wasm.Structure as Wasm
6 |
7 | -- | in which we write some actual files somewhere for lols
8 | writeModule :: FilePath -> Wasm.Module -> IO ()
9 | writeModule path wasmMod = do
10 | let bs = Wasm.dumpModule wasmMod
11 | BS.writeFile path bs
12 |
13 | -- | in which we output to stdout
14 | printModule :: Wasm.Module -> IO ()
15 | printModule = BS.putStr . Wasm.dumpModule
16 |
--------------------------------------------------------------------------------
/wasm-calc12/static/.gitignore:
--------------------------------------------------------------------------------
1 | # generated malloc file, don't keep
2 | malloc-new.wasm
3 |
--------------------------------------------------------------------------------
/wasm-calc12/static/malloc-new.wat:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/danieljharvey/wasm-calc/aa3b58a049d37192528afc441c01f9642fa3f731/wasm-calc12/static/malloc-new.wat
--------------------------------------------------------------------------------
/wasm-calc12/static/malloc-old.wasm:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/danieljharvey/wasm-calc/aa3b58a049d37192528afc441c01f9642fa3f731/wasm-calc12/static/malloc-old.wasm
--------------------------------------------------------------------------------
/wasm-calc12/static/malloc.wasm:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/danieljharvey/wasm-calc/aa3b58a049d37192528afc441c01f9642fa3f731/wasm-calc12/static/malloc.wasm
--------------------------------------------------------------------------------
/wasm-calc12/test/Main.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import qualified Test.Ability.AbilitySpec
4 | import Test.Hspec
5 | import qualified Test.Linearity.LinearitySpec
6 | import qualified Test.Parser.ParserSpec
7 | import qualified Test.PrettyPrint.PrettyPrintSpec
8 | import qualified Test.Typecheck.PatternsSpec
9 | import qualified Test.Typecheck.TypecheckSpec
10 | import qualified Test.Wasm.FromWasmSpec
11 | import qualified Test.Wasm.WasmSpec
12 |
13 | main :: IO ()
14 | main = hspec $ do
15 | Test.Ability.AbilitySpec.spec
16 | Test.Parser.ParserSpec.spec
17 | Test.PrettyPrint.PrettyPrintSpec.spec
18 | Test.Linearity.LinearitySpec.spec
19 | Test.Typecheck.TypecheckSpec.spec
20 | Test.Typecheck.PatternsSpec.spec
21 | Test.Wasm.WasmSpec.spec
22 | Test.Wasm.FromWasmSpec.spec
23 |
--------------------------------------------------------------------------------
/wasm-calc12/test/js/test.mjs:
--------------------------------------------------------------------------------
1 | // this file is used in tests to check imports work correctly
2 | import fs from "fs/promises";
3 |
4 | const filename = process.argv[2];
5 | const wasmBytes = await fs.readFile(filename);
6 |
7 | async function go() {
8 | const imports = {
9 | console : {log : a => console.log(a)},
10 | env : {memory : new WebAssembly.Memory({initial : 1})}
11 | };
12 |
13 | const {instance} = await WebAssembly.instantiate(wasmBytes, imports);
14 | const {test} = instance.exports;
15 |
16 | return test()
17 | }
18 |
19 | go()
20 |
--------------------------------------------------------------------------------
/wasm-calc12/test/static/bigfunction.calc:
--------------------------------------------------------------------------------
1 | function big(
2 | a: Int32, b: Int32, c: Int32, d: Int32, e: Int32
3 | ) -> Int32 {
4 | if True then
5 | 2
6 | else
7 | {
8 | let a: Int32 = 100;
9 | if False then
10 | a
11 | else
12 | if True then
13 | b
14 | else
15 | if True then c else if False then d else e
16 | }
17 | }
--------------------------------------------------------------------------------
/wasm-calc12/test/static/datatypes.calc:
--------------------------------------------------------------------------------
1 | type Colour
2 | = Blue
3 | | Green
4 | | Red
5 |
6 | type Maybe
7 | = Just(a)
8 | | Nothing
9 |
10 | type Either
11 | = Left(e)
12 | | Right(a)
13 |
14 | type These
15 | = That(b)
16 | | These(a, b)
17 | | This(a)
18 |
19 | type Expr
20 | = EBool(ann, Boolean)
21 | | EInt(ann, Int32)
22 |
23 | type List
24 | = Cons(a, List(a))
25 | | Nil
26 |
27 | function matchList() -> Boolean {
28 | let list = Cons(True, Cons(False, Cons(True, Nil)));
29 | case list {
30 | Cons(a, Cons(b, Cons(c, Nil))) -> a && b && c,
31 | _ -> False
32 | }
33 | }
34 |
35 | function listId(list: List(a)) -> List(a) { list}
36 |
37 | function nextColour(colour: Colour) -> Colour {
38 | case colour { Red -> Green, Green -> Blue, Blue -> Red }
39 | }
--------------------------------------------------------------------------------
/wasm-calc12/test/static/lambda.calc:
--------------------------------------------------------------------------------
1 | function useFlip() -> Boolean {
2 | let fn = \(b:Boolean) -> Boolean {
3 | if b then False else True
4 | };
5 | fn(False)
6 | }
7 |
8 | test flip =
9 | { useFlip() }
--------------------------------------------------------------------------------
/wasm-calc12/test/static/lambda2.calc:
--------------------------------------------------------------------------------
1 | type YesOrNo
2 | = No
3 | | Yes
4 |
5 | type Maybe
6 | = Just(a)
7 | | Nothing
8 |
9 | function mapMaybe(
10 | maybe: Maybe(Boolean), fn: Fn(Boolean) -> Boolean
11 | ) -> Maybe(Boolean) {
12 | case maybe { Just(a) -> Just(fn(a)), Nothing -> Nothing }
13 | }
14 |
15 | function useMapMaybe() -> Boolean {
16 | let fn = \(b:Boolean) -> Boolean {
17 | if b then False else True
18 | };
19 | let result = mapMaybe(Just(False), fn);
20 | case result { Just(True) -> True, _ -> False }
21 | }
22 |
23 | test useMapMaybe =
24 | { useMapMaybe() }
--------------------------------------------------------------------------------
/wasm-calc12/test/static/lambda3.calc:
--------------------------------------------------------------------------------
1 | type YesOrNo
2 | = No
3 | | Yes
4 |
5 | function useDataTypeInLambda() -> Boolean {
6 | let fn = \(b:YesOrNo) -> YesOrNo {
7 | case b { Yes -> No, No -> Yes }
8 | };
9 | fn(No);
10 | True
11 | }
12 |
13 | test useDataTypeInLambda =
14 | { useDataTypeInLambda() }
--------------------------------------------------------------------------------
/wasm-calc12/test/static/lambda4.calc:
--------------------------------------------------------------------------------
1 | type YesOrNo
2 | = No
3 | | Yes
4 |
5 | type Maybe
6 | = Just(a)
7 | | Nothing
8 |
9 | function mapMaybe(
10 | maybe: Maybe(YesOrNo), fn: Fn(YesOrNo) -> YesOrNo
11 | ) -> Maybe(YesOrNo) {
12 | case maybe { Just(a) -> Just(fn(a)), Nothing -> Nothing }
13 | }
14 |
15 | function useDataTypeInLambda() -> Boolean {
16 | let fn = \(b:YesOrNo) -> YesOrNo {
17 | case b { Yes -> No, No -> Yes }
18 | };
19 | case mapMaybe(Just(No), fn) {
20 | Just(Yes) -> True, _ -> False
21 | }
22 | }
23 |
24 | test useDataTypeInLambda =
25 | { useDataTypeInLambda() }
--------------------------------------------------------------------------------
/wasm-calc12/test/static/map.calc:
--------------------------------------------------------------------------------
1 | type List
2 | = Cons(a, List(a))
3 | | Nil
4 |
5 | function mapList(
6 | list: List(Int32), fn: &Fn(Int32) -> Int32
7 | ) -> List(Int32) {
8 | case list {
9 | Cons(a, rest) -> Cons(fn(a), mapList(rest, fn)),
10 | Nil -> Nil
11 | }
12 | }
13 |
14 | function sumList(list: List(Int32)) -> Int32 {
15 | case list { Cons(a, rest) -> a + sumList(rest), Nil -> 0 }
16 | }
17 |
18 | function useDataTypeInLambda() -> Boolean {
19 | let inc = \(a:Int32) -> Int32 { a + 1};
20 | let list: List(Int32) = Cons(1, Cons(2, Cons(3, Nil)));
21 | sumList(mapList(list, &inc)) == (9: Int32)
22 | }
23 |
24 | test useDataTypeInLambda =
25 | { useDataTypeInLambda() }
--------------------------------------------------------------------------------
/wasm-calc12/test/static/nice.calc:
--------------------------------------------------------------------------------
1 | function main() -> Int64 { 100}
2 |
3 | type Dog
4 | = Big(Int32)
5 | | Little
6 | | Massive
7 |
8 | function thisIsAllowed() -> Boolean {
9 | let pair = (True, False);
10 | let borrowed = &pair;
11 | case borrowed { (true, _) -> true }
12 | }
13 |
14 | function useReference(dogRef: &Dog) -> Int32 {
15 | case dogRef { Big(i) -> i, _ -> 0 }
16 | }
17 |
18 | function callingFunctionShouldntCountAsABorrowBecauseItsOutOfScope(
19 |
20 | ) -> Dog { let dog = Big(100); useReference(&dog); dog}
--------------------------------------------------------------------------------
/wasm-calc12/test/static/noalloc.calc:
--------------------------------------------------------------------------------
1 | function [noglobalmutate noallocate noimports] add(
2 | a: Int8, b: Int8
3 | ) -> Int8 { a + b}
4 |
5 | function id(a: a) -> a { a}
6 |
7 | export function test() -> Int8 {
8 | let a: Box(Int8) = Box(1);
9 | let b: Box(Int8) = Box(2);
10 | let (Box(c), Box(d)) = (id(a), id(b));
11 | add(c, d)
12 | }
--------------------------------------------------------------------------------
/wasm-calc12/test/static/smalltypecheck.calc:
--------------------------------------------------------------------------------
1 | type Result
2 | = Left(e)
3 | | Right(a)
4 |
5 | type Type
6 | = TBoolean
7 | | TInt
8 |
9 | type Expr
10 | = EBoolean(ann, Boolean)
11 | | EInt(ann, Int32)
12 |
13 | type Unit
14 | = Unit
15 |
16 | type Error
17 | = OhNo
18 |
19 | function typecheck(expr: Expr(Unit)) -> Result(
20 | Error, Expr(Type)
21 | ) {
22 | case expr {
23 | EInt(_, i) -> Right(EInt(TInt, i)),
24 | EBoolean(_, b) -> Right(EBoolean(TBoolean, b))
25 | }
26 | }
--------------------------------------------------------------------------------
/wasm-calc13/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle
2 | .direnv
3 |
--------------------------------------------------------------------------------
/wasm-calc13/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Revision history for nix-basic
2 |
3 | ## 0.1.0.0 -- YYYY-mm-dd
4 |
5 | * First version. Released on an unsuspecting world.
6 |
--------------------------------------------------------------------------------
/wasm-calc13/demo/.gitignore:
--------------------------------------------------------------------------------
1 | # ignore compiler wasm files
2 | *.wasm
3 |
--------------------------------------------------------------------------------
/wasm-calc13/demo/README.md:
--------------------------------------------------------------------------------
1 | # demo
2 |
3 | This is a small demo that runs in the browser, passing a `draw` function into a
4 | WASM module.
5 |
6 | To open it in a browser, run `serve .` and navigate to
7 | `localhost:3000/draw.html`.
8 |
9 | To change the file and see results, run `watchexec -w ./**/*.calc make
10 | run-build-drawing-demo-7`. This will watch all `.calc` files and recompile on file changes.
11 |
12 | You will need to reload the browser after each change.
13 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc.hs:
--------------------------------------------------------------------------------
1 | module Calc
2 | ( module Calc.Types,
3 | module Calc.Build,
4 | module Calc.Parser,
5 | module Calc.ExprUtils,
6 | module Calc.Repl,
7 | module Calc.Wasm,
8 | module Calc.PrettyPrint,
9 | )
10 | where
11 |
12 | import Calc.Build
13 | import Calc.ExprUtils
14 | import Calc.Parser
15 | import Calc.PrettyPrint
16 | import Calc.Repl
17 | import Calc.Types
18 | import Calc.Wasm
19 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Build/Print.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE FlexibleContexts #-}
2 | {-# LANGUAGE FlexibleInstances #-}
3 | {-# LANGUAGE MultiParamTypeClasses #-}
4 |
5 | module Calc.Build.Print (printBuildError) where
6 |
7 | import Calc.Build.Steps
8 | import Control.Monad.IO.Class
9 | import qualified Data.Text.IO as T
10 | import qualified Error.Diagnose as Diag
11 |
12 | printBuildError :: (MonadIO m) => BuildError -> m ()
13 | printBuildError (BuildDiagnostic diag) =
14 | Diag.printDiagnostic
15 | Diag.stderr
16 | Diag.WithUnicode
17 | (Diag.TabSize 4)
18 | Diag.defaultStyle
19 | diag
20 | printBuildError (BuildMessage msg) =
21 | liftIO (T.hPutStrLn Diag.stderr msg)
22 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Linearity.hs:
--------------------------------------------------------------------------------
1 | module Calc.Linearity
2 | ( module Calc.Linearity.Types,
3 | module Calc.Linearity.Error,
4 | module Calc.Linearity.Validate,
5 | )
6 | where
7 |
8 | import Calc.Linearity.Error
9 | import Calc.Linearity.Types
10 | import Calc.Linearity.Validate
11 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Parser/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Types
2 | ( Parser,
3 | ParseErrorType,
4 | ParserExpr,
5 | ParserType,
6 | ParserFunction,
7 | ParserModule,
8 | ParserPattern,
9 | ParserData,
10 | )
11 | where
12 |
13 | import Calc.Types.Annotation
14 | import Calc.Types.Data
15 | import Calc.Types.Expr
16 | import Calc.Types.Function
17 | import Calc.Types.Module
18 | import Calc.Types.Pattern
19 | import Calc.Types.Type
20 | import Data.Text (Text)
21 | import Data.Void
22 | import Text.Megaparsec
23 |
24 | type Parser = Parsec Void Text
25 |
26 | type ParseErrorType = ParseErrorBundle Text Void
27 |
28 | type ParserExpr = Expr Annotation
29 |
30 | type ParserType = Type Annotation
31 |
32 | type ParserFunction = Function Annotation
33 |
34 | type ParserModule = [ModuleItem Annotation]
35 |
36 | type ParserPattern = Pattern Annotation
37 |
38 | type ParserData = Data Annotation
39 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/PrettyPrint.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE FlexibleContexts #-}
2 | {-# LANGUAGE FlexibleInstances #-}
3 | {-# LANGUAGE MultiParamTypeClasses #-}
4 |
5 | module Calc.PrettyPrint
6 | ( prettyPrint,
7 | )
8 | where
9 |
10 | import Calc.Build.Format
11 | import Calc.Build.Print
12 | import Calc.Build.Steps
13 | import Control.Monad.IO.Class
14 | import Data.Functor (($>))
15 | import qualified Data.Text as T
16 | import System.Exit
17 |
18 | prettyPrint :: FilePath -> IO ()
19 | prettyPrint filePath =
20 | liftIO $ doPrettyPrint filePath >>= exitWith
21 |
22 | doPrettyPrint :: (MonadIO m) => FilePath -> m ExitCode
23 | doPrettyPrint filePath = do
24 | input <- liftIO (readFile filePath)
25 | case parseModuleStep (T.pack input) of
26 | Left buildError -> printBuildError buildError $> ExitFailure 1
27 | Right parsedModule -> do
28 | formatAndSave filePath (T.pack input) parsedModule
29 | pure ExitSuccess
30 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Typecheck.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck
2 | ( module Calc.Typecheck.Error,
3 | module Calc.Typecheck.Helpers,
4 | module Calc.Typecheck.Elaborate,
5 | module Calc.Typecheck.Types,
6 | module Calc.Typecheck.Infer,
7 | )
8 | where
9 |
10 | import Calc.Typecheck.Elaborate
11 | import Calc.Typecheck.Error
12 | import Calc.Typecheck.Helpers
13 | import Calc.Typecheck.Infer
14 | import Calc.Typecheck.Types
15 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Typecheck/Error.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Error
2 | ( module Calc.Typecheck.Error.TypeError,
3 | module Calc.Typecheck.Error.PatternMatchError,
4 | )
5 | where
6 |
7 | import Calc.Typecheck.Error.PatternMatchError
8 | import Calc.Typecheck.Error.TypeError
9 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Typecheck/Patterns.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Patterns
2 | ( module Calc.Typecheck.Patterns.Annihilate,
3 | module Calc.Typecheck.Patterns.Validate,
4 | module Calc.Typecheck.Patterns.Generate,
5 | )
6 | where
7 |
8 | import Calc.Typecheck.Patterns.Annihilate
9 | import Calc.Typecheck.Patterns.Generate
10 | import Calc.Typecheck.Patterns.Validate
11 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Typecheck/Substitute.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Substitute (substitute) where
2 |
3 | import Calc.TypeUtils
4 | import Calc.Types.Type
5 | import qualified Data.HashMap.Strict as HM
6 | import Data.Maybe (fromMaybe)
7 | import GHC.Natural
8 |
9 | substitute ::
10 | HM.HashMap Natural (Type ann) ->
11 | Type ann ->
12 | Type ann
13 | substitute subs oldTy@(TUnificationVar _ nat) =
14 | fromMaybe oldTy (HM.lookup nat subs)
15 | substitute subs other =
16 | mapType (substitute subs) other
17 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Types/Ability.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE OverloadedStrings #-}
4 |
5 | module Calc.Types.Ability where
6 |
7 | import Calc.Types.Function
8 | import Calc.Types.Identifier
9 | import Prettyprinter ((<+>))
10 | import qualified Prettyprinter as PP
11 |
12 | -- | things that our functions might do
13 | data Ability ann
14 | = AllocateMemory ann
15 | | CallImportedFunction ann FunctionName
16 | | MutateGlobal ann Identifier
17 | deriving stock (Eq, Ord, Show, Functor)
18 |
19 | instance PP.Pretty (Ability ann) where
20 | pretty (AllocateMemory _) =
21 | "Allocating memory"
22 | pretty (CallImportedFunction _ fnName) =
23 | "Calling imported function" <+> PP.dquotes (PP.pretty fnName)
24 | pretty (MutateGlobal _ ident) =
25 | "Mutate global" <+> PP.dquotes (PP.pretty ident)
26 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Types/Annotation.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Annotation
4 | ( Annotation (..),
5 | )
6 | where
7 |
8 | -- | `Annotation` is used to track source code location
9 | -- it is added to parts of `Expr` during parsing and used to
10 | -- make errors nicer
11 | data Annotation = Location Int Int
12 | deriving stock (Eq, Ord, Show)
13 |
14 | -- | when combining two `Annotation`, combine to make one big annotation
15 | instance Semigroup Annotation where
16 | (Location start end) <> (Location start' end') =
17 | Location (min start start') (max end end')
18 |
19 | -- | Default to an empty `Annotation`
20 | instance Monoid Annotation where
21 | mempty = Location 0 0
22 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Types/DataName.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.DataName (DataName (..)) where
5 |
6 | import Calc.Types.Constructor
7 | import qualified Prettyprinter as PP
8 |
9 | newtype DataName = DataName Constructor
10 | deriving newtype (Eq, Ord, Show, PP.Pretty)
11 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Types/FunctionName.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.FunctionName
5 | ( FunctionName (..),
6 | )
7 | where
8 |
9 | import Data.Hashable
10 | import Data.String
11 | import Data.Text (Text)
12 | import qualified Data.Text as T
13 | import qualified Prettyprinter as PP
14 |
15 | newtype FunctionName = FunctionName Text
16 | deriving newtype (Eq, Ord, Show, Hashable)
17 |
18 | instance IsString FunctionName where
19 | fromString = FunctionName . T.pack
20 |
21 | instance PP.Pretty FunctionName where
22 | pretty (FunctionName fn) = PP.pretty fn
23 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Types/Memory.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE NamedFieldPuns #-}
4 | {-# LANGUAGE OverloadedStrings #-}
5 |
6 | module Calc.Types.Memory (Memory (..)) where
7 |
8 | import Calc.Types.Identifier
9 | import GHC.Natural
10 | import Prettyprinter ((<+>))
11 | import qualified Prettyprinter as PP
12 |
13 | data Memory ann
14 | = LocalMemory {lmAnn :: ann, lmLimit :: Natural}
15 | | ImportedMemory
16 | { imAnn :: ann,
17 | imExternalModule :: Identifier,
18 | imExternalMemoryName :: Identifier,
19 | imLimit :: Natural
20 | }
21 | deriving stock (Eq, Ord, Show, Functor)
22 |
23 | instance PP.Pretty (Memory ann) where
24 | pretty (LocalMemory {lmLimit}) =
25 | "memory" <+> PP.pretty lmLimit
26 | pretty (ImportedMemory {imExternalModule, imExternalMemoryName, imLimit}) =
27 | "import" <+> PP.pretty imExternalModule <> "." <> PP.pretty imExternalMemoryName <+> "as memory" <+> PP.pretty imLimit
28 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Types/ModuleAnnotations.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.ModuleAnnotations (ModuleAnnotations (..)) where
4 |
5 | import Calc.Types
6 | import qualified Data.Map.Strict as M
7 |
8 | data ModuleAnnotations ann = ModuleAnnotations
9 | { maFunctions :: M.Map FunctionName ann,
10 | maTests :: M.Map Identifier ann
11 | }
12 | deriving stock (Eq, Ord, Show)
13 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Types/Op.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE OverloadedStrings #-}
3 |
4 | module Calc.Types.Op (Op (..)) where
5 |
6 | import qualified Prettyprinter as PP
7 |
8 | data Op
9 | = OpAdd
10 | | OpMultiply
11 | | OpSubtract
12 | | OpEquals
13 | | OpGreaterThan
14 | | OpGreaterThanOrEqualTo
15 | | OpLessThan
16 | | OpLessThanOrEqualTo
17 | | OpAnd
18 | | OpOr
19 | | OpRemainder
20 | deriving stock (Eq, Ord, Show)
21 |
22 | -- how to print `Op` values
23 | instance PP.Pretty Op where
24 | pretty OpAdd = "+"
25 | pretty OpMultiply = "*"
26 | pretty OpSubtract = "-"
27 | pretty OpEquals = "=="
28 | pretty OpGreaterThan = ">"
29 | pretty OpGreaterThanOrEqualTo = ">="
30 | pretty OpLessThan = "<"
31 | pretty OpLessThanOrEqualTo = "<="
32 | pretty OpAnd = "&&"
33 | pretty OpOr = "||"
34 | pretty OpRemainder = "%"
35 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Types/Prim.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Prim
4 | ( Prim (..),
5 | )
6 | where
7 |
8 | import Data.Word
9 | import qualified Prettyprinter as PP
10 |
11 | data Prim
12 | = PIntLit Word64 -- a polymorphic int literal, we don't know what size
13 | | PFloatLit Double -- a polymorphic float literal, we don't know what size
14 | | PBool Bool
15 | deriving stock (Eq, Ord, Show)
16 |
17 | instance PP.Pretty Prim where
18 | pretty (PIntLit i) = PP.pretty i
19 | pretty (PFloatLit f) = PP.pretty f
20 | pretty (PBool b) = PP.pretty b
21 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Types/Test.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE NamedFieldPuns #-}
4 | {-# LANGUAGE OverloadedStrings #-}
5 |
6 | module Calc.Types.Test where
7 |
8 | import Calc.Types.Expr
9 | import Calc.Types.Identifier
10 | import Calc.Utils
11 | import Prettyprinter ((<+>))
12 | import qualified Prettyprinter as PP
13 |
14 | data Test ann = Test
15 | { tesAnn :: ann,
16 | tesName :: Identifier,
17 | tesExpr :: Expr ann
18 | }
19 | deriving stock (Eq, Ord, Show, Functor)
20 |
21 | instance PP.Pretty (Test ann) where
22 | pretty (Test {tesName, tesExpr}) =
23 | "test"
24 | <+> PP.pretty tesName
25 | <+> "="
26 | <+> PP.line
27 | <> indentMulti 2 (PP.pretty tesExpr)
28 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Types/TypeVar.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.TypeVar (TypeVar (..), safeMkTypeVar) where
5 |
6 | import qualified Data.Char as Ch
7 | import Data.Hashable
8 | import Data.String
9 | import Data.Text (Text)
10 | import qualified Data.Text as T
11 | import qualified Prettyprinter as PP
12 |
13 | newtype TypeVar = TypeVar Text
14 | deriving newtype (Eq, Ord, Show, Hashable)
15 |
16 | instance IsString TypeVar where
17 | fromString = TypeVar . T.pack
18 |
19 | instance PP.Pretty TypeVar where
20 | pretty (TypeVar ident) = PP.pretty ident
21 |
22 | validTypeVar :: Text -> Bool
23 | validTypeVar a =
24 | T.length a > 0
25 | && T.filter Ch.isAlphaNum a == a
26 | && not (Ch.isDigit (T.head a))
27 | && Ch.isLower (T.head a)
28 |
29 | safeMkTypeVar :: Text -> Maybe TypeVar
30 | safeMkTypeVar a =
31 | if validTypeVar a
32 | then Just (TypeVar a)
33 | else Nothing
34 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Wasm.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm (module Calc.Wasm.WriteModule) where
2 |
3 | import Calc.Wasm.WriteModule
4 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Wasm/Allocator.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE TemplateHaskell #-}
2 |
3 | module Calc.Wasm.Allocator (moduleWithAllocator) where
4 |
5 | import qualified Data.ByteString as B
6 | import Data.FileEmbed
7 | import qualified Language.Wasm as Wasm
8 |
9 | -- these are saved in a file that is included in compilation
10 | allocatorSource :: B.ByteString
11 | allocatorSource =
12 | $(makeRelativeToProject "static/malloc.wasm" >>= embedFile)
13 |
14 | -- we have an allocator, we need to import it
15 | moduleWithAllocator :: Wasm.Module
16 | moduleWithAllocator = case Wasm.decode allocatorSource of
17 | Right mod' -> mod'
18 | Left e -> error (show e)
19 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Wasm/FromExpr.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.FromExpr (module Calc.Wasm.FromExpr.Types, module Calc.Wasm.FromExpr.Module) where
2 |
3 | import Calc.Wasm.FromExpr.Module
4 | import Calc.Wasm.FromExpr.Types
5 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Wasm/FromExpr/Patterns.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.FromExpr.Patterns
2 | ( module Calc.Wasm.FromExpr.Patterns.Paths,
3 | module Calc.Wasm.FromExpr.Patterns.Predicates,
4 | )
5 | where
6 |
7 | import Calc.Wasm.FromExpr.Patterns.Paths
8 | import Calc.Wasm.FromExpr.Patterns.Predicates
9 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Wasm/Run.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Wasm.Run (runWasm) where
4 |
5 | import Calc.Utils
6 | import qualified Data.Text.Lazy as TL
7 | import qualified Language.Wasm as Wasm
8 | import qualified Language.Wasm.Interpreter as Wasm
9 |
10 | runWasm :: TL.Text -> Wasm.Module -> IO (Maybe [Wasm.Value])
11 | runWasm startFunctionName wasmModule = do
12 | case Wasm.validate wasmModule of
13 | Right validModule -> do
14 | (result, store) <- Wasm.instantiate Wasm.emptyStore mempty validModule
15 | case result of
16 | Right moduleInstance ->
17 | Wasm.invokeExport store moduleInstance startFunctionName mempty
18 | Left e -> error $ "Error instantiating wasm module: " <> show e
19 | Left e ->
20 | error $
21 | "invalid module: "
22 | <> show e
23 | <> "\n\n"
24 | <> prettyShow wasmModule
25 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Wasm/ToWasm.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.ToWasm
2 | ( module Calc.Wasm.ToWasm.Module,
3 | module Calc.Wasm.ToWasm.Types,
4 | module Calc.Wasm.ToWasm.Helpers,
5 | )
6 | where
7 |
8 | import Calc.Wasm.ToWasm.Helpers
9 | import Calc.Wasm.ToWasm.Module
10 | import Calc.Wasm.ToWasm.Types
11 |
--------------------------------------------------------------------------------
/wasm-calc13/src/Calc/Wasm/WriteModule.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.WriteModule (printModule, writeModule) where
2 |
3 | import qualified Data.ByteString as BS
4 | import qualified Language.Wasm.Binary as Wasm
5 | import qualified Language.Wasm.Structure as Wasm
6 |
7 | -- | in which we write some actual files somewhere for lols
8 | writeModule :: FilePath -> Wasm.Module -> IO ()
9 | writeModule path wasmMod = do
10 | let bs = Wasm.dumpModule wasmMod
11 | BS.writeFile path bs
12 |
13 | -- | in which we output to stdout
14 | printModule :: Wasm.Module -> IO ()
15 | printModule = BS.putStr . Wasm.dumpModule
16 |
--------------------------------------------------------------------------------
/wasm-calc13/static/.gitignore:
--------------------------------------------------------------------------------
1 | # generated malloc file, don't keep
2 | malloc-new.wasm
3 |
--------------------------------------------------------------------------------
/wasm-calc13/static/malloc-new.wat:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/danieljharvey/wasm-calc/aa3b58a049d37192528afc441c01f9642fa3f731/wasm-calc13/static/malloc-new.wat
--------------------------------------------------------------------------------
/wasm-calc13/static/malloc-old.wasm:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/danieljharvey/wasm-calc/aa3b58a049d37192528afc441c01f9642fa3f731/wasm-calc13/static/malloc-old.wasm
--------------------------------------------------------------------------------
/wasm-calc13/static/malloc.wasm:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/danieljharvey/wasm-calc/aa3b58a049d37192528afc441c01f9642fa3f731/wasm-calc13/static/malloc.wasm
--------------------------------------------------------------------------------
/wasm-calc13/test/Main.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import qualified Test.Ability.AbilitySpec
4 | import Test.Hspec
5 | import qualified Test.Linearity.LinearitySpec
6 | import qualified Test.Parser.ParserSpec
7 | import qualified Test.PrettyPrint.PrettyPrintSpec
8 | import qualified Test.Typecheck.PatternsSpec
9 | import qualified Test.Typecheck.TypecheckSpec
10 | import qualified Test.Wasm.FromWasmSpec
11 | import qualified Test.Wasm.WasmSpec
12 |
13 | main :: IO ()
14 | main = hspec $ do
15 | Test.Ability.AbilitySpec.spec
16 | Test.Parser.ParserSpec.spec
17 | Test.PrettyPrint.PrettyPrintSpec.spec
18 | Test.Linearity.LinearitySpec.spec
19 | Test.Typecheck.TypecheckSpec.spec
20 | Test.Typecheck.PatternsSpec.spec
21 | Test.Wasm.WasmSpec.spec
22 | Test.Wasm.FromWasmSpec.spec
23 |
--------------------------------------------------------------------------------
/wasm-calc13/test/js/test.mjs:
--------------------------------------------------------------------------------
1 | // this file is used in tests to check imports work correctly
2 | import fs from "fs/promises";
3 |
4 | const filename = process.argv[2];
5 | const wasmBytes = await fs.readFile(filename);
6 |
7 | async function go() {
8 | const imports = {
9 | console : {log : a => console.log(a)},
10 | env : {memory : new WebAssembly.Memory({initial : 1})}
11 | };
12 |
13 | const {instance} = await WebAssembly.instantiate(wasmBytes, imports);
14 | const {test} = instance.exports;
15 |
16 | return test()
17 | }
18 |
19 | go()
20 |
--------------------------------------------------------------------------------
/wasm-calc13/test/static/bigfunction.calc:
--------------------------------------------------------------------------------
1 | function big(
2 | a: Int32, b: Int32, c: Int32, d: Int32, e: Int32
3 | ) -> Int32 {
4 | if True then
5 | 2
6 | else
7 | {
8 | let a: Int32 = 100;
9 | if False then
10 | a
11 | else
12 | if True then
13 | b
14 | else
15 | if True then c else if False then d else e
16 | }
17 | }
--------------------------------------------------------------------------------
/wasm-calc13/test/static/datatypes.calc:
--------------------------------------------------------------------------------
1 | type Colour
2 | = Blue
3 | | Green
4 | | Red
5 |
6 | type Maybe
7 | = Just(a)
8 | | Nothing
9 |
10 | type Either
11 | = Left(e)
12 | | Right(a)
13 |
14 | type These
15 | = That(b)
16 | | These(a, b)
17 | | This(a)
18 |
19 | type Expr
20 | = EBool(ann, Boolean)
21 | | EInt(ann, Int32)
22 |
23 | type List
24 | = Cons(a, List(a))
25 | | Nil
26 |
27 | function matchList() -> Boolean {
28 | let list = Cons(True, Cons(False, Cons(True, Nil)));
29 | case list {
30 | Cons(a, Cons(b, Cons(c, Nil))) -> a && b && c,
31 | _ -> False
32 | }
33 | }
34 |
35 | function listId(list: List(a)) -> List(a) { list}
36 |
37 | function nextColour(colour: Colour) -> Colour {
38 | case colour { Red -> Green, Green -> Blue, Blue -> Red }
39 | }
--------------------------------------------------------------------------------
/wasm-calc13/test/static/lambda.calc:
--------------------------------------------------------------------------------
1 | function useFlip() -> Boolean {
2 | let fn = \(b:Boolean) -> Boolean {
3 | if b then False else True
4 | };
5 | fn(False)
6 | }
7 |
8 | test flip =
9 | { useFlip() }
--------------------------------------------------------------------------------
/wasm-calc13/test/static/lambda2.calc:
--------------------------------------------------------------------------------
1 | type YesOrNo
2 | = No
3 | | Yes
4 |
5 | type Maybe
6 | = Just(a)
7 | | Nothing
8 |
9 | function mapMaybe(
10 | maybe: Maybe(Boolean), fn: Fn(Boolean) -> Boolean
11 | ) -> Maybe(Boolean) {
12 | case maybe { Just(a) -> Just(fn(a)), Nothing -> Nothing }
13 | }
14 |
15 | function useMapMaybe() -> Boolean {
16 | let fn = \(b:Boolean) -> Boolean {
17 | if b then False else True
18 | };
19 | let result = mapMaybe(Just(False), fn);
20 | case result { Just(True) -> True, _ -> False }
21 | }
22 |
23 | test useMapMaybe =
24 | { useMapMaybe() }
--------------------------------------------------------------------------------
/wasm-calc13/test/static/lambda3.calc:
--------------------------------------------------------------------------------
1 | type YesOrNo
2 | = No
3 | | Yes
4 |
5 | function useDataTypeInLambda() -> Boolean {
6 | let fn = \(b:YesOrNo) -> YesOrNo {
7 | case b { Yes -> No, No -> Yes }
8 | };
9 | fn(No);
10 | True
11 | }
12 |
13 | test useDataTypeInLambda =
14 | { useDataTypeInLambda() }
--------------------------------------------------------------------------------
/wasm-calc13/test/static/lambda4.calc:
--------------------------------------------------------------------------------
1 | type YesOrNo
2 | = No
3 | | Yes
4 |
5 | type Maybe
6 | = Just(a)
7 | | Nothing
8 |
9 | function mapMaybe(
10 | maybe: Maybe(YesOrNo), fn: Fn(YesOrNo) -> YesOrNo
11 | ) -> Maybe(YesOrNo) {
12 | case maybe { Just(a) -> Just(fn(a)), Nothing -> Nothing }
13 | }
14 |
15 | function useDataTypeInLambda() -> Boolean {
16 | let fn = \(b:YesOrNo) -> YesOrNo {
17 | case b { Yes -> No, No -> Yes }
18 | };
19 | case mapMaybe(Just(No), fn) {
20 | Just(Yes) -> True, _ -> False
21 | }
22 | }
23 |
24 | test useDataTypeInLambda =
25 | { useDataTypeInLambda() }
--------------------------------------------------------------------------------
/wasm-calc13/test/static/map.calc:
--------------------------------------------------------------------------------
1 | type List
2 | = Cons(a, List(a))
3 | | Nil
4 |
5 | function mapList(
6 | list: List(Int32), fn: &Fn(Int32) -> Int32
7 | ) -> List(Int32) {
8 | case list {
9 | Cons(a, rest) -> Cons(fn(a), mapList(rest, fn)),
10 | Nil -> Nil
11 | }
12 | }
13 |
14 | function sumList(list: List(Int32)) -> Int32 {
15 | case list { Cons(a, rest) -> a + sumList(rest), Nil -> 0 }
16 | }
17 |
18 | function useDataTypeInLambda() -> Boolean {
19 | let inc = \(a:Int32) -> Int32 { a + 1};
20 | let list: List(Int32) = Cons(1, Cons(2, Cons(3, Nil)));
21 | sumList(mapList(list, &inc)) == (9: Int32)
22 | }
23 |
24 | test useDataTypeInLambda =
25 | { useDataTypeInLambda() }
--------------------------------------------------------------------------------
/wasm-calc13/test/static/nice.calc:
--------------------------------------------------------------------------------
1 | function main() -> Int64 { 100}
2 |
3 | type Dog
4 | = Big(Int32)
5 | | Little
6 | | Massive
7 |
8 | function thisIsAllowed() -> Boolean {
9 | let pair = (True, False);
10 | let borrowed = &pair;
11 | case borrowed { (true, _) -> true }
12 | }
13 |
14 | function useReference(dogRef: &Dog) -> Int32 {
15 | case dogRef { Big(i) -> i, _ -> 0 }
16 | }
17 |
18 | function callingFunctionShouldntCountAsABorrowBecauseItsOutOfScope(
19 |
20 | ) -> Dog { let dog = Big(100); useReference(&dog); dog}
--------------------------------------------------------------------------------
/wasm-calc13/test/static/noalloc.calc:
--------------------------------------------------------------------------------
1 | function [noglobalmutate noallocate noimports] add(
2 | a: Int8, b: Int8
3 | ) -> Int8 { a + b}
4 |
5 | function id(a: a) -> a { a}
6 |
7 | export function test() -> Int8 {
8 | let a: Box(Int8) = Box(1);
9 | let b: Box(Int8) = Box(2);
10 | let (Box(c), Box(d)) = (id(a), id(b));
11 | add(c, d)
12 | }
--------------------------------------------------------------------------------
/wasm-calc13/test/static/smalltypecheck.calc:
--------------------------------------------------------------------------------
1 | type Result
2 | = Left(e)
3 | | Right(a)
4 |
5 | type Type
6 | = TBoolean
7 | | TInt
8 |
9 | type Expr
10 | = EBoolean(ann, Boolean)
11 | | EInt(ann, Int32)
12 |
13 | type Unit
14 | = Unit
15 |
16 | type Error
17 | = OhNo
18 |
19 | function typecheck(expr: Expr(Unit)) -> Result(
20 | Error, Expr(Type)
21 | ) {
22 | case expr {
23 | EInt(_, i) -> Right(EInt(TInt, i)),
24 | EBoolean(_, b) -> Right(EBoolean(TBoolean, b))
25 | }
26 | }
--------------------------------------------------------------------------------
/wasm-calc2/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle
2 | .direnv
3 |
--------------------------------------------------------------------------------
/wasm-calc2/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Revision history for nix-basic
2 |
3 | ## 0.1.0.0 -- YYYY-mm-dd
4 |
5 | * First version. Released on an unsuspecting world.
6 |
--------------------------------------------------------------------------------
/wasm-calc2/app/Main.hs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Calc (repl)
4 |
5 | main :: IO ()
6 | main = repl
7 |
--------------------------------------------------------------------------------
/wasm-calc2/src/Calc.hs:
--------------------------------------------------------------------------------
1 | module Calc
2 | ( module Calc.Types,
3 | module Calc.Parser,
4 | module Calc.ExprUtils,
5 | module Calc.Interpreter,
6 | module Calc.Repl,
7 | )
8 | where
9 |
10 | import Calc.ExprUtils
11 | import Calc.Interpreter
12 | import Calc.Parser
13 | import Calc.Repl
14 | import Calc.Types
15 |
--------------------------------------------------------------------------------
/wasm-calc2/src/Calc/Parser/Type.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Parser.Type (typeParser) where
4 |
5 | import Calc.Parser.Shared
6 | ( addTypeLocation,
7 | myLexeme,
8 | stringLiteral,
9 | )
10 | import Calc.Parser.Types
11 | import Calc.Types.Type
12 | import Data.Functor (($>))
13 | import Text.Megaparsec
14 | ( MonadParsec (try),
15 | (<|>),
16 | )
17 |
18 | -- | top-level parser for type signatures
19 | typeParser :: Parser ParserType
20 | typeParser =
21 | myLexeme (addTypeLocation tyPrimitiveParser)
22 |
23 | tyPrimitiveParser :: Parser ParserType
24 | tyPrimitiveParser = TPrim mempty <$> tyPrimParser
25 | where
26 | tyPrimParser =
27 | try (stringLiteral "Boolean" $> TBool)
28 | <|> try (stringLiteral "Integer" $> TInt)
29 |
--------------------------------------------------------------------------------
/wasm-calc2/src/Calc/Parser/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Types
2 | ( Parser,
3 | ParseErrorType,
4 | ParserExpr,
5 | ParserType,
6 | )
7 | where
8 |
9 | import Calc.Types.Annotation
10 | import Calc.Types.Expr
11 | import Calc.Types.Type
12 | import Data.Text (Text)
13 | import Data.Void
14 | import Text.Megaparsec
15 |
16 | type Parser = Parsec Void Text
17 |
18 | type ParseErrorType = ParseErrorBundle Text Void
19 |
20 | type ParserExpr = Expr Annotation
21 |
22 | type ParserType = Type Annotation
23 |
--------------------------------------------------------------------------------
/wasm-calc2/src/Calc/TypeUtils.hs:
--------------------------------------------------------------------------------
1 | module Calc.TypeUtils (mapOuterTypeAnnotation, getOuterTypeAnnotation) where
2 |
3 | import Calc.Types.Type
4 |
5 | getOuterTypeAnnotation :: Type ann -> ann
6 | getOuterTypeAnnotation (TPrim ann _) = ann
7 |
8 | mapOuterTypeAnnotation :: (ann -> ann) -> Type ann -> Type ann
9 | mapOuterTypeAnnotation f (TPrim ann p) = TPrim (f ann) p
10 |
--------------------------------------------------------------------------------
/wasm-calc2/src/Calc/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Types
2 | ( module Calc.Types.Annotation,
3 | module Calc.Types.Expr,
4 | module Calc.Types.Prim,
5 | module Calc.Types.Type,
6 | )
7 | where
8 |
9 | import Calc.Types.Annotation
10 | import Calc.Types.Expr
11 | import Calc.Types.Prim
12 | import Calc.Types.Type
13 |
--------------------------------------------------------------------------------
/wasm-calc2/src/Calc/Types/Annotation.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Annotation
4 | ( Annotation (..),
5 | )
6 | where
7 |
8 | -- | `Annotation` is used to track source code location
9 | -- it is added to parts of `Expr` during parsing and used to
10 | -- make errors nicer
11 | data Annotation = Location Int Int
12 | deriving stock (Eq, Ord, Show)
13 |
14 | -- | when combining two `Annotation`, take the first one
15 | instance Semigroup Annotation where
16 | a <> _ = a
17 |
18 | -- | Default to an empty `Annotation`
19 | instance Monoid Annotation where
20 | mempty = Location 0 0
21 |
--------------------------------------------------------------------------------
/wasm-calc2/src/Calc/Types/Prim.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Prim
4 | ( Prim (..),
5 | )
6 | where
7 |
8 | import qualified Prettyprinter as PP
9 |
10 | data Prim
11 | = PInt Integer
12 | | PBool Bool
13 | deriving stock (Eq, Ord, Show)
14 |
15 | instance PP.Pretty Prim where
16 | pretty (PInt i) = PP.pretty i
17 | pretty (PBool b) = PP.pretty b
18 |
--------------------------------------------------------------------------------
/wasm-calc2/src/Calc/Types/Type.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE OverloadedStrings #-}
4 |
5 | module Calc.Types.Type (Type (..), TypePrim (..)) where
6 |
7 | import qualified Prettyprinter as PP
8 |
9 | data TypePrim = TBool | TInt
10 | deriving stock (Eq, Ord, Show)
11 |
12 | instance PP.Pretty TypePrim where
13 | pretty TBool = "Boolean"
14 | pretty TInt = "Integer"
15 |
16 | data Type ann
17 | = TPrim ann TypePrim
18 | deriving stock (Eq, Ord, Show, Functor)
19 |
20 | instance PP.Pretty (Type ann) where
21 | pretty (TPrim _ prim) = PP.pretty prim
22 |
--------------------------------------------------------------------------------
/wasm-calc2/src/Calc/Wasm/Run.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Wasm.Run (runWasm) where
4 |
5 | import qualified Language.Wasm as Wasm
6 | import qualified Language.Wasm.Interpreter as Wasm
7 |
8 | runWasm :: Wasm.Module -> IO (Maybe [Wasm.Value])
9 | runWasm wasmModule = do
10 | case Wasm.validate wasmModule of
11 | Right validModule -> do
12 | (result, store) <- Wasm.instantiate Wasm.emptyStore mempty validModule
13 | case result of
14 | Right moduleInstance ->
15 | Wasm.invokeExport store moduleInstance "main" mempty
16 | Left e -> error e
17 | Left e -> do
18 | print wasmModule
19 | error $ "invalid module: " <> show e
20 |
--------------------------------------------------------------------------------
/wasm-calc2/src/Calc/Wasm/Types.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Wasm.Types (Type (..), Module (..), Function (..)) where
4 |
5 | import Calc.Types.Expr
6 |
7 | data Type ann = I32
8 | deriving stock (Eq, Ord, Show)
9 |
10 | newtype Module ann = Module
11 | { -- | the functions themselves, their index comes from the list placement
12 | modFunctions :: [Function ann]
13 | }
14 | deriving stock (Eq, Ord, Show)
15 |
16 | data Function ann = Function
17 | { fnName :: String,
18 | fnExpr :: Expr ann,
19 | fnPublic :: Bool,
20 | fnArgs :: [Type ann],
21 | fnReturnType :: Type ann
22 | }
23 | deriving stock (Eq, Ord, Show)
24 |
--------------------------------------------------------------------------------
/wasm-calc2/test/Main.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import Test.Hspec
4 | import qualified Test.Interpreter.InterpreterSpec
5 | import qualified Test.Parser.ParserSpec
6 | import qualified Test.Typecheck.TypecheckSpec
7 | import qualified Test.Wasm.WasmSpec
8 |
9 | main :: IO ()
10 | main = hspec $ do
11 | Test.Parser.ParserSpec.spec
12 | Test.Interpreter.InterpreterSpec.spec
13 | Test.Wasm.WasmSpec.spec
14 | Test.Typecheck.TypecheckSpec.spec
15 |
--------------------------------------------------------------------------------
/wasm-calc3/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle
2 | .direnv
3 |
--------------------------------------------------------------------------------
/wasm-calc3/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Revision history for nix-basic
2 |
3 | ## 0.1.0.0 -- YYYY-mm-dd
4 |
5 | * First version. Released on an unsuspecting world.
6 |
--------------------------------------------------------------------------------
/wasm-calc3/app/Main.hs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Calc (repl)
4 |
5 | main :: IO ()
6 | main = repl
7 |
--------------------------------------------------------------------------------
/wasm-calc3/src/Calc.hs:
--------------------------------------------------------------------------------
1 | module Calc
2 | ( module Calc.Types,
3 | module Calc.Parser,
4 | module Calc.ExprUtils,
5 | module Calc.Interpreter,
6 | module Calc.Repl,
7 | )
8 | where
9 |
10 | import Calc.ExprUtils
11 | import Calc.Interpreter
12 | import Calc.Parser
13 | import Calc.Repl
14 | import Calc.Types
15 |
--------------------------------------------------------------------------------
/wasm-calc3/src/Calc/Parser/Module.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Module (moduleParser) where
2 |
3 | import Calc.Parser.Expr
4 | import Calc.Parser.Function
5 | import Calc.Parser.Types
6 | import Calc.Types.Annotation
7 | import Calc.Types.Module
8 | import Text.Megaparsec
9 |
10 | moduleParser :: Parser (Module Annotation)
11 | moduleParser = do
12 | funcs <- many functionParser
13 | Module funcs <$> exprParser
14 |
--------------------------------------------------------------------------------
/wasm-calc3/src/Calc/Parser/Type.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Parser.Type (typeParser) where
4 |
5 | import Calc.Parser.Shared
6 | ( addTypeLocation,
7 | myLexeme,
8 | stringLiteral,
9 | )
10 | import Calc.Parser.Types
11 | import Calc.Types.Type
12 | import Data.Functor (($>))
13 | import Text.Megaparsec
14 | ( MonadParsec (try),
15 | (<|>),
16 | )
17 |
18 | -- | top-level parser for type signatures
19 | typeParser :: Parser ParserType
20 | typeParser =
21 | myLexeme (addTypeLocation tyPrimitiveParser)
22 |
23 | tyPrimitiveParser :: Parser ParserType
24 | tyPrimitiveParser = TPrim mempty <$> tyPrimParser
25 | where
26 | tyPrimParser =
27 | try (stringLiteral "Boolean" $> TBool)
28 | <|> try (stringLiteral "Integer" $> TInt)
29 |
--------------------------------------------------------------------------------
/wasm-calc3/src/Calc/Parser/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Types
2 | ( Parser,
3 | ParseErrorType,
4 | ParserExpr,
5 | ParserType,
6 | ParserFunction,
7 | ParserModule,
8 | )
9 | where
10 |
11 | import Calc.Types.Annotation
12 | import Calc.Types.Expr
13 | import Calc.Types.Function
14 | import Calc.Types.Module
15 | import Calc.Types.Type
16 | import Data.Text (Text)
17 | import Data.Void
18 | import Text.Megaparsec
19 |
20 | type Parser = Parsec Void Text
21 |
22 | type ParseErrorType = ParseErrorBundle Text Void
23 |
24 | type ParserExpr = Expr Annotation
25 |
26 | type ParserType = Type Annotation
27 |
28 | type ParserFunction = Function Annotation
29 |
30 | type ParserModule = Module Annotation
31 |
--------------------------------------------------------------------------------
/wasm-calc3/src/Calc/TypeUtils.hs:
--------------------------------------------------------------------------------
1 | module Calc.TypeUtils (mapOuterTypeAnnotation, getOuterTypeAnnotation) where
2 |
3 | import Calc.Types.Type
4 |
5 | getOuterTypeAnnotation :: Type ann -> ann
6 | getOuterTypeAnnotation (TPrim ann _) = ann
7 | getOuterTypeAnnotation (TFunction ann _ _) = ann
8 |
9 | mapOuterTypeAnnotation :: (ann -> ann) -> Type ann -> Type ann
10 | mapOuterTypeAnnotation f (TPrim ann p) = TPrim (f ann) p
11 | mapOuterTypeAnnotation f (TFunction ann a b) = TFunction (f ann) a b
12 |
--------------------------------------------------------------------------------
/wasm-calc3/src/Calc/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Types
2 | ( module Calc.Types.Annotation,
3 | module Calc.Types.Identifier,
4 | module Calc.Types.Expr,
5 | module Calc.Types.Function,
6 | module Calc.Types.Module,
7 | module Calc.Types.Prim,
8 | module Calc.Types.Type,
9 | )
10 | where
11 |
12 | import Calc.Types.Annotation
13 | import Calc.Types.Expr
14 | import Calc.Types.Function
15 | import Calc.Types.Identifier
16 | import Calc.Types.Module
17 | import Calc.Types.Prim
18 | import Calc.Types.Type
19 |
--------------------------------------------------------------------------------
/wasm-calc3/src/Calc/Types/Annotation.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Annotation
4 | ( Annotation (..),
5 | )
6 | where
7 |
8 | -- | `Annotation` is used to track source code location
9 | -- it is added to parts of `Expr` during parsing and used to
10 | -- make errors nicer
11 | data Annotation = Location Int Int
12 | deriving stock (Eq, Ord, Show)
13 |
14 | -- | when combining two `Annotation`, take the first one
15 | instance Semigroup Annotation where
16 | a <> _ = a
17 |
18 | -- | Default to an empty `Annotation`
19 | instance Monoid Annotation where
20 | mempty = Location 0 0
21 |
--------------------------------------------------------------------------------
/wasm-calc3/src/Calc/Types/Function.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
4 |
5 | module Calc.Types.Function
6 | ( ArgumentName (..),
7 | FunctionName (..),
8 | Function (..),
9 | )
10 | where
11 |
12 | import Calc.Types.Expr
13 | import Calc.Types.FunctionName
14 | import Calc.Types.Type
15 | import Data.String
16 | import Data.Text (Text)
17 | import qualified Data.Text as T
18 |
19 | newtype ArgumentName = ArgumentName Text
20 | deriving newtype (Eq, Ord, Show)
21 |
22 | instance IsString ArgumentName where
23 | fromString = ArgumentName . T.pack
24 |
25 | data Function ann = Function
26 | { fnAnn :: ann,
27 | fnArgs :: [(ArgumentName, Type ann)],
28 | fnFunctionName :: FunctionName,
29 | fnBody :: Expr ann
30 | }
31 | deriving stock (Eq, Ord, Show, Functor)
32 |
--------------------------------------------------------------------------------
/wasm-calc3/src/Calc/Types/FunctionName.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.FunctionName
5 | ( FunctionName (..),
6 | )
7 | where
8 |
9 | import Data.Hashable
10 | import Data.String
11 | import Data.Text (Text)
12 | import qualified Data.Text as T
13 | import qualified Prettyprinter as PP
14 |
15 | newtype FunctionName = FunctionName Text
16 | deriving newtype (Eq, Ord, Show, Hashable)
17 |
18 | instance IsString FunctionName where
19 | fromString = FunctionName . T.pack
20 |
21 | instance PP.Pretty FunctionName where
22 | pretty (FunctionName fn) = PP.pretty fn
23 |
--------------------------------------------------------------------------------
/wasm-calc3/src/Calc/Types/Module.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 |
4 | module Calc.Types.Module where
5 |
6 | import Calc.Types.Expr
7 | import Calc.Types.Function
8 |
9 | data Module ann = Module
10 | { mdFunctions :: [Function ann],
11 | mdExpr :: Expr ann
12 | }
13 | deriving stock (Eq, Ord, Show, Functor)
14 |
--------------------------------------------------------------------------------
/wasm-calc3/src/Calc/Types/Prim.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Prim
4 | ( Prim (..),
5 | )
6 | where
7 |
8 | import qualified Prettyprinter as PP
9 |
10 | data Prim
11 | = PInt Integer
12 | | PBool Bool
13 | deriving stock (Eq, Ord, Show)
14 |
15 | instance PP.Pretty Prim where
16 | pretty (PInt i) = PP.pretty i
17 | pretty (PBool b) = PP.pretty b
18 |
--------------------------------------------------------------------------------
/wasm-calc3/src/Calc/Types/Type.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE OverloadedStrings #-}
4 |
5 | module Calc.Types.Type (Type (..), TypePrim (..)) where
6 |
7 | import qualified Prettyprinter as PP
8 |
9 | data TypePrim = TBool | TInt
10 | deriving stock (Eq, Ord, Show)
11 |
12 | instance PP.Pretty TypePrim where
13 | pretty TBool = "Boolean"
14 | pretty TInt = "Integer"
15 |
16 | data Type ann
17 | = TPrim ann TypePrim
18 | | TFunction ann [Type ann] (Type ann)
19 | deriving stock (Eq, Ord, Show, Functor)
20 |
21 | instance PP.Pretty (Type ann) where
22 | pretty (TPrim _ prim) = PP.pretty prim
23 | pretty (TFunction _ args ret) =
24 | "(" <> prettyArgs <> ") -> " <> PP.pretty ret
25 | where
26 | prettyArgs = PP.concatWith (PP.surround PP.comma) (PP.pretty <$> args)
27 |
--------------------------------------------------------------------------------
/wasm-calc3/src/Calc/Wasm/Run.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Wasm.Run (runWasm) where
4 |
5 | import qualified Language.Wasm as Wasm
6 | import qualified Language.Wasm.Interpreter as Wasm
7 |
8 | runWasm :: Wasm.Module -> IO (Maybe [Wasm.Value])
9 | runWasm wasmModule = do
10 | case Wasm.validate wasmModule of
11 | Right validModule -> do
12 | (result, store) <- Wasm.instantiate Wasm.emptyStore mempty validModule
13 | case result of
14 | Right moduleInstance ->
15 | Wasm.invokeExport store moduleInstance "main" mempty
16 | Left e -> error e
17 | Left e -> do
18 | print wasmModule
19 | error $ "invalid module: " <> show e
20 |
--------------------------------------------------------------------------------
/wasm-calc3/static/runtime.c:
--------------------------------------------------------------------------------
1 | #include
2 | #include
3 |
4 | void printint(int i) {
5 | printf("%d", i);
6 | }
7 |
8 | void printbool(int b) {
9 | printf(b ? "True" : "False");
10 | }
11 |
12 |
--------------------------------------------------------------------------------
/wasm-calc3/test/Main.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import Test.Hspec
4 | import qualified Test.Interpreter.InterpreterSpec
5 | import qualified Test.Parser.ParserSpec
6 | import qualified Test.Typecheck.TypecheckSpec
7 | import qualified Test.Wasm.WasmSpec
8 |
9 | main :: IO ()
10 | main = hspec $ do
11 | Test.Parser.ParserSpec.spec
12 | Test.Interpreter.InterpreterSpec.spec
13 | Test.Wasm.WasmSpec.spec
14 | Test.Typecheck.TypecheckSpec.spec
15 |
--------------------------------------------------------------------------------
/wasm-calc4/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle
2 | .direnv
3 |
--------------------------------------------------------------------------------
/wasm-calc4/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Revision history for nix-basic
2 |
3 | ## 0.1.0.0 -- YYYY-mm-dd
4 |
5 | * First version. Released on an unsuspecting world.
6 |
--------------------------------------------------------------------------------
/wasm-calc4/app/Main.hs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Calc (repl)
4 |
5 | main :: IO ()
6 | main = repl
7 |
--------------------------------------------------------------------------------
/wasm-calc4/src/Calc.hs:
--------------------------------------------------------------------------------
1 | module Calc
2 | ( module Calc.Types,
3 | module Calc.Parser,
4 | module Calc.ExprUtils,
5 | module Calc.Interpreter,
6 | module Calc.Repl,
7 | )
8 | where
9 |
10 | import Calc.ExprUtils
11 | import Calc.Interpreter
12 | import Calc.Parser
13 | import Calc.Repl
14 | import Calc.Types
15 |
--------------------------------------------------------------------------------
/wasm-calc4/src/Calc/Parser/Module.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Module (moduleParser) where
2 |
3 | import Calc.Parser.Expr
4 | import Calc.Parser.Function
5 | import Calc.Parser.Types
6 | import Calc.Types.Annotation
7 | import Calc.Types.Module
8 | import Text.Megaparsec
9 |
10 | moduleParser :: Parser (Module Annotation)
11 | moduleParser = do
12 | funcs <- many functionParser
13 | Module funcs <$> exprParser
14 |
--------------------------------------------------------------------------------
/wasm-calc4/src/Calc/Parser/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Types
2 | ( Parser,
3 | ParseErrorType,
4 | ParserExpr,
5 | ParserType,
6 | ParserFunction,
7 | ParserModule,
8 | )
9 | where
10 |
11 | import Calc.Types.Annotation
12 | import Calc.Types.Expr
13 | import Calc.Types.Function
14 | import Calc.Types.Module
15 | import Calc.Types.Type
16 | import Data.Text (Text)
17 | import Data.Void
18 | import Text.Megaparsec
19 |
20 | type Parser = Parsec Void Text
21 |
22 | type ParseErrorType = ParseErrorBundle Text Void
23 |
24 | type ParserExpr = Expr Annotation
25 |
26 | type ParserType = Type Annotation
27 |
28 | type ParserFunction = Function Annotation
29 |
30 | type ParserModule = Module Annotation
31 |
--------------------------------------------------------------------------------
/wasm-calc4/src/Calc/TypeUtils.hs:
--------------------------------------------------------------------------------
1 | module Calc.TypeUtils (mapOuterTypeAnnotation, getOuterTypeAnnotation) where
2 |
3 | import Calc.Types.Type
4 |
5 | getOuterTypeAnnotation :: Type ann -> ann
6 | getOuterTypeAnnotation (TPrim ann _) = ann
7 | getOuterTypeAnnotation (TFunction ann _ _) = ann
8 | getOuterTypeAnnotation (TTuple ann _ _) = ann
9 |
10 | mapOuterTypeAnnotation :: (ann -> ann) -> Type ann -> Type ann
11 | mapOuterTypeAnnotation f (TPrim ann p) = TPrim (f ann) p
12 | mapOuterTypeAnnotation f (TFunction ann a b) = TFunction (f ann) a b
13 | mapOuterTypeAnnotation f (TTuple ann a b) = TTuple (f ann) a b
14 |
--------------------------------------------------------------------------------
/wasm-calc4/src/Calc/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Types
2 | ( module Calc.Types.Annotation,
3 | module Calc.Types.Identifier,
4 | module Calc.Types.Expr,
5 | module Calc.Types.Function,
6 | module Calc.Types.Module,
7 | module Calc.Types.Prim,
8 | module Calc.Types.Type,
9 | )
10 | where
11 |
12 | import Calc.Types.Annotation
13 | import Calc.Types.Expr
14 | import Calc.Types.Function
15 | import Calc.Types.Identifier
16 | import Calc.Types.Module
17 | import Calc.Types.Prim
18 | import Calc.Types.Type
19 |
--------------------------------------------------------------------------------
/wasm-calc4/src/Calc/Types/Annotation.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Annotation
4 | ( Annotation (..),
5 | )
6 | where
7 |
8 | -- | `Annotation` is used to track source code location
9 | -- it is added to parts of `Expr` during parsing and used to
10 | -- make errors nicer
11 | data Annotation = Location Int Int
12 | deriving stock (Eq, Ord, Show)
13 |
14 | -- | when combining two `Annotation`, combine to make one big annotation
15 | instance Semigroup Annotation where
16 | (Location start end) <> (Location start' end') =
17 | Location (min start start') (max end end')
18 |
19 | -- | Default to an empty `Annotation`
20 | instance Monoid Annotation where
21 | mempty = Location 0 0
22 |
--------------------------------------------------------------------------------
/wasm-calc4/src/Calc/Types/Function.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
4 |
5 | module Calc.Types.Function
6 | ( ArgumentName (..),
7 | FunctionName (..),
8 | Function (..),
9 | )
10 | where
11 |
12 | import Calc.Types.Expr
13 | import Calc.Types.FunctionName
14 | import Calc.Types.Type
15 | import Data.String
16 | import Data.Text (Text)
17 | import qualified Data.Text as T
18 |
19 | newtype ArgumentName = ArgumentName Text
20 | deriving newtype (Eq, Ord, Show)
21 |
22 | instance IsString ArgumentName where
23 | fromString = ArgumentName . T.pack
24 |
25 | data Function ann = Function
26 | { fnAnn :: ann,
27 | fnArgs :: [(ArgumentName, Type ann)],
28 | fnFunctionName :: FunctionName,
29 | fnBody :: Expr ann
30 | }
31 | deriving stock (Eq, Ord, Show, Functor)
32 |
--------------------------------------------------------------------------------
/wasm-calc4/src/Calc/Types/FunctionName.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.FunctionName
5 | ( FunctionName (..),
6 | )
7 | where
8 |
9 | import Data.Hashable
10 | import Data.String
11 | import Data.Text (Text)
12 | import qualified Data.Text as T
13 | import qualified Prettyprinter as PP
14 |
15 | newtype FunctionName = FunctionName Text
16 | deriving newtype (Eq, Ord, Show, Hashable)
17 |
18 | instance IsString FunctionName where
19 | fromString = FunctionName . T.pack
20 |
21 | instance PP.Pretty FunctionName where
22 | pretty (FunctionName fn) = PP.pretty fn
23 |
--------------------------------------------------------------------------------
/wasm-calc4/src/Calc/Types/Module.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 |
4 | module Calc.Types.Module where
5 |
6 | import Calc.Types.Expr
7 | import Calc.Types.Function
8 |
9 | data Module ann = Module
10 | { mdFunctions :: [Function ann],
11 | mdExpr :: Expr ann
12 | }
13 | deriving stock (Eq, Ord, Show, Functor)
14 |
--------------------------------------------------------------------------------
/wasm-calc4/src/Calc/Types/Prim.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Prim
4 | ( Prim (..),
5 | )
6 | where
7 |
8 | import qualified Prettyprinter as PP
9 |
10 | data Prim
11 | = PInt Integer
12 | | PBool Bool
13 | deriving stock (Eq, Ord, Show)
14 |
15 | instance PP.Pretty Prim where
16 | pretty (PInt i) = PP.pretty i
17 | pretty (PBool b) = PP.pretty b
18 |
--------------------------------------------------------------------------------
/wasm-calc4/src/Calc/Utils.hs:
--------------------------------------------------------------------------------
1 | module Calc.Utils (ltrace, neZipWithM, neUnzip) where
2 |
3 | -- useful junk goes here
4 |
5 | import Control.Monad (zipWithM)
6 | import Data.Bifunctor
7 | import qualified Data.List.NonEmpty as NE
8 | import qualified Data.Text.Lazy as TL
9 | import qualified Debug.Trace as Debug
10 | import qualified Text.Pretty.Simple as PS
11 |
12 | neZipWithM ::
13 | (Applicative m) =>
14 | (a -> b -> m c) ->
15 | NE.NonEmpty a ->
16 | NE.NonEmpty b ->
17 | m (NE.NonEmpty c)
18 | neZipWithM f as bs =
19 | NE.fromList <$> zipWithM f (NE.toList as) (NE.toList bs)
20 |
21 | neUnzip :: NE.NonEmpty (a, b) -> (NE.NonEmpty a, NE.NonEmpty b)
22 | neUnzip = bimap NE.fromList NE.fromList . unzip . NE.toList
23 |
24 | ltrace :: (Show a) => String -> a -> a
25 | ltrace lbl x = Debug.trace (lbl <> ": " <> TL.unpack (PS.pShow x)) x
26 |
--------------------------------------------------------------------------------
/wasm-calc4/src/Calc/Wasm/Allocator.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE TemplateHaskell #-}
2 |
3 | module Calc.Wasm.Allocator (moduleWithAllocator) where
4 |
5 | import qualified Data.ByteString.Lazy as LB
6 | import Data.FileEmbed
7 | import qualified Language.Wasm as Wasm
8 |
9 | -- these are saved in a file that is included in compilation
10 | allocatorSource :: LB.ByteString
11 | allocatorSource =
12 | LB.fromStrict $(makeRelativeToProject "static/bump-allocator.wat" >>= embedFile)
13 |
14 | -- we have an allocator, we need to import it
15 | moduleWithAllocator :: Wasm.Module
16 | moduleWithAllocator = case Wasm.parse allocatorSource of
17 | Right mod' -> mod'
18 | Left e -> error (show e)
19 |
--------------------------------------------------------------------------------
/wasm-calc4/src/Calc/Wasm/Helpers.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.Helpers (memorySize) where
2 |
3 | import Calc.Wasm.Types
4 | import GHC.Natural
5 |
6 | -- our memory is bits of i32s
7 | memorySize :: WasmType -> Natural
8 | memorySize I32 = 8
9 | memorySize Pointer = 8
10 |
--------------------------------------------------------------------------------
/wasm-calc4/src/Calc/Wasm/Run.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Wasm.Run (runWasm) where
4 |
5 | import qualified Language.Wasm as Wasm
6 | import qualified Language.Wasm.Interpreter as Wasm
7 |
8 | runWasm :: Wasm.Module -> IO (Maybe [Wasm.Value])
9 | runWasm wasmModule = do
10 | case Wasm.validate wasmModule of
11 | Right validModule -> do
12 | (result, store) <- Wasm.instantiate Wasm.emptyStore mempty validModule
13 | case result of
14 | Right moduleInstance ->
15 | Wasm.invokeExport store moduleInstance "main" mempty
16 | Left e -> error e
17 | Left e -> do
18 | print wasmModule
19 | error $ "invalid module: " <> show e
20 |
--------------------------------------------------------------------------------
/wasm-calc4/test/Main.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import Test.Hspec
4 | import qualified Test.Interpreter.InterpreterSpec
5 | import qualified Test.Parser.ParserSpec
6 | import qualified Test.Typecheck.TypecheckSpec
7 | import qualified Test.Wasm.WasmSpec
8 |
9 | main :: IO ()
10 | main = hspec $ do
11 | Test.Parser.ParserSpec.spec
12 | Test.Interpreter.InterpreterSpec.spec
13 | Test.Typecheck.TypecheckSpec.spec
14 | Test.Wasm.WasmSpec.spec
15 |
--------------------------------------------------------------------------------
/wasm-calc5/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle
2 | .direnv
3 |
--------------------------------------------------------------------------------
/wasm-calc5/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Revision history for nix-basic
2 |
3 | ## 0.1.0.0 -- YYYY-mm-dd
4 |
5 | * First version. Released on an unsuspecting world.
6 |
--------------------------------------------------------------------------------
/wasm-calc5/app/Main.hs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Calc (repl)
4 |
5 | main :: IO ()
6 | main = repl
7 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc.hs:
--------------------------------------------------------------------------------
1 | module Calc
2 | ( module Calc.Types,
3 | module Calc.Parser,
4 | module Calc.ExprUtils,
5 | module Calc.Interpreter,
6 | module Calc.Repl,
7 | )
8 | where
9 |
10 | import Calc.ExprUtils
11 | import Calc.Interpreter
12 | import Calc.Parser
13 | import Calc.Repl
14 | import Calc.Types
15 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc/Parser/Module.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Module (moduleParser) where
2 |
3 | import Calc.Parser.Expr
4 | import Calc.Parser.Function
5 | import Calc.Parser.Types
6 | import Calc.Types.Annotation
7 | import Calc.Types.Module
8 | import Text.Megaparsec
9 |
10 | moduleParser :: Parser (Module Annotation)
11 | moduleParser = do
12 | funcs <- many functionParser
13 | Module funcs <$> exprParser
14 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc/Parser/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Types
2 | ( Parser,
3 | ParseErrorType,
4 | ParserExpr,
5 | ParserType,
6 | ParserFunction,
7 | ParserModule,
8 | )
9 | where
10 |
11 | import Calc.Types.Annotation
12 | import Calc.Types.Expr
13 | import Calc.Types.Function
14 | import Calc.Types.Module
15 | import Calc.Types.Type
16 | import Data.Text (Text)
17 | import Data.Void
18 | import Text.Megaparsec
19 |
20 | type Parser = Parsec Void Text
21 |
22 | type ParseErrorType = ParseErrorBundle Text Void
23 |
24 | type ParserExpr = Expr Annotation
25 |
26 | type ParserType = Type Annotation
27 |
28 | type ParserFunction = Function Annotation
29 |
30 | type ParserModule = Module Annotation
31 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc/Typecheck/Substitute.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Substitute (substitute) where
2 |
3 | import Calc.TypeUtils
4 | import Calc.Types.Type
5 | import qualified Data.HashMap.Strict as HM
6 | import GHC.Natural
7 |
8 | substitute ::
9 | HM.HashMap Natural (Type ann) ->
10 | Type ann ->
11 | Type ann
12 | substitute subs (TUnificationVar _ nat) =
13 | case HM.lookup nat subs of
14 | Just ty -> ty
15 | Nothing -> error $ "Could not find unification var for " <> show nat
16 | substitute subs other =
17 | mapType (substitute subs) other
18 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Types
2 | ( module Calc.Types.Annotation,
3 | module Calc.Types.Identifier,
4 | module Calc.Types.Expr,
5 | module Calc.Types.Function,
6 | module Calc.Types.Module,
7 | module Calc.Types.Prim,
8 | module Calc.Types.Type,
9 | module Calc.Types.TypeVar,
10 | )
11 | where
12 |
13 | import Calc.Types.Annotation
14 | import Calc.Types.Expr
15 | import Calc.Types.Function
16 | import Calc.Types.Identifier
17 | import Calc.Types.Module
18 | import Calc.Types.Prim
19 | import Calc.Types.Type
20 | import Calc.Types.TypeVar
21 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc/Types/Annotation.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Annotation
4 | ( Annotation (..),
5 | )
6 | where
7 |
8 | -- | `Annotation` is used to track source code location
9 | -- it is added to parts of `Expr` during parsing and used to
10 | -- make errors nicer
11 | data Annotation = Location Int Int
12 | deriving stock (Eq, Ord, Show)
13 |
14 | -- | when combining two `Annotation`, combine to make one big annotation
15 | instance Semigroup Annotation where
16 | (Location start end) <> (Location start' end') =
17 | Location (min start start') (max end end')
18 |
19 | -- | Default to an empty `Annotation`
20 | instance Monoid Annotation where
21 | mempty = Location 0 0
22 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc/Types/Function.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
4 |
5 | module Calc.Types.Function
6 | ( ArgumentName (..),
7 | FunctionName (..),
8 | Function (..),
9 | )
10 | where
11 |
12 | import Calc.Types.Expr
13 | import Calc.Types.FunctionName
14 | import Calc.Types.Type
15 | import Calc.Types.TypeVar
16 | import Data.String
17 | import Data.Text (Text)
18 | import qualified Data.Text as T
19 |
20 | newtype ArgumentName = ArgumentName Text
21 | deriving newtype (Eq, Ord, Show)
22 |
23 | instance IsString ArgumentName where
24 | fromString = ArgumentName . T.pack
25 |
26 | data Function ann = Function
27 | { fnAnn :: ann,
28 | fnGenerics :: [TypeVar],
29 | fnArgs :: [(ArgumentName, Type ann)],
30 | fnFunctionName :: FunctionName,
31 | fnBody :: Expr ann
32 | }
33 | deriving stock (Eq, Ord, Show, Functor)
34 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc/Types/FunctionName.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.FunctionName
5 | ( FunctionName (..),
6 | )
7 | where
8 |
9 | import Data.Hashable
10 | import Data.String
11 | import Data.Text (Text)
12 | import qualified Data.Text as T
13 | import qualified Prettyprinter as PP
14 |
15 | newtype FunctionName = FunctionName Text
16 | deriving newtype (Eq, Ord, Show, Hashable)
17 |
18 | instance IsString FunctionName where
19 | fromString = FunctionName . T.pack
20 |
21 | instance PP.Pretty FunctionName where
22 | pretty (FunctionName fn) = PP.pretty fn
23 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc/Types/Module.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 |
4 | module Calc.Types.Module where
5 |
6 | import Calc.Types.Expr
7 | import Calc.Types.Function
8 |
9 | data Module ann = Module
10 | { mdFunctions :: [Function ann],
11 | mdExpr :: Expr ann
12 | }
13 | deriving stock (Eq, Ord, Show, Functor)
14 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc/Types/Prim.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Prim
4 | ( Prim (..),
5 | )
6 | where
7 |
8 | import qualified Prettyprinter as PP
9 |
10 | data Prim
11 | = PInt Integer
12 | | PFloat Float
13 | | PBool Bool
14 | deriving stock (Eq, Ord, Show)
15 |
16 | instance PP.Pretty Prim where
17 | pretty (PInt i) = PP.pretty i
18 | pretty (PFloat f) = PP.pretty f
19 | pretty (PBool b) = PP.pretty b
20 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc/Types/TypeVar.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.TypeVar (TypeVar (..), safeMkTypeVar) where
5 |
6 | import qualified Data.Char as Ch
7 | import Data.Hashable
8 | import Data.String
9 | import Data.Text (Text)
10 | import qualified Data.Text as T
11 | import qualified Prettyprinter as PP
12 |
13 | newtype TypeVar = TypeVar Text
14 | deriving newtype (Eq, Ord, Show, Hashable)
15 |
16 | instance IsString TypeVar where
17 | fromString = TypeVar . T.pack
18 |
19 | instance PP.Pretty TypeVar where
20 | pretty (TypeVar ident) = PP.pretty ident
21 |
22 | validTypeVar :: Text -> Bool
23 | validTypeVar a =
24 | T.length a > 0
25 | && T.filter Ch.isAlphaNum a == a
26 | && not (Ch.isDigit (T.head a))
27 | && Ch.isLower (T.head a)
28 |
29 | safeMkTypeVar :: Text -> Maybe TypeVar
30 | safeMkTypeVar a =
31 | if validTypeVar a
32 | then Just (TypeVar a)
33 | else Nothing
34 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc/Utils.hs:
--------------------------------------------------------------------------------
1 | module Calc.Utils (prettyShow, ltrace, neZipWithM, neUnzip) where
2 |
3 | -- useful junk goes here
4 |
5 | import Control.Monad (zipWithM)
6 | import Data.Bifunctor
7 | import qualified Data.List.NonEmpty as NE
8 | import qualified Data.Text.Lazy as TL
9 | import qualified Debug.Trace as Debug
10 | import qualified Text.Pretty.Simple as PS
11 |
12 | neZipWithM ::
13 | (Applicative m) =>
14 | (a -> b -> m c) ->
15 | NE.NonEmpty a ->
16 | NE.NonEmpty b ->
17 | m (NE.NonEmpty c)
18 | neZipWithM f as bs =
19 | NE.fromList <$> zipWithM f (NE.toList as) (NE.toList bs)
20 |
21 | neUnzip :: NE.NonEmpty (a, b) -> (NE.NonEmpty a, NE.NonEmpty b)
22 | neUnzip = bimap NE.fromList NE.fromList . unzip . NE.toList
23 |
24 | ltrace :: (Show a) => String -> a -> a
25 | ltrace lbl x = Debug.trace (lbl <> ": " <> TL.unpack (PS.pShow x)) x
26 |
27 | prettyShow :: (Show a) => a -> String
28 | prettyShow = TL.unpack . PS.pShow
29 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc/Wasm/Allocator.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE TemplateHaskell #-}
2 |
3 | module Calc.Wasm.Allocator (moduleWithAllocator) where
4 |
5 | import qualified Data.ByteString.Lazy as LB
6 | import Data.FileEmbed
7 | import qualified Language.Wasm as Wasm
8 |
9 | -- these are saved in a file that is included in compilation
10 | allocatorSource :: LB.ByteString
11 | allocatorSource =
12 | LB.fromStrict $(makeRelativeToProject "static/bump-allocator.wat" >>= embedFile)
13 |
14 | -- we have an allocator, we need to import it
15 | moduleWithAllocator :: Wasm.Module
16 | moduleWithAllocator = case Wasm.parse allocatorSource of
17 | Right mod' -> mod'
18 | Left e -> error (show e)
19 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc/Wasm/Helpers.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.Helpers (memorySize) where
2 |
3 | import Calc.Wasm.Types
4 | import GHC.Natural
5 |
6 | -- our memory is bits of i32s
7 | memorySize :: WasmType -> Natural
8 | memorySize I32 = 8
9 | memorySize I64 = 16
10 | memorySize F64 = 16
11 | memorySize Pointer = memorySize I32
12 |
--------------------------------------------------------------------------------
/wasm-calc5/src/Calc/Wasm/Run.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Wasm.Run (runWasm) where
4 |
5 | import Calc.Utils
6 | import qualified Language.Wasm as Wasm
7 | import qualified Language.Wasm.Interpreter as Wasm
8 |
9 | runWasm :: Wasm.Module -> IO (Maybe [Wasm.Value])
10 | runWasm wasmModule = do
11 | case Wasm.validate wasmModule of
12 | Right validModule -> do
13 | (result, store) <- Wasm.instantiate Wasm.emptyStore mempty validModule
14 | case result of
15 | Right moduleInstance ->
16 | Wasm.invokeExport store moduleInstance "main" mempty
17 | Left e -> error e
18 | Left e ->
19 | error $
20 | "invalid module: "
21 | <> show e
22 | <> "\n\n"
23 | <> prettyShow wasmModule
24 |
--------------------------------------------------------------------------------
/wasm-calc5/test/Main.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import Test.Hspec
4 | import qualified Test.Interpreter.InterpreterSpec
5 | import qualified Test.Parser.ParserSpec
6 | import qualified Test.Typecheck.TypecheckSpec
7 | import qualified Test.Wasm.WasmSpec
8 |
9 | main :: IO ()
10 | main = hspec $ do
11 | Test.Parser.ParserSpec.spec
12 | Test.Interpreter.InterpreterSpec.spec
13 | Test.Typecheck.TypecheckSpec.spec
14 | Test.Wasm.WasmSpec.spec
15 |
--------------------------------------------------------------------------------
/wasm-calc6/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle
2 | .direnv
3 |
--------------------------------------------------------------------------------
/wasm-calc6/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Revision history for nix-basic
2 |
3 | ## 0.1.0.0 -- YYYY-mm-dd
4 |
5 | * First version. Released on an unsuspecting world.
6 |
--------------------------------------------------------------------------------
/wasm-calc6/app/Main.hs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Calc (repl)
4 |
5 | main :: IO ()
6 | main = repl
7 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc.hs:
--------------------------------------------------------------------------------
1 | module Calc
2 | ( module Calc.Types,
3 | module Calc.Parser,
4 | module Calc.ExprUtils,
5 | module Calc.Interpreter,
6 | module Calc.Repl,
7 | )
8 | where
9 |
10 | import Calc.ExprUtils
11 | import Calc.Interpreter
12 | import Calc.Parser
13 | import Calc.Repl
14 | import Calc.Types
15 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Linearity.hs:
--------------------------------------------------------------------------------
1 | module Calc.Linearity
2 | ( module Calc.Linearity.Types,
3 | module Calc.Linearity.Error,
4 | module Calc.Linearity.Validate,
5 | )
6 | where
7 |
8 | import Calc.Linearity.Error
9 | import Calc.Linearity.Types
10 | import Calc.Linearity.Validate
11 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Linearity/Types.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE FlexibleContexts #-}
4 |
5 | module Calc.Linearity.Types
6 | ( Linearity (..),
7 | LinearityType (..),
8 | LinearState (..),
9 | )
10 | where
11 |
12 | import Calc.Types.Identifier
13 | import qualified Data.Map as M
14 | import GHC.Natural
15 |
16 | -- | Are we using the whole type or bits of it?
17 | -- this distinction will be gone once we can destructure types instead,
18 | -- implicitly destroying them
19 | data Linearity ann
20 | = Whole ann
21 | | Slice ann Natural
22 | deriving stock (Eq, Ord, Show, Functor)
23 |
24 | -- | we're less fussy about the use of primitive values
25 | data LinearityType = LTPrimitive | LTBoxed
26 | deriving stock (Eq, Ord, Show)
27 |
28 | data LinearState ann = LinearState
29 | { lsVars :: M.Map Identifier (LinearityType, ann),
30 | lsUses :: [(Identifier, Linearity ann)]
31 | }
32 | deriving stock (Eq, Ord, Show, Functor)
33 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Parser/Module.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Module (moduleParser) where
2 |
3 | import Calc.Parser.Expr
4 | import Calc.Parser.Function
5 | import Calc.Parser.Types
6 | import Calc.Types.Annotation
7 | import Calc.Types.Module
8 | import Text.Megaparsec
9 |
10 | moduleParser :: Parser (Module Annotation)
11 | moduleParser = do
12 | funcs <- many functionParser
13 | Module funcs <$> exprParser
14 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Parser/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Types
2 | ( Parser,
3 | ParseErrorType,
4 | ParserExpr,
5 | ParserType,
6 | ParserFunction,
7 | ParserModule,
8 | ParserPattern,
9 | )
10 | where
11 |
12 | import Calc.Types.Annotation
13 | import Calc.Types.Expr
14 | import Calc.Types.Function
15 | import Calc.Types.Module
16 | import Calc.Types.Pattern
17 | import Calc.Types.Type
18 | import Data.Text (Text)
19 | import Data.Void
20 | import Text.Megaparsec
21 |
22 | type Parser = Parsec Void Text
23 |
24 | type ParseErrorType = ParseErrorBundle Text Void
25 |
26 | type ParserExpr = Expr Annotation
27 |
28 | type ParserType = Type Annotation
29 |
30 | type ParserFunction = Function Annotation
31 |
32 | type ParserModule = Module Annotation
33 |
34 | type ParserPattern = Pattern Annotation
35 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Typecheck.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck
2 | ( module Calc.Typecheck.Error,
3 | module Calc.Typecheck.Helpers,
4 | module Calc.Typecheck.Elaborate,
5 | module Calc.Typecheck.Types,
6 | )
7 | where
8 |
9 | import Calc.Typecheck.Elaborate
10 | import Calc.Typecheck.Error
11 | import Calc.Typecheck.Helpers
12 | import Calc.Typecheck.Types
13 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Typecheck/Substitute.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Substitute (substitute) where
2 |
3 | import Calc.TypeUtils
4 | import Calc.Types.Type
5 | import qualified Data.HashMap.Strict as HM
6 | import GHC.Natural
7 |
8 | substitute ::
9 | HM.HashMap Natural (Type ann) ->
10 | Type ann ->
11 | Type ann
12 | substitute subs (TUnificationVar _ nat) =
13 | case HM.lookup nat subs of
14 | Just ty -> ty
15 | Nothing -> error $ "Could not find unification var for " <> show nat
16 | substitute subs other =
17 | mapType (substitute subs) other
18 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Types
2 | ( module Calc.Types.Annotation,
3 | module Calc.Types.Identifier,
4 | module Calc.Types.Expr,
5 | module Calc.Types.Function,
6 | module Calc.Types.Module,
7 | module Calc.Types.Pattern,
8 | module Calc.Types.Prim,
9 | module Calc.Types.Type,
10 | module Calc.Types.TypeVar,
11 | )
12 | where
13 |
14 | import Calc.Types.Annotation
15 | import Calc.Types.Expr
16 | import Calc.Types.Function
17 | import Calc.Types.Identifier
18 | import Calc.Types.Module
19 | import Calc.Types.Pattern
20 | import Calc.Types.Prim
21 | import Calc.Types.Type
22 | import Calc.Types.TypeVar
23 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Types/Annotation.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Annotation
4 | ( Annotation (..),
5 | )
6 | where
7 |
8 | -- | `Annotation` is used to track source code location
9 | -- it is added to parts of `Expr` during parsing and used to
10 | -- make errors nicer
11 | data Annotation = Location Int Int
12 | deriving stock (Eq, Ord, Show)
13 |
14 | -- | when combining two `Annotation`, combine to make one big annotation
15 | instance Semigroup Annotation where
16 | (Location start end) <> (Location start' end') =
17 | Location (min start start') (max end end')
18 |
19 | -- | Default to an empty `Annotation`
20 | instance Monoid Annotation where
21 | mempty = Location 0 0
22 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Types/FunctionName.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.FunctionName
5 | ( FunctionName (..),
6 | )
7 | where
8 |
9 | import Data.Hashable
10 | import Data.String
11 | import Data.Text (Text)
12 | import qualified Data.Text as T
13 | import qualified Prettyprinter as PP
14 |
15 | newtype FunctionName = FunctionName Text
16 | deriving newtype (Eq, Ord, Show, Hashable)
17 |
18 | instance IsString FunctionName where
19 | fromString = FunctionName . T.pack
20 |
21 | instance PP.Pretty FunctionName where
22 | pretty (FunctionName fn) = PP.pretty fn
23 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Types/Module.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 |
4 | module Calc.Types.Module where
5 |
6 | import Calc.Types.Expr
7 | import Calc.Types.Function
8 |
9 | data Module ann = Module
10 | { mdFunctions :: [Function ann],
11 | mdExpr :: Expr ann
12 | }
13 | deriving stock (Eq, Ord, Show, Functor)
14 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Types/Pattern.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveTraversable #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE OverloadedStrings #-}
4 |
5 | module Calc.Types.Pattern where
6 |
7 | import Calc.Types.Identifier
8 | import qualified Data.List.NonEmpty as NE
9 | import qualified Prettyprinter as PP
10 |
11 | data Pattern ann
12 | = PVar ann Identifier
13 | | PWildcard ann
14 | | PTuple ann (Pattern ann) (NE.NonEmpty (Pattern ann))
15 | | PBox ann (Pattern ann)
16 | deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable)
17 |
18 | instance PP.Pretty (Pattern ann) where
19 | pretty (PVar _ identifier) = PP.pretty identifier
20 | pretty (PWildcard _) = "_"
21 | pretty (PBox _ inner) = "Box(" <> PP.pretty inner <> ")"
22 | pretty (PTuple _ a as) =
23 | "(" <> PP.cat (PP.punctuate "," (PP.pretty <$> tupleItems a as)) <> ")"
24 | where
25 | tupleItems :: a -> NE.NonEmpty a -> [a]
26 | tupleItems b bs = b : NE.toList bs
27 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Types/Prim.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Prim
4 | ( Prim (..),
5 | )
6 | where
7 |
8 | import qualified Prettyprinter as PP
9 |
10 | data Prim
11 | = PInt Integer
12 | | PFloat Float
13 | | PBool Bool
14 | deriving stock (Eq, Ord, Show)
15 |
16 | instance PP.Pretty Prim where
17 | pretty (PInt i) = PP.pretty i
18 | pretty (PFloat f) = PP.pretty f
19 | pretty (PBool b) = PP.pretty b
20 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Types/TypeVar.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.TypeVar (TypeVar (..), safeMkTypeVar) where
5 |
6 | import qualified Data.Char as Ch
7 | import Data.Hashable
8 | import Data.String
9 | import Data.Text (Text)
10 | import qualified Data.Text as T
11 | import qualified Prettyprinter as PP
12 |
13 | newtype TypeVar = TypeVar Text
14 | deriving newtype (Eq, Ord, Show, Hashable)
15 |
16 | instance IsString TypeVar where
17 | fromString = TypeVar . T.pack
18 |
19 | instance PP.Pretty TypeVar where
20 | pretty (TypeVar ident) = PP.pretty ident
21 |
22 | validTypeVar :: Text -> Bool
23 | validTypeVar a =
24 | T.length a > 0
25 | && T.filter Ch.isAlphaNum a == a
26 | && not (Ch.isDigit (T.head a))
27 | && Ch.isLower (T.head a)
28 |
29 | safeMkTypeVar :: Text -> Maybe TypeVar
30 | safeMkTypeVar a =
31 | if validTypeVar a
32 | then Just (TypeVar a)
33 | else Nothing
34 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Utils.hs:
--------------------------------------------------------------------------------
1 | module Calc.Utils (prettyShow, ltrace, neZipWithM, neUnzip) where
2 |
3 | -- useful junk goes here
4 |
5 | import Control.Monad (zipWithM)
6 | import Data.Bifunctor
7 | import qualified Data.List.NonEmpty as NE
8 | import qualified Data.Text.Lazy as TL
9 | import qualified Debug.Trace as Debug
10 | import qualified Text.Pretty.Simple as PS
11 |
12 | neZipWithM ::
13 | (Applicative m) =>
14 | (a -> b -> m c) ->
15 | NE.NonEmpty a ->
16 | NE.NonEmpty b ->
17 | m (NE.NonEmpty c)
18 | neZipWithM f as bs =
19 | NE.fromList <$> zipWithM f (NE.toList as) (NE.toList bs)
20 |
21 | neUnzip :: NE.NonEmpty (a, b) -> (NE.NonEmpty a, NE.NonEmpty b)
22 | neUnzip = bimap NE.fromList NE.fromList . unzip . NE.toList
23 |
24 | ltrace :: (Show a) => String -> a -> a
25 | ltrace lbl x = Debug.trace (lbl <> ": " <> TL.unpack (PS.pShow x)) x
26 |
27 | prettyShow :: (Show a) => a -> String
28 | prettyShow = TL.unpack . PS.pShow
29 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Wasm/Allocator.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE TemplateHaskell #-}
2 |
3 | module Calc.Wasm.Allocator (moduleWithAllocator) where
4 |
5 | import qualified Data.ByteString.Lazy as LB
6 | import Data.FileEmbed
7 | import qualified Language.Wasm as Wasm
8 |
9 | -- these are saved in a file that is included in compilation
10 | allocatorSource :: LB.ByteString
11 | allocatorSource =
12 | LB.fromStrict $(makeRelativeToProject "static/bump-allocator.wat" >>= embedFile)
13 |
14 | -- we have an allocator, we need to import it
15 | moduleWithAllocator :: Wasm.Module
16 | moduleWithAllocator = case Wasm.parse allocatorSource of
17 | Right mod' -> mod'
18 | Left e -> error (show e)
19 |
--------------------------------------------------------------------------------
/wasm-calc6/src/Calc/Wasm/Run.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Wasm.Run (runWasm) where
4 |
5 | import Calc.Utils
6 | import qualified Language.Wasm as Wasm
7 | import qualified Language.Wasm.Interpreter as Wasm
8 |
9 | runWasm :: Wasm.Module -> IO (Maybe [Wasm.Value])
10 | runWasm wasmModule = do
11 | case Wasm.validate wasmModule of
12 | Right validModule -> do
13 | (result, store) <- Wasm.instantiate Wasm.emptyStore mempty validModule
14 | case result of
15 | Right moduleInstance ->
16 | Wasm.invokeExport store moduleInstance "main" mempty
17 | Left e -> error e
18 | Left e ->
19 | error $
20 | "invalid module: "
21 | <> show e
22 | <> "\n\n"
23 | <> prettyShow wasmModule
24 |
--------------------------------------------------------------------------------
/wasm-calc6/test/Main.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import Test.Hspec
4 | import qualified Test.Interpreter.InterpreterSpec
5 | import qualified Test.Linearity.LinearitySpec
6 | import qualified Test.Parser.ParserSpec
7 | import qualified Test.Typecheck.TypecheckSpec
8 | import qualified Test.Wasm.WasmSpec
9 |
10 | main :: IO ()
11 | main = hspec $ do
12 | Test.Parser.ParserSpec.spec
13 | Test.Interpreter.InterpreterSpec.spec
14 | Test.Linearity.LinearitySpec.spec
15 | Test.Typecheck.TypecheckSpec.spec
16 | Test.Wasm.WasmSpec.spec
17 |
--------------------------------------------------------------------------------
/wasm-calc7/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle
2 | .direnv
3 |
--------------------------------------------------------------------------------
/wasm-calc7/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Revision history for nix-basic
2 |
3 | ## 0.1.0.0 -- YYYY-mm-dd
4 |
5 | * First version. Released on an unsuspecting world.
6 |
--------------------------------------------------------------------------------
/wasm-calc7/demo/.gitignore:
--------------------------------------------------------------------------------
1 | # ignore compiler wasm files
2 | *.wasm
3 |
--------------------------------------------------------------------------------
/wasm-calc7/demo/README.md:
--------------------------------------------------------------------------------
1 | # demo
2 |
3 | This is a small demo that runs in the browser, passing a `draw` function into a
4 | WASM module.
5 |
6 | To open it in a browser, run `serve .` and navigate to
7 | `localhost:3000/draw.html`.
8 |
9 | To change the file and see results, run `watchexec -w ./**/*.calc make
10 | run-build-drawing-demo-7`. This will watch all `.calc` files and recompile on file changes.
11 |
12 | You will need to reload the browser after each change.
13 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc.hs:
--------------------------------------------------------------------------------
1 | module Calc
2 | ( module Calc.Types,
3 | module Calc.Build,
4 | module Calc.Parser,
5 | module Calc.ExprUtils,
6 | module Calc.Repl,
7 | module Calc.Wasm,
8 | module Calc.PrettyPrint,
9 | )
10 | where
11 |
12 | import Calc.Build
13 | import Calc.ExprUtils
14 | import Calc.Parser
15 | import Calc.PrettyPrint
16 | import Calc.Repl
17 | import Calc.Types
18 | import Calc.Wasm
19 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Linearity.hs:
--------------------------------------------------------------------------------
1 | module Calc.Linearity
2 | ( module Calc.Linearity.Types,
3 | module Calc.Linearity.Error,
4 | module Calc.Linearity.Validate,
5 | )
6 | where
7 |
8 | import Calc.Linearity.Error
9 | import Calc.Linearity.Types
10 | import Calc.Linearity.Validate
11 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Linearity/Types.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE FlexibleContexts #-}
4 |
5 | module Calc.Linearity.Types
6 | ( Linearity (..),
7 | LinearityType (..),
8 | LinearState (..),
9 | )
10 | where
11 |
12 | import Calc.Types.Identifier
13 | import qualified Data.Map as M
14 | import GHC.Natural
15 |
16 | -- | Are we using the whole type or bits of it?
17 | -- this distinction will be gone once we can destructure types instead,
18 | -- implicitly destroying them
19 | data Linearity ann
20 | = Whole ann
21 | | Slice ann Natural
22 | deriving stock (Eq, Ord, Show, Functor)
23 |
24 | -- | we're less fussy about the use of primitive values
25 | data LinearityType = LTPrimitive | LTBoxed
26 | deriving stock (Eq, Ord, Show)
27 |
28 | data LinearState ann = LinearState
29 | { lsVars :: M.Map Identifier (LinearityType, ann),
30 | lsUses :: [(Identifier, Linearity ann)]
31 | }
32 | deriving stock (Eq, Ord, Show, Functor)
33 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Parser/Module.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Module (moduleParser) where
2 |
3 | import Calc.Parser.Function
4 | import Calc.Parser.Import
5 | import Calc.Parser.Types
6 | import Calc.Types.Annotation
7 | import Calc.Types.Module
8 | import Text.Megaparsec
9 |
10 | moduleParser :: Parser (Module Annotation)
11 | moduleParser = do
12 | imports <- many importParser
13 | funcs <- many functionParser
14 | pure $ Module {mdFunctions = funcs, mdImports = imports}
15 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Parser/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Types
2 | ( Parser,
3 | ParseErrorType,
4 | ParserExpr,
5 | ParserType,
6 | ParserFunction,
7 | ParserModule,
8 | ParserPattern,
9 | )
10 | where
11 |
12 | import Calc.Types.Annotation
13 | import Calc.Types.Expr
14 | import Calc.Types.Function
15 | import Calc.Types.Module
16 | import Calc.Types.Pattern
17 | import Calc.Types.Type
18 | import Data.Text (Text)
19 | import Data.Void
20 | import Text.Megaparsec
21 |
22 | type Parser = Parsec Void Text
23 |
24 | type ParseErrorType = ParseErrorBundle Text Void
25 |
26 | type ParserExpr = Expr Annotation
27 |
28 | type ParserType = Type Annotation
29 |
30 | type ParserFunction = Function Annotation
31 |
32 | type ParserModule = Module Annotation
33 |
34 | type ParserPattern = Pattern Annotation
35 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Typecheck.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck
2 | ( module Calc.Typecheck.Error,
3 | module Calc.Typecheck.Helpers,
4 | module Calc.Typecheck.Elaborate,
5 | module Calc.Typecheck.Types,
6 | )
7 | where
8 |
9 | import Calc.Typecheck.Elaborate
10 | import Calc.Typecheck.Error
11 | import Calc.Typecheck.Helpers
12 | import Calc.Typecheck.Types
13 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Typecheck/Substitute.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Substitute (substitute) where
2 |
3 | import Calc.TypeUtils
4 | import Calc.Types.Type
5 | import qualified Data.HashMap.Strict as HM
6 | import GHC.Natural
7 |
8 | substitute ::
9 | HM.HashMap Natural (Type ann) ->
10 | Type ann ->
11 | Type ann
12 | substitute subs (TUnificationVar _ nat) =
13 | case HM.lookup nat subs of
14 | Just ty -> ty
15 | Nothing -> error $ "Could not find unification var for " <> show nat
16 | substitute subs other =
17 | mapType (substitute subs) other
18 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Types
2 | ( module Calc.Types.Annotation,
3 | module Calc.Types.Op,
4 | module Calc.Types.Identifier,
5 | module Calc.Types.Import,
6 | module Calc.Types.Expr,
7 | module Calc.Types.Function,
8 | module Calc.Types.Module,
9 | module Calc.Types.Pattern,
10 | module Calc.Types.Prim,
11 | module Calc.Types.Type,
12 | module Calc.Types.TypeVar,
13 | )
14 | where
15 |
16 | import Calc.Types.Annotation
17 | import Calc.Types.Expr
18 | import Calc.Types.Function
19 | import Calc.Types.Identifier
20 | import Calc.Types.Import
21 | import Calc.Types.Module
22 | import Calc.Types.Op
23 | import Calc.Types.Pattern
24 | import Calc.Types.Prim
25 | import Calc.Types.Type
26 | import Calc.Types.TypeVar
27 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Types/Annotation.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Annotation
4 | ( Annotation (..),
5 | )
6 | where
7 |
8 | -- | `Annotation` is used to track source code location
9 | -- it is added to parts of `Expr` during parsing and used to
10 | -- make errors nicer
11 | data Annotation = Location Int Int
12 | deriving stock (Eq, Ord, Show)
13 |
14 | -- | when combining two `Annotation`, combine to make one big annotation
15 | instance Semigroup Annotation where
16 | (Location start end) <> (Location start' end') =
17 | Location (min start start') (max end end')
18 |
19 | -- | Default to an empty `Annotation`
20 | instance Monoid Annotation where
21 | mempty = Location 0 0
22 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Types/FunctionName.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.FunctionName
5 | ( FunctionName (..),
6 | )
7 | where
8 |
9 | import Data.Hashable
10 | import Data.String
11 | import Data.Text (Text)
12 | import qualified Data.Text as T
13 | import qualified Prettyprinter as PP
14 |
15 | newtype FunctionName = FunctionName Text
16 | deriving newtype (Eq, Ord, Show, Hashable)
17 |
18 | instance IsString FunctionName where
19 | fromString = FunctionName . T.pack
20 |
21 | instance PP.Pretty FunctionName where
22 | pretty (FunctionName fn) = PP.pretty fn
23 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Types/Module.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE NamedFieldPuns #-}
4 |
5 | module Calc.Types.Module where
6 |
7 | import Calc.Types.Function
8 | import Calc.Types.Import
9 | import qualified Prettyprinter as PP
10 |
11 | data Module ann = Module
12 | { mdFunctions :: [Function ann],
13 | mdImports :: [Import ann]
14 | }
15 | deriving stock (Eq, Ord, Show, Functor)
16 |
17 | instance PP.Pretty (Module ann) where
18 | pretty (Module {mdFunctions, mdImports}) =
19 | let parts = (PP.pretty <$> mdImports) <> (PP.pretty <$> mdFunctions)
20 | in PP.cat (PP.punctuate PP.line parts)
21 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Types/Op.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE OverloadedStrings #-}
3 |
4 | module Calc.Types.Op (Op (..)) where
5 |
6 | import qualified Prettyprinter as PP
7 |
8 | data Op
9 | = OpAdd
10 | | OpMultiply
11 | | OpSubtract
12 | | OpEquals
13 | | OpGreaterThan
14 | | OpGreaterThanOrEqualTo
15 | | OpLessThan
16 | | OpLessThanOrEqualTo
17 | deriving stock (Eq, Ord, Show)
18 |
19 | -- how to print `Op` values
20 | instance PP.Pretty Op where
21 | pretty OpAdd = "+"
22 | pretty OpMultiply = "*"
23 | pretty OpSubtract = "-"
24 | pretty OpEquals = "=="
25 | pretty OpGreaterThan = ">"
26 | pretty OpGreaterThanOrEqualTo = ">="
27 | pretty OpLessThan = "<"
28 | pretty OpLessThanOrEqualTo = "<="
29 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Types/Pattern.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveTraversable #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE OverloadedStrings #-}
4 |
5 | module Calc.Types.Pattern where
6 |
7 | import Calc.Types.Identifier
8 | import qualified Data.List.NonEmpty as NE
9 | import qualified Prettyprinter as PP
10 |
11 | data Pattern ann
12 | = PVar ann Identifier
13 | | PWildcard ann
14 | | PTuple ann (Pattern ann) (NE.NonEmpty (Pattern ann))
15 | | PBox ann (Pattern ann)
16 | deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable)
17 |
18 | instance PP.Pretty (Pattern ann) where
19 | pretty (PVar _ identifier) = PP.pretty identifier
20 | pretty (PWildcard _) = "_"
21 | pretty (PBox _ inner) = "Box(" <> PP.pretty inner <> ")"
22 | pretty (PTuple _ a as) =
23 | "(" <> PP.cat (PP.punctuate "," (PP.pretty <$> tupleItems a as)) <> ")"
24 | where
25 | tupleItems :: a -> NE.NonEmpty a -> [a]
26 | tupleItems b bs = b : NE.toList bs
27 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Types/Prim.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Prim
4 | ( Prim (..),
5 | )
6 | where
7 |
8 | import Data.Word
9 | import qualified Prettyprinter as PP
10 |
11 | data Prim
12 | = PInt32 Word32
13 | | PInt64 Word64
14 | | PFloat32 Float
15 | | PFloat64 Double
16 | | PBool Bool
17 | deriving stock (Eq, Ord, Show)
18 |
19 | instance PP.Pretty Prim where
20 | pretty (PInt32 i) = PP.pretty i
21 | pretty (PInt64 i) = PP.pretty i
22 | pretty (PFloat32 f) = PP.pretty f
23 | pretty (PFloat64 f) = PP.pretty f
24 | pretty (PBool b) = PP.pretty b
25 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Types/TypeVar.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.TypeVar (TypeVar (..), safeMkTypeVar) where
5 |
6 | import qualified Data.Char as Ch
7 | import Data.Hashable
8 | import Data.String
9 | import Data.Text (Text)
10 | import qualified Data.Text as T
11 | import qualified Prettyprinter as PP
12 |
13 | newtype TypeVar = TypeVar Text
14 | deriving newtype (Eq, Ord, Show, Hashable)
15 |
16 | instance IsString TypeVar where
17 | fromString = TypeVar . T.pack
18 |
19 | instance PP.Pretty TypeVar where
20 | pretty (TypeVar ident) = PP.pretty ident
21 |
22 | validTypeVar :: Text -> Bool
23 | validTypeVar a =
24 | T.length a > 0
25 | && T.filter Ch.isAlphaNum a == a
26 | && not (Ch.isDigit (T.head a))
27 | && Ch.isLower (T.head a)
28 |
29 | safeMkTypeVar :: Text -> Maybe TypeVar
30 | safeMkTypeVar a =
31 | if validTypeVar a
32 | then Just (TypeVar a)
33 | else Nothing
34 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Utils.hs:
--------------------------------------------------------------------------------
1 | module Calc.Utils (prettyShow, ltrace, neZipWithM, neUnzip) where
2 |
3 | -- useful junk goes here
4 |
5 | import Control.Monad (zipWithM)
6 | import Data.Bifunctor
7 | import qualified Data.List.NonEmpty as NE
8 | import qualified Data.Text.Lazy as TL
9 | import qualified Debug.Trace as Debug
10 | import qualified Text.Pretty.Simple as PS
11 |
12 | neZipWithM ::
13 | (Applicative m) =>
14 | (a -> b -> m c) ->
15 | NE.NonEmpty a ->
16 | NE.NonEmpty b ->
17 | m (NE.NonEmpty c)
18 | neZipWithM f as bs =
19 | NE.fromList <$> zipWithM f (NE.toList as) (NE.toList bs)
20 |
21 | neUnzip :: NE.NonEmpty (a, b) -> (NE.NonEmpty a, NE.NonEmpty b)
22 | neUnzip = bimap NE.fromList NE.fromList . unzip . NE.toList
23 |
24 | ltrace :: (Show a) => String -> a -> a
25 | ltrace lbl x = Debug.trace (lbl <> ": " <> TL.unpack (PS.pShow x)) x
26 |
27 | prettyShow :: (Show a) => a -> String
28 | prettyShow = TL.unpack . PS.pShow
29 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Wasm.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm (module Calc.Wasm.WriteModule) where
2 |
3 | import Calc.Wasm.WriteModule
4 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Wasm/Allocator.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE TemplateHaskell #-}
2 |
3 | module Calc.Wasm.Allocator (moduleWithAllocator) where
4 |
5 | import qualified Data.ByteString.Lazy as LB
6 | import Data.FileEmbed
7 | import qualified Language.Wasm as Wasm
8 |
9 | -- these are saved in a file that is included in compilation
10 | allocatorSource :: LB.ByteString
11 | allocatorSource =
12 | LB.fromStrict $(makeRelativeToProject "static/bump-allocator.wat" >>= embedFile)
13 |
14 | -- we have an allocator, we need to import it
15 | moduleWithAllocator :: Wasm.Module
16 | moduleWithAllocator = case Wasm.parse allocatorSource of
17 | Right mod' -> mod'
18 | Left e -> error (show e)
19 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Wasm/Run.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Wasm.Run (runWasm) where
4 |
5 | import Calc.Utils
6 | import qualified Data.Text.Lazy as TL
7 | import qualified Language.Wasm as Wasm
8 | import qualified Language.Wasm.Interpreter as Wasm
9 |
10 | runWasm :: TL.Text -> Wasm.Module -> IO (Maybe [Wasm.Value])
11 | runWasm startFunctionName wasmModule = do
12 | case Wasm.validate wasmModule of
13 | Right validModule -> do
14 | (result, store) <- Wasm.instantiate Wasm.emptyStore mempty validModule
15 | case result of
16 | Right moduleInstance ->
17 | Wasm.invokeExport store moduleInstance startFunctionName mempty
18 | Left e -> error $ "Error instantiating wasm module: " <> show e
19 | Left e ->
20 | error $
21 | "invalid module: "
22 | <> show e
23 | <> "\n\n"
24 | <> prettyShow wasmModule
25 |
--------------------------------------------------------------------------------
/wasm-calc7/src/Calc/Wasm/WriteModule.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.WriteModule (printModule, writeModule) where
2 |
3 | import qualified Data.ByteString as BS
4 | import qualified Language.Wasm.Binary as Wasm
5 | import qualified Language.Wasm.Structure as Wasm
6 |
7 | -- | in which we write some actual files somewhere for lols
8 | writeModule :: FilePath -> Wasm.Module -> IO ()
9 | writeModule path wasmMod = do
10 | let bs = Wasm.dumpModule wasmMod
11 | BS.writeFile path bs
12 |
13 | -- | in which we output to stdout
14 | printModule :: Wasm.Module -> IO ()
15 | printModule = BS.putStr . Wasm.dumpModule
16 |
--------------------------------------------------------------------------------
/wasm-calc7/test/Main.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import Test.Hspec
4 | import qualified Test.Linearity.LinearitySpec
5 | import qualified Test.Parser.ParserSpec
6 | import qualified Test.PrettyPrint.PrettyPrintSpec
7 | import qualified Test.Typecheck.TypecheckSpec
8 | import qualified Test.Wasm.WasmSpec
9 |
10 | main :: IO ()
11 | main = hspec $ do
12 | Test.Parser.ParserSpec.spec
13 | Test.PrettyPrint.PrettyPrintSpec.spec
14 | Test.Linearity.LinearitySpec.spec
15 | Test.Typecheck.TypecheckSpec.spec
16 | Test.Wasm.WasmSpec.spec
17 |
--------------------------------------------------------------------------------
/wasm-calc7/test/js/test.mjs:
--------------------------------------------------------------------------------
1 | // this file is used in tests to check imports work correctly
2 | import fs from "fs/promises";
3 |
4 | const filename = process.argv[2];
5 | const wasmBytes = await fs.readFile(filename);
6 |
7 | async function go() {
8 | const imports = {
9 | console : {log : a => console.log(a)},
10 | env : {memory : new WebAssembly.Memory({initial : 1})}
11 | };
12 |
13 | const {instance} = await WebAssembly.instantiate(wasmBytes, imports);
14 | const {test} = instance.exports;
15 |
16 | return test()
17 | }
18 |
19 | go()
20 |
--------------------------------------------------------------------------------
/wasm-calc7/test/static/bigfunction.calc:
--------------------------------------------------------------------------------
1 | function big(
2 | a: Int32,
3 | b: Int32,
4 | c: Int32,
5 | d: Int32,
6 | e: Int32,
7 | f: Int32,
8 | g: Int32,
9 | h: Int32
10 | ) {
11 | if 1 then
12 | 2
13 | else
14 | if 3 then
15 | 4
16 | else
17 | if 5 then 6 else if 7 then 8 else if 9 then 10 else 11
18 | }
--------------------------------------------------------------------------------
/wasm-calc8/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle
2 | .direnv
3 |
--------------------------------------------------------------------------------
/wasm-calc8/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Revision history for nix-basic
2 |
3 | ## 0.1.0.0 -- YYYY-mm-dd
4 |
5 | * First version. Released on an unsuspecting world.
6 |
--------------------------------------------------------------------------------
/wasm-calc8/demo/.gitignore:
--------------------------------------------------------------------------------
1 | # ignore compiler wasm files
2 | *.wasm
3 |
--------------------------------------------------------------------------------
/wasm-calc8/demo/README.md:
--------------------------------------------------------------------------------
1 | # demo
2 |
3 | This is a small demo that runs in the browser, passing a `draw` function into a
4 | WASM module.
5 |
6 | To open it in a browser, run `serve .` and navigate to
7 | `localhost:3000/draw.html`.
8 |
9 | To change the file and see results, run `watchexec -w ./**/*.calc make
10 | run-build-drawing-demo-7`. This will watch all `.calc` files and recompile on file changes.
11 |
12 | You will need to reload the browser after each change.
13 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc.hs:
--------------------------------------------------------------------------------
1 | module Calc
2 | ( module Calc.Types,
3 | module Calc.Build,
4 | module Calc.Parser,
5 | module Calc.ExprUtils,
6 | module Calc.Repl,
7 | module Calc.Wasm,
8 | module Calc.PrettyPrint,
9 | )
10 | where
11 |
12 | import Calc.Build
13 | import Calc.ExprUtils
14 | import Calc.Parser
15 | import Calc.PrettyPrint
16 | import Calc.Repl
17 | import Calc.Types
18 | import Calc.Wasm
19 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Linearity.hs:
--------------------------------------------------------------------------------
1 | module Calc.Linearity
2 | ( module Calc.Linearity.Types,
3 | module Calc.Linearity.Error,
4 | module Calc.Linearity.Validate,
5 | )
6 | where
7 |
8 | import Calc.Linearity.Error
9 | import Calc.Linearity.Types
10 | import Calc.Linearity.Validate
11 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Parser/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Types
2 | ( Parser,
3 | ParseErrorType,
4 | ParserExpr,
5 | ParserType,
6 | ParserFunction,
7 | ParserModule,
8 | ParserPattern,
9 | )
10 | where
11 |
12 | import Calc.Types.Annotation
13 | import Calc.Types.Expr
14 | import Calc.Types.Function
15 | import Calc.Types.Module
16 | import Calc.Types.Pattern
17 | import Calc.Types.Type
18 | import Data.Text (Text)
19 | import Data.Void
20 | import Text.Megaparsec
21 |
22 | type Parser = Parsec Void Text
23 |
24 | type ParseErrorType = ParseErrorBundle Text Void
25 |
26 | type ParserExpr = Expr Annotation
27 |
28 | type ParserType = Type Annotation
29 |
30 | type ParserFunction = Function Annotation
31 |
32 | type ParserModule = Module Annotation
33 |
34 | type ParserPattern = Pattern Annotation
35 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Typecheck.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck
2 | ( module Calc.Typecheck.Error,
3 | module Calc.Typecheck.Helpers,
4 | module Calc.Typecheck.Elaborate,
5 | module Calc.Typecheck.Types,
6 | module Calc.Typecheck.Infer,
7 | )
8 | where
9 |
10 | import Calc.Typecheck.Elaborate
11 | import Calc.Typecheck.Error
12 | import Calc.Typecheck.Helpers
13 | import Calc.Typecheck.Infer
14 | import Calc.Typecheck.Types
15 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Typecheck/Substitute.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Substitute (substitute) where
2 |
3 | import Calc.TypeUtils
4 | import Calc.Types.Type
5 | import qualified Data.HashMap.Strict as HM
6 | import Data.Maybe (fromMaybe)
7 | import GHC.Natural
8 |
9 | substitute ::
10 | HM.HashMap Natural (Type ann) ->
11 | Type ann ->
12 | Type ann
13 | substitute subs oldTy@(TUnificationVar _ nat) =
14 | fromMaybe oldTy (HM.lookup nat subs)
15 | substitute subs other =
16 | mapType (substitute subs) other
17 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Types
2 | ( module Calc.Types.Annotation,
3 | module Calc.Types.Op,
4 | module Calc.Types.Identifier,
5 | module Calc.Types.Import,
6 | module Calc.Types.Expr,
7 | module Calc.Types.Function,
8 | module Calc.Types.Global,
9 | module Calc.Types.Memory,
10 | module Calc.Types.Module,
11 | module Calc.Types.Pattern,
12 | module Calc.Types.Prim,
13 | module Calc.Types.Type,
14 | module Calc.Types.TypeVar,
15 | )
16 | where
17 |
18 | import Calc.Types.Annotation
19 | import Calc.Types.Expr
20 | import Calc.Types.Function
21 | import Calc.Types.Global
22 | import Calc.Types.Identifier
23 | import Calc.Types.Import
24 | import Calc.Types.Memory
25 | import Calc.Types.Module
26 | import Calc.Types.Op
27 | import Calc.Types.Pattern
28 | import Calc.Types.Prim
29 | import Calc.Types.Type
30 | import Calc.Types.TypeVar
31 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Types/Annotation.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Annotation
4 | ( Annotation (..),
5 | )
6 | where
7 |
8 | -- | `Annotation` is used to track source code location
9 | -- it is added to parts of `Expr` during parsing and used to
10 | -- make errors nicer
11 | data Annotation = Location Int Int
12 | deriving stock (Eq, Ord, Show)
13 |
14 | -- | when combining two `Annotation`, combine to make one big annotation
15 | instance Semigroup Annotation where
16 | (Location start end) <> (Location start' end') =
17 | Location (min start start') (max end end')
18 |
19 | -- | Default to an empty `Annotation`
20 | instance Monoid Annotation where
21 | mempty = Location 0 0
22 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Types/FunctionName.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.FunctionName
5 | ( FunctionName (..),
6 | )
7 | where
8 |
9 | import Data.Hashable
10 | import Data.String
11 | import Data.Text (Text)
12 | import qualified Data.Text as T
13 | import qualified Prettyprinter as PP
14 |
15 | newtype FunctionName = FunctionName Text
16 | deriving newtype (Eq, Ord, Show, Hashable)
17 |
18 | instance IsString FunctionName where
19 | fromString = FunctionName . T.pack
20 |
21 | instance PP.Pretty FunctionName where
22 | pretty (FunctionName fn) = PP.pretty fn
23 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Types/Op.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE OverloadedStrings #-}
3 |
4 | module Calc.Types.Op (Op (..)) where
5 |
6 | import qualified Prettyprinter as PP
7 |
8 | data Op
9 | = OpAdd
10 | | OpMultiply
11 | | OpSubtract
12 | | OpEquals
13 | | OpGreaterThan
14 | | OpGreaterThanOrEqualTo
15 | | OpLessThan
16 | | OpLessThanOrEqualTo
17 | deriving stock (Eq, Ord, Show)
18 |
19 | -- how to print `Op` values
20 | instance PP.Pretty Op where
21 | pretty OpAdd = "+"
22 | pretty OpMultiply = "*"
23 | pretty OpSubtract = "-"
24 | pretty OpEquals = "=="
25 | pretty OpGreaterThan = ">"
26 | pretty OpGreaterThanOrEqualTo = ">="
27 | pretty OpLessThan = "<"
28 | pretty OpLessThanOrEqualTo = "<="
29 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Types/Pattern.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveTraversable #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE OverloadedStrings #-}
4 |
5 | module Calc.Types.Pattern where
6 |
7 | import Calc.Types.Identifier
8 | import qualified Data.List.NonEmpty as NE
9 | import qualified Prettyprinter as PP
10 |
11 | data Pattern ann
12 | = PVar ann Identifier
13 | | PWildcard ann
14 | | PTuple ann (Pattern ann) (NE.NonEmpty (Pattern ann))
15 | | PBox ann (Pattern ann)
16 | deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable)
17 |
18 | instance PP.Pretty (Pattern ann) where
19 | pretty (PVar _ identifier) = PP.pretty identifier
20 | pretty (PWildcard _) = "_"
21 | pretty (PBox _ inner) = "Box(" <> PP.pretty inner <> ")"
22 | pretty (PTuple _ a as) =
23 | "(" <> PP.cat (PP.punctuate "," (PP.pretty <$> tupleItems a as)) <> ")"
24 | where
25 | tupleItems :: a -> NE.NonEmpty a -> [a]
26 | tupleItems b bs = b : NE.toList bs
27 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Types/Prim.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Prim
4 | ( Prim (..),
5 | )
6 | where
7 |
8 | import Data.Word
9 | import qualified Prettyprinter as PP
10 |
11 | data Prim
12 | = PIntLit Word64 -- a polymorphic int literal, we don't know what size
13 | | PFloatLit Double -- a polymorphic float literal, we don't know what size
14 | | PBool Bool
15 | deriving stock (Eq, Ord, Show)
16 |
17 | instance PP.Pretty Prim where
18 | pretty (PIntLit i) = PP.pretty i
19 | pretty (PFloatLit f) = PP.pretty f
20 | pretty (PBool b) = PP.pretty b
21 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Types/TypeVar.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.TypeVar (TypeVar (..), safeMkTypeVar) where
5 |
6 | import qualified Data.Char as Ch
7 | import Data.Hashable
8 | import Data.String
9 | import Data.Text (Text)
10 | import qualified Data.Text as T
11 | import qualified Prettyprinter as PP
12 |
13 | newtype TypeVar = TypeVar Text
14 | deriving newtype (Eq, Ord, Show, Hashable)
15 |
16 | instance IsString TypeVar where
17 | fromString = TypeVar . T.pack
18 |
19 | instance PP.Pretty TypeVar where
20 | pretty (TypeVar ident) = PP.pretty ident
21 |
22 | validTypeVar :: Text -> Bool
23 | validTypeVar a =
24 | T.length a > 0
25 | && T.filter Ch.isAlphaNum a == a
26 | && not (Ch.isDigit (T.head a))
27 | && Ch.isLower (T.head a)
28 |
29 | safeMkTypeVar :: Text -> Maybe TypeVar
30 | safeMkTypeVar a =
31 | if validTypeVar a
32 | then Just (TypeVar a)
33 | else Nothing
34 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Utils.hs:
--------------------------------------------------------------------------------
1 | module Calc.Utils (prettyShow, ltrace, neZipWithM, neUnzip) where
2 |
3 | -- useful junk goes here
4 |
5 | import Control.Monad (zipWithM)
6 | import Data.Bifunctor
7 | import qualified Data.List.NonEmpty as NE
8 | import qualified Data.Text.Lazy as TL
9 | import qualified Debug.Trace as Debug
10 | import qualified Text.Pretty.Simple as PS
11 |
12 | neZipWithM ::
13 | (Applicative m) =>
14 | (a -> b -> m c) ->
15 | NE.NonEmpty a ->
16 | NE.NonEmpty b ->
17 | m (NE.NonEmpty c)
18 | neZipWithM f as bs =
19 | NE.fromList <$> zipWithM f (NE.toList as) (NE.toList bs)
20 |
21 | neUnzip :: NE.NonEmpty (a, b) -> (NE.NonEmpty a, NE.NonEmpty b)
22 | neUnzip = bimap NE.fromList NE.fromList . unzip . NE.toList
23 |
24 | ltrace :: (Show a) => String -> a -> a
25 | ltrace lbl x = Debug.trace (lbl <> ": " <> TL.unpack (PS.pShow x)) x
26 |
27 | prettyShow :: (Show a) => a -> String
28 | prettyShow = TL.unpack . PS.pShow
29 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Wasm.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm (module Calc.Wasm.WriteModule) where
2 |
3 | import Calc.Wasm.WriteModule
4 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Wasm/Allocator.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE TemplateHaskell #-}
2 |
3 | module Calc.Wasm.Allocator (moduleWithAllocator) where
4 |
5 | import qualified Data.ByteString.Lazy as LB
6 | import Data.FileEmbed
7 | import qualified Language.Wasm as Wasm
8 |
9 | -- these are saved in a file that is included in compilation
10 | allocatorSource :: LB.ByteString
11 | allocatorSource =
12 | LB.fromStrict $(makeRelativeToProject "static/bump-allocator.wat" >>= embedFile)
13 |
14 | -- we have an allocator, we need to import it
15 | moduleWithAllocator :: Wasm.Module
16 | moduleWithAllocator = case Wasm.parse allocatorSource of
17 | Right mod' -> mod'
18 | Left e -> error (show e)
19 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Wasm/Run.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Wasm.Run (runWasm) where
4 |
5 | import Calc.Utils
6 | import qualified Data.Text.Lazy as TL
7 | import qualified Language.Wasm as Wasm
8 | import qualified Language.Wasm.Interpreter as Wasm
9 |
10 | runWasm :: TL.Text -> Wasm.Module -> IO (Maybe [Wasm.Value])
11 | runWasm startFunctionName wasmModule = do
12 | case Wasm.validate wasmModule of
13 | Right validModule -> do
14 | (result, store) <- Wasm.instantiate Wasm.emptyStore mempty validModule
15 | case result of
16 | Right moduleInstance ->
17 | Wasm.invokeExport store moduleInstance startFunctionName mempty
18 | Left e -> error $ "Error instantiating wasm module: " <> show e
19 | Left e ->
20 | error $
21 | "invalid module: "
22 | <> show e
23 | <> "\n\n"
24 | <> prettyShow wasmModule
25 |
--------------------------------------------------------------------------------
/wasm-calc8/src/Calc/Wasm/WriteModule.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.WriteModule (printModule, writeModule) where
2 |
3 | import qualified Data.ByteString as BS
4 | import qualified Language.Wasm.Binary as Wasm
5 | import qualified Language.Wasm.Structure as Wasm
6 |
7 | -- | in which we write some actual files somewhere for lols
8 | writeModule :: FilePath -> Wasm.Module -> IO ()
9 | writeModule path wasmMod = do
10 | let bs = Wasm.dumpModule wasmMod
11 | BS.writeFile path bs
12 |
13 | -- | in which we output to stdout
14 | printModule :: Wasm.Module -> IO ()
15 | printModule = BS.putStr . Wasm.dumpModule
16 |
--------------------------------------------------------------------------------
/wasm-calc8/test/Main.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import Test.Hspec
4 | import qualified Test.Linearity.LinearitySpec
5 | import qualified Test.Parser.ParserSpec
6 | import qualified Test.PrettyPrint.PrettyPrintSpec
7 | import qualified Test.Typecheck.TypecheckSpec
8 | import qualified Test.Wasm.WasmSpec
9 |
10 | main :: IO ()
11 | main = hspec $ do
12 | Test.Parser.ParserSpec.spec
13 | Test.PrettyPrint.PrettyPrintSpec.spec
14 | Test.Linearity.LinearitySpec.spec
15 | Test.Typecheck.TypecheckSpec.spec
16 | Test.Wasm.WasmSpec.spec
17 |
--------------------------------------------------------------------------------
/wasm-calc8/test/js/test.mjs:
--------------------------------------------------------------------------------
1 | // this file is used in tests to check imports work correctly
2 | import fs from "fs/promises";
3 |
4 | const filename = process.argv[2];
5 | const wasmBytes = await fs.readFile(filename);
6 |
7 | async function go() {
8 | const imports = {
9 | console : {log : a => console.log(a)},
10 | env : {memory : new WebAssembly.Memory({initial : 1})}
11 | };
12 |
13 | const {instance} = await WebAssembly.instantiate(wasmBytes, imports);
14 | const {test} = instance.exports;
15 |
16 | return test()
17 | }
18 |
19 | go()
20 |
--------------------------------------------------------------------------------
/wasm-calc8/test/static/bigfunction.calc:
--------------------------------------------------------------------------------
1 | function big(
2 | a: Int32,
3 | b: Int32,
4 | c: Int32,
5 | d: Int32,
6 | e: Int32,
7 | f: Int32,
8 | g: Int32,
9 | h: Int32
10 | ) -> Int32 {
11 | if 1 then
12 | 2
13 | else
14 | if 3 then
15 | 4
16 | else
17 | if 5 then 6 else if 7 then 8 else if 9 then 10 else 11
18 | }
--------------------------------------------------------------------------------
/wasm-calc9/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle
2 | .direnv
3 |
--------------------------------------------------------------------------------
/wasm-calc9/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | # Revision history for nix-basic
2 |
3 | ## 0.1.0.0 -- YYYY-mm-dd
4 |
5 | * First version. Released on an unsuspecting world.
6 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc.hs:
--------------------------------------------------------------------------------
1 | module Calc
2 | ( module Calc.Types,
3 | module Calc.Build,
4 | module Calc.Parser,
5 | module Calc.ExprUtils,
6 | module Calc.Repl,
7 | module Calc.Wasm,
8 | module Calc.PrettyPrint,
9 | )
10 | where
11 |
12 | import Calc.Build
13 | import Calc.ExprUtils
14 | import Calc.Parser
15 | import Calc.PrettyPrint
16 | import Calc.Repl
17 | import Calc.Types
18 | import Calc.Wasm
19 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Linearity.hs:
--------------------------------------------------------------------------------
1 | module Calc.Linearity
2 | ( module Calc.Linearity.Types,
3 | module Calc.Linearity.Error,
4 | module Calc.Linearity.Validate,
5 | )
6 | where
7 |
8 | import Calc.Linearity.Error
9 | import Calc.Linearity.Types
10 | import Calc.Linearity.Validate
11 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Parser/Types.hs:
--------------------------------------------------------------------------------
1 | module Calc.Parser.Types
2 | ( Parser,
3 | ParseErrorType,
4 | ParserExpr,
5 | ParserType,
6 | ParserFunction,
7 | ParserModule,
8 | ParserPattern,
9 | )
10 | where
11 |
12 | import Calc.Types.Annotation
13 | import Calc.Types.Expr
14 | import Calc.Types.Function
15 | import Calc.Types.Module
16 | import Calc.Types.Pattern
17 | import Calc.Types.Type
18 | import Data.Text (Text)
19 | import Data.Void
20 | import Text.Megaparsec
21 |
22 | type Parser = Parsec Void Text
23 |
24 | type ParseErrorType = ParseErrorBundle Text Void
25 |
26 | type ParserExpr = Expr Annotation
27 |
28 | type ParserType = Type Annotation
29 |
30 | type ParserFunction = Function Annotation
31 |
32 | type ParserModule = Module Annotation
33 |
34 | type ParserPattern = Pattern Annotation
35 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Typecheck.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck
2 | ( module Calc.Typecheck.Error,
3 | module Calc.Typecheck.Helpers,
4 | module Calc.Typecheck.Elaborate,
5 | module Calc.Typecheck.Types,
6 | module Calc.Typecheck.Infer,
7 | )
8 | where
9 |
10 | import Calc.Typecheck.Elaborate
11 | import Calc.Typecheck.Error
12 | import Calc.Typecheck.Helpers
13 | import Calc.Typecheck.Infer
14 | import Calc.Typecheck.Types
15 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Typecheck/Substitute.hs:
--------------------------------------------------------------------------------
1 | module Calc.Typecheck.Substitute (substitute) where
2 |
3 | import Calc.TypeUtils
4 | import Calc.Types.Type
5 | import qualified Data.HashMap.Strict as HM
6 | import Data.Maybe (fromMaybe)
7 | import GHC.Natural
8 |
9 | substitute ::
10 | HM.HashMap Natural (Type ann) ->
11 | Type ann ->
12 | Type ann
13 | substitute subs oldTy@(TUnificationVar _ nat) =
14 | fromMaybe oldTy (HM.lookup nat subs)
15 | substitute subs other =
16 | mapType (substitute subs) other
17 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Types/Ability.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE OverloadedStrings #-}
4 |
5 | module Calc.Types.Ability where
6 |
7 | import Calc.Types.Function
8 | import Calc.Types.Identifier
9 | import Prettyprinter ((<+>))
10 | import qualified Prettyprinter as PP
11 |
12 | -- | things that our functions might do
13 | data Ability ann
14 | = AllocateMemory ann
15 | | CallImportedFunction ann FunctionName
16 | | MutateGlobal ann Identifier
17 | deriving stock (Eq, Ord, Show, Functor)
18 |
19 | instance PP.Pretty (Ability ann) where
20 | pretty (AllocateMemory _) =
21 | "Allocating memory"
22 | pretty (CallImportedFunction _ fnName) =
23 | "Calling imported function" <+> PP.dquotes (PP.pretty fnName)
24 | pretty (MutateGlobal _ ident) =
25 | "Mutate global" <+> PP.dquotes (PP.pretty ident)
26 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Types/Annotation.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Annotation
4 | ( Annotation (..),
5 | )
6 | where
7 |
8 | -- | `Annotation` is used to track source code location
9 | -- it is added to parts of `Expr` during parsing and used to
10 | -- make errors nicer
11 | data Annotation = Location Int Int
12 | deriving stock (Eq, Ord, Show)
13 |
14 | -- | when combining two `Annotation`, combine to make one big annotation
15 | instance Semigroup Annotation where
16 | (Location start end) <> (Location start' end') =
17 | Location (min start start') (max end end')
18 |
19 | -- | Default to an empty `Annotation`
20 | instance Monoid Annotation where
21 | mempty = Location 0 0
22 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Types/FunctionName.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.FunctionName
5 | ( FunctionName (..),
6 | )
7 | where
8 |
9 | import Data.Hashable
10 | import Data.String
11 | import Data.Text (Text)
12 | import qualified Data.Text as T
13 | import qualified Prettyprinter as PP
14 |
15 | newtype FunctionName = FunctionName Text
16 | deriving newtype (Eq, Ord, Show, Hashable)
17 |
18 | instance IsString FunctionName where
19 | fromString = FunctionName . T.pack
20 |
21 | instance PP.Pretty FunctionName where
22 | pretty (FunctionName fn) = PP.pretty fn
23 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Types/ModuleAnnotations.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.ModuleAnnotations (ModuleAnnotations (..)) where
4 |
5 | import Calc.Types
6 | import qualified Data.Map.Strict as M
7 |
8 | data ModuleAnnotations ann = ModuleAnnotations
9 | { maFunctions :: M.Map FunctionName ann,
10 | maTests :: M.Map Identifier ann
11 | }
12 | deriving stock (Eq, Ord, Show)
13 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Types/Op.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE OverloadedStrings #-}
3 |
4 | module Calc.Types.Op (Op (..)) where
5 |
6 | import qualified Prettyprinter as PP
7 |
8 | data Op
9 | = OpAdd
10 | | OpMultiply
11 | | OpSubtract
12 | | OpEquals
13 | | OpGreaterThan
14 | | OpGreaterThanOrEqualTo
15 | | OpLessThan
16 | | OpLessThanOrEqualTo
17 | | OpAnd
18 | | OpOr
19 | deriving stock (Eq, Ord, Show)
20 |
21 | -- how to print `Op` values
22 | instance PP.Pretty Op where
23 | pretty OpAdd = "+"
24 | pretty OpMultiply = "*"
25 | pretty OpSubtract = "-"
26 | pretty OpEquals = "=="
27 | pretty OpGreaterThan = ">"
28 | pretty OpGreaterThanOrEqualTo = ">="
29 | pretty OpLessThan = "<"
30 | pretty OpLessThanOrEqualTo = "<="
31 | pretty OpAnd = "&&"
32 | pretty OpOr = "||"
33 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Types/Pattern.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveTraversable #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE OverloadedStrings #-}
4 |
5 | module Calc.Types.Pattern where
6 |
7 | import Calc.Types.Identifier
8 | import qualified Data.List.NonEmpty as NE
9 | import qualified Prettyprinter as PP
10 |
11 | data Pattern ann
12 | = PVar ann Identifier
13 | | PWildcard ann
14 | | PTuple ann (Pattern ann) (NE.NonEmpty (Pattern ann))
15 | | PBox ann (Pattern ann)
16 | deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable)
17 |
18 | instance PP.Pretty (Pattern ann) where
19 | pretty (PVar _ identifier) = PP.pretty identifier
20 | pretty (PWildcard _) = "_"
21 | pretty (PBox _ inner) = "Box(" <> PP.pretty inner <> ")"
22 | pretty (PTuple _ a as) =
23 | "(" <> PP.cat (PP.punctuate "," (PP.pretty <$> tupleItems a as)) <> ")"
24 | where
25 | tupleItems :: a -> NE.NonEmpty a -> [a]
26 | tupleItems b bs = b : NE.toList bs
27 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Types/Prim.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 |
3 | module Calc.Types.Prim
4 | ( Prim (..),
5 | )
6 | where
7 |
8 | import Data.Word
9 | import qualified Prettyprinter as PP
10 |
11 | data Prim
12 | = PIntLit Word64 -- a polymorphic int literal, we don't know what size
13 | | PFloatLit Double -- a polymorphic float literal, we don't know what size
14 | | PBool Bool
15 | deriving stock (Eq, Ord, Show)
16 |
17 | instance PP.Pretty Prim where
18 | pretty (PIntLit i) = PP.pretty i
19 | pretty (PFloatLit f) = PP.pretty f
20 | pretty (PBool b) = PP.pretty b
21 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Types/Test.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DeriveFunctor #-}
2 | {-# LANGUAGE DerivingStrategies #-}
3 | {-# LANGUAGE NamedFieldPuns #-}
4 | {-# LANGUAGE OverloadedStrings #-}
5 |
6 | module Calc.Types.Test where
7 |
8 | import Calc.Types.Expr
9 | import Calc.Types.Identifier
10 | import Prettyprinter ((<+>))
11 | import qualified Prettyprinter as PP
12 |
13 | data Test ann = Test
14 | { tesAnn :: ann,
15 | tesName :: Identifier,
16 | tesExpr :: Expr ann
17 | }
18 | deriving stock (Eq, Ord, Show, Functor)
19 |
20 | -- when on multilines, indent by `i`, if not then nothing
21 | indentMulti :: Integer -> PP.Doc style -> PP.Doc style
22 | indentMulti i doc =
23 | PP.flatAlt (PP.indent (fromIntegral i) doc) doc
24 |
25 | instance PP.Pretty (Test ann) where
26 | pretty (Test {tesName, tesExpr}) =
27 | "test"
28 | <+> PP.pretty tesName
29 | <+> "="
30 | <+> PP.line
31 | <> indentMulti 2 (PP.pretty tesExpr)
32 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Types/TypeVar.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE DerivingStrategies #-}
2 | {-# LANGUAGE GeneralisedNewtypeDeriving #-}
3 |
4 | module Calc.Types.TypeVar (TypeVar (..), safeMkTypeVar) where
5 |
6 | import qualified Data.Char as Ch
7 | import Data.Hashable
8 | import Data.String
9 | import Data.Text (Text)
10 | import qualified Data.Text as T
11 | import qualified Prettyprinter as PP
12 |
13 | newtype TypeVar = TypeVar Text
14 | deriving newtype (Eq, Ord, Show, Hashable)
15 |
16 | instance IsString TypeVar where
17 | fromString = TypeVar . T.pack
18 |
19 | instance PP.Pretty TypeVar where
20 | pretty (TypeVar ident) = PP.pretty ident
21 |
22 | validTypeVar :: Text -> Bool
23 | validTypeVar a =
24 | T.length a > 0
25 | && T.filter Ch.isAlphaNum a == a
26 | && not (Ch.isDigit (T.head a))
27 | && Ch.isLower (T.head a)
28 |
29 | safeMkTypeVar :: Text -> Maybe TypeVar
30 | safeMkTypeVar a =
31 | if validTypeVar a
32 | then Just (TypeVar a)
33 | else Nothing
34 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Wasm.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm (module Calc.Wasm.WriteModule) where
2 |
3 | import Calc.Wasm.WriteModule
4 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Wasm/Allocator.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE TemplateHaskell #-}
2 |
3 | module Calc.Wasm.Allocator (moduleWithAllocator) where
4 |
5 | import qualified Data.ByteString as B
6 | import Data.FileEmbed
7 | import qualified Language.Wasm as Wasm
8 |
9 | -- these are saved in a file that is included in compilation
10 | allocatorSource :: B.ByteString
11 | allocatorSource =
12 | $(makeRelativeToProject "static/malloc.wasm" >>= embedFile)
13 |
14 | -- we have an allocator, we need to import it
15 | moduleWithAllocator :: Wasm.Module
16 | moduleWithAllocator = case Wasm.decode allocatorSource of
17 | Right mod' -> mod'
18 | Left e -> error (show e)
19 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Wasm/FromExpr.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.FromExpr (module Calc.Wasm.FromExpr.Types, module Calc.Wasm.FromExpr.Module) where
2 |
3 | import Calc.Wasm.FromExpr.Module
4 | import Calc.Wasm.FromExpr.Types
5 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Wasm/Run.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module Calc.Wasm.Run (runWasm) where
4 |
5 | import Calc.Utils
6 | import qualified Data.Text.Lazy as TL
7 | import qualified Language.Wasm as Wasm
8 | import qualified Language.Wasm.Interpreter as Wasm
9 |
10 | runWasm :: TL.Text -> Wasm.Module -> IO (Maybe [Wasm.Value])
11 | runWasm startFunctionName wasmModule = do
12 | case Wasm.validate wasmModule of
13 | Right validModule -> do
14 | (result, store) <- Wasm.instantiate Wasm.emptyStore mempty validModule
15 | case result of
16 | Right moduleInstance ->
17 | Wasm.invokeExport store moduleInstance startFunctionName mempty
18 | Left e -> error $ "Error instantiating wasm module: " <> show e
19 | Left e ->
20 | error $
21 | "invalid module: "
22 | <> show e
23 | <> "\n\n"
24 | <> prettyShow wasmModule
25 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Wasm/ToWasm.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.ToWasm
2 | ( module Calc.Wasm.ToWasm.Module,
3 | module Calc.Wasm.ToWasm.Types,
4 | module Calc.Wasm.ToWasm.Helpers,
5 | )
6 | where
7 |
8 | import Calc.Wasm.ToWasm.Helpers
9 | import Calc.Wasm.ToWasm.Module
10 | import Calc.Wasm.ToWasm.Types
11 |
--------------------------------------------------------------------------------
/wasm-calc9/src/Calc/Wasm/WriteModule.hs:
--------------------------------------------------------------------------------
1 | module Calc.Wasm.WriteModule (printModule, writeModule) where
2 |
3 | import qualified Data.ByteString as BS
4 | import qualified Language.Wasm.Binary as Wasm
5 | import qualified Language.Wasm.Structure as Wasm
6 |
7 | -- | in which we write some actual files somewhere for lols
8 | writeModule :: FilePath -> Wasm.Module -> IO ()
9 | writeModule path wasmMod = do
10 | let bs = Wasm.dumpModule wasmMod
11 | BS.writeFile path bs
12 |
13 | -- | in which we output to stdout
14 | printModule :: Wasm.Module -> IO ()
15 | printModule = BS.putStr . Wasm.dumpModule
16 |
--------------------------------------------------------------------------------
/wasm-calc9/static/.gitignore:
--------------------------------------------------------------------------------
1 | # we don't want to commit this
2 | malloc-new.wasm
3 |
--------------------------------------------------------------------------------
/wasm-calc9/static/malloc.wasm:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/danieljharvey/wasm-calc/aa3b58a049d37192528afc441c01f9642fa3f731/wasm-calc9/static/malloc.wasm
--------------------------------------------------------------------------------
/wasm-calc9/test/Main.hs:
--------------------------------------------------------------------------------
1 | module Main (main) where
2 |
3 | import qualified Test.Ability.AbilitySpec
4 | import Test.Hspec
5 | import qualified Test.Linearity.LinearitySpec
6 | import qualified Test.Parser.ParserSpec
7 | import qualified Test.PrettyPrint.PrettyPrintSpec
8 | import qualified Test.Typecheck.TypecheckSpec
9 | import qualified Test.Wasm.FromWasmSpec
10 | import qualified Test.Wasm.WasmSpec
11 |
12 | main :: IO ()
13 | main = hspec $ do
14 | Test.Ability.AbilitySpec.spec
15 | Test.Parser.ParserSpec.spec
16 | Test.PrettyPrint.PrettyPrintSpec.spec
17 | Test.Linearity.LinearitySpec.spec
18 | Test.Typecheck.TypecheckSpec.spec
19 | Test.Wasm.WasmSpec.spec
20 | Test.Wasm.FromWasmSpec.spec
21 |
--------------------------------------------------------------------------------
/wasm-calc9/test/js/test.mjs:
--------------------------------------------------------------------------------
1 | // this file is used in tests to check imports work correctly
2 | import fs from "fs/promises";
3 |
4 | const filename = process.argv[2];
5 | const wasmBytes = await fs.readFile(filename);
6 |
7 | async function go() {
8 | const imports = {
9 | console : {log : a => console.log(a)},
10 | env : {memory : new WebAssembly.Memory({initial : 1})}
11 | };
12 |
13 | const {instance} = await WebAssembly.instantiate(wasmBytes, imports);
14 | const {test} = instance.exports;
15 |
16 | return test()
17 | }
18 |
19 | go()
20 |
--------------------------------------------------------------------------------
/wasm-calc9/test/static/bigfunction.calc:
--------------------------------------------------------------------------------
1 | function big(
2 | a: Int32,
3 | b: Int32,
4 | c: Int32,
5 | d: Int32,
6 | e: Int32,
7 | f: Int32,
8 | g: Int32,
9 | h: Int32
10 | ) -> Int32 {
11 | if 1 then
12 | 2
13 | else
14 | {
15 | let a: Int8 = 100;
16 | if 3 then
17 | 4
18 | else
19 | if 5 then
20 | 6
21 | else
22 | if 7 then 8 else if 9 then 10 else 11
23 | }
24 | }
--------------------------------------------------------------------------------
/wasm-calc9/test/static/noalloc.calc:
--------------------------------------------------------------------------------
1 | function [noglobalmutate noallocate noimports] add(
2 | a: Int8, b: Int8
3 | ) -> Int8 { a + b}
4 |
5 | function id(a: a) -> a { a}
6 |
7 | export function test(index: Int8) -> Int8 {
8 | let a: Box(Int8) = Box(1);
9 | let b: Box(Int8) = Box(2);
10 | let (Box(c),Box(d)) = (id(a),id(b));
11 | add(c, d)
12 | }
--------------------------------------------------------------------------------