move of lexical scope encoding via RLList from uhc to uhc-util

UU-ComputerScience · Nov 4, 2015 · 2f29531 · 2f29531
1 parent d506d22
commit 2f29531
Show file tree

Hide file tree

Showing 4 changed files with 14 additions and 29 deletions.
diff --git a/EHC/changelog.md.editthis b/EHC/changelog.md.editthis
@@ -1,4 +1,4 @@
-- [edit this] and this, adding new entries as needed (version nr etc is prefixed when using version bumping Makefile targets)
+- [uhc-util] move of LexScope encoding via RLList to separate module in uhc-util
 
 ## 1.1.9.2 - 20151027
 

diff --git a/EHC/src/ehc/Base/Common.chs b/EHC/src/ehc/Base/Common.chs
@@ -87,12 +87,6 @@
 %%[50 import(UHC.Util.Binary, UHC.Util.Serialize)
 %%]
 
-%%[9999 import(UHC.Util.RLList) export(module UHC.Util.RLList)
-%%]
-
-%%[9999 import({%{EH}Base.ForceEval})
-%%]
-
 %%[99 import(Data.Version)
 %%]
 

diff --git a/EHC/src/ehc/Ty.cag b/EHC/src/ehc/Ty.cag
@@ -84,7 +84,7 @@ used by EHC. The AST is described in Ty/AbsSyn.
 %%[(9 hmtyinfer || hmtyast) hs export(tyEnsureNonAnyImpl)
 %%]
 
-%%[(9 hmtyinfer || hmtyast) hs import(qualified UHC.Util.RLList as RLL)
+%%[(9 hmtyinfer || hmtyast) hs import(qualified UHC.Util.RLList.LexScope as LexScope)
 %%]
 
 %%[(9_1 hmtyinfer || hmtyast) hs export(TyPlusId)
@@ -374,12 +374,12 @@ instance Show LabelOffset where
 
 %%[(9 hmtyinfer || hmtyast) hs export(PredScope(..),initPredScope)
 data PredScope
-  = PredScope_Lev !(RLL.RLList Int)
+  = PredScope_Lev !LexScope.LexScope
   | PredScope_Var !TyVarId
   deriving (Eq,Ord)
 
 initPredScope :: PredScope
-initPredScope = PredScope_Lev RLL.empty
+initPredScope = PredScope_Lev LexScope.empty
 %%]
 
 %%[(50 hmtyinfer || hmtyast) hs
@@ -400,10 +400,10 @@ instance Show PredScope where
 
 %%[(9 hmtyinfer || hmtyast) hs export(pscpEnter,pscpLeave)
 pscpEnter :: Int -> PredScope -> (Int,PredScope)
-pscpEnter x (PredScope_Lev s) = (x+1,PredScope_Lev (s `RLL.concat` RLL.singleton x))
+pscpEnter x (PredScope_Lev s) = (x+1,PredScope_Lev (x `LexScope.enter` s))
 
 pscpLeave :: PredScope -> PredScope
-pscpLeave (PredScope_Lev s) = PredScope_Lev $ fst $ fromJust $ RLL.initLast s
+pscpLeave (PredScope_Lev s) = PredScope_Lev $ fromJust $ LexScope.leave s
 %%]
 
 %%[(9 hmtyinfer || hmtyast) hs export(pscpEnter',pscpLeave',pscpMk')
@@ -434,27 +434,18 @@ pscpMk' yesEnter x s
 
 %%[(9 hmtyinfer || hmtyast) hs export(pscpIsVisibleIn,pscpCommon)
 pscpIsVisibleIn :: PredScope -> PredScope -> Bool
-pscpIsVisibleIn (PredScope_Lev sOuter) (PredScope_Lev sInner) = sOuter `RLL.isPrefixOf` sInner
+pscpIsVisibleIn (PredScope_Lev sOuter) (PredScope_Lev sInner) = sOuter `LexScope.isVisibleIn` sInner
 pscpIsVisibleIn _                      _                      = False
 
 pscpCommon :: PredScope -> PredScope -> Maybe PredScope
-pscpCommon (PredScope_Lev s1) (PredScope_Lev s2)
-  = Just $ PredScope_Lev $ commonPrefix s1 s2
-  where commonPrefix xxs     yys     | isJust ht1 && isJust ht2 && x == y     = RLL.singleton x `RLL.concat` commonPrefix xs ys
-                                     | otherwise                              = RLL.empty
-                                     where ht1 = RLL.headTail xxs
-                                           ht2 = RLL.headTail yys
-                                           (x,xs) = fromJust ht1
-                                           (y,ys) = fromJust ht2
-        -- commonPrefix _       _                    = RLL.empty
-pscpCommon _                  _                  
-  = Nothing        
+pscpCommon (PredScope_Lev s1) (PredScope_Lev s2) = Just $ PredScope_Lev $ LexScope.common s1 s2
+pscpCommon _                  _                  = Nothing        
 %%]
 
 %%[(9 hmtyinfer || hmtyast) hs export(pscpParents)
 pscpParents :: PredScope -> [PredScope]
-pscpParents (PredScope_Lev s) | not (RLL.null s) = map PredScope_Lev $ RLL.inits $ RLL.init s
-pscpParents _                                   = []
+pscpParents (PredScope_Lev s) = map PredScope_Lev $ LexScope.parents s
+pscpParents _                 = []
 %%]
 
 %%[(9 hmtyinfer || hmtyast) hs export(pscpCmp,pscpCmpByLen)
@@ -463,7 +454,7 @@ pscpCmp (PredScope_Lev s) (PredScope_Lev t) = Just $ s `compare` t
 pscpCmp _                 _                 = Nothing                 
 
 pscpCmpByLen :: PredScope -> PredScope -> Ordering                  
-pscpCmpByLen (PredScope_Lev s) (PredScope_Lev t) = (RLL.length s) `compare` (RLL.length t)                    
+pscpCmpByLen (PredScope_Lev s) (PredScope_Lev t) = s `LexScope.compareByLength` t                 
 %%]
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

diff --git a/EHC/src/ehc/Ty/Pretty.cag b/EHC/src/ehc/Ty/Pretty.cag
@@ -30,7 +30,7 @@
 %%[(9 hmtyinfer || hmtyast) hs export(ppTyPr)
 %%]
 
-%%[(9 hmtyinfer || hmtyast) hs import(qualified UHC.Util.RLList as RLL)
+%%[(9 hmtyinfer || hmtyast) hs import(qualified UHC.Util.RLList.LexScope as LexScope)
 %%]
 
 %%[(1 hmtyinfer || hmtyast).WRAPPER ag import({Ty/AbsSyn},{Ty/CommonAG})
@@ -157,7 +157,7 @@ instance PP CHRPredOcc where
             ]
 
 instance PP PredScope where
-  pp (PredScope_Lev l) = ppListSep "<" ">" "," $ RLL.toList l
+  pp (PredScope_Lev l) = ppListSep "<" ">" "," $ LexScope.toList l
   pp (PredScope_Var v) = "<sc_" >|< v >|< ">"
 
 instance PP ImplsProveOcc where