HaskSheet

User Tools

Site Tools

Trace: • either • statefuldecoder • datastructuresfromsymboltrees • letandwhereconstructs • listcomprehension • statemonads • octets • applicative • filesystemioandstreams
codesnippets:datastructuresfromsymboltrees

Differences

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

Link to this comparison view

Both sides previous revisionPrevious revision
Next revision		Previous revision
codesnippets:datastructuresfromsymboltrees [2021/04/12 19:08] – f2b216codesnippets:datastructuresfromsymboltrees [2025/10/08 00:48] (current) – external edit 127.0.0.1
Line 23: Line 23:
 module Main where module Main where
  
-import Builder (Builder(..), SymbolTree(..), Symbol(..), Construction(..), ErrorKind(..), String', cmbnFast, cmbnNCmt)+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 :: IO ()
Line 29: Line 31:
     do     do
         print (buildValidM symTheTree :: (Construction String'))         print (buildValidM symTheTree :: (Construction String'))
 +        print (buildValidM symTheTree :: (Construction ConstDef))
  
 symTheTree :: SymbolTree symTheTree :: SymbolTree
 symTheTree =  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 ConstDef = ConstDef { rsConstName :: String, rnConstValue :: Integer } 
 +    deriving Show 
 + 
 +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 instance Builder Integer where
     buildValidDflt = 0     buildValidDflt = 0
-    buildValidM symTree@(Node Number _) = (Contains (read (buildValid symTree))) +    buildValidM (Node Sym.ConstExpression (trSym:[])) = cnstInt "ConstExpression" $ buildValidM trSym 
-    buildValidM (Node Add ltrSym) = cnstInt "Add" $ cmbnFast (+) 0 ltrSym +    buildValidM (Node Sym.ConstExpression _) = Error (ErrSymTree "instance Builder Integer" "buildValidM (Node Sym.ConstExpression _)") 
-    buildValidM (Node Sub ltrSym) = cnstInt "Sub" $ cmbnNCmt (-) 0 ltrSym +    buildValidM (Node Sym.Number ltrSym) = cnstInt "Number" $ cmbnFast (\nA chB -> (10 * nA) + (toInteger ((Ch.ord chB) - 48))) 0 ltrSym 
-    buildValidM (Node Mul ltrSym) = cnstInt "Mul" $ cmbnFast (*) 1 ltrSym +    buildValidM (Node Sym.Add ltrSym) = cnstInt "Add" $ cmbnFast (+) 0 ltrSym 
-    buildValidM (Node Div ltrSym) = cnstInt "Div" $ cmbnNCmt (div) 1 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 _")     buildValidM _ = Error (ErrSymTree "instance Builder Integer" "buildValidM _")
  
 cnstInt :: String -> (Construction Integer) -> (Construction Integer) cnstInt :: String -> (Construction Integer) -> (Construction Integer)
-cnstInt sCase g = constraint (<= 4294967295) sCase "smaller than 2^32-1" g+cnstInt sCase g = constraint (\n -> (n >= 0) && (n <= 4294967295)) sCase "between 0 and 2^32-1" g
  
 instance Builder String where instance Builder String where
     buildValidDflt = ""     buildValidDflt = ""
-    buildValidM (Node Number ltrSym) = Contains [ch | (Contains ch) <- (map buildValidM ltrSym) ]+    buildValidM (Node Sym.ConstName ltrSym) = cnstConstName $ cmbnNCmt (\(Simply chA) sB -> chA : sB) [] ltrSym
     buildValidM _ = Error (ErrSymTree "instance Builder String" "buildValidM _")     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 instance Builder Char where
     buildValidDflt = ' '     buildValidDflt = ' '
-    buildValidM (Node (Terminal ch) _) = Contains ch+    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 _")     buildValidM _ = Error (ErrSymTree "instance Builder Char" "buildValidM _")
 </code> </code>
Line 125: Line 159:
     Construction(..),      Construction(..), 
     ErrorKind(..),      ErrorKind(..), 
 +    SimpleContainer(..), 
     String',      String', 
 +    Char', 
     -- * Functions     -- * Functions
-    fOpFromSymTree,  
-    fOpFlippedFromSymTree,  
     cmbnNCmt,      cmbnNCmt, 
-    cmbnFast+    cmbnFast,  
 +    buildValidMChar'
     ) where     ) where
  
Line 139: Line 174:
 --  Basic types --  Basic types
  
-data Symbol = Add | Sub | Mul | Div | Number | Terminal Char+data Symbol = ConstDef | ConstName | ConstExpression | Add | Sub | Mul | Div | Number | DecDigit | Terminal Char
     deriving Show     deriving Show
  
Line 186: Line 221:
  
 -------------------------------------------------------------------------------- --------------------------------------------------------------------------------
---  'Builder' instance String'+--  'Builder' instance for String' and Char'
  
-type String' = SimpleContainer String +newtype SimpleContainer a = Simply { rSimply :: a }
- +
-newtype SimpleContainer a = Simply a+
     deriving Show     deriving Show
 +
 +fromSimple :: (Construction (SimpleContainer a)) -> (Construction a)
 +fromSimple (Contains (Simply x)) = Contains x
 +fromSimple (Error x) = Error x
 +
 +type String' = SimpleContainer String
  
 instance Builder (SimpleContainer String) where instance Builder (SimpleContainer String) where
     buildValidDflt = (Simply "")     buildValidDflt = (Simply "")
     buildValidM (Node (Terminal ch) _) = Contains (Simply [ch])     buildValidM (Node (Terminal ch) _) = Contains (Simply [ch])
-    buildValidM (Node _ ltrSym) = (cmbnFast (liftSimply (++)) (Simply "") ltrSym)+    buildValidM (Node _ ltrSym) = (cmbnNCmt (liftSimply (++)) (Simply "") ltrSym)
  
 liftSimply :: (a -> a -> a) -> (SimpleContainer a) -> (SimpleContainer a) -> (SimpleContainer a) liftSimply :: (a -> a -> a) -> (SimpleContainer a) -> (SimpleContainer a) -> (SimpleContainer a)
 liftSimply f (Simply xA) (Simply xB) = Simply (f xA xB) liftSimply f (Simply xA) (Simply xB) = Simply (f xA xB)
 +
 +type Char' = SimpleContainer Char
 +
 +instance Builder (SimpleContainer Char) where
 +    buildValidDflt = (Simply ' ')
 +    buildValidM (Node (Terminal ch) _) = Contains (Simply ch)
 +    buildValidM _ = Error (ErrSymTree "instance Builder Char'" "buildValidM _")
 +
 +buildValidMChar' :: SymbolTree -> (Construction Char)
 +buildValidMChar' trSym = fromSimple (buildValidM trSym)
  
 -------------------------------------------------------------------------------- --------------------------------------------------------------------------------
 --  Helper functions for type class 'Builder' --  Helper functions for type class 'Builder'
  
-fOpFromSymTree :: (Builder g) => (g -> g -> g) -> (SymbolTree -> g -> Construction g) +fLOpFromSymTree :: (Builder g, Builder a) => (g -> a -> g) -> g -> SymbolTree -> Construction g 
-fOpFromSymTree fOp trSymA nB = +fLOpFromSymTree fOp nA trSymB = 
     do     do
-        nA <- buildValidM trSymA +        chB <- buildValidM trSymB 
-        return (fOp nA nB);+        return (fOp nA chB)
  
-fOpFlippedFromSymTree :: (Builder g) => (g -> g -> g) -> (g -> SymbolTree -> Construction g) +fROpFromSymTree :: (Builder g, Builder a) => (a -> g -> g) -> SymbolTree -> g -> Construction g 
-fOpFlippedFromSymTree fOp nA trSymB = +fROpFromSymTree fOp trSymA nB = 
     do     do
-        nB <- buildValidM trSymB +        chA <- buildValidM trSymA 
-        return (fOp nB nA);+        return (fOp chA nB)
  
-cmbnNCmt :: (Builder g) => (g -> g -> g) -> g -> [SymbolTree] -> Construction g +cmbnNCmt :: (Builder g, Builder a) => (a -> g -> g) -> g -> [SymbolTree] -> Construction g 
-cmbnNCmt fOp identity ltrSym = Fld.foldrM (fOpFromSymTree fOp) identity ltrSym+cmbnNCmt fOp identity ltrSym = Fld.foldrM (fROpFromSymTree fOp) identity ltrSym
  
-cmbnFast :: (Builder g) => (g -> g -> g) -> g -> [SymbolTree] -> Construction g +cmbnFast :: (Builder g, Builder a) => (g -> a -> g) -> g -> [SymbolTree] -> Construction g 
-cmbnFast fOp identity ltrSym = Fld.foldlM (fOpFlippedFromSymTree fOp) identity ltrSym+cmbnFast fOp identity ltrSym = Fld.foldlM (fLOpFromSymTree fOp) identity ltrSym
 </code> </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~~
codesnippets/datastructuresfromsymboltrees.1618247315.txt.gz · Last modified: (external edit)
Except where otherwise noted, content on this wiki is licensed under the following license: CC0 1.0 Universal
CC0 1.0 Universal Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki