git.iko.soy/elk
on 441aeba help sign in
elk/src/Elm/Compiler/Objects/Internal.hs
127 lines 2.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Elm.Compiler.Objects.Internal
4 ( Graph(..)
5 , fromModule
6 , union
7 , unions
8 , SymbolTable
9 , symbolTable
10 , Symbol(..)
11 , lookup
12 , Roots
13 , root
14 , toGlobals
15 )
16 where
19import Prelude hiding (lookup)
20import Control.Arrow (first)
21import Control.Monad (liftM, liftM2)
22import Data.Binary
23import qualified Data.Map as Map
25import qualified AST.Expression.Optimized as Opt
26import qualified AST.Module.Name as ModuleName
27import qualified AST.Module as Module
28import qualified AST.Variable as Var
29import qualified Elm.Package as Pkg
33-- OBJECT GRAPH
36newtype Graph =
37 Graph (Map.Map Var.Global Opt.Decl)
41-- OBJECT GRAPH HELPERS
44fromModule :: Module.Optimized -> Graph
45fromModule (Module.Module home info) =
46 Graph $ Map.fromList $
47 map (first (Var.Global home)) (Module.program info)
50union :: Graph -> Graph -> Graph
51union (Graph objs1) (Graph objs2) =
52 Graph (Map.union objs1 objs2)
55unions :: [Graph] -> Graph
56unions graphs =
57 Graph (Map.unions (map destruct graphs))
60destruct :: Graph -> Map.Map Var.Global Opt.Decl
61destruct (Graph graph) =
62 graph
66-- SYMBOLS
69newtype SymbolTable =
70 SymbolTable (Map.Map Var.Global Symbol)
73symbolTable :: Map.Map Var.Global Symbol -> SymbolTable
74symbolTable =
75 SymbolTable
78data Symbol =
79 Symbol
80 { _home :: !Word16
81 , _name :: !Word32
82 }
85lookup :: Var.Global -> SymbolTable -> Maybe Symbol
86lookup var (SymbolTable symbols) =
87 Map.lookup var symbols
91-- ROOTS
94data Roots
95 = Main ModuleName.Canonical
98root :: Pkg.Name -> ModuleName.Raw -> Roots
99root pkg name =
100 Main (ModuleName.Canonical pkg name)
103toGlobals :: Roots -> [Var.Global]
104toGlobals roots =
105 case roots of
106 Main home ->
107 [ Var.Global home "main" ]
111-- BINARY
114instance Binary Graph where
115 put (Graph dict) =
116 put dict
118 get =
119 liftM Graph get
122instance Binary Symbol where
123 put (Symbol home name) =
124 put home >> put name
126 get =
127 liftM2 Symbol get get