Differences

This shows you the differences between two versions of the page.

--- codesnippets:datastructuresfromsymboltrees [2021/04/09 14:56] – f2b216
+++ codesnippets:datastructuresfromsymboltrees [2025/10/08 00:48] (current) – external edit 127.0.0.1
@@ Line 7: / Line 7: @@
       * container Construction as monadic class and instances
         * error handling
-      * newtypes for standard Construction instances
+      * types for standard Construction instances
-        * String'
+        * ''String' ''
         * in order to have standard build of constructions
       * easy combination methods for childs of symbol trees
-      * using folds (foldlM, foldrM)
+        * ''cmbnFast''
-    * code:<code Haskell>
+          * for faster execution, using ''foldlM''
+        * ''cmbnNCmt''
+          * for compatibility to non commutative operations like subtraction and devision, using ''foldrM''
+      * using GHC Extension ''[[codesnippets:flexibleinstances|FlexibleInstances]]''
+      * using GHC option ''[[codesnippets:fnowarnorphans|-fno-warn-orphans]]''
+    * code, module Main:<code Haskell>
 {-# LANGUAGE FlexibleInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
-import qualified Control.Monad as M (liftM, ap)
+module Main where
-import qualified Data.Foldable as Fld (foldlM, foldrM)
+import qualified Data.Char as Ch
+import Builder (Builder(..), SymbolTree(..), Construction(..), ErrorKind(..), SimpleContainer(..), String', cmbnFast, cmbnNCmt, buildValidMChar')
+import qualified Builder as Sym (Symbol(..))
 main :: IO ()
 main =
     do
-        print (buildValidM symTheTree :: (Construction Integer))
+        print (buildValidM symTheTree :: (Construction String'))
+        print (buildValidM symTheTree :: (Construction ConstDef))
 symTheTree :: SymbolTree
 symTheTree =
-    Node Div [                          -- shall create an Integer
+    Node Sym.ConstDef [                        -- shall create a ConstDef
-        Node Mul [                        -- shall create an Integer
+        Node Sym.ConstName [                     -- shall create a String
-            Node Add [                      -- shall create an Integer
+            Node (Sym.Terminal 'n') [],            -- shall create a Char
-                Node Number [                 -- shall create an Integer (and/or String)
+            Node (Sym.Terminal 'M') [],            -- shall create a Char
-                    Node (Terminal '3') [],     -- shall create a Char
+            Node (Sym.Terminal 'y') [],            -- shall create a Char
-                    Node (Terminal '3') [],     -- shall create a Char
+            Node (Sym.Terminal 'C') [],            -- shall create a Char
-                    Node (Terminal '3') [],     -- shall create a Char
+            Node (Sym.Terminal 'o') [],            -- shall create a Char
-                    Node (Terminal '1') []],    -- shall create a Char
+            Node (Sym.Terminal 'n') [],            -- shall create a Char
-                Node Number [                 -- shall create an Integer (and/or String)
+            Node (Sym.Terminal 's') [],            -- shall create a Char
-                    Node (Terminal '3') [],     -- shall create a Char
+            Node (Sym.Terminal 't') []             -- shall create a Char
-                    Node (Terminal '3') [],     -- shall create a Char
+        ],
-                    Node (Terminal '1') []]],   -- shall create a Char
+        Node Sym.ConstExpression [                -- shall create an Integer
-            Node Sub [                      -- shall create an Integer
+            Node Sym.Div [                          -- shall create an Integer
-                Node Number [                 -- shall create an Integer (and/or String)
+                Node Sym.Mul [                        -- shall create an Integer
-                    Node (Terminal '3') [],   -- shall create a Char
+                    Node Sym.Add [                      -- shall create an Integer
-                    Node (Terminal '3') [],   -- shall create a Char
+                        Node Sym.Number [                 -- shall create an Integer (and/or String)
-                    Node (Terminal '1') []],  -- shall create a Char
+                            Node Sym.DecDigit [Node (Sym.Terminal '3') []],     -- shall create a Char
-                Node Number [               -- shall create an Integer (and/or String)
+                            Node Sym.DecDigit [Node (Sym.Terminal '3') []],     -- shall create a Char
-                    Node (Terminal '1') [],   -- shall create a Char
+                            Node Sym.DecDigit [Node (Sym.Terminal '3') []],     -- shall create a Char
-                    Node (Terminal '3') []]]],-- shall create a Char
+                            Node Sym.DecDigit [Node (Sym.Terminal '1') []]],    -- shall create a Char
-        Node Number [                       -- shall create an Integer (and/or String)
+                        Node Sym.Number [                 -- shall create an Integer (and/or String)
-            Node (Terminal '7') []]]          -- shall create a Char
+                            Node Sym.DecDigit [Node (Sym.Terminal '3') []],     -- shall create a Char
+                            Node Sym.DecDigit [Node (Sym.Terminal '3') []],     -- shall create a Char
+                            Node Sym.DecDigit [Node (Sym.Terminal '1') []]]],   -- shall create a Char
+                    Node Sym.Sub [                      -- shall create an Integer
+                        Node Sym.Number [                 -- shall create an Integer (and/or String)
+                            Node Sym.DecDigit [Node (Sym.Terminal '3') []],   -- shall create a Char
+                            Node Sym.DecDigit [Node (Sym.Terminal '3') []],   -- shall create a Char
+                            Node Sym.DecDigit [Node (Sym.Terminal '1') []]],  -- shall create a Char
+                        Node Sym.Number [               -- shall create an Integer (and/or String)
+                            Node Sym.DecDigit [Node (Sym.Terminal '1') []],   -- shall create a Char
+                            Node Sym.DecDigit [Node (Sym.Terminal '3') []]]]],-- shall create a Char
+                Node Sym.Number [                       -- shall create an Integer (and/or String)
+                    Node Sym.DecDigit [Node (Sym.Terminal '7') []]]]]]        -- shall create a Char
-data SymbolTree = Node Symbol [SymbolTree]
+data ConstDef = ConstDef { rsConstName :: String, rnConstValue :: Integer }
     deriving Show
-data Symbol = Add | Sub | Mul | Div | Number | Terminal Char
+instance Builder ConstDef where
+    buildValidDflt = ConstDef "" 0
+    buildValidM (Node Sym.ConstDef (trSymConstName:trSymConstExpression:[])) =
+        do
+            sConstName <- buildValidM trSymConstName
+            nConstValue <- buildValidM trSymConstExpression
+            return (ConstDef sConstName nConstValue)
+    buildValidM (Node Sym.ConstDef _) = Error (ErrSymTree "instance Builder ConstDef" "buildValidM (Node Sym.ConstDef _)")
+    buildValidM _ = Error (ErrSymTree "instance Builder ConstDef" "buildValidM _")
+instance Builder Integer where
+    buildValidDflt = 0
+    buildValidM (Node Sym.ConstExpression (trSym:[])) = cnstInt "ConstExpression" $ buildValidM trSym
+    buildValidM (Node Sym.ConstExpression _) = Error (ErrSymTree "instance Builder Integer" "buildValidM (Node Sym.ConstExpression _)")
+    buildValidM (Node Sym.Number ltrSym) = cnstInt "Number" $ cmbnFast (\nA chB -> (10 * nA) + (toInteger ((Ch.ord chB) - 48))) 0 ltrSym
+    buildValidM (Node Sym.Add ltrSym) = cnstInt "Add" $ cmbnFast (+) 0 ltrSym
+    buildValidM (Node Sym.Sub ltrSym) = cnstInt "Sub" $ cmbnNCmt (-) 0 ltrSym
+    buildValidM (Node Sym.Mul ltrSym) = cnstInt "Mul" $ cmbnFast (*) 1 ltrSym
+    buildValidM (Node Sym.Div ltrSym) = cnstInt "Div" $ cmbnNCmt (div) 1 ltrSym
+    buildValidM _ = Error (ErrSymTree "instance Builder Integer" "buildValidM _")
+cnstInt :: String -> (Construction Integer) -> (Construction Integer)
+cnstInt sCase g = constraint (\n -> (n >= 0) && (n <= 4294967295)) sCase "between 0 and 2^32-1" g
+instance Builder String where
+    buildValidDflt = ""
+    buildValidM (Node Sym.ConstName ltrSym) = cnstConstName $ cmbnNCmt (\(Simply chA) sB -> chA : sB) [] ltrSym
+    buildValidM _ = Error (ErrSymTree "instance Builder String" "buildValidM _")
+cnstConstName :: (Construction String) -> (Construction String)
+cnstConstName g = constraint (\s -> (length s) >= 0) "ConstName" "at least one character" g
+instance Builder Char where
+    buildValidDflt = ' '
+    buildValidM (Node Sym.DecDigit (trSym:[])) = constraint (\ch -> (ch >= '0') && (ch <= '9')) "DecDigit" "between 0 and 9" $ buildValidMChar' trSym
+    buildValidM (Node Sym.DecDigit _) = Error (ErrSymTree "instance Builder Char" "buildValidM (Node DecDigit _)")
+    buildValidM _ = Error (ErrSymTree "instance Builder Char" "buildValidM _")
+</code>
+    * code, module Builder:<code Haskell>
+{-|
+Description : to create data structures from symbol trees.
+Copyright   : (c) Jörg K.-H. W. Brüggmann, 2021
+License     : CC0 1.0 Universal
+Maintainer  : - none -
+Stability   : experimental
+Portability : POSIX
+* supports creation of any data structures from symbol trees which type is defined in here:
+* example
+    @
+    instance Builder Integer where
+        buildValidDflt = 0
+        buildValidM symTree@(Node Number _) = (Contains (read (buildValid symTree)))
+        buildValidM (Node Add ltrSym) = cnstInt "Add" $ cmbnFast (+) 0 ltrSym
+        buildValidM (Node Sub ltrSym) = cnstInt "Sub" $ cmbnNCmt (-) 0 ltrSym
+        buildValidM (Node Mul ltrSym) = cnstInt "Mul" $ cmbnFast (*) 1 ltrSym
+        buildValidM (Node Div ltrSym) = cnstInt "Div" $ cmbnNCmt (div) 1 ltrSym
+        buildValidM _ = Error (ErrSymTree "instance Builder Integer" "buildValidM _")
+    cnstInt :: String -> (Construction Integer) -> (Construction Integer)
+    cnstInt sCase g = constraint (<= 4294967295) sCase "smaller than 2^32-1" g
+    instance Builder String where
+        buildValidDflt = ""
+        buildValidM (Node Number ltrSym) = Contains [ch | (Contains ch) <- (map buildValidM ltrSym) ]
+        buildValidM _ = Error (ErrSymTree "instance Builder String" "buildValidM _")
+    instance Builder Char where
+        buildValidDflt = ' '
+        buildValidM (Node (Terminal ch) _) = Contains ch
+        buildValidM _ = Error (ErrSymTree "instance Builder Char" "buildValidM _")
+    @
+-}
+{-# LANGUAGE FlexibleInstances #-}
+module Builder (
+    -- * Classes
+    Builder(..),
+    -- * Types
+    SymbolTree(..),
+    Symbol(..),
+    Construction(..),
+    ErrorKind(..),
+    SimpleContainer(..),
+    String',
+    Char',
+    -- * Functions
+    cmbnNCmt,
+    cmbnFast,
+    buildValidMChar'
+    ) where
+import qualified Control.Monad as M (liftM, ap)
+import qualified Data.Foldable as Fld (foldlM, foldrM)
+--------------------------------------------------------------------------------
+--  Basic types
+data Symbol = ConstDef | ConstName | ConstExpression | Add | Sub | Mul | Div | Number | DecDigit | Terminal Char
     deriving Show
-data Construction model = Contains model | Error ErrorKind
+data SymbolTree = Node Symbol [SymbolTree]
     deriving Show
@@ Line 62: / Line 185: @@
     deriving Show
-newtype String' = String' String
+--------------------------------------------------------------------------------
+--  Monadic type
+data Construction model = Contains model | Error ErrorKind
     deriving Show
@@ Line 77: / Line 203: @@
     return              = Contains
-class Generator g where
+--------------------------------------------------------------------------------
+--  Type class 'Builder'
+class Builder g where
     buildValidM :: SymbolTree -> (Construction g)
     buildValidDflt :: g
@@ Line 91: / Line 220: @@
         | otherwise = Error (Constraint sCase sConstraint)
-fOpFromSymTree :: (Generator g) => (g -> g -> g) -> (SymbolTree -> g -> Construction g)
+--------------------------------------------------------------------------------
-fOpFromSymTree fOp trSymA nB =
+--  'Builder' instance for String' and Char'
-    do
-        nA <- buildValidM trSymA
-        return (fOp nA nB);
-fOpFlippedFromSymTree :: (Generator g) => (g -> g -> g) -> (g -> SymbolTree -> Construction g)
+newtype SimpleContainer a = Simply { rSimply :: a }
-fOpFlippedFromSymTree fOp nA trSymB =
+    deriving Show
-    do
-        nB <- buildValidM trSymB
-        return (fOp nA nB);
-cmbnNCmt :: (Generator g) => (g -> g -> g) -> g -> [SymbolTree] -> Construction g
+fromSimple :: (Construction (SimpleContainer a)) -> (Construction a)
-cmbnNCmt fOp identity ltrSym = Fld.foldrM (fOpFromSymTree fOp) identity ltrSym
+fromSimple (Contains (Simply x)) = Contains x
+fromSimple (Error x) = Error x
-cmbnFast :: (Generator g) => (g -> g -> g) -> g -> [SymbolTree] -> Construction g
+type String' = SimpleContainer String
-cmbnFast fOp identity ltrSym = Fld.foldlM (fOpFlippedFromSymTree fOp) identity ltrSym
-instance Generator String' where
+instance Builder (SimpleContainer String) where
-    buildValidDflt = (String' "")
+    buildValidDflt = (Simply "")
-    buildValidM (Node (Terminal ch) _) = Contains (String' [ch])
+    buildValidM (Node (Terminal ch) _) = Contains (Simply [ch])
-    buildValidM (Node _ ltrSym) = (cmbnFast (s'concat) (String' "") ltrSym)
+    buildValidM (Node _ ltrSym) = (cmbnNCmt (liftSimply (++)) (Simply "") ltrSym)
-s'concat :: String' -> String' -> String'
+liftSimply :: (a -> a -> a) -> (SimpleContainer a) -> (SimpleContainer a) -> (SimpleContainer a)
-s'concat (String' sA) (String' sB) = String' (sA ++ sB)
+liftSimply f (Simply xA) (Simply xB) = Simply (f xA xB)
-instance Generator Integer where
+type Char' = SimpleContainer Char
-    buildValidDflt = 0
-    buildValidM symTree@(Node Number _) = (Contains (read (buildValid symTree)))
-    buildValidM (Node Add ltrSym) = cnstInt "Add" $ cmbnFast (+) 0 ltrSym
-    buildValidM (Node Sub ltrSym) = cnstInt "Sub" $ cmbnNCmt (-) 0 ltrSym
-    buildValidM (Node Mul ltrSym) = cnstInt "Mul" $ cmbnFast (*) 1 ltrSym
-    buildValidM (Node Div ltrSym) = cnstInt "Div" $ cmbnNCmt (div) 1 ltrSym
-    buildValidM _ = Error (ErrSymTree "instance Generator Integer" "buildValidM _")
-cnstInt :: String -> (Construction Integer) -> (Construction Integer)
+instance Builder (SimpleContainer Char) where
-cnstInt sCase g = constraint (<= 65535) sCase "smaller than 2^16-1" g
+    buildValidDflt = (Simply ' ')
+    buildValidM (Node (Terminal ch) _) = Contains (Simply ch)
+    buildValidM _ = Error (ErrSymTree "instance Builder Char'" "buildValidM _")
-instance Generator String where
+buildValidMChar' :: SymbolTree -> (Construction Char)
-    buildValidDflt = ""
+buildValidMChar' trSym = fromSimple (buildValidM trSym)
-    buildValidM (Node Number ltrSym) = Contains [ch | (Contains ch) <- (map buildValidM ltrSym) ]
-    --buildValidM (Node _ ltrSym) = cmbnFast (++) "" ltrSym
-    buildValidM _ = Error (ErrSymTree "instance Generator String" "buildValidM _")
-instance Generator Char where
+--------------------------------------------------------------------------------
-    buildValidDflt = ' '
+--  Helper functions for type class 'Builder'
-    buildValidM (Node (Terminal ch) _) = Contains ch
-    buildValidM _ = Error (ErrSymTree "instance Generator Char" "buildValidM _")
+fLOpFromSymTree :: (Builder g, Builder a) => (g -> a -> g) -> g -> SymbolTree -> Construction g
+fLOpFromSymTree fOp nA trSymB =
+    do
+        chB <- buildValidM trSymB
+        return (fOp nA chB)
+fROpFromSymTree :: (Builder g, Builder a) => (a -> g -> g) -> SymbolTree -> g -> Construction g
+fROpFromSymTree fOp trSymA nB =
+    do
+        chA <- buildValidM trSymA
+        return (fOp chA nB)
+cmbnNCmt :: (Builder g, Builder a) => (a -> g -> g) -> g -> [SymbolTree] -> Construction g
+cmbnNCmt fOp identity ltrSym = Fld.foldrM (fROpFromSymTree fOp) identity ltrSym
+cmbnFast :: (Builder g, Builder a) => (g -> a -> g) -> g -> [SymbolTree] -> Construction g
+cmbnFast fOp identity ltrSym = Fld.foldlM (fLOpFromSymTree fOp) identity ltrSym
 </code>
+    * compiles, error and warning free, with compiler: GHC 8.10.4, using -Wall
+    * executes, with output:<code>
+Contains (Simply {rSimply = "nMyConst3331331331137"})
+Contains (ConstDef {rsConstName = "nMyConst", rnConstValue = 166359})
+</code>
+===== ✎ =====
+~~DISCUSSION~~