From ab2f2c6045dbf6b085b5380d93998e62a9d9f33a Mon Sep 17 00:00:00 2001 From: jingus Date: Sat, 2 May 2026 21:42:19 -0500 Subject: [PATCH] brainf --- .envrc | 1 + .gitignore | 3 ++ README.md | 9 ++++++ brainf.cabal | 19 +++++++++++++ flake.lock | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++ flake.nix | 58 ++++++++++++++++++++++++++++++++++++++ hello.bf | 1 + src/Main.hs | 78 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 8 files changed, 246 insertions(+) create mode 100644 .envrc create mode 100644 .gitignore create mode 100644 README.md create mode 100644 brainf.cabal create mode 100644 flake.lock create mode 100644 flake.nix create mode 100644 hello.bf create mode 100644 src/Main.hs diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..3550a30 --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +use flake diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..f1ce3f6 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +result +dist-newstyle +.direnv diff --git a/README.md b/README.md new file mode 100644 index 0000000..3c1138b --- /dev/null +++ b/README.md @@ -0,0 +1,9 @@ +# Brainf + +Just a basic bf interpretation in Haskell for fun. + +``` +nix build + +./result/bin/brainf hello.bf +``` diff --git a/brainf.cabal b/brainf.cabal new file mode 100644 index 0000000..638437e --- /dev/null +++ b/brainf.cabal @@ -0,0 +1,19 @@ +cabal-version: 3.0 +name: bf +version: 0.1.0.0 +license: NONE +author: Jack +maintainer: jack@jingus.dev +build-type: Simple + +common warnings + ghc-options: -Wall + +executable brainf + import: warnings + main-is: Main.hs + build-depends: + base, + vector + hs-source-dirs: src + default-language: Haskell2010 diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..2ea9c72 --- /dev/null +++ b/flake.lock @@ -0,0 +1,77 @@ +{ + "nodes": { + "flake-parts": { + "inputs": { + "nixpkgs-lib": "nixpkgs-lib" + }, + "locked": { + "lastModified": 1775087534, + "narHash": "sha256-91qqW8lhL7TLwgQWijoGBbiD4t7/q75KTi8NxjVmSmA=", + "owner": "hercules-ci", + "repo": "flake-parts", + "rev": "3107b77cd68437b9a76194f0f7f9c55f2329ca5b", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "repo": "flake-parts", + "type": "github" + } + }, + "haskell-flake": { + "locked": { + "lastModified": 1776367004, + "narHash": "sha256-P2E65OCyIe2EjIG30vWF0HseHxZb4oujGdFhQInQ9c8=", + "owner": "srid", + "repo": "haskell-flake", + "rev": "dd6bbc834f5942f3255d9f9d7b06dbf14b84f05c", + "type": "github" + }, + "original": { + "owner": "srid", + "repo": "haskell-flake", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1776329215, + "narHash": "sha256-a8BYi3mzoJ/AcJP8UldOx8emoPRLeWqALZWu4ZvjPXw=", + "owner": "nixos", + "repo": "nixpkgs", + "rev": "b86751bc4085f48661017fa226dee99fab6c651b", + "type": "github" + }, + "original": { + "owner": "nixos", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs-lib": { + "locked": { + "lastModified": 1774748309, + "narHash": "sha256-+U7gF3qxzwD5TZuANzZPeJTZRHS29OFQgkQ2kiTJBIQ=", + "owner": "nix-community", + "repo": "nixpkgs.lib", + "rev": "333c4e0545a6da976206c74db8773a1645b5870a", + "type": "github" + }, + "original": { + "owner": "nix-community", + "repo": "nixpkgs.lib", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-parts": "flake-parts", + "haskell-flake": "haskell-flake", + "nixpkgs": "nixpkgs" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..541ec33 --- /dev/null +++ b/flake.nix @@ -0,0 +1,58 @@ +{ + inputs = { + nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable"; + flake-parts.url = "github:hercules-ci/flake-parts"; + haskell-flake.url = "github:srid/haskell-flake"; + }; + outputs = inputs@{ self, nixpkgs, flake-parts, ... }: + flake-parts.lib.mkFlake { inherit inputs; } { + systems = nixpkgs.lib.systems.flakeExposed; + imports = [ inputs.haskell-flake.flakeModule ]; + + perSystem = { self', pkgs, ... }: { + + # Typically, you just want a single project named "default". But + # multiple projects are also possible, each using different GHC version. + haskellProjects.default = { + # The base package set representing a specific GHC version. + # By default, this is pkgs.haskellPackages. + # You may also create your own. See https://haskell.nixos.asia/package-set + # basePackages = pkgs.haskellPackages; + + # Extra package information. See https://haskell.nixos.asia/dependency + # + # Note that local packages are automatically included in `packages` + # (defined by `defaults.packages` option). + # + packages = { + # aeson.source = "1.5.0.0"; # Override aeson to a custom version from Hackage + # shower.source = inputs.shower; # Override shower to a custom source path + }; + settings = { + # aeson = { + # check = false; + # }; + # relude = { + # haddock = false; + # broken = false; + # }; + }; + + devShell = { + # Enabled by default + # enable = true; + + # Programs you want to make available in the shell. + # Default programs can be disabled by setting to 'null' + # tools = hp: { fourmolu = hp.fourmolu; ghcid = null; }; + + # Check that haskell-language-server works + # hlsCheck.enable = true; # Requires sandbox to be disabled + }; + }; + + # haskell-flake doesn't set the default package, but you can do it here. + packages.default = self'.packages.brainf; + }; + }; +} diff --git a/hello.bf b/hello.bf new file mode 100644 index 0000000..8fa0f72 --- /dev/null +++ b/hello.bf @@ -0,0 +1 @@ +++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++. diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..61ce361 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,78 @@ +module Main where + +import Data.Bifunctor (Bifunctor (first)) +import Data.Char (chr, ord) +import qualified Data.Vector.Unboxed.Mutable as UM +import Data.Word (Word8) +import System.Environment (getArgs) +import System.IO (IOMode (ReadMode), hGetContents, openFile) + +data Instruction + = IncPointer + | DecPointer + | IncByte + | DecByte + | OutByte + | AccByte + | Loop [Instruction] + deriving (Show) + +parseBf' :: String -> ([Instruction], String) +parseBf' ('>' : rest) = first (IncPointer :) (parseBf' rest) +parseBf' ('<' : rest) = first (DecPointer :) (parseBf' rest) +parseBf' ('+' : rest) = first (IncByte :) (parseBf' rest) +parseBf' ('-' : rest) = first (DecByte :) (parseBf' rest) +parseBf' ('.' : rest) = first (OutByte :) (parseBf' rest) +parseBf' (',' : rest) = first (AccByte :) (parseBf' rest) +parseBf' ('[' : rest) = + let (parsed, next) = parseBf' rest + in first (Loop (parsed) :) (parseBf' next) +parseBf' (']' : rest) = ([], rest) +parseBf' (_ : rest) = parseBf' rest +parseBf' [] = ([], "") + +parseBf :: String -> [Instruction] +parseBf = fst . parseBf' + +interpret :: [Instruction] -> UM.IOVector Word8 -> Int -> IO Int +interpret [] _ pointer = return pointer +interpret (IncPointer : rest) tape pointer = interpret rest tape (pointer + 1) +interpret (DecPointer : rest) tape pointer = interpret rest tape (pointer - 1) +interpret (IncByte : rest) tape pointer = do + UM.modify tape (+ 1) pointer + interpret rest tape pointer +interpret (DecByte : rest) tape pointer = do + UM.modify tape (subtract 1) pointer + interpret rest tape pointer +interpret (OutByte : rest) tape pointer = do + UM.read tape pointer >>= putChar . chr . fromIntegral + interpret rest tape pointer +interpret (AccByte : rest) tape pointer = do + getChar >>= (return . fromIntegral . ord) >>= UM.write tape pointer + interpret rest tape pointer +interpret (Loop instructions : rest) tape pointer = do + pointer' <- looper pointer + interpret rest tape pointer' + where + looper :: Int -> IO Int + looper pointer' = do + currentByte <- UM.read tape pointer' + case currentByte of + 0 -> return pointer' + _ -> do + pointer'' <- interpret instructions tape pointer' + looper pointer'' + +run :: String -> IO () +run input = do + initialTape <- UM.replicate 30000 0 + _ <- interpret (parseBf input) initialTape 0 + return () + +main :: IO () +main = do + args <- getArgs + + let path = args !! 0 + + openFile path ReadMode >>= hGetContents >>= run