git.iko.soy/elk
on e00a3f3 help sign in
elk/src/Elm/Compiler/Objects/Internal.hs
104 lines 1.8 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Elm.Compiler.Objects.Internal
4 ( Graph(..)
5 , fromModule
6 , union
7 , unions
8 , Roots
9 , mains
10 , value
11 , toGlobals
12 )
13 where
16import Prelude hiding (lookup)
17import Control.Arrow (first)
18import Control.Monad (liftM2)
19import Data.Binary
20import qualified Data.Map as Map
21import qualified Data.Text as Text
23import qualified AST.Expression.Optimized as Opt
24import qualified AST.Kernel as Kernel
25import qualified AST.Module.Name as ModuleName
26import qualified AST.Module as Module
27import qualified AST.Variable as Var
31-- OBJECT GRAPH
34data Graph =
35 Graph
36 { _decls :: Map.Map Var.Global Opt.Decl
37 , _kernels :: Map.Map ModuleName.Raw Kernel.Info
38 }
42-- OBJECT GRAPH HELPERS
45fromModule :: Module.Optimized -> Graph
46fromModule (Module.Module home info) =
47 let
48 decls =
49 Map.fromList $ map (first (Var.Global home)) (Module.program info)
50 in
51 Graph decls Map.empty
54union :: Graph -> Graph -> Graph
55union (Graph decls1 kernels1) (Graph decls2 kernels2) =
56 Graph (Map.union decls1 decls2) (Map.union kernels1 kernels2)
59unions :: [Graph] -> Graph
60unions graphs =
61 Graph
62 (Map.unions (map _decls graphs))
63 (Map.unions (map _kernels graphs))
67-- ROOTS
70data Roots
71 = Mains [ModuleName.Canonical]
72 | Value ModuleName.Canonical Text.Text
75mains :: [ModuleName.Canonical] -> Roots
76mains =
77 Mains
80value :: ModuleName.Canonical -> String -> Roots
81value home name =
82 Value home (Text.pack name)
85toGlobals :: Roots -> [Var.Global]
86toGlobals roots =
87 case roots of
88 Mains modules ->
89 map (\home -> Var.Global home "main") modules
91 Value home name ->
92 [ Var.Global home name ]
96-- BINARY
99instance Binary Graph where
100 put (Graph decls kernels) =
101 put decls >> put kernels
103 get =
104 liftM2 Graph get get