From f6789fdfbf97c4a516ec9ef700da68f7e5e60d28 Mon Sep 17 00:00:00 2001 From: krangelov Date: Sun, 19 Dec 2021 14:13:37 +0100 Subject: [PATCH] refactor VC -> VC & VEmpty --- src/compiler/GF/Compile/Compute/Concrete.hs | 46 +++++++++++---------- src/compiler/GF/Compile/GeneratePMCFG.hs | 5 ++- 2 files changed, 27 insertions(+), 24 deletions(-) diff --git a/src/compiler/GF/Compile/Compute/Concrete.hs b/src/compiler/GF/Compile/Compute/Concrete.hs index 464a5bf6a..c3315089d 100644 --- a/src/compiler/GF/Compile/Compute/Concrete.hs +++ b/src/compiler/GF/Compile/Compute/Concrete.hs @@ -74,7 +74,8 @@ data Value s | VInt Integer | VFlt Double | VStr String - | VC [Value s] + | VEmpty + | VC (Value s) (Value s) | VGlue (Value s) (Value s) | VPatt Int (Maybe Int) Patt | VPattType (Value s) @@ -104,7 +105,8 @@ showValue (VSort _) = "VSort" showValue (VInt _) = "VInt" showValue (VFlt _) = "VFlt" showValue (VStr s) = "(VStr "++show s++")" -showValue (VC _) = "VC" +showValue VEmpty = "VEmpty" +showValue (VC _ _) = "VC" showValue (VGlue _ _) = "VGlue" showValue (VPatt _ _ _) = "VPatt" showValue (VPattType _) = "VPattType" @@ -120,7 +122,7 @@ eval env (Sort s) [] = return (VSort s) eval env (EInt n) [] = return (VInt n) eval env (EFloat d) [] = return (VFlt d) eval env (K t) [] = return (VStr t) -eval env Empty [] = return (VC []) +eval env Empty [] = return VEmpty eval env (App t1 t2) vs = do tnk <- newThunk env t2 eval env t1 (tnk : vs) eval env (Abs b x t) [] = return (VClosure env (Abs b x t)) @@ -182,10 +184,10 @@ eval env (QC q) vs = return (VApp q vs) eval env (C t1 t2) [] = do v1 <- eval env t1 [] v2 <- eval env t2 [] case (v1,v2) of - (VC vs1,VC vs2) -> return (VC (vs1++vs2)) - (VC vs1,v2 ) -> return (VC (vs1++[v2])) - (v1, VC vs2) -> return (VC ([v1]++vs2)) - (v1, v2 ) -> return (VC [v1,v2]) + (VEmpty,VEmpty) -> return VEmpty + (v1, VEmpty) -> return v1 + (VEmpty,v2 ) -> return v2 + _ -> return (VC v1 v2) eval env t@(Glue t1 t2) [] = do v1 <- eval env t1 [] v2 <- eval env t2 [] case liftA2 (++) (value2string v1) (value2string v2) of @@ -320,7 +322,7 @@ patternMatch v0 ((env0,ps,args0,t):eqs) = match env0 ps eqs args0 (PR pas, VR as) -> matchRec env pas as ps eqs args (PString s1, VStr s2) | s1 == s2 -> match env ps eqs args - (PString s1, VC []) + (PString s1, VEmpty) | null s1 -> match env ps eqs args (PSeq min1 max1 p1 min2 max2 p2,v) -> case value2string v of @@ -531,11 +533,11 @@ value2term xs (VSort s) = return (Sort s) value2term xs (VStr tok) = return (K tok) value2term xs (VInt n) = return (EInt n) value2term xs (VFlt n) = return (EFloat n) -value2term xs (VC vs) = do - ts <- mapM (value2term xs) vs - case ts of - [] -> return Empty - (t:ts) -> return (foldl C t ts) +value2term xs VEmpty = return Empty +value2term xs (VC v1 v2) = do + t1 <- value2term xs v1 + t2 <- value2term xs v2 + return (C t1 t2) value2term xs (VGlue v1 v2) = do t1 <- value2term xs v1 t2 <- value2term xs v2 @@ -592,10 +594,10 @@ value2string v = fmap (unwords.snd) (value2string v False []) where value2string (VStr w1) True (w2:ws) = Const (False,(w1++w2):ws) value2string (VStr w) _ ws = Const (False,w :ws) - value2string (VC []) b ws = Const (b,ws) - value2string (VC (v:vs)) b ws = - case value2string (VC vs) b ws of - Const (b,ws) -> value2string v b ws + value2string VEmpty b ws = Const (b,ws) + value2string (VC v1 v2) b ws = + case value2string v2 b ws of + Const (b,ws) -> value2string v1 b ws st -> st value2string (VApp q []) b ws | q == (cPredef,cNonExist) = NonExist @@ -630,11 +632,11 @@ startsWith (x:xs) (y:ys) startsWith _ _ = False -string2value s = - case words s of - [] -> VC [] - [w] -> VStr w - ws -> VC (map VStr ws) +string2value s = string2value (words s) + where + string2value [] = VEmpty + string2value [w] = VStr w + string2value (w:ws) = VC (VStr w) (string2value ws) value2int (VInt n) = Const n value2int _ = RunTime diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs index cf337809f..9d2c70ddd 100644 --- a/src/compiler/GF/Compile/GeneratePMCFG.hs +++ b/src/compiler/GF/Compile/GeneratePMCFG.hs @@ -156,7 +156,7 @@ flatten v ty (lins,params) deepForce (VR as) = mapM_ (\(lbl,v) -> force v >>= deepForce) as deepForce (VApp q tnks) = mapM_ (\tnk -> force tnk >>= deepForce) tnks -deepForce (VC vs) = mapM_ deepForce vs +deepForce (VC v1 v2) = deepForce v1 >> deepForce v2 deepForce (VAlts def alts) = do deepForce def mapM_ (\(v,_) -> deepForce v) alts deepForce _ = return () @@ -179,7 +179,8 @@ str2lin (VSymCat d r rs) = do (r, rs) <- compute r rs (r',rs' ) <- compute r' tnks return (r*cnt'+r',combine cnt' rs rs') str2lin (VSymVar d r) = return [SymVar d r] -str2lin (VC vs) = fmap concat (mapM str2lin vs) +str2lin VEmpty = return [] +str2lin (VC v1 v2) = liftM2 (++) (str2lin v1) (str2lin v2) str2lin (VAlts def alts) = do def <- str2lin def alts <- forM alts $ \(v,VStrs vs) -> do lin <- str2lin v