├── .gitignore ├── Chemlambda ├── Chemistry ├── Core ├── Experimental ├── Language └── SampleData ├── README.md ├── chemlambda-chemistry ├── ChangeLog.md ├── Chemlambda │ └── Chemistry │ │ ├── Enzymes.hs │ │ ├── Moves.hs │ │ ├── Patterns.hs │ │ ├── Reaction.hs │ │ └── Rewrite │ │ ├── Deterministic.hs │ │ ├── Random.hs │ │ └── Util.hs ├── LICENSE ├── Setup.hs ├── bench │ ├── Main.hs │ └── ReactionSitesBench.hs ├── chemlambda-chemistry.cabal └── test │ ├── Main.hs │ └── RewritesTests.hs ├── chemlambda-core ├── ChangeLog.md ├── Chemlambda │ └── Core │ │ ├── AdjList.hs │ │ ├── Atom.hs │ │ ├── Node.hs │ │ ├── Pattern.hs │ │ └── Port.hs ├── LICENSE ├── Setup.hs └── chemlambda-core.cabal ├── chemlambda-experimental ├── ChangeLog.md ├── Chemlambda │ └── Experimental │ │ └── ComonadicGraphs │ │ ├── Graph.hs │ │ └── Reaction.hs ├── LICENSE ├── Setup.hs └── chemlambda-experimental.cabal ├── chemlambda-language ├── ChangeLog.md ├── Chemlambda │ └── Language │ │ ├── Chemeral │ │ └── Definition.hs │ │ └── MolParser │ │ ├── IO │ │ └── Main.hs │ │ └── Parser.hs ├── LICENSE ├── Setup.hs └── chemlambda-language.cabal ├── chemlambda-sampledata ├── ChangeLog.md ├── Chemlambda │ └── SampleData │ │ └── Graphs.hs ├── LICENSE ├── Setup.hs └── chemlambda-sampledata.cabal ├── molfiles ├── 4up4.mol ├── ackerman_2_2.mol ├── skk.mol └── y.mol └── stack.yaml /.gitignore: -------------------------------------------------------------------------------- 1 | .cabal-sandbox 2 | dist 3 | dist-* 4 | cabal-dev 5 | *.o 6 | *.hi 7 | *.chi 8 | *.chs.h 9 | *.dyn_o 10 | *.dyn_hi 11 | .hpc 12 | .hsenv 13 | .cabal-sandbox/ 14 | cabal.sandbox.config 15 | *.prof 16 | *.aux 17 | *.hp 18 | *.eventlog 19 | .stack-work/ 20 | cabal.project.local 21 | 22 | ^Chemlambda 23 | helpers 24 | -------------------------------------------------------------------------------- /Chemlambda/Chemistry: -------------------------------------------------------------------------------- 1 | ../chemlambda-chemistry/Chemlambda/Chemistry -------------------------------------------------------------------------------- /Chemlambda/Core: -------------------------------------------------------------------------------- 1 | ../chemlambda-core/Chemlambda/Core -------------------------------------------------------------------------------- /Chemlambda/Experimental: -------------------------------------------------------------------------------- 1 | ../chemlambda-experimental/Chemlambda/Experimental -------------------------------------------------------------------------------- /Chemlambda/Language: -------------------------------------------------------------------------------- 1 | ../chemlambda-language/Chemlambda/Language -------------------------------------------------------------------------------- /Chemlambda/SampleData: -------------------------------------------------------------------------------- 1 | ../chemlambda-sampledata/Chemlambda/SampleData -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # chemlambda-hask 2 | 3 | ## Description 4 | chemlambda-hask is an implementation of the 5 | [Chemlambda](https://chorasimilarity.github.io/chemlambda-gui/index.html) 6 | graph rewriting system based on lambda calculus. Check out that link above to 7 | learn about Chemlambda itself. 8 | 9 | The original creator's, Marius Buliga, repository can be found 10 | [here](https://github.com/chorasimilarity/chemlambda-gui). 11 | 12 | chemlambda-hask is a set of tools for working with the Chemlambda system along 13 | with an implemetation of it. It is comprised of a core library upon which a 14 | graph rewrite system can be built, a chemistry implementing a small subset of 15 | what is possible with the core library, following the standard Chemlambda rules 16 | of graph rewrites, and a set of "language" modules for parsing .mol files (the 17 | barebones syntax for Chemlambda molecules). The project is still under constant 18 | development, so changes are to be expected along with new additions to what 19 | Chemlambda is and how it is implemented. 20 | 21 | ## The modules 22 | ### chemlambda-core 23 | This is the core library/API for building rewrite systems. Using this module 24 | along with chemlambda-chemistry, full graph rewriting systems, based on and 25 | possibly deviating from the Chemlambda standard chemistry are possible. This is 26 | to say that Core is a foundational, abstract library that can be used to construct 27 | a multitude of rewrite systems, not just the standard Chemlambda one. 28 | 29 | The only thing hindering Core's ability to be completely abstract is the module 30 | Chemlambda.Core.Node which specifies the vertices of graphs to be tethered to 31 | the Chemlambda standard rather than being completely abstract and 32 | user-definable. Core.Node may in the future be generalized beyond the vertices 33 | (atoms) of Chemlambda to avoid this tethering. 34 | 35 | ### chemlambda-chemistry 36 | Because the chemlambda-hask project is mostly specific to Chemlambda, and not 37 | rewrite systems in general, chemlambda-chemistry connects the abstract world 38 | defined in chemlambda-core to a concrete implementation of a graph rewriting 39 | system. In this module, the rewrite rules -- the chemistry -- of Chemlambda are 40 | defined by specifying the patterns of vertices to look for in a graph (called 41 | left patterns), the vertices with which to replace left patterns 42 | (called right patterns), and the enzymes that find left patterns in a graph and 43 | replace them with right patterns. There are other files in this module, but this 44 | is the conceputal bulk of it. 45 | 46 | ### chemlambda-langauge 47 | This component defines a parser for mol files and one for an enhanced mol syntax 48 | that is currently a work in progress. In Chemlambda, molecules are encoded in text 49 | files. Each line in a mol file represents an elementary molecule (a node) and its 50 | incoming and outgoing connections to other nodes in a molecule. Here's an example: 51 | 52 | L 1 1 2 53 | L 3 3 4 54 | A 2 4 5 55 | 56 | You can learn more about the molecule encoding using the links above. 57 | 58 | The MolParser interprets mol files, reading them into the chemlambda-hask evaluator 59 | so that they can be computed. 60 | 61 | There is some interest in developing an enhanced mol syntax that enables one to 62 | abstract over repetitive, or otherwise meaningful, parts of a molecule. Perhaps you 63 | have a section in a molecule that needs to be used in various places. This syntax 64 | would allow you to create molecule abstractions that can be parameterized to "hotswap" 65 | into multiple locations. Basically implementing molecule constructors. 66 | 67 | 68 | ## TODO 69 | ### Immediate 70 | - Get some decent tests! 71 | - After testing, work on the mol parser 72 | 73 | ### Soon 74 | - Generalize the rewrite system by making a Rewritable class that Actors and 75 | Graphs and maybe Graphs of Actors are instances 76 | 77 | ### Long Run 78 | - Make chemlambda-hask-repl executable subproject 79 | - Figure out what other subprojects would be helpful 80 | -------------------------------------------------------------------------------- /chemlambda-chemistry/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for chemlambda-chemistry 2 | 3 | ## 0.1.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /chemlambda-chemistry/Chemlambda/Chemistry/Enzymes.hs: -------------------------------------------------------------------------------- 1 | module Chemlambda.Chemistry.Enzymes 2 | ( enzymeList 3 | , deterministicEnzymeList 4 | , betaEnzyme 5 | , combEnzyme 6 | , fanInEnzyme 7 | , distLEnzyme 8 | , distAEnzyme 9 | , distFIEnzyme 10 | , distFOEnzyme 11 | , pruneAEnzyme 12 | , pruneFIEnzyme 13 | , pruneLEnzyme 14 | , pruneFObEnzyme 15 | , pruneFOEbEnzyme 16 | , pruneFOcEnzyme 17 | , pruneFOEcEnzyme 18 | ) 19 | where 20 | 21 | import Chemlambda.Chemistry.Reaction 22 | import Chemlambda.Chemistry.Patterns 23 | import Chemlambda.Chemistry.Moves 24 | 25 | 26 | enzymeList :: Eq a => [Enzyme a] 27 | enzymeList = 28 | [ distFOEnzyme 29 | , distAEnzyme 30 | , distLEnzyme 31 | , distFIEnzyme 32 | , betaEnzyme 33 | , fanInEnzyme 34 | , pruneAEnzyme 35 | , pruneLEnzyme 36 | , pruneFIEnzyme 37 | , pruneFObEnzyme 38 | , pruneFOEbEnzyme 39 | , pruneFOcEnzyme 40 | , pruneFOEcEnzyme 41 | ] 42 | 43 | deterministicEnzymeList :: Eq a => [[Enzyme a]] 44 | deterministicEnzymeList = 45 | [ [ distFOEnzyme ] 46 | , [ distAEnzyme, distLEnzyme, distFIEnzyme ] 47 | , [ betaEnzyme, fanInEnzyme ] 48 | , [ pruneAEnzyme, pruneLEnzyme, pruneFIEnzyme ] 49 | , [ pruneFObEnzyme, pruneFOEbEnzyme ] 50 | , [ pruneFOcEnzyme, pruneFOEcEnzyme ] 51 | ] 52 | 53 | 54 | betaEnzyme :: Eq a => Enzyme a 55 | betaEnzyme = Enzyme betaPattern betaMove 56 | 57 | fanInEnzyme :: Eq a => Enzyme a 58 | fanInEnzyme = Enzyme fanInPattern fanInMove 59 | 60 | distAEnzyme :: Eq a => Enzyme a 61 | distAEnzyme = Enzyme distAPattern distAMove 62 | 63 | distLEnzyme :: Eq a => Enzyme a 64 | distLEnzyme = Enzyme distLPattern distLMove 65 | 66 | distFOEnzyme :: Eq a => Enzyme a 67 | distFOEnzyme = Enzyme distFOPattern distFOMove 68 | 69 | distFIEnzyme :: Eq a => Enzyme a 70 | distFIEnzyme = Enzyme distFIPattern distFIMove 71 | 72 | pruneAEnzyme :: Eq a => Enzyme a 73 | pruneAEnzyme = Enzyme pruneAPattern pruneAMove 74 | 75 | pruneFIEnzyme :: Eq a => Enzyme a 76 | pruneFIEnzyme = Enzyme pruneFIPattern pruneFIMove 77 | 78 | pruneLEnzyme :: Eq a => Enzyme a 79 | pruneLEnzyme = Enzyme pruneLPattern pruneLMove 80 | 81 | pruneFObEnzyme :: Eq a => Enzyme a 82 | pruneFObEnzyme = Enzyme pruneFObPattern pruneFObMove 83 | 84 | pruneFOcEnzyme :: Eq a => Enzyme a 85 | pruneFOcEnzyme = Enzyme pruneFOcPattern pruneFOcMove 86 | 87 | pruneFOEbEnzyme :: Eq a => Enzyme a 88 | pruneFOEbEnzyme = Enzyme pruneFOEbPattern pruneFOEbMove 89 | 90 | pruneFOEcEnzyme :: Eq a => Enzyme a 91 | pruneFOEcEnzyme = Enzyme pruneFOEcPattern pruneFOEcMove 92 | 93 | combEnzyme :: Eq a => Enzyme a 94 | combEnzyme = Enzyme combPattern combMove 95 | -------------------------------------------------------------------------------- /chemlambda-chemistry/Chemlambda/Chemistry/Moves.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MultiWayIf #-} 2 | {-# LANGUAGE ViewPatterns #-} 3 | 4 | module Chemlambda.Chemistry.Moves 5 | ( betaMove 6 | , combMove 7 | , fanInMove 8 | , distLMove 9 | , distAMove 10 | , distFIMove 11 | , distFOMove 12 | , pruneAMove 13 | , pruneFIMove 14 | , pruneLMove 15 | , pruneFObMove 16 | , pruneFOEbMove 17 | , pruneFOcMove 18 | , pruneFOEcMove 19 | ) 20 | where 21 | 22 | import Chemlambda.Core.Port 23 | import Chemlambda.Core.Atom 24 | import Chemlambda.Core.Node 25 | import Chemlambda.Core.Graph 26 | 27 | 28 | -- Might need to split 29 | combMove :: (Eq a) => Graph a -> Graph (NewId a) 30 | combMove (nodes -> [nodeN, Node ARROW [d,e]]) = 31 | case nodeN of 32 | (Node L [a,b,c]) -> 33 | let 34 | a' = mkActualId a 35 | b' = mkActualId b 36 | c' = mkActualId c 37 | e' = mkActualId e 38 | in 39 | if | b `connects` d -> mkGraph [lam a' e' c'] 40 | | c `connects` d -> mkGraph [lam a' b' e'] 41 | 42 | (Node FO [a,b,c]) -> 43 | let 44 | a' = mkActualId a 45 | b' = mkActualId b 46 | c' = mkActualId c 47 | e' = mkActualId e 48 | in 49 | if | b `connects` d -> mkGraph [fo a' e' c'] 50 | | c `connects` d -> mkGraph [fo a' b' e'] 51 | 52 | (Node FOE [a,b,c]) -> 53 | let 54 | a' = mkActualId a 55 | b' = mkActualId b 56 | c' = mkActualId c 57 | e' = mkActualId e 58 | in 59 | if | b `connects` d -> mkGraph [foe a' e' c'] 60 | | c `connects` d -> mkGraph [foe a' b' e'] 61 | 62 | (Node A [a,b,_]) -> 63 | let 64 | a' = mkActualId a 65 | b' = mkActualId b 66 | e' = mkActualId e 67 | in 68 | mkGraph [app a' b' e'] 69 | 70 | (Node FI [a,b,_]) -> 71 | let 72 | a' = mkActualId a 73 | b' = mkActualId b 74 | e' = mkActualId e 75 | in 76 | mkGraph [fi a' b' e'] 77 | 78 | (Node ARROW [a,_]) -> 79 | let 80 | a' = mkActualId a 81 | e' = mkActualId e 82 | in 83 | mkGraph [arrow a' e'] 84 | 85 | (Node FRIN [_]) -> 86 | let 87 | e' = mkActualId e 88 | in 89 | mkGraph [frin e'] 90 | 91 | betaMove :: Graph a -> Graph (NewId a) 92 | betaMove (nodes -> [Node L [a,b,c], Node A [d,e,f]]) = 93 | let 94 | a' = mkActualId a 95 | b' = mkActualId b 96 | e' = mkActualId e 97 | f' = mkActualId f 98 | in 99 | mkGraph [arrow a' f', arrow e' b'] 100 | 101 | fanInMove :: Graph a -> Graph (NewId a) 102 | fanInMove (nodes -> [Node FI [a,b,c], Node FOE [d,e,f]]) = 103 | let 104 | a' = mkActualId a 105 | b' = mkActualId b 106 | e' = mkActualId e 107 | f' = mkActualId f 108 | in 109 | mkGraph [arrow a' f', arrow b' e'] 110 | 111 | distLMove :: Graph a -> Graph (NewId a) 112 | distLMove (nodes -> [Node L [a,b,c], outNode]) = 113 | case elem (atom outNode) [FO,FOE] of 114 | True -> let 115 | Node _ [d,e,f] = outNode 116 | a' = mkActualId a 117 | b' = mkActualId b 118 | e' = mkActualId e 119 | f' = mkActualId f 120 | i = NewId 0 121 | j = NewId 1 122 | k = NewId 2 123 | l = NewId 3 124 | in 125 | mkGraph [fi j i b', lam k i e', lam l j f', foe a' k l] 126 | 127 | distAMove :: Graph a -> Graph (NewId a) 128 | distAMove (nodes -> [Node A [a,b,c], outNode]) = 129 | case elem (atom outNode) [FO,FOE] of 130 | True -> let 131 | Node _ [d,e,f] = outNode 132 | a' = mkActualId a 133 | b' = mkActualId b 134 | e' = mkActualId e 135 | f' = mkActualId f 136 | i = NewId 0 137 | j = NewId 1 138 | k = NewId 2 139 | l = NewId 3 140 | in 141 | mkGraph [foe a' i j, foe b' k l, app i k e', app j l f'] 142 | 143 | distFIMove :: Graph a -> Graph (NewId a) 144 | distFIMove (nodes -> [Node FI [a,b,c], Node FO [d,e,f]]) = 145 | let 146 | a' = mkActualId a 147 | b' = mkActualId b 148 | e' = mkActualId e 149 | f' = mkActualId f 150 | i = NewId 0 151 | j = NewId 1 152 | k = NewId 2 153 | l = NewId 3 154 | in 155 | mkGraph [fo a' i j, fo b' k l, fi i k e', fi j l f'] 156 | 157 | distFOMove :: Graph a -> Graph (NewId a) 158 | distFOMove (nodes -> [Node FO [a,b,c], Node FOE [d,e,f]]) = 159 | let 160 | a' = mkActualId a 161 | b' = mkActualId b 162 | e' = mkActualId e 163 | f' = mkActualId f 164 | i = NewId 0 165 | j = NewId 1 166 | k = NewId 2 167 | l = NewId 3 168 | in 169 | mkGraph [fi j i b', fo k i e', fo l j f', foe a' k l] 170 | 171 | pruneAMove :: Graph a -> Graph (NewId a) 172 | pruneAMove (nodes -> [Node A [a,b,c], Node T [d]]) = 173 | let 174 | a' = mkActualId a 175 | b' = mkActualId b 176 | in mkGraph [t a', t b'] 177 | 178 | pruneFIMove :: Graph a -> Graph (NewId a) 179 | pruneFIMove (nodes -> [Node FI [a,b,c], Node T [d]]) = 180 | let 181 | a' = mkActualId a 182 | b' = mkActualId b 183 | in mkGraph [t a', t b'] 184 | 185 | pruneLMove :: Graph a -> Graph (NewId a) 186 | pruneLMove (nodes -> [Node L [a,b,c], Node T [d]]) = 187 | let 188 | a' = mkActualId a 189 | b' = mkActualId b 190 | in mkGraph [t a', frin b'] 191 | 192 | pruneFObMove :: Graph a -> Graph (NewId a) 193 | pruneFObMove (nodes -> [Node FO [a,b,c], Node T [d]]) = 194 | let 195 | a' = mkActualId a 196 | c' = mkActualId c 197 | in 198 | mkGraph [arrow a' c'] 199 | 200 | pruneFOEbMove :: Graph a -> Graph (NewId a) 201 | pruneFOEbMove (nodes -> [Node FOE [a,b,c], Node T [d]]) = 202 | let 203 | a' = mkActualId a 204 | c' = mkActualId c 205 | in 206 | mkGraph [arrow a' c'] 207 | 208 | pruneFOcMove :: Graph a -> Graph (NewId a) 209 | pruneFOcMove (nodes -> [Node FO [a,b,c], Node T [d]]) = 210 | let 211 | a' = mkActualId a 212 | b' = mkActualId b 213 | in 214 | mkGraph [arrow a' b'] 215 | 216 | pruneFOEcMove :: Graph a -> Graph (NewId a) 217 | pruneFOEcMove (nodes -> [Node FOE [a,b,c], Node T [d]]) = 218 | let 219 | a' = mkActualId a 220 | b' = mkActualId b 221 | in 222 | mkGraph [arrow a' b'] 223 | -------------------------------------------------------------------------------- /chemlambda-chemistry/Chemlambda/Chemistry/Patterns.hs: -------------------------------------------------------------------------------- 1 | module Chemlambda.Chemistry.Patterns 2 | ( betaPattern 3 | , combPattern 4 | , fanInPattern 5 | , distLPattern 6 | , distAPattern 7 | , distFIPattern 8 | , distFOPattern 9 | , pruneAPattern 10 | , pruneFIPattern 11 | , pruneLPattern 12 | , pruneFObPattern 13 | , pruneFOEbPattern 14 | , pruneFOcPattern 15 | , pruneFOEcPattern 16 | ) 17 | where 18 | 19 | import Control.Applicative 20 | import Chemlambda.Core.Port 21 | import Chemlambda.Core.Atom 22 | import Chemlambda.Core.Node 23 | import Chemlambda.Core.Graph 24 | import Chemlambda.Core.Pattern 25 | 26 | betaPattern :: Eq a => Pattern a (Graph a) 27 | betaPattern = conn (atomOf L) (atomOf A) [roPort] [liPort] 28 | 29 | combPattern :: Eq a => Pattern a (Graph a) 30 | combPattern = conn anyNode (atomOf ARROW) [loPort,roPort,moPort] [miPort] 31 | 32 | fanInPattern :: Eq a => Pattern a (Graph a) 33 | fanInPattern = conn (atomOf FI) (atomOf FOE) [moPort] [miPort] 34 | 35 | distLPattern :: Eq a => Pattern a (Graph a) 36 | distLPattern = conn (atomOf L) (atomOf FO <|> atomOf FOE) [roPort] [miPort] 37 | 38 | distAPattern :: Eq a => Pattern a (Graph a) 39 | distAPattern = conn (atomOf A) (atomOf FO <|> atomOf FOE) [moPort] [miPort] 40 | 41 | distFIPattern :: Eq a => Pattern a (Graph a) 42 | distFIPattern = conn (atomOf FI) (atomOf FO) [moPort] [miPort] 43 | 44 | distFOPattern :: Eq a => Pattern a (Graph a) 45 | distFOPattern = conn (atomOf FO) (atomOf FOE) [roPort] [miPort] 46 | 47 | pruneAPattern :: Eq a => Pattern a (Graph a) 48 | pruneAPattern = conn (atomOf A) (atomOf T) [moPort] [miPort] 49 | 50 | pruneFIPattern :: Eq a => Pattern a (Graph a) 51 | pruneFIPattern = conn (atomOf FI) (atomOf T) [moPort] [miPort] 52 | 53 | pruneLPattern :: Eq a => Pattern a (Graph a) 54 | pruneLPattern = conn (atomOf L) (atomOf T) [roPort] [miPort] 55 | 56 | pruneFObPattern :: Eq a => Pattern a (Graph a) 57 | pruneFObPattern = conn (atomOf FO) (atomOf T) [loPort] [miPort] 58 | 59 | pruneFOEbPattern :: Eq a => Pattern a (Graph a) 60 | pruneFOEbPattern = conn (atomOf FOE) (atomOf T) [loPort] [miPort] 61 | 62 | pruneFOcPattern :: Eq a => Pattern a (Graph a) 63 | pruneFOcPattern = conn (atomOf FO) (atomOf T) [roPort] [miPort] 64 | 65 | pruneFOEcPattern :: Eq a => Pattern a (Graph a) 66 | pruneFOEcPattern = conn (atomOf FOE) (atomOf T) [roPort] [miPort] 67 | 68 | -------------------------------------------------------------------------------- /chemlambda-chemistry/Chemlambda/Chemistry/Reaction.hs: -------------------------------------------------------------------------------- 1 | module Chemlambda.Chemistry.Reaction 2 | ( Enzyme(..) 3 | , ReactionSite(..) 4 | , sitesOverlap 5 | , runReaction 6 | , reactionSites 7 | , reactInGraph 8 | , randomReactionSites 9 | , deterministicReactionSites 10 | ) 11 | where 12 | 13 | -- Test performance differences with reacting automatically (lazily so not really) versus 14 | -- going through the intermediate step of ReactionSite 15 | import Data.List 16 | import Data.List.Extra 17 | import System.Random 18 | import Chemlambda.Core.Port 19 | import Chemlambda.Core.Node 20 | import Chemlambda.Core.Graph 21 | import Chemlambda.Core.Pattern 22 | 23 | 24 | data Enzyme a = Enzyme 25 | { pattern :: Pattern a (Graph a) 26 | , move :: Graph a -> Graph (NewId a) } 27 | 28 | data ReactionSite a = ReactionSite 29 | { site :: Graph a 30 | , reaction :: Graph a -> Graph (NewId a) } 31 | 32 | runReaction :: ReactionSite a -> Graph (NewId a) 33 | runReaction rsite = reaction rsite $ site rsite 34 | 35 | reactionSites :: Enzyme a -> Graph a -> [ReactionSite a] 36 | reactionSites enzyme graph = 37 | let matches = match (pattern enzyme) graph 38 | in map (\graph -> ReactionSite graph (move enzyme)) matches 39 | 40 | sitesOverlap :: Eq a => ReactionSite a -> ReactionSite a -> Bool 41 | sitesOverlap rsiteA rsiteB = 42 | let 43 | siteA = site rsiteA 44 | siteB = site rsiteB 45 | sharedGraph = intersect <$> siteA <*> siteB 46 | in 47 | (not . null . nodes) sharedGraph 48 | 49 | reactInGraph 50 | :: (Enum a, Ord a) 51 | => ReactionSite a 52 | -> Graph a 53 | -> Graph a 54 | reactInGraph rsite graph = 55 | let 56 | withAdded = graph `plusNew` runReaction rsite 57 | withRemoved = withAdded `minus` site rsite 58 | in withRemoved 59 | 60 | randomReactionSites :: Eq a => Graph a -> [Enzyme a] -> IO [ReactionSite a] 61 | randomReactionSites graph enzymes = 62 | let 63 | rsites = concatMap (\enzyme -> reactionSites enzyme graph) enzymes 64 | randomChoiceSites = 65 | do 66 | boolGen <- newStdGen 67 | numGen <- newStdGen 68 | let 69 | shuffleSites = sortBy $ \(_,_,a) (_,_,b) -> compare a b 70 | 71 | pairs = shuffleSites $ zip3 rsites (randoms boolGen :: [Bool]) (randoms numGen :: [Int]) 72 | picked = 73 | foldr 74 | (\(rsite, picked, _) rsitesAcc -> 75 | if picked 76 | then rsite:rsitesAcc 77 | else rsitesAcc) 78 | [] 79 | pairs 80 | -- return $ nubBy (\rsA rsB -> sitesOverlap rsA rsB) picked 81 | return $ nubOrdBy (\rsA rsB -> if sitesOverlap rsA rsB then EQ else LT) picked 82 | in 83 | randomChoiceSites 84 | 85 | 86 | 87 | deterministicReactionSites :: Eq a => Graph a -> [Enzyme a] -> [ReactionSite a] 88 | deterministicReactionSites graph enzymes = 89 | let 90 | rsites = concatMap (\enzyme -> reactionSites enzyme graph) enzymes 91 | picked = drop (length rsites `div` 2) rsites 92 | in 93 | nubOrdBy (\rsA rsB -> if sitesOverlap rsA rsB then EQ else LT) picked 94 | -- nubBy (\rsA rsB -> sitesOverlap rsA rsB) picked 95 | 96 | -- deterministicReactionSites graph lolEnzymes = snd $ foldl' 97 | -- -- (list of lists of enzymes) 98 | -- (\(graph, rsites) enzymes -> 99 | -- let 100 | -- rsites' = concatMap (\enzyme -> reactionSites enzyme graph) enzymes 101 | -- sites = map site rsites' 102 | -- graph' = foldl' minus graph sites 103 | -- in (graph', rsites' ++ rsites)) 104 | -- (graph, []) 105 | -- lolEnzymes 106 | 107 | -------------------------------------------------------------------------------- /chemlambda-chemistry/Chemlambda/Chemistry/Rewrite/Deterministic.hs: -------------------------------------------------------------------------------- 1 | module Chemlambda.Chemistry.Rewrite.Deterministic 2 | ( detRewrite ) 3 | where 4 | 5 | import Data.List 6 | import Chemlambda.Core.Port 7 | import Chemlambda.Core.Node 8 | import Chemlambda.Core.Graph 9 | import Chemlambda.Core.Pattern 10 | import Chemlambda.Chemistry.Reaction 11 | import Chemlambda.Chemistry.Enzymes 12 | import Chemlambda.Chemistry.Rewrite.Util 13 | 14 | detRewrite :: (Ord a, Enum a) => Graph a -> Graph a 15 | detRewrite graph = 16 | let 17 | result = 18 | foldl 19 | (\graph rsite -> 20 | reactInGraph rsite graph) 21 | graph 22 | (deterministicReactionSites graph enzymeList) 23 | in runCombCycle result 24 | -------------------------------------------------------------------------------- /chemlambda-chemistry/Chemlambda/Chemistry/Rewrite/Random.hs: -------------------------------------------------------------------------------- 1 | module Chemlambda.Chemistry.Rewrite.Random 2 | ( randRewrite ) 3 | where 4 | 5 | import Chemlambda.Core.Port 6 | import Chemlambda.Core.Node 7 | import Chemlambda.Core.Graph 8 | import Chemlambda.Core.Pattern 9 | import Chemlambda.Chemistry.Reaction 10 | import Chemlambda.Chemistry.Enzymes 11 | import Chemlambda.Chemistry.Rewrite.Util 12 | 13 | 14 | randRewrite :: (Ord a, Enum a) => Graph a -> IO (Graph a) 15 | randRewrite graph = 16 | do 17 | sites <- randomReactionSites graph enzymeList 18 | let 19 | result = 20 | foldl 21 | (\graph r -> 22 | reactInGraph r graph) 23 | graph 24 | sites 25 | return $ runCombCycle result 26 | -------------------------------------------------------------------------------- /chemlambda-chemistry/Chemlambda/Chemistry/Rewrite/Util.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ViewPatterns #-} 2 | 3 | module Chemlambda.Chemistry.Rewrite.Util 4 | ( runCombCycle 5 | , rewriteIO 6 | , rewriteIter 7 | , rewriteIterIO 8 | , rewriteIterFull 9 | ) 10 | where 11 | 12 | import Chemlambda.Core.Node 13 | import Chemlambda.Core.Graph 14 | import Chemlambda.Core.Pattern 15 | import Chemlambda.Chemistry.Reaction 16 | import Chemlambda.Chemistry.Enzymes 17 | 18 | runCombCycle :: (Enum a, Ord a) => Graph a -> Graph a 19 | runCombCycle graph = 20 | let 21 | comb graph = 22 | let a = reactionSites combEnzyme graph 23 | in case a of 24 | [] -> graph 25 | _ -> reactInGraph (head a) graph 26 | 27 | go (nodes -> []) curr = go curr (comb curr) 28 | go prev curr = 29 | if prev == curr 30 | then curr 31 | else go curr (comb curr) 32 | in 33 | go (mkGraph []) graph 34 | 35 | -- Maybe use a monad transformer to remove this unnecessary specificity. GraphT 36 | rewriteIO :: (Graph a -> IO (Graph a)) -> IO (Graph a) -> IO (Graph a) 37 | rewriteIO rewrite ioG = do 38 | g <- ioG 39 | rewrite g 40 | 41 | rewriteIter rewrite times graph = iterate rewrite graph !! times 42 | rewriteIterIO rewrite times graph = iterate (rewriteIO rewrite) (return graph) !! times 43 | 44 | rewriteIterFull rewrite graph = 45 | let 46 | go (nodes -> []) curr = go curr (rewrite curr) 47 | go prev curr = if prev == curr then curr else go curr (rewrite curr) 48 | in 49 | go (mkGraph []) graph 50 | -------------------------------------------------------------------------------- /chemlambda-chemistry/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, synergistics 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of synergistics nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /chemlambda-chemistry/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /chemlambda-chemistry/bench/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified ReactionSitesBench as RSB 4 | 5 | main = RSB.run 6 | -- main = RSB.run >>= print 7 | -------------------------------------------------------------------------------- /chemlambda-chemistry/bench/ReactionSitesBench.hs: -------------------------------------------------------------------------------- 1 | module ReactionSitesBench where 2 | 3 | import Criterion.Main 4 | import Chemlambda.Chemistry.Reaction 5 | import Chemlambda.Chemistry.Rewrite.Deterministic 6 | import Chemlambda.Chemistry.Rewrite.Random 7 | import Chemlambda.Chemistry.Rewrite.Util 8 | import Chemlambda.SampleData.Graphs 9 | 10 | run = defaultMain 11 | [ bench "deterministic" $ whnf (rewriteIter detRewrite 10) longIdentity 12 | , bench "random" $ whnf (rewriteIterIO randRewrite 10) longIdentity 13 | ] 14 | 15 | -- run = rewriteIter detRewrite 10 longIdentity 16 | -- run = rewriteIterIO randRewrite 10 longIdentity 17 | 18 | -------------------------------------------------------------------------------- /chemlambda-chemistry/chemlambda-chemistry.cabal: -------------------------------------------------------------------------------- 1 | -- Initial chemlambda-chemistry.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | name: chemlambda-chemistry 5 | version: 0.1.0 6 | synopsis: The standard rules of chemistry for Chemlambda 7 | -- description: 8 | homepage: https://github.com/synergistics/chemlambda-hask 9 | license: BSD3 10 | license-file: LICENSE 11 | author: synergistics 12 | maintainer: kingjak678@gmail.com 13 | -- copyright: 14 | -- category: 15 | build-type: Simple 16 | extra-source-files: ChangeLog.md 17 | cabal-version: >=1.10 18 | 19 | library 20 | default-language: Haskell2010 21 | 22 | exposed-modules: 23 | Chemlambda.Chemistry.Patterns 24 | Chemlambda.Chemistry.Moves 25 | Chemlambda.Chemistry.Enzymes 26 | Chemlambda.Chemistry.Reaction 27 | Chemlambda.Chemistry.Rewrite.Util 28 | Chemlambda.Chemistry.Rewrite.Deterministic 29 | Chemlambda.Chemistry.Rewrite.Random 30 | 31 | -- other-modules: 32 | -- other-extensions: 33 | build-depends: 34 | base >=4.9 && <4.10, 35 | extra, 36 | random, 37 | chemlambda-core 38 | 39 | test-suite chemistry-test 40 | default-language: Haskell2010 41 | type: exitcode-stdio-1.0 42 | hs-source-dirs: test 43 | 44 | main-is: Main.hs 45 | other-modules: 46 | RewritesTests 47 | 48 | build-depends: 49 | base, 50 | pretty-show, 51 | hspec, 52 | chemlambda-core, 53 | chemlambda-chemistry 54 | 55 | ghc-options: 56 | -O2 57 | -threaded 58 | -fprof-auto 59 | 60 | benchmark reactionsites 61 | default-language: Haskell2010 62 | type: exitcode-stdio-1.0 63 | hs-source-dirs: bench 64 | 65 | main-is: Main.hs 66 | other-modules: 67 | ReactionSitesBench 68 | 69 | build-depends: 70 | base, 71 | criterion, 72 | chemlambda-core, 73 | chemlambda-chemistry, 74 | chemlambda-sampledata 75 | 76 | ghc-options: 77 | -O2 78 | -threaded 79 | -fprof-auto 80 | 81 | -------------------------------------------------------------------------------- /chemlambda-chemistry/test/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import RewritesTests 4 | 5 | main = a 6 | -------------------------------------------------------------------------------- /chemlambda-chemistry/test/RewritesTests.hs: -------------------------------------------------------------------------------- 1 | module RewritesTests where 2 | 3 | import qualified Chemlambda.Chemistry.Rewrite.Deterministic as RD 4 | import qualified Chemlambda.Chemistry.Rewrite.Random as RR 5 | 6 | a = putStrLn "Sup man" 7 | -------------------------------------------------------------------------------- /chemlambda-core/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for chemlambda-chemistry 2 | 3 | ## 0.1.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /chemlambda-core/Chemlambda/Core/AdjList.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | module Chemlambda.Core.AdjList 3 | where 4 | 5 | import qualified Data.List as List 6 | import qualified Data.Map as Map 7 | import qualified Data.Maybe as Maybe 8 | import qualified Data.IntMap as IntMap 9 | import Data.Map (Map) 10 | import Data.Maybe (Maybe) 11 | import Data.IntMap (IntMap, (!)) 12 | 13 | import Chemlambda.Core.Atom 14 | import Chemlambda.Core.Port 15 | 16 | 17 | data Flagged a = Blocked a | Free a 18 | 19 | type PortMap = Map PortType Int 20 | 21 | data AdjList a b = AdjList 22 | { entries :: IntMap (AdjEntry a b) } 23 | deriving (Ord, Eq, Show) 24 | 25 | data AdjEntry a b = AdjEntry 26 | { node :: a 27 | , portMap :: b } 28 | deriving (Ord, Eq, Show) 29 | 30 | 31 | getEntry :: AdjList a b -> Int -> AdjEntry a b 32 | getEntry = (!) . entries 33 | 34 | addFrees :: [(Atom, [(PortType, Int)])] -> [(Atom, [(PortType, Int)])] 35 | addFrees entries = 36 | let 37 | allPorts = concatMap snd entries 38 | 39 | withoutPair = 40 | filter 41 | (\(p,i) 42 | -> List.notElem i 43 | $ map snd 44 | $ allPorts List.\\ [(p,i)]) 45 | allPorts 46 | 47 | frees = 48 | map 49 | (\(p,i) -> case direction p of 50 | O -> (FROUT, [(MI,i)]) 51 | I -> (FRIN, [(MO,i)])) 52 | withoutPair 53 | 54 | in entries ++ frees 55 | 56 | -- subGraph :: [Int] -> Graph a -> Graph a 57 | -- subGraph elems graph = 58 | -- let 59 | -- selectedNodes 60 | -- = filter (\(i,_) -> elem i elems) 61 | -- $ IntMap.assocs 62 | -- $ unGraph graph 63 | -- in Graph $ IntMap.fromList selectedNodes 64 | 65 | -- nodeAtPort :: Node Atom Int -> PortType -> Graph Atom -> Maybe (Node Atom Int) 66 | -- nodeAtPort node pt graph 67 | -- = getNode graph 68 | -- <$> nRef 69 | -- <$> refAtPort node pt 70 | 71 | toAdjList :: [(Atom, [(PortType, Int)])] -> AdjList Atom PortMap 72 | toAdjList portIdEntries = 73 | let 74 | indexedAtoms = zip [0..] $ map fst portIdEntries -- give an index to each atom 75 | 76 | portsWithAtomIndex :: [(Int, (PortType, Int))] -- give each port the index associated with its atom 77 | portsWithAtomIndex = 78 | let 79 | ports = map snd portIdEntries 80 | givePortsIndex i ps = map ((,) i) ps 81 | in concat $ zipWith givePortsIndex [0..] ports 82 | 83 | -- Make the port numbers of an atom refer to other atoms rather than port variable names 84 | toAtomRefPorts :: (Atom, [(PortType, Int)]) -> (Atom, [(PortType, Int)]) 85 | toAtomRefPorts (a,ps) = 86 | let 87 | ps' = foldr (\(j,(p,i)) ps'' -> 88 | let 89 | withoutCurrentPort = ps List.\\ [(p,i)] -- Ensures that port variable must occur twice to be added 90 | indices = map snd withoutCurrentPort 91 | in 92 | if elem i indices 93 | then let 94 | matchingPort 95 | = Maybe.fromJust 96 | $ fmap (const j) -- \(p,_) -> (p,j) 97 | <$> List.find (\(_,i') -> i' == i) withoutCurrentPort 98 | in matchingPort : ps'' 99 | else ps'') 100 | [] 101 | portsWithAtomIndex 102 | in 103 | (a,ps') 104 | 105 | adjList 106 | = AdjList 107 | $ IntMap.fromList 108 | $ zip [0..] 109 | $ map ((\(a,ps) -> AdjEntry a (Map.fromList ps)) . toAtomRefPorts) 110 | $ portIdEntries 111 | 112 | in adjList 113 | 114 | 115 | idAtPort :: AdjEntry a PortMap -> PortType -> Maybe Int 116 | idAtPort adjEntry port = Map.lookup port $ portMap adjEntry 117 | 118 | lam a b c = (L, [ (MI,a), (LO,b), (RO,c) ]) 119 | fo a b c = (FO, [ (MI,a), (LO,b), (RO,c) ]) 120 | app a b c = (A, [ (LI,a), (RI,b), (MO,c) ]) 121 | 122 | -- test :: [(Atom, [(PortType, Int)])] 123 | !test 124 | = toAdjList 125 | $ addFrees 126 | $ concat 127 | $ take 2000 128 | $ iterate (map (\(a, [(x,xx), (y,yy), (z,zz)]) -> (a, [(x,xx+200),(y,yy+200),(z,zz+200)]))) 129 | [ app 2 3 4 130 | , lam 1 1 2 131 | , fo 8 9 10 132 | , app 11 12 13 133 | , lam 14 15 16 ] 134 | -------------------------------------------------------------------------------- /chemlambda-core/Chemlambda/Core/Atom.hs: -------------------------------------------------------------------------------- 1 | module Chemlambda.Core.Atom 2 | ( Atom(..) 3 | , valence 4 | ) 5 | where 6 | 7 | -- A Chemlambda atom 8 | data Atom 9 | = L 10 | | FO 11 | | FOE 12 | | A 13 | | FI 14 | | ARROW 15 | | FRIN 16 | | FROUT 17 | | T 18 | deriving ( Show, Eq, Ord ) 19 | 20 | valence :: Num a => Atom -> a 21 | valence a | elem a [FRIN,FROUT,T] = 1 22 | valence a | elem a [ARROW] = 2 23 | valence a | elem a [L,FO,FOE,A,FI] = 3 24 | 25 | -------------------------------------------------------------------------------- /chemlambda-core/Chemlambda/Core/Node.hs: -------------------------------------------------------------------------------- 1 | module Chemlambda.Core.Node 2 | where 3 | 4 | import qualified Data.List as List 5 | import Chemlambda.Core.Port 6 | 7 | 8 | data NodeRef a = NR { nRef :: a, nPT :: PortType } 9 | deriving ( Eq ) 10 | 11 | data Node a b = Node { atom :: a, refs :: [ NodeRef b ] } 12 | deriving ( Eq, Show ) 13 | 14 | instance Show a => Show (NodeRef a) where 15 | show (NR i pt) = "(NR " ++ show i ++ " " ++ show pt ++ ")" 16 | 17 | 18 | refAtPort :: Node a b -> PortType -> Maybe (NodeRef b) 19 | refAtPort node pt 20 | = List.find (\(NR _ pt') -> pt' == pt) 21 | $ refs node 22 | 23 | refsWithVal :: Eq b => Node a b -> b -> [NodeRef b] 24 | refsWithVal node a 25 | = filter (\(NR a' _) -> a' == a) 26 | $ refs node 27 | 28 | adjustRef :: (a -> b) -> (PortType -> PortType) -> NodeRef a -> NodeRef b 29 | adjustRef refAdj portAdj (NR a pt) = (NR (refAdj a) (portAdj pt)) 30 | 31 | adjustRefInNode nr nr' (Node x rs) = Node x $ map (\r -> if r == nr then nr else r) rs 32 | -------------------------------------------------------------------------------- /chemlambda-core/Chemlambda/Core/Pattern.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE MultiWayIf #-} 3 | module Chemlambda.Core.Pattern 4 | where 5 | 6 | import qualified Data.IntMap as IntMap 7 | import qualified Data.Maybe as Maybe 8 | import qualified Data.Map as Map 9 | import qualified Data.List as List 10 | import Data.IntMap (IntMap, (!)) 11 | import Data.Maybe (Maybe) 12 | import Data.Map (Map) 13 | 14 | import Chemlambda.Core.Port 15 | import Chemlambda.Core.Atom 16 | import Chemlambda.Core.Node 17 | import Chemlambda.Core.AdjList 18 | 19 | 20 | -- pattern :: AdjList Atom PortMap -> (Atom,PortType) -> (Atom,PortType) -> IntMap (AdjEntry Atom PortMap) 21 | pattern adjList (atom1,pt1) (atom2,pt2) = 22 | let 23 | pairs 24 | = Maybe.fromJust 25 | $ foldr 26 | (\entry acc -> 27 | let entryAtom = node entry in 28 | if entryAtom == atom1 29 | then 30 | let 31 | pair = do 32 | id2 <- idAtPort entry pt1 33 | let otherEntry = getEntry adjList id2 34 | id1 <- idAtPort otherEntry pt2 35 | 36 | return [(entry, otherEntry)] 37 | in mappend pair acc 38 | 39 | else acc) 40 | (Just []) 41 | (map snd $ IntMap.toList $ entries adjList) 42 | in 43 | -- pairs 44 | map (\(entryA, entryB) -> 45 | let 46 | associateWithAtom :: Atom -> (PortType,Int) -> (PortType, Atom) 47 | associateWithAtom atom port = fmap (const atom) port 48 | 49 | portsA = Map.toList (portMap entryA) 50 | portsB = Map.toList (portMap entryB) 51 | 52 | toAssocs atom ports = 53 | let 54 | labels = map (associateWithAtom atom) ports 55 | values = map (\(pt,i) -> getEntry adjList i) ports 56 | in Map.fromList $ zip labels values 57 | 58 | in toAssocs L (portsA ++ portsB)) pairs 59 | 60 | -- type PatternResult = Map (Atom,PortType) (Int, Node Atom Int) 61 | 62 | 63 | -- getMatchingNodes (a,ptA) (b,ptB) graph 64 | -- = IntMap.toList 65 | -- $ IntMap.filterWithKey 66 | -- (\i node -> 67 | -- if atom node == a 68 | -- then let 69 | -- atPortA 70 | -- = getNode graph 71 | -- <$> nRef 72 | -- <$> refAtPort node ptA 73 | 74 | -- atPortB 75 | -- = getNode graph 76 | -- <$> nRef 77 | -- <$> (atPortA >>= flip refAtPort ptB) 78 | -- in (atom <$> atPortA) == Just b && atPortB == Just node 79 | -- else False) 80 | -- (unGraph graph) 81 | 82 | -- runPattern 83 | -- :: (Atom,PortType) -- AtomA 84 | -- -> (Atom,PortType) -- AtomB 85 | -- -> [PortType] -- Select nodes at these ports of AtomA 86 | -- -> [PortType] -- Select nodes at these ports of AtomB 87 | -- -> Graph Atom -- Initial graph -- 88 | -- -> [PatternResult] -- List of "subgraphs" that match the pattern 89 | -- runPattern (a,ptA) (b,ptB) portsA portsB graph = 90 | -- let 91 | -- nodeAssocs = IntMap.assocs $ unGraph graph 92 | -- matchingNodes = getMatchingNodes (a,ptA) (b,ptB) graph 93 | 94 | -- mkKeys atom pts = map ((,) atom) pts 95 | 96 | -- results = 97 | -- foldr 98 | -- (\(i, nodeA@(Node a nrs)) acc -> 99 | -- let 100 | -- (Just nodeB) = nodeAtPort nodeA ptA graph 101 | 102 | -- nodeRefs 103 | -- = ((++) 104 | -- (map (\port -> 105 | -- let 106 | -- nodeRef = refAtPort nodeA port 107 | -- ref = nRef <$> nodeRef 108 | -- in fmap (\r -> (r, getNode graph r)) ref) 109 | -- portsA) 110 | -- (map (\port -> 111 | -- let 112 | -- nodeRef = refAtPort nodeB port 113 | -- ref = nRef <$> nodeRef 114 | -- in fmap (\r -> (r, getNode graph r)) ref) 115 | -- portsB)) 116 | 117 | -- keys = mkKeys a portsA ++ mkKeys b portsB 118 | -- -- in if List.any Maybe.isNothing nodeRefs 119 | -- -- then acc 120 | -- in (Map.fromList $ zip keys (map Maybe.fromJust nodeRefs)) : acc) 121 | -- [] 122 | -- matchingNodes 123 | 124 | -- in results 125 | 126 | 127 | -- betaPattern :: Graph Atom -> [PatternResult] 128 | -- betaPattern = runPattern (L,RO) (A,LI) [MI,LO,RO] [LI,RI,MO] 129 | 130 | -- -- betaMove :: PatternResult -> Maybe (Graph Atom) 131 | -- betaMove nodes = 132 | -- let 133 | -- lam = Map.lookup (A,LI) nodes 134 | -- app = Map.lookup (L,RO) nodes 135 | -- miLam = Map.lookup (L,MI) nodes 136 | -- loLam = Map.lookup (L,LO) nodes 137 | -- riApp = Map.lookup (A,RI) nodes 138 | -- moApp = Map.lookup (A,MO) nodes 139 | 140 | -- in do 141 | -- (iL, lamNode) <- lam 142 | -- (iA, appNode) <- app 143 | -- (iMiL, miLamNode) <- miLam 144 | -- (iLoL, loLamNode) <- loLam 145 | -- (iRiA, riAppNode) <- riApp 146 | -- (iMoA, moAppNode) <- moApp 147 | 148 | -- refAi <- refAtPort lamNode MI 149 | -- let refAo = head $ refsWithVal miLamNode iL 150 | 151 | -- let refBi = head $ refsWithVal loLamNode iL 152 | -- refBo <- adjustRef id (const MO) <$> refAtPort lamNode LO 153 | 154 | -- refDi <- adjustRef id (const MI) <$> refAtPort appNode RI 155 | -- let refDo = head $ refsWithVal riAppNode iA 156 | 157 | -- refEo <- refAtPort appNode MO 158 | -- let refEi = head $ refsWithVal moAppNode iA 159 | 160 | -- let arrNode1 = (iL, Node ARROW [refAi, refEo]) 161 | -- let arrNode2 = (iA, Node ARROW [refDi, refBo]) 162 | 163 | -- let rawNodes = Map.elems nodes 164 | -- let withRemoved = filter (\n -> not $ elem n [(iL,lamNode),(iA,appNode)]) $ rawNodes 165 | 166 | -- let newLoL = (iLoL, adjustRefInNode refBi (NR iA (nPT refBi)) loLamNode) 167 | -- let newMoA = (iMoA, adjustRefInNode refEi (NR iL (nPT refEi)) moAppNode) 168 | 169 | -- let newNodes' = withRemoved ++ [arrNode1, arrNode2, newLoL, newMoA] 170 | 171 | -- return $ Graph $ IntMap.fromList $ newNodes' 172 | 173 | 174 | -------------------------------------------------------------------------------- /chemlambda-core/Chemlambda/Core/Port.hs: -------------------------------------------------------------------------------- 1 | module Chemlambda.Core.Port 2 | where 3 | 4 | data PortType = LO | LI | RO | RI | MO | MI 5 | deriving ( Eq, Ord, Show ) 6 | 7 | data Direction = I | O 8 | deriving ( Eq, Ord, Show ) 9 | 10 | isOut :: PortType -> Bool 11 | isOut = flip elem [LO, RO, MO] 12 | 13 | isIn :: PortType -> Bool 14 | isIn = flip elem [LI, RI, MI] 15 | 16 | direction :: PortType -> Direction 17 | direction p 18 | | isOut p = O 19 | | isIn p = I 20 | 21 | -------------------------------------------------------------------------------- /chemlambda-core/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, synergistics 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of synergistics nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /chemlambda-core/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /chemlambda-core/chemlambda-core.cabal: -------------------------------------------------------------------------------- 1 | name: chemlambda-core 2 | version: 0.1.0 3 | synopsis: An implementation of the artificial chemistry Chemlambda in haskell 4 | description: The core components of the Chemlambda project 5 | homepage: https://github.com/synergistics 6 | license: BSD3 7 | license-file: LICENSE 8 | author: synergistics 9 | maintainer: kingjak678@gmail.com 10 | -- copyright: 11 | -- category: 12 | build-type: Simple 13 | extra-source-files: ChangeLog.md, README.md 14 | cabal-version: >=1.10 15 | 16 | 17 | library 18 | default-language: Haskell2010 19 | 20 | exposed-modules: 21 | -- Chemlambda.Core.Node, 22 | Chemlambda.Core.Pattern, 23 | Chemlambda.Core.AdjList, 24 | Chemlambda.Core.Port, 25 | Chemlambda.Core.Atom 26 | -- Chemlambda.Core.Connectable 27 | 28 | build-depends: 29 | base >=4.9 && <4.10, 30 | containers >=0.5 && <0.6, 31 | vector 32 | -- , parallel 33 | 34 | 35 | test-suite test 36 | default-language: Haskell2010 37 | hs-source-dirs: test 38 | main-is: Main.hs 39 | type: exitcode-stdio-1.0 40 | 41 | build-depends: 42 | base, 43 | pretty-show, 44 | hspec, 45 | chemlambda-core 46 | 47 | 48 | ghc-options: 49 | -O2 50 | -threaded 51 | -fprof-auto 52 | 53 | 54 | -- benchmark bench 55 | -- default-language: Haskell2010 56 | -- hs-source-dirs: bench 57 | -- main-is: .hs 58 | -- build-depends: base, chemlambda, criterion, parallel 59 | -- type: exitcode-stdio-1.0 60 | 61 | -------------------------------------------------------------------------------- /chemlambda-experimental/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for chemlambda-experimental 2 | 3 | ## 0.1.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /chemlambda-experimental/Chemlambda/Experimental/ComonadicGraphs/Graph.hs: -------------------------------------------------------------------------------- 1 | module Chemlambda.Experimental.ComonadicGraphs.Graph where 2 | 3 | data Atom = L | FO | FOE | A | FI | ARROW | FRIN | FROUT | T deriving ( Show, Eq ) 4 | data Node a = Node Atom [a] deriving ( Show, Eq ) 5 | data Graph a = Graph { node :: a, nodes :: [Graph a] } deriving ( Show ) 6 | 7 | class Comonad c where 8 | extract :: c a -> a 9 | unfold :: c a -> c (c a) 10 | 11 | instance Comonad Graph where 12 | extract (Graph n gs) = n 13 | 14 | unfold g@(Graph n gs) = Graph g (map unfold gs) 15 | 16 | 17 | (!?) :: [a] -> Int -> Maybe a 18 | xs !? i = 19 | if i > (length xs - 1) then Nothing else Just $ xs !! i 20 | 21 | atEdge :: Int -> Graph a -> Maybe (Graph a) 22 | atEdge i (Graph _ gs) = gs !? i 23 | 24 | 25 | connects :: Eq a => Node a -> Node a -> Bool 26 | connects n@(Node _ es) m@(Node _ ds) = any (`elem` ds) es && n /= m 27 | 28 | mkGraph :: Eq a => [Node a] -> Graph Atom 29 | mkGraph ns = 30 | let 31 | n@(Node x es) = head ns 32 | connectedNodes = filter (connects n) ns 33 | in Graph x (map mkGraph $ map (\n -> n:filter (/= n) ns) connectedNodes) 34 | 35 | omega = 36 | [ Node L [0,1,2] 37 | , Node FO [1,3,4] 38 | , Node A [3,4,0] 39 | , Node L [5,6,7] 40 | , Node FO [6,8,9] 41 | , Node A [8,9,5] 42 | , Node A [2,7,10] 43 | , Node FROUT [10] 44 | ] 45 | -------------------------------------------------------------------------------- /chemlambda-experimental/Chemlambda/Experimental/ComonadicGraphs/Reaction.hs: -------------------------------------------------------------------------------- 1 | module Chemlambda.Experimental.ComonadicGraphs.Reaction where 2 | 3 | import Data.List 4 | import Chemlambda.Core.Port 5 | import Chemlambda.Core.Node 6 | import Chemlambda.Core.Graph 7 | import Chemlambda.Core.Pattern 8 | import Chemlambda.Chemistry.Patterns 9 | import Chemlambda.Chemistry.Moves 10 | 11 | 12 | data Enzyme a = Enzyme 13 | { pattern :: Pattern [Node a] (Graph [Node a]) 14 | , move :: Graph [Node a] -> Graph [Node (NewId a)] 15 | , ePriority :: Int } 16 | 17 | data ReactionSite a = ReactionSite 18 | { site :: Graph [Node a] 19 | , reaction :: Graph [Node a] -> Graph [Node (NewId a)] 20 | , sPriority :: Int } 21 | 22 | 23 | reactionSites :: Enzyme a -> Graph [Node a] -> [ReactionSite a] 24 | reactionSites enzyme graph = 25 | let matches = match (pattern enzyme) graph 26 | in map (\graph' -> ReactionSite graph' (move enzyme) (ePriority enzyme)) matches 27 | 28 | 29 | betaEnzyme :: Eq a => Enzyme a 30 | betaEnzyme = Enzyme betaPattern betaMove 3 31 | 32 | fanInEnzyme :: Eq a => Enzyme a 33 | fanInEnzyme = Enzyme fanInPattern fanInMove 3 34 | 35 | distAEnzyme :: Eq a => Enzyme a 36 | distAEnzyme = Enzyme distAPattern distAMove 4 37 | 38 | distLEnzyme :: Eq a => Enzyme a 39 | distLEnzyme = Enzyme distLPattern distLMove 4 40 | 41 | distFOEnzyme :: Eq a => Enzyme a 42 | distFOEnzyme = Enzyme distFOPattern distFOMove 5 43 | 44 | distFIEnzyme :: Eq a => Enzyme a 45 | distFIEnzyme = Enzyme distFIPattern distFIMove 4 46 | 47 | pruneAEnzyme :: Eq a => Enzyme a 48 | pruneAEnzyme = Enzyme pruneAPattern pruneAMove 2 49 | 50 | pruneFIEnzyme :: Eq a => Enzyme a 51 | pruneFIEnzyme = Enzyme pruneFIPattern pruneFIMove 2 52 | 53 | pruneLEnzyme :: Eq a => Enzyme a 54 | pruneLEnzyme = Enzyme pruneLPattern pruneLMove 2 55 | 56 | pruneFObEnzyme :: Eq a => Enzyme a 57 | pruneFObEnzyme = Enzyme pruneFObPattern pruneFObMove 1 58 | 59 | pruneFOcEnzyme :: Eq a => Enzyme a 60 | pruneFOcEnzyme = Enzyme pruneFOcPattern pruneFOcMove 0 61 | 62 | pruneFOEbEnzyme :: Eq a => Enzyme a 63 | pruneFOEbEnzyme = Enzyme pruneFOEbPattern pruneFOEbMove 1 64 | 65 | pruneFOEcEnzyme :: Eq a => Enzyme a 66 | pruneFOEcEnzyme = Enzyme pruneFOEcPattern pruneFOEcMove 0 67 | 68 | combEnzyme :: Eq a => Enzyme a 69 | combEnzyme = Enzyme combPattern combMove (-1) 70 | 71 | -------------------------------------------------------------------------------- /chemlambda-experimental/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, synergistics 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of synergistics nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /chemlambda-experimental/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /chemlambda-experimental/chemlambda-experimental.cabal: -------------------------------------------------------------------------------- 1 | -- Initial chemlambda-experimental.cabal generated by cabal init. For 2 | -- further documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | name: chemlambda-experimental 5 | version: 0.1.0 6 | synopsis: A playground for experimental Chemlambda features 7 | -- description: 8 | homepage: https://github.com/synergistics/chemlambda-hask 9 | license: BSD3 10 | license-file: LICENSE 11 | author: synergistics 12 | maintainer: kingjak678@gmail.com 13 | -- copyright: 14 | -- category: 15 | build-type: Simple 16 | extra-source-files: ChangeLog.md 17 | cabal-version: >=1.10 18 | 19 | library 20 | default-language: Haskell2010 21 | 22 | exposed-modules: 23 | Chemlambda.Experimental.ComonadicGraphs.Graph, 24 | Chemlambda.Experimental.ComonadicGraphs.Reaction 25 | 26 | build-depends: 27 | base >=4.9 && <4.10, 28 | chemlambda-core, 29 | chemlambda-chemistry 30 | 31 | -- other-modules: 32 | -- other-extensions: 33 | -------------------------------------------------------------------------------- /chemlambda-language/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for chemlambda-language 2 | 3 | ## 0.1.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /chemlambda-language/Chemlambda/Language/Chemeral/Definition.hs: -------------------------------------------------------------------------------- 1 | module Chemlambda.Language.Chemeral.Definition where 2 | 3 | import Data.List (nub) 4 | import Data.Maybe (fromJust) 5 | import qualified Data.Map as M 6 | import Control.Monad 7 | import Chemlambda.Core.Node 8 | import Chemlambda.Core.Port 9 | 10 | 11 | type Namespace = String 12 | 13 | data Var a = Structural { varNamespace :: Namespace, val :: a } 14 | | Parameter { varNamespace :: Namespace, param :: String } 15 | deriving ( Eq, Show, Ord ) 16 | 17 | isStructural (Structural _ _) = True 18 | isStructural _ = False 19 | 20 | isParameter (Parameter _ _) = True 21 | isParameter _ = False 22 | 23 | -- With this implementation, all invoked moldefs such as "Id 1" are 24 | -- turned into nodes eagerly, i.e. when they are invoked. 25 | -- Maybe defNodes could be made into thunks of themselves? Or is that even 26 | -- necessary due to haskell's laziness. Note to self: find out! 27 | data MolDef a = MolDef 28 | { molNamespace :: Namespace -- not the same as the name of the def 29 | , params :: [Var a] 30 | , molCalls :: [MolInvoke a] } 31 | deriving ( Show ) 32 | 33 | data MolInvoke a 34 | = Thunked { invokedDef :: MolDef a, args :: [Var a] } 35 | | Invoked { node :: Node (Var a) } 36 | deriving ( Show ) 37 | 38 | -- instance Functor (MolDef ir) where 39 | -- fmap f md = md { ret = f $ ret md } 40 | 41 | -- instance Applicative (MolDef ir) where 42 | -- pure a = MolDef "" [] [] (const []) a 43 | -- mdf <*> md = fmap (ret mdf) md 44 | 45 | -- instance Monad (MolDef ir) where -- The monad is realized by the fact that a MolDef is a set of molCalls in a context 46 | -- return = pure 47 | -- md >>= f = f (ret md) 48 | 49 | -- getField :: (MolDef ir r -> s) -> MolDef ir r -> MolDef ir s 50 | -- getField field md = const (field md) <$> md 51 | 52 | repVars :: Ord a => M.Map (Var a) (Var a) -> [MolInvoke a] -> [MolInvoke a] 53 | repVars varMap mis = map go mis 54 | where 55 | go (Thunked d as) = Thunked d $ map (\a -> M.findWithDefault a a varMap) as 56 | go (Invoked n) = Invoked $ n { ports = liftM (fmap (\p -> M.findWithDefault p p varMap)) (ports n) } 57 | 58 | runDef :: Ord a => MolDef a -> [Var a] -> [MolInvoke a] 59 | runDef md args = 60 | let 61 | paramMap = M.fromList $ zip (params md) args 62 | in 63 | repVars paramMap (molCalls md) 64 | 65 | expandInvoke :: Ord a => MolInvoke a -> [MolInvoke a] 66 | expandInvoke (Thunked d as) = concatMap expandInvoke (runDef d as) 67 | expandInvoke (Invoked n) = [Invoked n] 68 | 69 | lamMol = 70 | MolDef "prim_l" 71 | [ Parameter "prim_l" "a" 72 | , Parameter "prim_l" "b" 73 | , Parameter "prim_l" "c" ] 74 | [ Invoked $ lam (params lamMol !! 0) (params lamMol !! 1) (params lamMol !! 2) ] 75 | 76 | idMol = 77 | MolDef "ID" 78 | [ Parameter "ID" "c" ] 79 | $ concat [ runDef lamMol [Structural "ID" 1, Structural "ID" 1, params idMol !! 0] ] 80 | 81 | kMol = 82 | MolDef "K" 83 | [ Parameter "K" "c" ] 84 | $ concat [ runDef idMol [Structural "K" 1] 85 | , runDef lamMol [Structural "K" 1, Structural "K" 2, Parameter "K" "c"] ] 86 | 87 | -- structurals :: MolInvoke a -> [Var a] 88 | -- structurals mi = 89 | -- let 90 | -- allVars = case mi of 91 | -- (Thunked d as) -> as 92 | -- (Invoked n) -> map portId $ ports n 93 | -- in filter isStructural allVars 94 | 95 | 96 | -- addInvocations :: (Ord a, Enum a) => [MolInvoke a] -> MolDef a -> MolDef a 97 | -- addInvocations mis md = 98 | -- let 99 | -- unused = unusedStructuralVars md 100 | -- invokeVars = nub $ filter (\s -> varNamespace s /= molNamespace md) $ concatMap structurals mis -- replace nub with nubOrd if possible 101 | -- structuralMap = M.fromList $ zip invokeVars unused 102 | -- additions = map go mis 103 | -- where 104 | -- go (Thunked d as) = Thunked d (replaceVar structuralMap as) 105 | -- go (Invoked n) = Invoked $ n { ports = map (fmap (head . (replaceVar structuralMap) . return)) (ports n) } 106 | -- in 107 | -- md {molCalls = molCalls md ++ additions} 108 | 109 | -- expandInvocation 110 | 111 | -- unusedStructuralVars :: (Ord a, Enum a) => MolDef a -> [Var a] 112 | -- unusedStructuralVars md = 113 | -- let 114 | -- start = succ 115 | -- $ maximum 116 | -- $ map val 117 | -- $ concatMap structurals 118 | -- $ molCalls md 119 | -- newVars = iterate succ start 120 | -- in map (Structural (molNamespace md)) newVars 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | 148 | 149 | 150 | 151 | 152 | 153 | 154 | 155 | 156 | 157 | 158 | 159 | 160 | 161 | 162 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 | 174 | 175 | 176 | 177 | 178 | 179 | 180 | 181 | 182 | 183 | 184 | 185 | 186 | 187 | 188 | 189 | 190 | 191 | 192 | 193 | 194 | 195 | 196 | 197 | 198 | 199 | 200 | 201 | 202 | 203 | 204 | 205 | 206 | 207 | 208 | 209 | 210 | 211 | 212 | 213 | 214 | 215 | 216 | 217 | 218 | 219 | -- -- -- replaceVar :: Eq a => Var a -> Var a -> Node (Var a) -> Node (Var a) 220 | -- -- -- replaceVar v1 v2 (Node a pvs) = Node a $ map (fmap (\v -> if v == v1 then v2 else v)) pvs 221 | 222 | -- -- mkMolDef :: (Ord a, Enum a) => Namespace -> [Var a] -> [Node (Var a)] -> MolDef a 223 | -- -- mkMolDef nsp params nodes = 224 | -- -- let 225 | -- -- runDef' = \args -> 226 | -- -- let 227 | -- -- paramMap = M.fromList $ zip params args 228 | -- -- in 229 | -- -- map 230 | -- -- (\(Node a ps) -> Node a $ 231 | -- -- map (fmap (\v -> M.findWithDefault v v paramMap)) ps) 232 | -- -- nodes 233 | -- -- in 234 | -- -- MolDef nsp params nodes runDef' 235 | 236 | -- -- -- lamMol :: (Ord a, Enum a) => MolDef a 237 | -- -- -- lamMol = 238 | -- -- -- let 239 | -- -- -- params@[a,b,c] = [Parameter "ID" "a", Parameter "ID" "b", Parameter "ID" "c"] 240 | -- -- -- nodes = [lam a b c] 241 | -- -- -- in 242 | -- -- -- mkMolDef "PRIM_L" params nodes 243 | 244 | -- -- -- idMolDef :: (Ord a, Enum a, Num a) => MolDef a 245 | -- -- -- idMolDef = mkMolDef "ID" 246 | -- -- -- [Parameter "ID" "c"] 247 | -- -- -- (concat 248 | -- -- -- [ runDef lamMol 249 | -- -- -- [ (Structural "ID" 1) 250 | -- -- -- , (Structural "ID" 1) 251 | -- -- -- , (params idMolDef !! 0)] ]) 252 | 253 | -- -- -- let 254 | -- -- -- namespace = "ID" 255 | -- -- -- params = [Parameter "ID" "c"] 256 | -- -- -- defNodes = concat [runDef lMolDef [(Structural "ID" 1), (Structural "ID" 1), (params !! 0)]] 257 | -- -- -- runDef' = \[c] -> map (replaceVar (params !! 0) c) defNodes 258 | -- -- -- in 259 | -- -- -- MolDef namespace params defNodes runDef' 260 | 261 | 262 | -- -- -- appendInvokes :: (Ord a, Enum a) => MolDef a -> [MolInvoke a] -> MolDef a 263 | -- -- -- appendInvokes md mis = 264 | -- -- -- let 265 | -- -- -- mdName = molNamespace md 266 | -- -- -- unused = unusedStructuralVars md 267 | -- -- -- structurals = filter isStructural $ concatMap args mis 268 | 269 | -- -- -- m = M.fromList $ zip structurals unused 270 | 271 | -- -- -- go (MolInvoke md' pvs) = MolInvoke md' $ map (\v -> if isStructural v && varNamespace v /= molNamespace md then fromJust $ M.lookup v m else v) pvs 272 | -- -- -- in md { molCalls = molCalls md ++ map go mis } 273 | -- -- -- -- in structurals 274 | 275 | -- -- -- -- expandDef :: MolDef a -> [Var a] -> MolDef a -> [Node (Var a)] 276 | -- -- -- -- expandDef mdWithin vars mdEnclosing = 277 | 278 | -- -- -- -- make fully parameterized MolDefs for the standard nodes. 279 | -- -- -- -- namespace = "PRIMITIVE-APP 280 | -- -- -- -- idMol :: (Ord a, Enum a, Num a) => MolDef a 281 | -- -- -- -- idMol = 282 | -- -- -- -- let 283 | -- -- -- -- namespace = "ID" 284 | -- -- -- -- defNodes = [ lam (Structural "ID" 1) (Structural "ID" 1) (Parameter "ID" "a") ] 285 | 286 | -- -- -- -- runDef vs = map (replaceVar (Parameter "ID" "a") (vs !! 0)) defNodes 287 | -- -- -- -- where 288 | -- -- -- -- 289 | -- -- -- -- in 290 | -- -- -- -- MolDef namespace defNodes runDef 291 | 292 | 293 | 294 | 295 | -- -- -- -- kMol :: MolDef a 296 | -- -- -- -- kMol = MolDef $ \[a] -> [runDef (getEnv kMol) idMol 2, l 2 1 a, t 1] 297 | -------------------------------------------------------------------------------- /chemlambda-language/Chemlambda/Language/MolParser/IO/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import System.Environment 4 | import Chemlambda.Core.Graph 5 | import Chemlambda.Chemistry.Rewrite.Random 6 | import Chemlambda.Chemistry.Rewrite.Deterministic 7 | import Chemlambda.Chemistry.Rewrite.Util 8 | import Chemlambda.Language.MolParser.Parser 9 | 10 | main :: IO () 11 | main = do 12 | [fileName] <- getArgs 13 | molFile <- readFile fileName 14 | let (Right a) = parseMol molFile 15 | let a' = length $ nodes $ rewriteIterFull detRewrite a 16 | -- a' <- rewriteIterIO randRewrite 200 a 17 | print a' 18 | 19 | -------------------------------------------------------------------------------- /chemlambda-language/Chemlambda/Language/MolParser/Parser.hs: -------------------------------------------------------------------------------- 1 | {- LANGUAGE PartialTypeSignatures -} 2 | 3 | module Chemlambda.Language.MolParser.Parser where 4 | 5 | import Data.Maybe ( fromJust ) 6 | import qualified Data.Map as M 7 | 8 | import Chemlambda.Core.Atom 9 | import Chemlambda.Core.Graph 10 | import Chemlambda.Core.Node 11 | 12 | import Control.Monad 13 | 14 | import Text.Parsec 15 | import Text.Parsec.Char 16 | import Text.Parsec.Error 17 | 18 | 19 | atomP :: Parsec String (Int, M.Map String Int) Atom 20 | atomP = 21 | let 22 | as = map try 23 | [ (string "L") >> return L 24 | , (string "FOE") >> return FOE 25 | , (string "FO") >> return FO 26 | , (string "A") >> return A 27 | , (string "FI") >> return FI 28 | , (string "ARROW") >> return ARROW 29 | , (string "FRIN") >> return FRIN 30 | , (string "FROUT") >> return FROUT 31 | , (string "T") >> return T 32 | ] 33 | in choice as 34 | 35 | 36 | nodeP :: Parsec String (Int, M.Map String Int) (Node Int) 37 | nodeP = do 38 | a <- between spaces (many1 space) atomP 39 | -- IAaMFG 40 | words <- count (valence a) word 41 | 42 | forM_ words $ \w -> do 43 | modifyState (\(i, m) -> if M.notMember w m 44 | then (i+1, M.insert w i m) 45 | else (i, m)) 46 | 47 | (i, m) <- getState 48 | return (toNode a words m) 49 | where 50 | word = do 51 | w <- many1 (alphaNum <|> char '_') 52 | spaces 53 | return w 54 | 55 | toPorts words m = map (\w -> fromJust $ M.lookup w m) words 56 | 57 | toNode atom portNames m = 58 | let ports = toPorts portNames m in 59 | case atom of 60 | L -> 61 | let [a,b,c] = ports 62 | in lam a b c 63 | FO -> 64 | let [a,b,c] = ports 65 | in fo a b c 66 | FOE -> 67 | let [a,b,c] = ports 68 | in foe a b c 69 | A -> 70 | let [a,b,c] = ports 71 | in app a b c 72 | FI -> 73 | let [a,b,c] = ports 74 | in fi a b c 75 | ARROW -> 76 | let [a,b] = ports 77 | in arrow a b 78 | FRIN -> 79 | let [a] = ports 80 | in frin a 81 | FROUT -> 82 | let [a] = ports 83 | in frout a 84 | T -> 85 | let [a] = ports 86 | in t a 87 | 88 | molP :: Parsec String (Int, M.Map String Int) (Graph Int) 89 | molP = mkGraph <$> nodeP `sepBy` spaces 90 | 91 | parseMol :: String -> Either ParseError (Graph Int) 92 | parseMol = runParser molP (0, M.empty) "" 93 | -------------------------------------------------------------------------------- /chemlambda-language/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, synergistics 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of synergistics nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /chemlambda-language/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /chemlambda-language/chemlambda-language.cabal: -------------------------------------------------------------------------------- 1 | -- Initial chemlambda-language.cabal generated by cabal init. For further 2 | -- documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | name: chemlambda-language 5 | version: 0.1.0 6 | synopsis: A molfile parser for Chemlambda 7 | -- description: 8 | homepage: https://github.com/synergistics/chemlambda-hask 9 | license: BSD3 10 | license-file: LICENSE 11 | author: synergistics 12 | maintainer: kingjak678@gmail.com 13 | -- copyright: 14 | -- category: 15 | build-type: Simple 16 | extra-source-files: ChangeLog.md 17 | cabal-version: >=1.10 18 | 19 | library 20 | exposed-modules: 21 | Chemlambda.Language.MolParser.Parser 22 | Chemlambda.Language.Chemeral.Definition 23 | -- other-modules: 24 | -- other-extensions: 25 | build-depends: 26 | base >=4.9 && <4.10, 27 | containers, 28 | chemlambda-core, 29 | chemlambda-chemistry, 30 | parsec, 31 | mtl 32 | 33 | -- hs-source-dirs: 34 | default-language: Haskell2010 35 | 36 | executable molparse 37 | default-language: Haskell2010 38 | build-depends: 39 | base >=4.9 && <4.10, 40 | chemlambda-core, 41 | chemlambda-chemistry, 42 | chemlambda-language 43 | 44 | hs-source-dirs: Chemlambda/Language/MolParser/IO 45 | main-is: Main.hs 46 | 47 | ghc-options: 48 | -O2 49 | -threaded 50 | -fprof-auto 51 | -prof 52 | -------------------------------------------------------------------------------- /chemlambda-sampledata/ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Revision history for chemlambda-sampledata 2 | 3 | ## 0.1.0 -- YYYY-mm-dd 4 | 5 | * First version. Released on an unsuspecting world. 6 | -------------------------------------------------------------------------------- /chemlambda-sampledata/Chemlambda/SampleData/Graphs.hs: -------------------------------------------------------------------------------- 1 | module Chemlambda.SampleData.Graphs where 2 | 3 | import Chemlambda.Core.Node 4 | import Chemlambda.Core.Graph 5 | 6 | 7 | succNode node = node { ports = map ((+ 15) <$>) $ ports node } 8 | 9 | longIdentity = mkGraph . concat . take 100 . iterate (map succNode) $ nodes identity 10 | 11 | identity = mkGraph 12 | [ lam 4 4 5 13 | , app 5 2 9 14 | , foe 9 10 11 15 | ] 16 | 17 | omega = mkGraph 18 | [ lam 0 1 2 19 | , fo 1 3 4 20 | , app 3 4 0 21 | , lam 5 6 7 22 | , fo 6 8 9 23 | , app 8 9 5 24 | , app 2 7 10 25 | , frout 10 26 | ] 27 | 28 | longY = mkGraph . concat . take 100 . iterate (map succNode) $ nodes y 29 | y = mkGraph 30 | [ fo 0 1 2 31 | , lam 3 4 5 32 | , fo 4 6 7 33 | , app 6 7 8 34 | , app 1 8 3 35 | , lam 10 11 12 36 | , fo 11 13 14 37 | , app 13 14 15 38 | , app 2 15 10 39 | , app 5 12 99 40 | , frout 99 41 | ] 42 | 43 | meh = mkGraph 44 | [ lam 0 1 2 45 | , t 1 46 | , lam 2 0 3 47 | , app 3 6 5 48 | , lam 4 4 6 49 | ] 50 | 51 | skk = mkGraph 52 | [ foe 3 1 2 53 | , lam 5 4 3 54 | , lam 4 6 5 55 | , t 6 56 | , app 41 1 51 57 | , app 51 2 61 58 | , lam 7 84 41 59 | , lam 8 85 7 60 | , lam 9 86 8 61 | , app 10 11 9 62 | , app 84 12 10 63 | , app 85 13 11 64 | , fo 86 12 13 65 | ] 66 | 67 | quine = mkGraph 68 | [ lam 5 1 2 69 | , fi 1 7 6 70 | , app 2 3 4 71 | , fi 4 6 9 72 | , lam 8 7 10 73 | , foe 9 5 8 74 | , foe 10 12 11 75 | , app 12 15 13 76 | , foe 13 15 14 77 | , app 11 14 3 78 | ] 79 | -------------------------------------------------------------------------------- /chemlambda-sampledata/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, synergistics 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of synergistics nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /chemlambda-sampledata/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /chemlambda-sampledata/chemlambda-sampledata.cabal: -------------------------------------------------------------------------------- 1 | -- Initial chemlambda-sampledata.cabal generated by cabal init. For 2 | -- further documentation, see http://haskell.org/cabal/users-guide/ 3 | 4 | name: chemlambda-sampledata 5 | version: 0.1.0 6 | synopsis: A repository of sample data for the Chemlambda project 7 | -- description: 8 | homepage: https://github.com/synergistics/chemlambda-hask 9 | license: BSD3 10 | license-file: LICENSE 11 | author: synergistics 12 | maintainer: kingjak678@gmail.com 13 | -- copyright: 14 | -- category: 15 | build-type: Simple 16 | extra-source-files: ChangeLog.md 17 | cabal-version: >=1.10 18 | 19 | library 20 | default-language: Haskell2010 21 | exposed-modules: 22 | Chemlambda.SampleData.Graphs 23 | -- other-modules: 24 | -- other-extensions: 25 | 26 | build-depends: 27 | base >=4.9 && <4.10, 28 | chemlambda-core 29 | -------------------------------------------------------------------------------- /molfiles/4up4.mol: -------------------------------------------------------------------------------- 1 | L a1num afnum anum 2 | L a2num axnum a1num 3 | 4 | FO afnum am1num ale2num 5 | A am1num ari1num a2num 6 | 7 | FO ale2num am3num ale4num 8 | A am3num ari4num ari1num 9 | 10 | 11 | FO ale4num am5num am6num 12 | A am5num ari5num ari4num 13 | 14 | A am6num axnum ari5num 15 | 16 | 17 | 18 | 19 | 20 | L 1num fnum num 21 | L 2num xnum 1num 22 | 23 | FO fnum m1num le2num 24 | A m1num ri1num 2num 25 | 26 | 27 | FO le2num m3num le4num 28 | A m3num ri4num ri1num 29 | 30 | 31 | FO le4num m5num m6num 32 | A m5num ri5num ri4num 33 | 34 | A m6num xnum ri5num 35 | 36 | A num anum out 37 | -------------------------------------------------------------------------------- /molfiles/ackerman_2_2.mol: -------------------------------------------------------------------------------- 1 | A 1 cb o 2 | A 2 ca 1 3 | L 3 a 2 4 | L 4 b 3 5 | A 5 b 4 6 | A 6 sp1 5 7 | A a f 6 8 | L 1s1 ns1 sp1 9 | L 2s1 ss1 1s1 10 | L 3s1 zs1 2s1 11 | A 4s1 5s1 3s1 12 | A 6s1 zs1 5s1 13 | A ns1 7s1 6s1 14 | FO ss1 4s1 7s1 15 | L 1f Af f 16 | L 2f bf 1f 17 | A 3f cone 2f 18 | A 4f Af 3f 19 | A sp2 bf 4f 20 | L 1s2 ns2 sp2 21 | L 2s2 ss2 1s2 22 | L 3s2 zs2 2s2 23 | A 4s2 5s2 3s2 24 | A 6s2 zs2 5s2 25 | A ns2 7s2 6s2 26 | FO ss2 4s2 7s2 27 | L 1cone fcone cone 28 | L 2cone xcone 1cone 29 | A fcone xcone 2cone 30 | L 1ca fca ca 31 | L 2ca xca 1ca 32 | A 3ca 4ca 2ca 33 | A 5ca xca 4ca 34 | FO fca 3ca 5ca 35 | L 1cb fcb cb 36 | L 2cb xcb 1cb 37 | A 3cb 4cb 2cb 38 | A 5cb xcb 4cb 39 | FO fcb 3cb 5cb 40 | -------------------------------------------------------------------------------- /molfiles/skk.mol: -------------------------------------------------------------------------------- 1 | FO 3 1 2 2 | L 5 4 3 3 | L 4 6 5 4 | T 6 5 | A 41 1 51 6 | A 51 2 61 7 | L 7 x 41 8 | L 8 y 7 9 | L 9 z 8 10 | A 10 11 9 11 | A x 12 10 12 | A y 13 11 13 | FO z 12 13 14 | -------------------------------------------------------------------------------- /molfiles/y.mol: -------------------------------------------------------------------------------- 1 | FO 0 1 2 2 | L 3 4 5 3 | FO 4 6 7 4 | A 6 7 8 5 | A 1 8 3 6 | L 10 11 12 7 | FO 11 13 14 8 | A 13 14 15 9 | A 2 15 10 10 | A 5 12 99 11 | FROUT 99 12 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | build: 2 | library-profiling: true 3 | 4 | # This file was automatically generated by 'stack init' 5 | # 6 | # Some commonly used options have been documented as comments in this file. 7 | # For advanced use and comprehensive documentation of the format, please see: 8 | # http://docs.haskellstack.org/en/stable/yaml_configuration/ 9 | 10 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 11 | # A snapshot resolver dictates the compiler version and the set of packages 12 | # to be used for project dependencies. For example: 13 | # 14 | # resolver: lts-3.5 15 | # resolver: nightly-2015-09-21 16 | # resolver: ghc-7.10.2 17 | # resolver: ghcjs-0.1.0_ghc-7.10.2 18 | # resolver: 19 | # name: custom-snapshot 20 | # location: "./custom-snapshot.yaml" 21 | resolver: nightly-2016-07-14 22 | 23 | # User packages to be built. 24 | # Various formats can be used as shown in the example below. 25 | # 26 | # packages: 27 | # - some-directory 28 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 29 | # - location: 30 | # git: https://github.com/commercialhaskell/stack.git 31 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 32 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 33 | # extra-dep: true 34 | # subdirs: 35 | # - auto-update 36 | # - wai 37 | # 38 | # A package marked 'extra-dep: true' will only be built if demanded by a 39 | # non-dependency (i.e. a user package), and its test suites and benchmarks 40 | # will not be run. This is useful for tweaking upstream packages. 41 | packages: 42 | - 'chemlambda-core' 43 | # - 'chemlambda-chemistry' 44 | # - 'chemlambda-sampledata' 45 | # - 'chemlambda-language' 46 | # - 'chemlambda-experimental' 47 | 48 | 49 | # Dependency packages to be pulled from upstream that are not in the resolver 50 | # (e.g., acme-missiles-0.3) 51 | extra-deps: [] 52 | 53 | # Override default flag values for local packages and extra-deps 54 | flags: {} 55 | 56 | # Extra package databases containing global packages 57 | extra-package-dbs: [] 58 | 59 | # Control whether we use the GHC we find on the path 60 | # system-ghc: true 61 | # 62 | # Require a specific version of stack, using version ranges 63 | # require-stack-version: -any # Default 64 | # require-stack-version: ">=1.1" 65 | # 66 | # Override the architecture used by stack, especially useful on Windows 67 | # arch: i386 68 | # arch: x86_64 69 | # 70 | # Extra directories used by stack for building 71 | # extra-include-dirs: [/path/to/dir] 72 | # extra-lib-dirs: [/path/to/dir] 73 | # 74 | # Allow a newer minor version of GHC than the snapshot specifies 75 | # compiler-check: newer-minor 76 | # 77 | --------------------------------------------------------------------------------