Skip to content
This repository was archived by the owner on Apr 1, 2025. It is now read-only.

Commit 1e8a4ff

Browse files
robrixrobrix
committed
Replace Core with Term CoreF.
1 parent 1adc85d commit 1e8a4ff

File tree

8 files changed

+89
-123
lines changed

8 files changed

+89
-123
lines changed

‎semantic-core/src/Analysis/Concrete.hs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@ import Data.Loc
3030
import qualified Data.Map as Map
3131
import Data.Monoid (Alt(..))
3232
import Data.Name hiding (fresh)
33+
import Data.Term
3334
import Data.Text (Text, pack)
3435
import Prelude hiding (fail)
3536

@@ -40,7 +41,7 @@ newtype FrameId = FrameId { unFrameId :: Precise }
4041
deriving (Eq, Ord, Show)
4142

4243
data Concrete
43-
= Closure Loc Name (Core.Core Name) Precise
44+
= Closure Loc Name (Term Core.Core Name) Precise
4445
| Unit
4546
| Bool Bool
4647
| String Text
@@ -64,7 +65,7 @@ type Heap = IntMap.IntMap Concrete
6465
--
6566
-- >>> map fileBody (snd (concrete [File (Loc "bool" emptySpan) (Core.Bool True)]))
6667
-- [Right (Bool True)]
67-
concrete :: [File (Core.Core Name)] -> (Heap, [File (Either (Loc, String) Concrete)])
68+
concrete :: [File (Term Core.Core Name)] -> (Heap, [File (Either (Loc, String) Concrete)])
6869
concrete
6970
= run
7071
. runFresh
@@ -79,7 +80,7 @@ runFile :: ( Carrier sig m
7980
, Member (Reader FrameId) sig
8081
, Member (State Heap) sig
8182
)
82-
=> File (Core.Core Name)
83+
=> File (Term Core.Core Name)
8384
-> m (File (Either (Loc, String) Concrete))
8485
runFile file = traverse run file
8586
where run = runReader (fileLoc file)

‎semantic-core/src/Analysis/Eval.hs‎

Lines changed: 13 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -20,14 +20,15 @@ import Data.Functor
2020
import Data.Loc
2121
import Data.Maybe (fromJust)
2222
import Data.Name
23+
import Data.Term
2324
import Data.Text (Text)
2425
import GHC.Stack
2526
import Prelude hiding (fail)
2627

27-
eval :: (Carrier sig m, Member Naming sig, Member (Reader Loc) sig, MonadFail m) => Analysis address value m -> (Core Name -> m value) -> Core Name -> m value
28+
eval :: (Carrier sig m, Member Naming sig, Member (Reader Loc) sig, MonadFail m) => Analysis address value m -> (Term Core Name -> m value) -> Term Core Name -> m value
2829
eval Analysis{..} eval = \case
2930
Var n -> lookupEnv' n >>= deref' n
30-
Core c -> case c of
31+
Term c -> case c of
3132
Let n -> alloc (User n) >>= bind (User n) >> unit
3233
a :>> b -> eval a >> eval b
3334
Lam _ b -> do
@@ -63,7 +64,7 @@ eval Analysis{..} eval = \case
6364

6465
ref = \case
6566
Var n -> lookupEnv' n
66-
Core c -> case c of
67+
Term c -> case c of
6768
Let n -> do
6869
addr <- alloc (User n)
6970
addr <$ bind (User n) addr
@@ -77,7 +78,7 @@ eval Analysis{..} eval = \case
7778
c -> invalidRef (show c)
7879

7980

80-
prog1 :: File (Core User)
81+
prog1 :: File (Term Core User)
8182
prog1 = fromBody . lam' foo $ block
8283
[ let' bar .= pure foo
8384
, Core.if' (pure bar)
@@ -86,17 +87,17 @@ prog1 = fromBody . lam' foo $ block
8687
]
8788
where (foo, bar) = ("foo", "bar")
8889

89-
prog2 :: File (Core User)
90+
prog2 :: File (Term Core User)
9091
prog2 = fromBody $ fileBody prog1 $$ Core.bool True
9192

92-
prog3 :: File (Core User)
93+
prog3 :: File (Term Core User)
9394
prog3 = fromBody $ lams' [foo, bar, quux]
9495
(Core.if' (pure quux)
9596
(pure bar)
9697
(pure foo))
9798
where (foo, bar, quux) = ("foo", "bar", "quux")
9899

99-
prog4 :: File (Core User)
100+
prog4 :: File (Term Core User)
100101
prog4 = fromBody $ block
101102
[ let' foo .= Core.bool True
102103
, Core.if' (pure foo)
@@ -105,7 +106,7 @@ prog4 = fromBody $ block
105106
]
106107
where foo = "foo"
107108

108-
prog5 :: File (Core User)
109+
prog5 :: File (Term Core User)
109110
prog5 = fromBody $ block
110111
[ let' "mkPoint" .= lam' "_x" (lam' "_y" (block
111112
[ let' "x" .= pure "_x"
@@ -115,7 +116,7 @@ prog5 = fromBody $ block
115116
, pure "point" Core.... pure "y" .= pure "point" Core.... pure "x"
116117
]
117118

118-
prog6 :: [File (Core User)]
119+
prog6 :: [File (Term Core User)]
119120
prog6 =
120121
[ File (Loc "dep" (locSpan (fromJust here))) $ block
121122
[ let' "dep" .= Core.frame
@@ -129,7 +130,7 @@ prog6 =
129130
]
130131
]
131132

132-
ruby :: File (Core User)
133+
ruby :: File (Term Core User)
133134
ruby = fromBody . ann . block $
134135
[ ann (let' "Class" .= Core.frame)
135136
, ann (pure "Class" Core....
@@ -207,8 +208,8 @@ data Analysis address value m = Analysis
207208
, lookupEnv :: Name -> m (Maybe address)
208209
, deref :: address -> m (Maybe value)
209210
, assign :: address -> value -> m ()
210-
, abstract :: (Core Name -> m value) -> Name -> Core Name -> m value
211-
, apply :: (Core Name -> m value) -> value -> value -> m value
211+
, abstract :: (Term Core Name -> m value) -> Name -> Term Core Name -> m value
212+
, apply :: (Term Core Name -> m value) -> value -> value -> m value
212213
, unit :: m value
213214
, bool :: Bool -> m value
214215
, asBool :: value -> m Bool

‎semantic-core/src/Analysis/FlowInsensitive.hs‎

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -18,8 +18,9 @@ import qualified Data.Map as Map
1818
import Data.Maybe (fromMaybe)
1919
import Data.Monoid (Alt(..))
2020
import qualified Data.Set as Set
21+
import Data.Term (Term)
2122

22-
type Cache name a = Map.Map (Core.Core name) (Set.Set a)
23+
type Cache name a = Map.Map (Term Core.Core name) (Set.Set a)
2324
type Heap name a = Map.Map name (Set.Set a)
2425

2526
newtype FrameId name = FrameId { unFrameId :: name }
@@ -34,8 +35,8 @@ convergeTerm :: forall m sig a name
3435
, Ord a
3536
, Ord name
3637
)
37-
=> (Core.Core name -> NonDetC (ReaderC (Cache name a) (StateC (Cache name a) m)) a)
38-
-> Core.Core name
38+
=> (Term Core.Core name -> NonDetC (ReaderC (Cache name a) (StateC (Cache name a) m)) a)
39+
-> Term Core.Core name
3940
-> m (Set.Set a)
4041
convergeTerm eval body = do
4142
heap <- get
@@ -52,8 +53,8 @@ cacheTerm :: forall m sig a name
5253
, Ord a
5354
, Ord name
5455
)
55-
=> (Core.Core name -> m a)
56-
-> (Core.Core name -> m a)
56+
=> (Term Core.Core name -> m a)
57+
-> (Term Core.Core name -> m a)
5758
cacheTerm eval term = do
5859
cached <- gets (Map.lookup term)
5960
case cached :: Maybe (Set.Set a) of

‎semantic-core/src/Analysis/ImportGraph.hs‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ import qualified Data.Map as Map
2323
import Data.Name
2424
import qualified Data.Set as Set
2525
import Data.Stack
26+
import Data.Term
2627
import Data.Text (Text)
2728
import Prelude hiding (fail)
2829

@@ -41,14 +42,14 @@ instance Monoid Value where
4142
mempty = Value Abstract mempty
4243

4344
data Semi
44-
= Closure Loc Name (Core.Core Name) Name
45+
= Closure Loc Name (Term Core.Core Name) Name
4546
-- FIXME: Bound String values.
4647
| String Text
4748
| Abstract
4849
deriving (Eq, Ord, Show)
4950

5051

51-
importGraph :: [File (Core.Core Name)] -> (Heap Name Value, [File (Either (Loc, String) Value)])
52+
importGraph :: [File (Term Core.Core Name)] -> (Heap Name Value, [File (Either (Loc, String) Value)])
5253
importGraph
5354
= run
5455
. runFresh
@@ -63,7 +64,7 @@ runFile :: ( Carrier sig m
6364
, Member (Reader (FrameId Name)) sig
6465
, Member (State (Heap Name Value)) sig
6566
)
66-
=> File (Core.Core Name)
67+
=> File (Term Core.Core Name)
6768
-> m (File (Either (Loc, String) Value))
6869
runFile file = traverse run file
6970
where run = runReader (fileLoc file)

‎semantic-core/src/Analysis/Typecheck.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ import qualified Data.Map as Map
3232
import Data.Name as Name
3333
import qualified Data.Set as Set
3434
import Data.Stack
35+
import Data.Term
3536
import Prelude hiding (fail)
3637

3738
data Monotype a
@@ -102,7 +103,7 @@ substIn free bound = go 0
102103
go i (PRecord fs) = PRecord (go i <$> fs)
103104

104105

105-
typecheckingFlowInsensitive :: [File (Core.Core Name)] -> (Heap Name (Monotype Meta), [File (Either (Loc, String) Polytype)])
106+
typecheckingFlowInsensitive :: [File (Term Core.Core Name)] -> (Heap Name (Monotype Meta), [File (Either (Loc, String) Polytype)])
106107
typecheckingFlowInsensitive
107108
= run
108109
. runFresh
@@ -117,7 +118,7 @@ runFile :: ( Carrier sig m
117118
, Member Naming sig
118119
, Member (State (Heap Name (Monotype Meta))) sig
119120
)
120-
=> File (Core.Core Name)
121+
=> File (Term Core.Core Name)
121122
-> m (File (Either (Loc, String) (Monotype Meta)))
122123
runFile file = traverse run file
123124
where run

0 commit comments

Comments
 (0)