diff --git a/.gitignore b/.gitignore index e70de9f..cea345a 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,2 @@ -/.stack-work/ \ No newline at end of file +/.stack-work/ +/ohua-show.cabal diff --git a/src/Main.hs b/src/Main.hs index e31cc78..2ad8443 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell, LambdaCase, RecordWildCards, - TypeFamilies #-} + TypeFamilies, TupleSections, TypeApplications #-} module Main where import qualified Ohua.DFGraph as G @@ -19,6 +19,7 @@ import Data.List (intercalate) import Ohua.Types import Ohua.Serialize.JSON () import qualified Data.ByteString.Lazy as BS +import qualified Ohua.Types as OT -- This is a hack. Right now the `GraphFile` data structure is defined only in @@ -30,18 +31,31 @@ A.deriveFromJSON A.defaultOptions ''P ohuaGrToDot :: G.OutGraph -> PG.Gr String String ohuaGrToDot G.OutGraph {..} = - PG.mkGraph ((envNode, "env") : map opToNode operators) (map arcToEdge arcs) + PG.mkGraph + ((envNode, "From Environment") : (litNode, "Literals") : map opToNode operators) + (map (arcToEdge targetToInfo) (G.direct arcs) <> + map (arcToEdge ((, "state") . unwrap)) (G.state arcs)) where envNode = succ $ maximum (map (unwrap . G.operatorId) operators) + litNode = succ envNode opToNode G.Operator {..} = (unwrap operatorId, show operatorType) - arcToEdge G.Arc {..} = (sOp, tOp, printf "%d -> %d" sIdx tIdx :: String) + targetToInfo G.Target {..} = (unwrap operator, show index) + + arcToEdge :: (target -> (Int, String)) -> G.Arc target (G.Source OT.Lit) -> (Int, Int, String) + arcToEdge targetToInfo' G.Arc {..} = + (sOp, tOp, printf "%v -> %v" sIdx tIdx :: String) where (sOp, sIdx) = case source of G.LocalSource t -> targetToInfo t - G.EnvSource e -> (envNode, unwrap e) - (tOp, tIdx) = targetToInfo target - targetToInfo G.Target {..} = (unwrap operator, index) + G.EnvSource (OT.EnvRefLit l) -> (envNode, show l) + G.EnvSource e -> (litNode, case e of + OT.NumericLit n -> show n + OT.UnitLit -> "()" + OT.FunRefLit _f -> "" + OT.EnvRefLit _ -> error "impossible" + ) + (tOp, tIdx) = targetToInfo' target printDot :: FilePath -> PG.DotGraph PG.Node -> IO () printDot path = PG.writeFile path . PG.printDotGraph diff --git a/stack.yaml b/stack.yaml index cb06ea4..1117732 100644 --- a/stack.yaml +++ b/stack.yaml @@ -18,7 +18,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: lts-10.10 +resolver: lts-12.06 # User packages to be built. # Various formats can be used as shown in the example below. @@ -37,7 +37,8 @@ packages: - . - location: git: https://github.com/ohua-dev/ohua-core - commit: 0865d3761a731bba8c838658b21519c358dca6a7 + commit: 83e989949ee31789f1c5c377a9e35d3473bb32e9 + subdirs: [core] extra-dep: true # Dependency packages to be pulled from upstream that are not in the resolver # using the same syntax as the packages field.