{-# LANGUAGE OverloadedStrings #-}
module Funcons.Printer (
ppFuncons, ppValues, ppTypes, ppTerms,
showValues, showFuncons, showTypes, showSorts, showTerms, showOp,
showValuesSeq, ppValuesSeq, showFunconsSeq, ppFunconsSeq,
) where
import Funcons.Types
import Funcons.RunOptions
import Data.List (intercalate)
import Data.Text (unpack)
showValues :: Values -> String
showValues = ppValues showFuncons
showValuesSeq :: [Values] -> String
showValuesSeq = ppValuesSeq defaultRunOptions
showOp :: SeqSortOp -> String
showOp = ppOp
ppValuesSeq :: RunOptions -> [Values] -> String
ppValuesSeq opts = showArgs opts False . map FValue
showFuncons :: Funcons -> String
showFuncons = ppFuncons defaultRunOptions
showFunconsSeq :: [Funcons] -> String
showFunconsSeq = ppFunconsSeq defaultRunOptions
ppFunconsSeq :: RunOptions -> [Funcons] -> String
ppFunconsSeq opts = showArgs opts False
showTypes :: Types -> String
showTypes = ppTypes showFuncons
showSorts :: ComputationTypes -> String
showSorts = ppComputationTypes showFuncons
showTerms :: FTerm -> String
showTerms = ppTerms defaultRunOptions
ppFuncons :: RunOptions -> Funcons -> String
ppFuncons opts (FApp "list" fs) = "[" ++ showArgs opts False fs ++ "]"
ppFuncons opts (FSet fs) = "{" ++ showArgs opts False fs ++ "}"
ppFuncons opts (FMap fs) =
"{" ++ intercalate "," (map toKeyFValue $ mkPairs fs) ++ "}"
where toKeyFValue (k,v) = ppFuncons opts k ++ " |-> " ++ ppFuncons opts v
ppFuncons opts (FValue v) = ppValues (ppFuncons opts) v
ppFuncons opts (FName nm) = unpack nm
ppFuncons opts (FSortSeq f o) = ppFuncons opts f ++ ppOp o
ppFuncons opts (FSortPower f1 f2) = ppFuncons opts f1 ++ "^" ++ ppFuncons opts f2
ppFuncons opts (FSortUnion f1 f2) = "(" ++ ppFuncons opts f1 ++ "|" ++ ppFuncons opts f2 ++ ")"
ppFuncons opts (FSortInter f1 f2) = "(" ++ ppFuncons opts f1 ++ "&" ++ ppFuncons opts f2 ++ ")"
ppFuncons opts (FSortComplement f1) = "~("++ ppFuncons opts f1 ++ ")"
ppFuncons opts (FSortComputes f) = "=>" ++ ppFuncons opts f
ppFuncons opts (FSortComputesFrom s t) = ppFuncons opts s ++ "=>" ++ ppFuncons opts t
ppFuncons opts (FApp "closure" [x, y]) =
let env | pp_full_environments opts = y
| otherwise = string_ "..."
in showFn opts "closure" [x, env]
ppFuncons opts (FApp "scope" [x, y]) =
let env | Prelude.not (pp_full_environments opts) && isMap x = string_ "..."
| otherwise = x
in showFn opts "scope" [env, y]
ppFuncons opts (FApp nm fs) = unpack nm ++ showArgs opts True fs
showFn :: RunOptions -> String -> [Funcons] -> String
showFn opts n xs = n ++ showArgs opts True xs
showArgs :: RunOptions -> Bool -> [Funcons] -> String
showArgs opts b args | b = "(" ++ seq ++ ")"
| otherwise = seq
where seq = intercalate "," (map (ppFuncons opts) args)
ppTerms :: RunOptions -> FTerm -> String
ppTerms opts (TApp "list" ts) = "[" ++ intercalate "," (map (ppTerms opts) ts) ++ "]"
ppTerms opts (TApp nm ts) = unpack nm ++ "(" ++ intercalate "," (map (ppTerms opts) ts) ++ ")"
ppTerms opts (TName nm) = unpack nm
ppTerms opts (TVar var) = var
ppTerms opts (TSeq ts) = "(" ++ intercalate "," (map (ppTerms opts) ts) ++ ")"
ppTerms opts (TSet ts) = "{" ++ intercalate "," (map (ppTerms opts) ts) ++ "}"
ppTerms opts (TMap ts) = "map" ++ ("(" ++ intercalate "," (map (ppTerms opts) ts) ++ ")")
ppTerms opts (TSortSeq term op) = ppTerms opts term ++ ppOp op
ppTerms opts (TSortPower t1 t2) = ppTerms opts t1 ++ "^" ++ ppTerms opts t2
ppTerms opts (TSortUnion t1 t2) = ppTerms opts t1 ++ "|" ++ show t2
ppTerms opts (TSortInter t1 t2) = ppTerms opts t1 ++ "&" ++ show t2
ppTerms opts (TSortComplement t1) = "~(" ++ ppTerms opts t1 ++ ")"
ppTerms opts (TSortComputes to) = "=>" ++ ppTerms opts to
ppTerms opts (TSortComputesFrom from to) = ppTerms opts from ++ "=>" ++ ppTerms opts to
ppTerms opts (TFuncon f) = ppFuncons opts f
ppTerms opts TAny = "_"