git.iko.soy/elk
on 60f4e71 help sign in
elk/src/Elm/Compiler/Objects/Internal.hs
146 lines 2.4 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 , mains
14 , value
15 , toGlobals
16 )
17 where
20import Prelude hiding (lookup)
21import Control.Arrow (first)
22import Control.Monad (liftM, liftM2)
23import Data.Binary
24import qualified Data.Map as Map
25import qualified Data.Text as Text
27import qualified AST.Expression.Optimized as Opt
28import qualified AST.Module.Name as ModuleName
29import qualified AST.Module as Module
30import qualified AST.Variable as Var
34-- OBJECT GRAPH
37newtype Graph =
38 Graph (Map.Map Var.Global Opt.Decl)
42-- OBJECT GRAPH HELPERS
45fromModule :: Module.Optimized -> Graph
46fromModule (Module.Module home info) =
47 Graph $ Map.fromList $
48 map (first (Var.Global home)) (Module.program info)
51union :: Graph -> Graph -> Graph
52union (Graph objs1) (Graph objs2) =
53 Graph (Map.union objs1 objs2)
56unions :: [Graph] -> Graph
57unions graphs =
58 Graph (Map.unions (map destruct graphs))
61destruct :: Graph -> Map.Map Var.Global Opt.Decl
62destruct (Graph graph) =
63 graph
67-- SYMBOLS
70newtype SymbolTable =
71 SymbolTable (Map.Map Var.Global Symbol)
74symbolTable :: Map.Map Var.Global Symbol -> SymbolTable
75symbolTable =
76 SymbolTable
79data Symbol =
80 Symbol
81 { _home :: !Word16
82 , _name :: !Word32
83 }
86lookup :: Var.Global -> SymbolTable -> Maybe Symbol
87lookup var (SymbolTable symbols) =
88 Map.lookup var symbols
92-- ROOTS
95data Roots
96 = Mains [ModuleName.Canonical]
97 | Value ModuleName.Canonical Text.Text
100mains :: [ModuleName.Canonical] -> Roots
101mains =
102 Mains
105value :: ModuleName.Canonical -> String -> Roots
106value home name =
107 Value home (Text.pack name)
110toGlobals :: Roots -> [Var.Global]
111toGlobals roots =
112 hiddenDependencies ++
113 case roots of
114 Mains modules ->
115 map (\home -> Var.Global home "main") modules
117 Value home name ->
118 [ Var.Global home name ]
121-- needed for (==) and toString
122hiddenDependencies :: [Var.Global]
123hiddenDependencies =
124 [ Var.Global (ModuleName.inCore "Dict") "toList"
125 , Var.Global (ModuleName.inCore "Set") "toList"
126 ]
130-- BINARY
133instance Binary Graph where
134 put (Graph dict) =
135 put dict
137 get =
138 liftM Graph get
141instance Binary Symbol where
142 put (Symbol home name) =
143 put home >> put name
145 get =
146 liftM2 Symbol get get