Output.hs 3.16 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
{-# LANGUAGE GADTs #-}

module Output (buildWTA) where

import qualified Data.Vector                   as V
import           Data.Vector                    ( Vector )
import           Data.Text.Lazy.Builder         ( Builder )
import qualified Data.Text.Lazy.Builder        as Build
import qualified Data.Text.Lazy.Builder.Int    as Build
import           Data.Foldable
import           Data.List
import           Data.String
import           Data.Maybe

import           Types

Hans-Peter Deifel's avatar
Hans-Peter Deifel committed
17
wtaFunctor :: WTASpec m -> Builder
18 19 20 21
wtaFunctor wta = monoidForStates (monoid wta) <> " × " <> withMonoidForWeights
  (monoid wta)
  (polynomial (numSymbols wta))

Hans-Peter Deifel's avatar
Hans-Peter Deifel committed
22
monoidForStates :: MonoidType m -> Builder
23 24 25 26
monoidForStates MaxInt   = "Z"
monoidForStates OrWord   = "N"
monoidForStates Powerset = "2"

27
withMonoidForWeights :: MonoidType m -> Builder -> Builder
28
withMonoidForWeights MaxInt   inner = "(Z, max)^(" <> inner <> ")"
29
withMonoidForWeights OrWord   inner = "(Word, or)^(" <> inner <> ")"
30 31 32 33 34 35 36 37
withMonoidForWeights Powerset inner = "P(" <> inner <> ")"

polynomial :: SymbolSpec -> Builder
polynomial = sepList " + " id . catMaybes . toList . V.imap summand
  where
    summand :: Int -> Int -> Maybe Builder
    summand arity 0    = Nothing
    summand 0     syms = Just (Build.decimal syms)
Hans-Peter Deifel's avatar
Hans-Peter Deifel committed
38 39
    summand arity syms =
      Just $ fold (intersperse "×" (Build.decimal syms : replicate arity "X"))
40 41 42 43

data ValueUse = Weight | StateVal

buildValue :: ValueUse -> MonoidType m -> m -> Builder
Hans-Peter Deifel's avatar
Hans-Peter Deifel committed
44
buildValue _      MaxInt   i = Build.decimal i
45
buildValue Weight OrWord   w = "0x" <> Build.hexadecimal w
Hans-Peter Deifel's avatar
Hans-Peter Deifel committed
46 47
buildValue StateVal OrWord w = Build.decimal w
buildValue _      Powerset b = if b then "1" else "0"
48 49 50 51 52 53 54 55 56 57 58 59

buildTransition :: MonoidType m -> Transition m -> Builder
buildTransition mon trans =
  "inj"
    <> Build.decimal (summand trans)
    <> " "
    <> buildSuccs (successors trans)
    <> buildWeight mon (weight trans)

  where
    buildSuccs succs = if V.null succs
      then Build.decimal (symbol trans)
Hans-Peter Deifel's avatar
Hans-Peter Deifel committed
60 61 62 63 64 65
      else
        "("
        <> Build.decimal (symbol trans)
        <> ", "
        <> sepList ", " buildStateName (successors trans)
        <> ")"
66 67 68 69 70 71 72 73 74 75 76

buildWeight :: MonoidType m -> m -> Builder
buildWeight Powerset _   = ""
buildWeight mon      val = ": " <> buildValue Weight mon val

buildTransitions :: MonoidType m -> Vector (Transition m) -> Builder
buildTransitions mon trans =
  "{ " <> sepList ", " (buildTransition mon) trans <> " }"

buildState :: WTASpec m -> (Int, m, Vector (Transition m)) -> Builder
buildState wtaSpec (state, value, trans) =
Hans-Peter Deifel's avatar
Hans-Peter Deifel committed
77
  buildStateName (State state)
78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
    <> ": ("
    <> buildValue StateVal (monoid wtaSpec) value
    <> ", "
    <> buildTransitions (monoid wtaSpec) trans
    <> ")\n"

buildStateName :: State -> Builder
buildStateName = ("s" <>) . Build.decimal

buildStates :: WTA m -> Builder
buildStates wta = foldMap
  (buildState (spec wta))
  (V.zip3 (V.fromList indices) (stateValue wta) (stateTransitions wta))
  where indices = [0 .. V.length (stateValue wta) - 1]

buildWTA :: WTA m -> Builder
Hans-Peter Deifel's avatar
Hans-Peter Deifel committed
94
buildWTA a = wtaFunctor (spec a) <> "\n" <> buildStates a
95 96 97 98 99 100


-- helpers

sepList :: (Foldable f, Monoid m, IsString m) => m -> (a -> m) -> f a -> m
sepList m action = fold . intersperse m . map action . toList