74 lines
2.1 KiB
Elm
74 lines
2.1 KiB
Elm
|
module SeqSim.Evaluator exposing (allOutcomes)
|
||
|
|
import SeqSim.Parser exposing (Prog, Source(..))
|
||
|
|
import Dict exposing (Dict, get, insert)
|
||
|
|
import Tuple exposing (first, second)
|
||
|
|
import List.Extra exposing (uniqueBy)
|
||
|
|
|
||
|
|
shuffle : List a -> List a -> List (List a)
|
||
|
|
shuffle l1 l2 =
|
||
|
|
case (l1, l2) of
|
||
|
|
([], _) -> [l2]
|
||
|
|
(_, []) -> [l1]
|
||
|
|
(x::xs, y::ys) ->
|
||
|
|
List.map ((::) x) (shuffle xs l2) ++
|
||
|
|
List.map ((::) y) (shuffle l1 ys)
|
||
|
|
|
||
|
|
shuffleAll : List (List a) -> List (List a)
|
||
|
|
shuffleAll l =
|
||
|
|
case l of
|
||
|
|
[] -> [[]]
|
||
|
|
(x::xs) -> List.concatMap (shuffle x) <| shuffleAll xs
|
||
|
|
|
||
|
|
type alias State = Dict String Int
|
||
|
|
type alias Evaluator a = State -> (a, State)
|
||
|
|
|
||
|
|
succeed : a -> Evaluator a
|
||
|
|
succeed a = \s -> (a, s)
|
||
|
|
|
||
|
|
andThen : (a -> Evaluator b) -> Evaluator a -> Evaluator b
|
||
|
|
andThen f e = \s -> let (a, ss) = e s in f a ss
|
||
|
|
|
||
|
|
map : (a -> b) -> Evaluator a -> Evaluator b
|
||
|
|
map f e = \s -> let (a, ss) = e s in (f a, ss)
|
||
|
|
|
||
|
|
run : Evaluator a -> State -> (a, State)
|
||
|
|
run e s = e s
|
||
|
|
|
||
|
|
getVar : String -> Evaluator Int
|
||
|
|
getVar x = \s -> (Maybe.withDefault 0 (Dict.get x s), s)
|
||
|
|
|
||
|
|
setVar : String -> Int -> Evaluator ()
|
||
|
|
setVar x v = \s -> ((), Dict.insert x v s)
|
||
|
|
|
||
|
|
mapM_ : (a -> Evaluator b) -> List a -> Evaluator ()
|
||
|
|
mapM_ f l = map (\_ -> ()) <| mapM f l
|
||
|
|
|
||
|
|
mapM : (a -> Evaluator b) -> List a -> Evaluator (List b)
|
||
|
|
mapM f l =
|
||
|
|
case l of
|
||
|
|
[] -> succeed []
|
||
|
|
(x::xs) -> andThen (\b -> map ((::) b) <| mapM f xs) (f x)
|
||
|
|
|
||
|
|
evalSource : Source -> Evaluator Int
|
||
|
|
evalSource s =
|
||
|
|
case s of
|
||
|
|
Var x -> getVar x
|
||
|
|
Const i -> succeed i
|
||
|
|
|
||
|
|
evalCmd : (String, Source) -> Evaluator ()
|
||
|
|
evalCmd (x, s) = evalSource s |> andThen (setVar x)
|
||
|
|
|
||
|
|
evalProg : Prog -> Evaluator ()
|
||
|
|
evalProg = mapM_ evalCmd
|
||
|
|
|
||
|
|
runShuffled : List String -> List Prog -> List (Prog, List Int)
|
||
|
|
runShuffled xs ps =
|
||
|
|
let
|
||
|
|
getVars = mapM getVar xs
|
||
|
|
runProg p = (p, first <| run (evalProg p |> andThen (\_ -> getVars)) Dict.empty)
|
||
|
|
in
|
||
|
|
List.map runProg <| shuffleAll ps
|
||
|
|
|
||
|
|
allOutcomes : List String -> List Prog -> List (Prog, List Int)
|
||
|
|
allOutcomes xs ps = uniqueBy second <| runShuffled xs ps
|