{- gulcii -- graphical untyped lambda calculus interpreter Copyright (C) 2011, 2013, 2017 Claude Heiland-Allen This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. -} module Layout (Term(..), Coords, Layout(..), layout, coordinates, Counts(..), counts) where import qualified Data.Map.Strict as M import Data.Map.Strict (Map) import qualified Graph as G import Evaluation (Strategy(..)) type Coords = (Integer, Integer) data Term = Free String Coords | Bound0 Coords | Scope Term Coords | Lambda Strategy Term Coords | Apply Term Term Coords | RefInst Integer Term Coords | Reference Integer Coords deriving (Read, Show, Eq, Ord) data Layout = Layout Term Integer Integer (Map Integer Coords) deriving (Read, Show, Eq, Ord) coordinates :: Term -> Coords coordinates (Free _ xy) = xy coordinates (Bound0 xy) = xy coordinates (Scope _ xy) = xy coordinates (Lambda _ _ xy) = xy coordinates (Apply _ _ xy) = xy coordinates (RefInst _ _ xy) = xy coordinates (Reference _ xy) = xy layout :: G.Term -> G.References -> Layout layout = layout' (0, 0) M.empty layout' :: Coords -> Map Integer Coords -> G.Term -> G.References -> Layout layout' xy ps (G.Free v) _ = Layout (Free v xy) 1 1 ps layout' xy ps (G.Bound0) _ = Layout (Bound0 xy) 1 1 ps layout' (x, y) ps (G.Scope t) g = let Layout lt w h ps' = layout' (x, y + 1) ps t g (px, _) = coordinates lt in Layout (Scope lt (px, y)) w (h + 1) ps' layout' (x,y) ps (G.Lambda k t) g = let Layout lt w h ps' = layout' (x, y + 1) ps t g (px, _) = coordinates lt in Layout (Lambda k lt (px, y)) w (h + 1) ps' layout' (x,y) ps (G.Apply a b) g = let Layout la aw ah psa = layout' (x, y + 1) ps a g Layout lb bw bh psb = layout' (x + aw + 1, y + 1) psa b g in Layout (Apply la lb (x + aw, y)) (1 + aw + bw) (1 + (ah `max` bh)) psb layout' xy@(x,y) ps (G.Reference p) g = if p `M.member` ps then Layout (Reference p xy) 1 1 ps else case M.lookup p g of Nothing -> error $ "layout': bad pointer: " ++ show p Just t -> let Layout lt w h pst = layout' (x, y + 1) ps t g (px, py) = coordinates lt in Layout (RefInst p lt (px, y)) w (1 + h) (M.insert p (px, py) pst) data Counts = Counts { nFree, nBound0, nScope, nLambda, nApply, nRefInst, nReference :: !Int } instance Monoid Counts where mempty = Counts 0 0 0 0 0 0 0 mappend c d = Counts { nFree = nFree c + nFree d , nBound0 = nBound0 c + nBound0 d , nScope = nScope c + nScope d , nLambda = nLambda c + nLambda d , nApply = nApply c + nApply d , nRefInst = nRefInst c + nRefInst d , nReference = nReference c + nReference d } counts :: Term -> Counts counts (Free _ _) = mempty{ nFree = 1 } counts (Bound0 _) = mempty{ nBound0 = 1 } counts (Scope t _) = let c = counts t in c{ nScope = nScope c + 1 } counts (Lambda _ t _) = let c = counts t in c{ nLambda = nLambda c + 1 } counts (Apply a b _) = let c = counts a ; d = counts b in mappend c d counts (RefInst _ t _) = let c = counts t in c{ nRefInst = nRefInst c + 1 } counts (Reference _ _) = mempty{ nReference = 1 }