diff --git a/src/Language/Fountain/Generator.hs b/src/Language/Fountain/Generator.hs index 038a5f9..0d430b3 100644 --- a/src/Language/Fountain/Generator.hs +++ b/src/Language/Fountain/Generator.hs @@ -2,12 +2,13 @@ import Data.Maybe (mapMaybe) +import Language.Fountain.Value import Language.Fountain.Store import Language.Fountain.Constraint import Language.Fountain.Grammar -data GenState = Generating String (Store Integer) +data GenState = Generating String (Store Value) | Failure deriving (Show, Ord, Eq) diff --git a/src/Language/Fountain/Parser.hs b/src/Language/Fountain/Parser.hs index 1ad94e7..4207342 100644 --- a/src/Language/Fountain/Parser.hs +++ b/src/Language/Fountain/Parser.hs @@ -2,12 +2,13 @@ import Data.Maybe (mapMaybe) +import Language.Fountain.Value import Language.Fountain.Store import Language.Fountain.Constraint import Language.Fountain.Grammar -data ParseState = Parsing String (Store Integer) +data ParseState = Parsing String (Store Value) | Failure deriving (Show, Ord, Eq) diff --git a/src/Language/Fountain/Store.hs b/src/Language/Fountain/Store.hs index 0d968cc..146bc86 100644 --- a/src/Language/Fountain/Store.hs +++ b/src/Language/Fountain/Store.hs @@ -12,6 +12,7 @@ import qualified Data.Map as Map +import Language.Fountain.Value import Language.Fountain.Constraint import Language.Fountain.Loader (parseConstConstraint) @@ -27,13 +28,13 @@ update f k s = s{ store=Map.update f k $ store s } -constructStore :: [String] -> Store Integer +constructStore :: [String] -> Store Value constructStore [] = empty constructStore (constConstrainer:rest) = let (k, v) = parseConstConstraint constConstrainer in - insert k v $ constructStore rest + insert k (IntVal v) $ constructStore rest updateStore :: [Variable] -> [Variable] -> Store a -> Store a -> Store a updateStore [] [] _sourceStore destStore = destStore @@ -48,17 +49,19 @@ in updateStore sourceKeys destKeys sourceStore destStore' -ceval :: CExpr -> Store Integer -> Maybe Integer +ceval :: CExpr -> Store Value -> Maybe Integer ceval (CInt i) _ = Just i -ceval (CVar v) st = fetch v st +ceval (CVar v) st = case fetch v st of + Just (IntVal i) -> Just i + _ -> Nothing -applyConstraint :: Constraint -> Store Integer -> Maybe (Store Integer) +applyConstraint :: Constraint -> Store Value -> Maybe (Store Value) applyConstraint (UnifyConst v i) st = case fetch v st of - Just value -> + Just (IntVal value) -> if value == i then Just st else Nothing Nothing -> - Just $ insert v i st + Just $ insert v (IntVal i) st applyConstraint (UnifyVar v w) st = case (fetch v st, fetch w st) of (Just vValue, Just wValue) -> @@ -72,13 +75,13 @@ applyConstraint (Inc v e) st = case ceval e st of Just delta -> - Just $ update (\i -> Just (i + delta)) v st + Just $ update (\(IntVal i) -> Just $ IntVal $ i + delta) v st Nothing -> Nothing applyConstraint (Dec v e) st = case ceval e st of Just delta -> - Just $ update (\i -> Just (i - delta)) v st + Just $ update (\(IntVal i) -> Just $ IntVal $ i - delta) v st Nothing -> Nothing applyConstraint (Both c1 c2) st = @@ -95,7 +98,7 @@ applyRelConstraint op v e st = case (fetch v st, ceval e st) of - (Just value, Just target) -> + (Just (IntVal value), Just target) -> if value `op` target then Just st else Nothing _ -> Nothing diff --git a/src/Language/Fountain/Value.hs b/src/Language/Fountain/Value.hs new file mode 100644 index 0000000..0c23b0c --- /dev/null +++ b/src/Language/Fountain/Value.hs @@ -0,0 +1,4 @@ +module Language.Fountain.Value where + +data Value = IntVal Integer + deriving (Show, Ord, Eq)