Commit 7a50111b130ef589e956251b781c53c519a87c52 - Fountain

Make Store store Values. Chris Pressey 1 year, 3 months ago

4 changed file(s) with 21 addition(s) and 12 deletion(s). Raw diff Collapse all Expand all

-1

src/Language/Fountain/Generator.hs less more

1	1
2	2	import Data.Maybe (mapMaybe)
3	3
	4	import Language.Fountain.Value
4	5	import Language.Fountain.Store
5	6	import Language.Fountain.Constraint
6	7	import Language.Fountain.Grammar
7	8
8	9
9		data GenState = Generating String (Store Integer)
	10	data GenState = Generating String (Store Value)
10	11	\| Failure
11	12	deriving (Show, Ord, Eq)
12	13

-1

src/Language/Fountain/Parser.hs less more

1	1
2	2	import Data.Maybe (mapMaybe)
3	3
	4	import Language.Fountain.Value
4	5	import Language.Fountain.Store
5	6	import Language.Fountain.Constraint
6	7	import Language.Fountain.Grammar
7	8
8	9
9		data ParseState = Parsing String (Store Integer)
	10	data ParseState = Parsing String (Store Value)
10	11	\| Failure
11	12	deriving (Show, Ord, Eq)
12	13

+13

-10

src/Language/Fountain/Store.hs less more

11	11
12	12	import qualified Data.Map as Map
13	13
	14	import Language.Fountain.Value
14	15	import Language.Fountain.Constraint
15	16	import Language.Fountain.Loader (parseConstConstraint)
16	17

26	27	update f k s = s{ store=Map.update f k $ store s }
27	28
28	29
29		constructStore :: [String] -> Store Integer
	30	constructStore :: [String] -> Store Value
30	31	constructStore [] = empty
31	32	constructStore (constConstrainer:rest) =
32	33	let
33	34	(k, v) = parseConstConstraint constConstrainer
34	35	in
35		insert k v $ constructStore rest
	36	insert k (IntVal v) $ constructStore rest
36	37
37	38	updateStore :: [Variable] -> [Variable] -> Store a -> Store a -> Store a
38	39	updateStore [] [] _sourceStore destStore = destStore

47	48	in
48	49	updateStore sourceKeys destKeys sourceStore destStore'
49	50
50		ceval :: CExpr -> Store Integer -> Maybe Integer
	51	ceval :: CExpr -> Store Value -> Maybe Integer
51	52	ceval (CInt i) _ = Just i
52		ceval (CVar v) st = fetch v st
	53	ceval (CVar v) st = case fetch v st of
	54	Just (IntVal i) -> Just i
	55	_ -> Nothing
53	56
54		applyConstraint :: Constraint -> Store Integer -> Maybe (Store Integer)
	57	applyConstraint :: Constraint -> Store Value -> Maybe (Store Value)
55	58	applyConstraint (UnifyConst v i) st =
56	59	case fetch v st of
57		Just value ->
	60	Just (IntVal value) ->
58	61	if value == i then Just st else Nothing
59	62	Nothing ->
60		Just $ insert v i st
	63	Just $ insert v (IntVal i) st
61	64	applyConstraint (UnifyVar v w) st =
62	65	case (fetch v st, fetch w st) of
63	66	(Just vValue, Just wValue) ->

71	74	applyConstraint (Inc v e) st =
72	75	case ceval e st of
73	76	Just delta ->
74		Just $ update (\i -> Just (i + delta)) v st
	77	Just $ update (\(IntVal i) -> Just $ IntVal $ i + delta) v st
75	78	Nothing ->
76	79	Nothing
77	80	applyConstraint (Dec v e) st =
78	81	case ceval e st of
79	82	Just delta ->
80		Just $ update (\i -> Just (i - delta)) v st
	83	Just $ update (\(IntVal i) -> Just $ IntVal $ i - delta) v st
81	84	Nothing ->
82	85	Nothing
83	86	applyConstraint (Both c1 c2) st =

94	97
95	98	applyRelConstraint op v e st =
96	99	case (fetch v st, ceval e st) of
97		(Just value, Just target) ->
	100	(Just (IntVal value), Just target) ->
98	101	if value `op` target then Just st else Nothing
99	102	_ ->
100	103	Nothing

-0

src/Language/Fountain/Value.hs less more

	0	module Language.Fountain.Value where
	1
	2	data Value = IntVal Integer
	3	deriving (Show, Ord, Eq)