This commit is contained in:
jingus 2026-05-02 21:42:19 -05:00
commit ab2f2c6045
8 changed files with 246 additions and 0 deletions

1
.envrc Normal file
View file

@ -0,0 +1 @@
use flake

3
.gitignore vendored Normal file
View file

@ -0,0 +1,3 @@
result
dist-newstyle
.direnv

9
README.md Normal file
View file

@ -0,0 +1,9 @@
# Brainf
Just a basic bf interpretation in Haskell for fun.
```
nix build
./result/bin/brainf hello.bf
```

19
brainf.cabal Normal file
View file

@ -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

77
flake.lock generated Normal file
View file

@ -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
}

58
flake.nix Normal file
View file

@ -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;
};
};
}

1
hello.bf Normal file
View file

@ -0,0 +1 @@
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.

78
src/Main.hs Normal file
View file

@ -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