git.iko.soy/elk
on 9b0c310 help sign in
elk/src/Canonicalize/Environment.hs
106 lines 2.5 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Canonicalize.Environment where
4import qualified Data.List as List
5import qualified Data.Map as Map
6import qualified Data.Set as Set
8import AST.Expression.General (saveEnvName)
9import qualified AST.Module as Module
10import qualified AST.Pattern as P
11import qualified AST.Type as Type
12import qualified AST.Variable as Var
15-- ENVIRONMENT
17data Environment = Env
18 { _home :: Module.Name
19 , _values :: Dict Var.Canonical
20 , _adts :: Dict Var.Canonical
21 , _aliases :: Dict (Var.Canonical, [String], Type.Canonical)
22 , _patterns :: Dict (Var.Canonical, Int)
23 }
26type Dict a =
27 Map.Map String (Set.Set a)
30fromPatches :: Module.Name -> [Patch] -> Environment
31fromPatches moduleName patches =
32 addPatches
33 patches
34 (Env moduleName Map.empty Map.empty Map.empty Map.empty)
37addPattern :: P.Pattern ann var -> Environment -> Environment
38addPattern pattern env =
39 let patches =
40 map (\x -> Value x (Var.local x)) (P.boundVarList pattern)
41 in
42 addPatches patches env
45-- PATCHES
47data Patch
48 = Value String Var.Canonical
49 | Union String Var.Canonical
50 | Alias String (Var.Canonical, [String], Type.Canonical)
51 | Pattern String (Var.Canonical, Int)
54-- ADD PATCH TO ENVIRONMENT
56addPatches :: [Patch] -> Environment -> Environment
57addPatches patches env =
58 List.foldl' (flip addPatch) env patches
61addPatch :: Patch -> Environment -> Environment
62addPatch patch env =
63 case patch of
64 Value name var ->
65 env { _values = insert name var (_values env) }
67 Union name var ->
68 env { _adts = insert name var (_adts env) }
70 Alias name var ->
71 env { _aliases = insert name var (_aliases env) }
73 Pattern name var ->
74 env { _patterns = insert name var (_patterns env) }
77insert :: (Ord a) => String -> a -> Dict a -> Dict a
78insert key value =
79 Map.insertWith Set.union key (Set.singleton value)
82-- PATCH HELPERS
84builtinPatches :: [Patch]
85builtinPatches =
86 concat
87 [ map (patch Value) (tupleNames ++ [saveEnvName])
88 , map (patch Union) (tupleNames ++ ["List","Int","Float","Char","Bool","String"])
89 , map (patternPatch) (tuples ++ [ ("::", 2), ("[]", 0) ])
90 ]
91 where
92 patch mkPatch name =
93 mkPatch name (Var.builtin name)
95 patternPatch (name, args) =
96 Pattern name (Var.builtin name, args)
98 tupleNames =
99 map fst tuples
101 tuples =
102 map toTuple [0..9]
104 toTuple :: Int -> (String, Int)
105 toTuple n =
106 ("_Tuple" ++ show n, n)