Add Functional Dependency in Memories

.output/actual/examples/sq/output/simpleEval/logging/hello.out

@@ -0,0 +1 @@
+-1

.output/actual/examples/sq/output/simpleEval/logging/longHello.out

@@ -0,0 +1 @@
+-1

.output/actual/examples/sq/output/simpleEvalIL/logging/helloSQIL.out

@@ -0,0 +1 @@
+-1

.output/golden/examples/sq/output/simpleEval/logging/hello.out

@@ -0,0 +1 @@
+-1

.output/golden/examples/sq/output/simpleEval/logging/longHello.out

@@ -0,0 +1 @@
+-1

.output/golden/examples/sq/output/simpleEvalIL/logging/helloSQIL.out

@@ -0,0 +1 @@
+-1

docs/CHANGELOG.md

@@ -1,4 +1,7 @@
 # 📅 Revision history for HelMA
+## 0.6.6.0  -- 2021-06-11
+
+* Use Functional Dependency in Memories and Collections
 
 ## 0.6.5.0  -- 2021-06-06
 

docs/README.md

@@ -1,6 +1,10 @@
 # Welcome to 🔧 🎨 HelMA
 🔧 🎨 **HelMA** - Heavenly Esoteric Little Minimal Automaton for Esoteric Languages implemented in Haskell
 
+**🧑‍🔧 🧑‍🎨 HAMAMAL** - Holistic Actual Minimalist Automatic Mechanical Languages is a kind of [Low-level] [First-generation] [Code] for Esoteric Languages.
+
+**🧑‍🔧 🧑‍🎨 HAMALAM** - Holistic Actual Minimalist Languages of Automatic Machine
+
 ```
 FOR everyone
 WHO want to run esoteric languages
@@ -26,3 +30,7 @@ THAT is an Evaluator and an Interpreter for Esoteric Languages (EsoAutomata)
 * [CODE OF CONDUCT](CODE_OF_CONDUCT.md)
 
 ## 🌈 ❤️ 💛 💚 💙 🤍 🖤 🦄
+
+[Low-level]:        https://en.wikipedia.org/wiki/Low-level_programming_language
+[First-generation]: https://en.wikipedia.org/wiki/First-generation_programming_language
+[Code]:             https://en.wikipedia.org/wiki/Machine_code

helma.cabal

@@ -1,7 +1,7 @@
 cabal-version:       2.2
 
 name:                helma
-version:             0.6.5.0
+version:             0.6.6.0
 
 synopsis:            HELMA - Heavenly Esoteric Little Minimal Automaton for Esoteric Languages implemented in Haskell
 description:         Please see the README on GitHub at <https://github.com/helvm/helma#readme>
@@ -34,12 +34,27 @@ library
   exposed-modules:
         HelVM.HelMA.Common.API.EvalParams
         HelVM.HelMA.Common.API.TypeOptions
+        HelVM.HelMA.Common.BinaryOperator
+        HelVM.HelMA.Common.Collections
+        HelVM.HelMA.Common.Collections.Drop
+        HelVM.HelMA.Common.Collections.FromList
+        HelVM.HelMA.Common.Collections.Insert
+        HelVM.HelMA.Common.Collections.Lookup
+        HelVM.HelMA.Common.Collections.Pop
+        HelVM.HelMA.Common.Collections.SplitAt
         HelVM.HelMA.Common.Memories.RAM
+        HelVM.HelMA.Common.Memories.RAMConst
+        HelVM.HelMA.Common.Memories.RAMImpl
+        HelVM.HelMA.Common.Memories.RAMUtil
         HelVM.HelMA.Common.Memories.Stack
+        HelVM.HelMA.Common.Memories.StackConst
+        HelVM.HelMA.Common.Memories.StackImpl
+        HelVM.HelMA.Common.Memories.StackUtil
         HelVM.HelMA.Common.IO.MockIO
         HelVM.HelMA.Common.IO.WrapperIO
         HelVM.HelMA.Common.OrError
         HelVM.HelMA.Common.Types.CellType
+        HelVM.HelMA.Common.Types.IntCellType
         HelVM.HelMA.Common.Types.StackType
         HelVM.HelMA.Common.Types.TokenType
         HelVM.HelMA.Common.Types.RAMType
@@ -56,7 +71,6 @@ library
         HelVM.HelMA.Automata.ETA.Evaluator
         HelVM.HelMA.Automata.ETA.EvaluatorUtil
         HelVM.HelMA.Automata.ETA.Lexer
-        HelVM.HelMA.Automata.ETA.StackOfSymbols
         HelVM.HelMA.Automata.ETA.Token
 
         HelVM.HelMA.Automata.SubLeq.Evaluator
@@ -67,7 +81,6 @@ library
         HelVM.HelMA.Automata.WhiteSpace.Lexer
         HelVM.HelMA.Automata.WhiteSpace.OperandParsers
         HelVM.HelMA.Automata.WhiteSpace.Parser
-        HelVM.HelMA.Automata.WhiteSpace.StackOfSymbols
         HelVM.HelMA.Automata.WhiteSpace.Token
   other-extensions:
   build-depends:
@@ -77,6 +90,7 @@ library
     , mtl
     , split
     , data-default
+    , ilist
   mixins:
       base hiding (Prelude)
     , relude (Relude as Prelude, Relude.Extra, Relude.Unsafe)
@@ -149,6 +163,7 @@ test-suite spec
         Spec
 
         HelVM.HelMA.Common.FilterIf0Spec
+        HelVM.HelMA.Common.UtilSpec
 
         HelVM.HelMA.Automata.CartesianProduct
         HelVM.HelMA.Automata.Expectations

hs/app/AppOptions.hs

@@ -1,6 +1,7 @@
 module AppOptions where
 
 import HelVM.HelMA.Common.Types.CellType
+import HelVM.HelMA.Common.Types.IntCellType
 import HelVM.HelMA.Common.Types.StackType
 import HelVM.HelMA.Common.Types.RAMType
 
@@ -63,6 +64,13 @@ optionParser = AppOptions
                    <> value (show defaultCellType)
                    <> showDefault
                    )
+  <*> strOption    (  long    "IntCellType"
+                   <> short   'i'
+                   <> metavar "[IntCellType]"
+                   <> help   ("Implementation of IntCell " <> show intCellTypes)
+                   <> value (show defaultIntCellType)
+                   <> showDefault
+                   )
   <*> switch       (  long    "exec"
                    <> short   'e'
                    <> help    "Exec"
@@ -80,6 +88,7 @@ data AppOptions = AppOptions
   , ramType     :: String      -- RAMType
   , stackType   :: String      -- StackType
   , cellType    :: String      -- CellType
+  , intCellType :: String      -- IntCellType
   , exec        :: Exec
   , file        :: String
   }
@@ -94,7 +103,7 @@ type Exec        = Bool
 ----
 
 data Lang = Cat | Rev | BF | ETA | SQ | STN | WS
-  deriving (Eq, Read, Show)
+  deriving (Eq , Read , Show)
 
 langs :: [Lang]
 langs = [Cat , Rev , BF , ETA , SQ , STN , WS]
@@ -106,10 +115,10 @@ parseLang raw = valid $ readMaybe raw where
 
 ----
 
-data Impl = Monadic | Interact deriving (Eq, Read, Show)
+data Impl = Monadic | Interact deriving (Eq , Read , Show)
 
 impls :: [Impl]
-impls = [Monadic, Interact]
+impls = [Monadic , Interact]
 
 parseImpl :: String -> Impl
 parseImpl raw = valid $ readMaybe raw where

hs/app/Main.hs

@@ -7,6 +7,7 @@ import HelVM.HelMA.Common.IO.WrapperIO
 import HelVM.HelMA.Common.API.TypeOptions
 
 import HelVM.HelMA.Common.Types.CellType
+import HelVM.HelMA.Common.Types.IntCellType
 import HelVM.HelMA.Common.Types.StackType
 import HelVM.HelMA.Common.Types.TokenType
 import HelVM.HelMA.Common.Types.RAMType
@@ -39,14 +40,15 @@ main :: IO ()
 main = runApp =<< execParser opts where
   opts = info (optionParser <**> helper)
       ( fullDesc
-     <> header "HelMA: The Interpreter of BrainFuck, ETA, SubLeq and WhiteSpace"
+     <> header "HelMA: The Interpreter of BrainFuck , ETA , SubLeq and WhiteSpace"
      <> progDesc "Runs esoteric programs - complete with pretty bad error messages" )
 
 runApp:: AppOptions -> IO ()
-runApp AppOptions{lang, minified, emitTL, emitIL, asciiLabels, impl, ramType, stackType, cellType, exec, file} = do
+runApp AppOptions{lang , minified , emitTL , emitIL , asciiLabels , impl , ramType , stackType , cellType , intCellType , exec , file} = do
   IO.hSetBuffering stdout IO.NoBuffering
   source <- readSource exec file
-  run minified emitTL emitIL (parseImpl impl) (TypeOptions (parseRAMType ramType) (parseStackType stackType) (parseCellType cellType)) asciiLabels (parseLang lang) source
+  run minified emitTL emitIL (parseImpl impl) typeOptions asciiLabels (parseLang lang) source
+    where typeOptions = TypeOptions (parseRAMType ramType) (parseStackType stackType) (parseCellType cellType) (parseIntCellType intCellType)
 
 readSource :: Exec -> String -> IO Source
 readSource True = pure
@@ -79,17 +81,17 @@ parse WS   a = pPrintNoColor . flip (WS.parse WhiteTokenType) a
 parse lang _ = tokenize lang
 
 eval :: Impl -> TypeOptions -> AsciiLabels -> Lang -> Source -> IO ()
-eval impl options a lang s = evalParams impl (lang, EvalParams {asciiLabel = a, source = s, typeOptions = options})
+eval impl options a lang s = evalParams impl (lang , EvalParams {asciiLabel = a , source = s , typeOptions = options})
 
-evalParams :: Impl -> (Lang, EvalParams) -> IO ()
+evalParams :: Impl -> (Lang , EvalParams) -> IO ()
 evalParams Interact = IO.interact . interactEval'
 evalParams Monadic  = monadicEval'
 
-interactEval' :: (Lang, EvalParams) -> Interact
-interactEval' (lang, params) = interactEval lang params
+interactEval' :: (Lang , EvalParams) -> Interact
+interactEval' (lang , params) = interactEval lang params
 
-monadicEval' :: WrapperIO m => (Lang, EvalParams) -> m ()
-monadicEval' (lang, params) = monadicEval lang params
+monadicEval' :: WrapperIO m => (Lang , EvalParams) -> m ()
+monadicEval' (lang , params) = monadicEval lang params
 
 interactEval :: Lang -> EvalParams -> Interact
 interactEval Cat = Cat.evalParams

hs/src/HelVM/HelMA/Automata/BrainFuck/Evaluator.hs

@@ -39,27 +39,28 @@ eval source Word32Type = start source (newTape :: FullTape Word32)
 eval source Int64Type  = start source (newTape :: FullTape Int64)
 eval source Word64Type = start source (newTape :: FullTape Word64)
 
-start :: (Symbol s, Evaluator r) => String -> FullTape s -> r
-start source = doInstruction ([], tokenize source)
-
 class Evaluator r where
+
+  start :: Symbol s => String -> FullTape s -> r
+  start source = doInstruction ([] , tokenize source)
+
   doInstruction :: Symbol s => Table -> FullTape s -> r
-  doInstruction table@(_, MoveR   :_) tape = doInstruction    (nextInst table) (moveHeadRight tape)
-  doInstruction table@(_, MoveL   :_) tape = doInstruction    (nextInst table)  (moveHeadLeft tape)
-  doInstruction table@(_, Inc     :_) tape = doInstruction    (nextInst table)   (wNextSymbol tape)
-  doInstruction table@(_, Dec     :_) tape = doInstruction    (nextInst table)   (wPrevSymbol tape)
-  doInstruction table@(_, JmpPast :_) tape = doJmpPast                  table                 tape
-  doInstruction table@(_, JmpBack :_) tape = doJmpBack                  table                 tape
-  doInstruction table@(_, Output  :_) tape = doOutputChar               table                 tape
-  doInstruction table@(_, Input   :_) tape = doInputChar                table                 tape
-  doInstruction       (_, []        ) _    = doEnd
+  doInstruction table@(_ , MoveR   :_) tape = doInstruction    (nextInst table) (moveHeadRight tape)
+  doInstruction table@(_ , MoveL   :_) tape = doInstruction    (nextInst table)  (moveHeadLeft tape)
+  doInstruction table@(_ , Inc     :_) tape = doInstruction    (nextInst table)   (wNextSymbol tape)
+  doInstruction table@(_ , Dec     :_) tape = doInstruction    (nextInst table)   (wPrevSymbol tape)
+  doInstruction table@(_ , JmpPast :_) tape = doJmpPast                  table                 tape
+  doInstruction table@(_ , JmpBack :_) tape = doJmpBack                  table                 tape
+  doInstruction table@(_ , Output  :_) tape = doOutputChar               table                 tape
+  doInstruction table@(_ , Input   :_) tape = doInputChar                table                 tape
+  doInstruction       (_ , []        ) _    = doEnd
 
   doJmpPast :: Symbol s => Table -> FullTape s -> r
-  doJmpPast table tape@(_, 0:_) = doInstruction (jumpPast table) tape
+  doJmpPast table tape@(_ , 0:_) = doInstruction (jumpPast table) tape
   doJmpPast table tape          = doInstruction (nextInst table) tape
 
   doJmpBack :: Symbol s => Table -> FullTape s -> r
-  doJmpBack table tape@(_, 0:_) = doInstruction (nextInst table) tape
+  doJmpBack table tape@(_ , 0:_) = doInstruction (nextInst table) tape
   doJmpBack table tape          = doInstruction (jumpBack table) tape
 
   doEnd        :: r
@@ -74,8 +75,8 @@ instance Evaluator Interact where
   doInputChar _     tape       []     = error $ "Empty input " <> show tape
   doInputChar table tape (char:input) = doInstruction (nextInst table) (writeSymbol char tape) input
 
-  doOutputChar _     tape@(_, [])       _     = error $ "Illegal State " <> show tape
-  doOutputChar table tape@(_, symbol:_) input = toChar symbol : doInstruction (nextInst table) tape input
+  doOutputChar _     tape@(_ , [])       _     = error $ "Illegal State " <> show tape
+  doOutputChar table tape@(_ , symbol:_) input = toChar symbol : doInstruction (nextInst table) tape input
 
 ----
 
@@ -85,5 +86,5 @@ instance WrapperIO m => Evaluator (m ()) where
   doInputChar table tape = doInputChar' =<< wGetChar where
     doInputChar' char = doInstruction (nextInst table) $ writeSymbol char tape
 
-  doOutputChar _          (_, [])       = error "Illegal State"
-  doOutputChar table tape@(_, symbol:_) = wPutChar (toChar symbol) *> doInstruction (nextInst table) tape
+  doOutputChar _          (_ , [])       = error "Illegal State"
+  doOutputChar table tape@(_ , symbol:_) = wPutChar (toChar symbol) *> doInstruction (nextInst table) tape

hs/src/HelVM/HelMA/Automata/BrainFuck/Symbol.hs

@@ -1,15 +1,16 @@
 module HelVM.HelMA.Automata.BrainFuck.Symbol (
   Symbol,
-  HelVM.HelMA.Automata.BrainFuck.Symbol.def,
-  HelVM.HelMA.Automata.BrainFuck.Symbol.next,
-  HelVM.HelMA.Automata.BrainFuck.Symbol.prev,
+  def,
+  next,
+  prev,
   fromChar,
   toChar
 ) where
 
-import Relude.Extra as Extra
+import Data.Default (Default)
 
-import Data.Default as Default
+import qualified Data.Default as Default
+import qualified Relude.Extra as Extra
 
 def :: Symbol s => s
 def = Default.def
@@ -20,7 +21,7 @@ next = Extra.next
 prev :: Symbol s => s -> s
 prev = Extra.prev
 
-class (Bounded a, Default a, Enum a, Eq a, Num a, Show a) => Symbol a where
+class (Bounded a , Default a , Enum a , Eq a , Num a , Show a) => Symbol a where
   fromChar   :: Char -> a
   toChar     :: a -> Char
 

hs/src/HelVM/HelMA/Automata/BrainFuck/TableOfInstructions.hs

@@ -3,25 +3,25 @@ module HelVM.HelMA.Automata.BrainFuck.TableOfInstructions where
 import HelVM.HelMA.Automata.BrainFuck.Token
 
 type HalfTable = TokenList
-type Table = (HalfTable, HalfTable)
+type Table = (HalfTable , HalfTable)
 type TableD = Table -> Table
 
 prevInst :: TableD
-prevInst (inst:prev, next) = (prev, inst:next)
-prevInst ([], _)           = error "End of the table"
+prevInst (inst:prev , next) = (prev , inst:next)
+prevInst ([] , _)           = error "End of the table"
 
 nextInst :: TableD
-nextInst (prev, inst:next) = (inst:prev, next)
-nextInst (_, [])           = error "End of the table"
+nextInst (prev , inst:next) = (inst:prev , next)
+nextInst (_ , [])           = error "End of the table"
 
 matchPrevJmp :: TableD
-matchPrevJmp table@(JmpPast:_, _) =                                                   table
-matchPrevJmp table@(JmpBack:_, _) = matchPrevJmp $ prevInst $ matchPrevJmp $ prevInst table
+matchPrevJmp table@(JmpPast:_ , _) =                                                   table
+matchPrevJmp table@(JmpBack:_ , _) = matchPrevJmp $ prevInst $ matchPrevJmp $ prevInst table
 matchPrevJmp table                =                           matchPrevJmp $ prevInst table
 
 matchNextJmp :: TableD
-matchNextJmp table@(_, JmpBack:_) =                               nextInst table
-matchNextJmp table@(_, JmpPast:_) = matchNextJmp $ matchNextJmp $ nextInst table
+matchNextJmp table@(_ , JmpBack:_) =                               nextInst table
+matchNextJmp table@(_ , JmpPast:_) = matchNextJmp $ matchNextJmp $ nextInst table
 matchNextJmp table                =                matchNextJmp $ nextInst table
 
 jumpPast :: TableD

hs/src/HelVM/HelMA/Automata/BrainFuck/TapeOfSymbols.hs

@@ -14,28 +14,28 @@ import HelVM.HelMA.Common.Util
 
 ----
 
-type FullTape s = (HalfTape s, HalfTape s)
+type FullTape s = (HalfTape s , HalfTape s)
 type FullTapeD s = D (FullTape s)
 
 type HalfTape s = [s]
 
 ----
 
 newTape :: (Symbol s) => FullTape s
-newTape = ([def], [def])
+newTape = ([def] , [def])
 
 moveHeadRight :: (Symbol s) => FullTapeD s
-moveHeadRight (cell:left, right) = pad (left, cell:right)
-moveHeadRight ([], _)            = error "End of the Tipe"
+moveHeadRight (cell:left , right) = pad (left , cell:right)
+moveHeadRight ([] , _)            = error "End of the Tipe"
 
 moveHeadLeft :: (Symbol s) => FullTapeD s
-moveHeadLeft (left, cell:right) = pad (cell:left, right)
-moveHeadLeft (_, [])            = error "End of the Tipe"
+moveHeadLeft (left , cell:right) = pad (cell:left , right)
+moveHeadLeft (_ , [])            = error "End of the Tipe"
 
 pad :: (Symbol s) => FullTapeD s
-pad ([], [])    = newTape
-pad ([], right) = ([def], right)
-pad (left, [])  = (left, [def])
+pad ([] , [])    = newTape
+pad ([] , right) = ([def] , right)
+pad (left , [])  = (left , [def])
 pad tape        = tape
 
 ----
@@ -50,5 +50,5 @@ writeSymbol :: (Symbol s) => Char -> FullTapeD s
 writeSymbol symbol = modifyCell (const $ fromChar symbol)
 
 modifyCell :: D s -> FullTapeD s
-modifyCell f (left, cell:right) = (left, f cell:right)
-modifyCell _ (_, [])            = error "End of the Tape"
+modifyCell f (left , cell:right) = (left , f cell:right)
+modifyCell _ (_ , [])            = error "End of the Tape"