From 5da77fee409e8f4d80563c4283bfe71c8e272266 Mon Sep 17 00:00:00 2001 From: Jacques Comeaux Date: Sun, 16 Oct 2022 16:03:10 -0500 Subject: Initial commit --- .gitignore | 3 +++ README.md | 1 + Setup.hs | 2 ++ package.yaml | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ src/Circuit.hs | 41 ++++++++++++++++++++++++++++++++++ stack.yaml | 67 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ stack.yaml.lock | 13 +++++++++++ 7 files changed, 196 insertions(+) create mode 100644 .gitignore create mode 100644 README.md create mode 100644 Setup.hs create mode 100644 package.yaml create mode 100644 src/Circuit.hs create mode 100644 stack.yaml create mode 100644 stack.yaml.lock diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..d3e342b --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +*~ +circuits.cabal diff --git a/README.md b/README.md new file mode 100644 index 0000000..9934abd --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +# circuits diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..5793777 --- /dev/null +++ b/package.yaml @@ -0,0 +1,69 @@ +name: circuits +version: 0.1.0.0 +github: "githubuser/circuits" +license: BSD3 +author: "Author name here" +maintainer: "example@example.com" +copyright: "2022 Author name here" + +extra-source-files: +- README.md + +# Metadata used when publishing your package +# synopsis: Short description of your package +# category: Web + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 +- rio + +library: + source-dirs: src + +ghc-options: +- -Wall +- -Wcompat +- -Wincomplete-record-updates +- -Wredundant-constraints +- -Wmissing-local-signatures +- -Wmissing-export-lists +- -Wpartial-fields +- -Wmonomorphism-restriction +- -Widentities +- -Wno-unticked-promoted-constructors +- -fprint-expanded-synonyms + +default-extensions: +- ApplicativeDo +- BangPatterns +- ConstraintKinds +- DataKinds +- EmptyCase +- ExistentialQuantification +- FlexibleContexts +- FlexibleInstances +- GADTs +- GeneralizedNewtypeDeriving +- InstanceSigs +- KindSignatures +- LambdaCase +- MultiParamTypeClasses +- NoImplicitPrelude +- NoStarIsType +- OverloadedStrings +- PatternSynonyms +- PolyKinds +- RankNTypes +- ScopedTypeVariables +- StandaloneDeriving +- StandaloneKindSignatures +- TupleSections +- TypeApplications +- TypeFamilies +- TypeFamilyDependencies +- TypeOperators diff --git a/src/Circuit.hs b/src/Circuit.hs new file mode 100644 index 0000000..d64e8c1 --- /dev/null +++ b/src/Circuit.hs @@ -0,0 +1,41 @@ +module Circuit () where + +import RIO + +import Data.Kind + + +data Nat = Zero | Succ Nat | Plus Nat Nat + +data Env :: Nat -> Type -> Type where + Leaf :: Env Zero a + Cons :: a -> Env n a -> Env (Succ n) a + Node :: Env l a -> Env r a -> Env (Plus l r) a + +data Circuit :: Nat -> Type -> Type where + Con :: Int -> Circuit Zero t + Var :: t -> Circuit Zero t + Add :: Circuit m t -> Circuit n t -> Circuit (Plus m n) t + Let :: Circuit m t -> (t -> Circuit n t) -> Circuit (Plus m n) t + Fix :: (t -> Circuit n t) -> Circuit n t + Reg :: Circuit n t -> Circuit (Succ n) t + +eval :: (Circuit n Int, Env n Int) -> Int +eval (Con i , _) = i +eval (Var x , _) = x +eval (Add e1 e2, Node l r) = eval (e1, l) + eval (e2, r) +eval (Let e1 e2, Node l r) = eval (e2 (eval (e1, l)), r) +eval (Fix e , env) = fix (\x -> eval (e x, env)) +eval (Reg _ , Cons v _) = v + +step :: (Circuit n Int, Env n Int) -> Env n Int +step (Con i , _) = Leaf +step (Var x , _) = Leaf +step (Add e1 e2, Node l r) = Node (step (e1, l)) (step (e2, r)) +step (Let e1 e2, Node l r) = Node (step (e1, l)) (step (e2 (eval (e1, l)), r)) +step (Fix e , env) = step (fix (\e' -> e (eval (e', env))), env) +step (Reg e , Cons _ vs) = Cons (eval (e, vs)) (step (e, vs)) + +acc i = Fix (\x -> Reg (Add (Var x) (Var i))) +fib = Fix (\x -> Reg (acc x)) +pipe = Reg (Reg (Reg (Reg (Reg (Reg (Con 6)))))) diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..3dffb2e --- /dev/null +++ b/stack.yaml @@ -0,0 +1,67 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/28.yaml + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.7" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..dc9b6b0 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,13 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + size: 619405 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/28.yaml + sha256: 7f4393ad659c579944d12202cffb12d8e4b8114566b015f77bbc303a24cff934 + original: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/28.yaml -- cgit v1.2.3