diff --git a/.gitignore b/.gitignore index 683c20e..807514f 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ +dist-* *$py.class **/*.DS_Store **/*__pycache__ diff --git a/HushGP.cabal b/HushGP.cabal new file mode 100644 index 0000000..717043a --- /dev/null +++ b/HushGP.cabal @@ -0,0 +1,105 @@ +cabal-version: 3.4 +-- The cabal-version field refers to the version of the .cabal specification, +-- and can be different from the cabal-install (the tool) version and the +-- Cabal (the library) version you are using. As such, the Cabal (the library) +-- version used must be equal or greater than the version stated in this field. +-- Starting from the specification version 2.2, the cabal-version field must be +-- the first thing in the cabal file. + +-- The name of the package. +name: HushGP + +-- The package version. +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +synopsis: A PushGP implementation in Haskell. + +-- The package author(s). +author: Taylor + +-- An email address to which users can send suggestions, bug reports, and patches. +maintainer: behindthebrain@zoho.eu + +category: Data +build-type: Simple + +common warnings + ghc-options: -Wall + +library + -- Import common warning flags. + import: warnings + + -- Modules exported by the library. + exposed-modules: Push, GP + + -- Modules included in this library but not exported. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: + base ^>=4.18.2.1, containers + + -- Directories containing source files. + hs-source-dirs: src + + -- Base language which the package is written in. + default-language: GHC2021 + +executable HushGP + -- Import common warning flags. + import: warnings + + -- .hs or .lhs file containing the Main module. + main-is: Main.hs + + -- Modules included in this executable, other than Main. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: + base ^>=4.18.2.1, + HushGP + + -- Directories containing source files. + hs-source-dirs: app + + -- Base language which the package is written in. + default-language: GHC2021 + +test-suite HushGP-test + -- Import common warning flags. + import: warnings + + -- Base language which the package is written in. + default-language: GHC2021 + + -- Modules included in this executable, other than Main. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- The interface type and version of the test suite. + type: exitcode-stdio-1.0 + + -- Directories containing source files. + hs-source-dirs: test + + -- The entrypoint to the test suite. + main-is: Main.hs + + -- Test dependencies. + build-depends: + base ^>=4.18.2.1, + HushGP diff --git a/Makefile b/Makefile index 1b84f2a..bd281ee 100644 --- a/Makefile +++ b/Makefile @@ -7,26 +7,27 @@ help: # Show help for each of the commented Makefile recipes. run: target/Main.out # Runs your compiled main code. ./target/Main.out -target/Main.out: src/* - ghc -g -fprof-auto -prof -Wall src/*.hs -o target/Main.out +target/Main.out: src/* app/* + ghc -g -fprof-auto -prof -Wall app/*.hs src/*.hs -o target/Main.out @rm -f src/*.o src/*.hi -test: tests/*.hs # Runs unit tests. - runghc -i./src/ tests/Main.hs +test: # Runs unit tests. + runghc -i./src/ test/Main.hs -format: src/* # Formats code using ormolu. - ormolu --mode inplace src/*.hs tests/*.hs +format: # Formats code using ormolu. + ormolu --mode inplace app/*.hs src/*.hs test/*.hs -hlint: src/*.hs # HLint for lint suggestions. +hlint: # HLint for lint suggestions. hlint src/*.hs -stan: src/*.hs # Stan for more optimization suggestions. - ghc -fwrite-ide-info src/*.hs -o target/temp.out +stan: # Stan for more optimization suggestions. + ghc -fwrite-ide-info app/*.hs src/*.hs -o target/temp.out stan --hiedir src/ - rm -f target/temp.out src/*.hi src/*.o src/*.hie + rm -f target/temp.out src/*.hi src/*.o src/*.hie app/*.o app/*.hi app/*.hie clean: # Cleans up all the generated logfiles and outfiles. @rm -rf *.out *.o *.hi @rm -rf target/* - @rm -rf */*.out */*.o */*.hi - @rm -rf */*/*.out */*/*.o */*/*.hi + @rm -rf */*.out */*.o */*.hi */*.hie + @rm -rf */*/*.out */*/*.o */*/*.hi */*.hie + @rm -rf dist-* diff --git a/README.md b/README.md index d51000a..d9e2b3c 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ A PushGP implementation in Haskell ## Tasks -* [ ] refactor Gene to contain *Gene to Gene* for naming consistency. +* [ ] Post minimal core of exec to haskell discourse for advice about speed optimization. * [x] Do test-driven development on this one. * [x] Write tests for every function. * [x] tests/ are just copied from make-grade, need to write for this project. diff --git a/tests/.ghci b/app/.ghci similarity index 65% rename from tests/.ghci rename to app/.ghci index d5be5bc..478f0d4 100644 --- a/tests/.ghci +++ b/app/.ghci @@ -1,3 +1,3 @@ :set stop :list :set prompt "\ESC[1;34m%s \ESC[0;35mλ>\ESC[m " -:load Main ../src/Push ../src/GP +:load Main ../src/GP ../src/Push diff --git a/src/Main.hs b/app/Main.hs similarity index 100% rename from src/Main.hs rename to app/Main.hs diff --git a/src/.ghci b/src/.ghci index 44a0883..96db894 100644 --- a/src/.ghci +++ b/src/.ghci @@ -1,3 +1,2 @@ :set stop :list :set prompt "\ESC[1;34m%s \ESC[0;35mλ>\ESC[m " -:load Main diff --git a/src/Push.hs b/src/Push.hs index 5f29987..df654c1 100644 --- a/src/Push.hs +++ b/src/Push.hs @@ -4,27 +4,27 @@ module Push where import qualified Data.Map as Map -import Debug.Trace (trace, traceStack) +-- import Debug.Trace (trace, traceStack) -- The exec stack must store heterogenous types, -- and we must be able to detect that type at runtime. -- One solution is for the exec stack to be a list of [Gene]. -- The parameter stack could be singular [Gene] or multiple [atomic] types. data Gene - = IntGene Int - | FloatGene Float - | BoolGene Bool - | StringGene String + = GeneInt Int + | GeneFloat Float + | GeneBool Bool + | GeneString String | StateFunc (State -> State) | PlaceInput String | Close | Block [Gene] instance Eq Gene where - IntGene x == IntGene y = x == y - FloatGene x == FloatGene y = x == y - BoolGene x == BoolGene y = x == y - StringGene x == StringGene y = x == y + GeneInt x == GeneInt y = x == y + GeneFloat x == GeneFloat y = x == y + GeneBool x == GeneBool y = x == y + GeneString x == GeneString y = x == y PlaceInput x == PlaceInput y = x == y Close == Close = True StateFunc x == StateFunc y = True -- This line is probably not the best thing to do @@ -32,10 +32,10 @@ instance Eq Gene where _ == _ = False instance Show Gene where - show (IntGene x) = "Int: " <> show x - show (FloatGene x) = "Float: " <> show x - show (BoolGene x) = "Bool: " <> show x - show (StringGene x) = "String: " <> x + show (GeneInt x) = "Int: " <> show x + show (GeneFloat x) = "Float: " <> show x + show (GeneBool x) = "Bool: " <> show x + show (GeneString x) = "String: " <> x show (StateFunc func) = "Func: unnamed" show (PlaceInput x) = "In: " <> x show Close = "Close" @@ -140,7 +140,7 @@ instructionExecDup state = state instructionExecDoRange :: State -> State instructionExecDoRange state@(State {exec = (e1 : es), int = (i0 : i1 : is), ..}) = if increment i0 i1 /= 0 - then state {exec = e1 : Block [IntGene (i1 + increment i0 i1), IntGene i0, StateFunc instructionExecDoRange, e1] : es, int = i1 : is} + then state {exec = e1 : Block [GeneInt (i1 + increment i0 i1), GeneInt i0, StateFunc instructionExecDoRange, e1] : es, int = i1 : is} else state {exec = e1 : es, int = i1 : is} where increment :: Int -> Int -> Int @@ -154,14 +154,14 @@ instructionExecDoCount :: State -> State instructionExecDoCount state@(State {exec = (e1 : es), int = (i1 : is), ..}) = if i1 < 1 then state - else state {exec = Block [IntGene 0, IntGene $ i1 - 1, StateFunc instructionExecDoRange, e1] : es, int = is} + else state {exec = Block [GeneInt 0, GeneInt $ i1 - 1, StateFunc instructionExecDoRange, e1] : es, int = is} instructionExecDoCount state = state instructionExecDoTimes :: State -> State instructionExecDoTimes state@(State {exec = (e1 : es), int = (i1 : is), ..}) = if i1 < 1 then state - else state {exec = Block [IntGene 0, IntGene $ i1 - 1, StateFunc instructionExecDoRange, Block [StateFunc instructionIntPop, e1]] : es, int = is} + else state {exec = Block [GeneInt 0, GeneInt $ i1 - 1, StateFunc instructionExecDoRange, Block [StateFunc instructionIntPop, e1]] : es, int = is} instructionExecDoTimes state = state instructionExecWhile :: State -> State @@ -190,10 +190,10 @@ instructionExecWhen state = state -- Optionally, split this off into independent functions instructionParameterLoad :: State -> State instructionParameterLoad state@(State {parameter = (p : ps), ..}) = case p of - (IntGene val) -> state {int = val : int} - (FloatGene val) -> state {float = val : float} - (BoolGene val) -> state {bool = val : bool} - (StringGene val) -> state {string = val : string} + (GeneInt val) -> state {int = val : int} + (GeneFloat val) -> state {float = val : float} + (GeneBool val) -> state {bool = val : bool} + (GeneString val) -> state {string = val : string} instructionParameterLoad state = state -- Loads a genome into the exec stack @@ -214,10 +214,10 @@ interpretExec :: State -> State interpretExec state@(State {exec = [], ..}) = state {exec = []} interpretExec state@(State {exec = (e : es), ..}) = case e of - (IntGene val) -> interpretExec state {exec = es, int = val : int} - (FloatGene val) -> interpretExec (state {exec = es, float = val : float}) - (BoolGene val) -> interpretExec (state {exec = es, bool = val : bool}) - (StringGene val) -> interpretExec (state {exec = es, string = val : string}) + (GeneInt val) -> interpretExec state {exec = es, int = val : int} + (GeneFloat val) -> interpretExec (state {exec = es, float = val : float}) + (GeneBool val) -> interpretExec (state {exec = es, bool = val : bool}) + (GeneString val) -> interpretExec (state {exec = es, string = val : string}) (StateFunc func) -> interpretExec $ func state {exec = es} (Block block) -> interpretExec (state {exec = block ++ es}) (PlaceInput val) -> interpretExec (state {exec = (input Map.! val) : es}) diff --git a/test/.ghci b/test/.ghci new file mode 100644 index 0000000..478f0d4 --- /dev/null +++ b/test/.ghci @@ -0,0 +1,3 @@ +:set stop :list +:set prompt "\ESC[1;34m%s \ESC[0;35mλ>\ESC[m " +:load Main ../src/GP ../src/Push diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 index 0000000..d101105 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,26 @@ +import Control.Exception (assert) +import GP +import Push + +intTestFunc :: String -> [Int] -> [Gene] -> State -> IO () +intTestFunc name goal genome startState = + let state = loadProgram genome startState + in assert (goal == int (interpretExec state)) putStrLn (name ++ " passed test.") + +main :: IO () +main = do + intTestFunc "instructionIntAdd" [8] [GeneInt 6, GeneInt 2, StateFunc instructionIntAdd] emptyState + intTestFunc "instructionIntSub" [4] [GeneInt 6, GeneInt 2, StateFunc instructionIntSub] emptyState + intTestFunc "instructionIntMul" [12] [GeneInt 6, GeneInt 2, StateFunc instructionIntMul] emptyState + intTestFunc "instructionIntDiv" [3] [GeneInt 6, GeneInt 2, StateFunc instructionIntDiv] emptyState + intTestFunc "instructionExecIf" [6, 5] [GeneBool True, StateFunc instructionExecIf, Block [GeneInt 5, GeneInt 6], Block [GeneInt 7, GeneInt 8]] emptyState + intTestFunc "instructionExecDup" [8] [StateFunc instructionExecDup, GeneInt 4, StateFunc instructionIntAdd] emptyState + intTestFunc "instructionExecDoRange" [12] [GeneInt 2, Block [GeneInt 4, GeneInt 1, StateFunc instructionExecDoRange], StateFunc instructionIntAdd] emptyState + intTestFunc "instructionExecDoCount" [8] [GeneInt 2, Block [GeneInt 4, StateFunc instructionExecDoCount], StateFunc instructionIntAdd] emptyState + intTestFunc "instructionIntAdd" [69, 69, 69, 69, 2] [GeneInt 2, Block [GeneInt 4, StateFunc instructionExecDoTimes], GeneInt 69] emptyState + intTestFunc "instructionExecDoTimes" [70, 70] [GeneBool False, GeneBool True, GeneBool True, StateFunc instructionExecWhile, GeneInt 70] emptyState + intTestFunc "instructionExecWhile" [70, 70, 70] [GeneBool False, GeneBool True, GeneBool True, StateFunc instructionExecDoWhile, GeneInt 70] emptyState + intTestFunc "instructionExecDoWhile" [71] [GeneBool True, StateFunc instructionExecWhen, GeneInt 71] emptyState + + let loadedState = loadProgram [GeneBool False, StateFunc instructionExecWhen, GeneInt 71] emptyState + assert (emptyState == interpretExec loadedState) putStrLn "instructionExecWhen passed test." diff --git a/tests/Main.hs b/tests/Main.hs deleted file mode 100644 index 47e462d..0000000 --- a/tests/Main.hs +++ /dev/null @@ -1,27 +0,0 @@ -import Control.Exception (assert) -import GP -import Push - -intTestFunc :: String -> [Int] -> [Gene] -> State -> IO () -intTestFunc name goal genome startState = - let state = loadProgram genome startState - in assert (goal == int (interpretExec state)) putStrLn (name ++ " passed test.") - - -main :: IO () -main = do - intTestFunc "instructionIntAdd" [8] [IntGene 6, IntGene 2, StateFunc instructionIntAdd] emptyState - intTestFunc "instructionIntSub" [4] [IntGene 6, IntGene 2, StateFunc instructionIntSub] emptyState - intTestFunc "instructionIntMul" [12] [IntGene 6, IntGene 2, StateFunc instructionIntMul] emptyState - intTestFunc "instructionIntDiv" [3] [IntGene 6, IntGene 2, StateFunc instructionIntDiv] emptyState - intTestFunc "instructionExecIf" [6, 5] [BoolGene True, StateFunc instructionExecIf, Block [IntGene 5, IntGene 6], Block [IntGene 7, IntGene 8]] emptyState - intTestFunc "instructionExecDup" [8] [StateFunc instructionExecDup, IntGene 4, StateFunc instructionIntAdd] emptyState - intTestFunc "instructionExecDoRange" [12] [IntGene 2, Block [IntGene 4, IntGene 1, StateFunc instructionExecDoRange], StateFunc instructionIntAdd] emptyState - intTestFunc "instructionExecDoCount" [8] [IntGene 2, Block [IntGene 4, StateFunc instructionExecDoCount], StateFunc instructionIntAdd] emptyState - intTestFunc "instructionIntAdd" [69, 69, 69, 69, 2] [IntGene 2, Block [IntGene 4, StateFunc instructionExecDoTimes], IntGene 69] emptyState - intTestFunc "instructionExecDoTimes" [70, 70] [BoolGene False, BoolGene True, BoolGene True, StateFunc instructionExecWhile, IntGene 70] emptyState - intTestFunc "instructionExecWhile" [70, 70, 70] [BoolGene False, BoolGene True, BoolGene True, StateFunc instructionExecDoWhile, IntGene 70] emptyState - intTestFunc "instructionExecDoWhile" [71] [BoolGene True, StateFunc instructionExecWhen, IntGene 71] emptyState - - let loadedState = loadProgram [BoolGene False, StateFunc instructionExecWhen, IntGene 71] emptyState - assert (emptyState == interpretExec loadedState) putStrLn "instructionExecWhen passed test."