From bc14bf10b5b3535a0f681d3ebd7f9de262602461 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 12:22:56 -0400 Subject: [PATCH] Move most of the value introduction forms into a new AbstractIntro typeclass. --- src/Control/Abstract/Value.hs | 73 ++++++++++++++++++----------------- src/Data/Abstract/Type.hs | 35 +++++++++-------- src/Data/Abstract/Value.hs | 35 +++++++++-------- 3 files changed, 76 insertions(+), 67 deletions(-) diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index a3add57f0..1af710767 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -1,6 +1,7 @@ {-# LANGUAGE GADTs, Rank2Types #-} module Control.Abstract.Value ( AbstractValue(..) +, AbstractIntro(..) , AbstractFunction(..) , AbstractHole(..) , Comparator(..) @@ -55,17 +56,47 @@ class Show value => AbstractFunction location value effects where call :: value -> [Evaluator location value effects value] -> Evaluator location value effects value --- | A 'Monad' abstracting the evaluation of (and under) binding constructs (functions, methods, etc). --- --- This allows us to abstract the choice of whether to evaluate under binders for different value types. -class AbstractFunction location value effects => AbstractValue location value effects where +class Show value => AbstractIntro value where -- | Construct an abstract unit value. -- TODO: This might be the same as the empty tuple for some value types unit :: Evaluator location value effects value + -- | Construct an abstract boolean value. + boolean :: Bool -> Evaluator location value effects value + + -- | Construct an abstract string value. + string :: ByteString -> Evaluator location value effects value + + -- | Construct a self-evaluating symbol value. + -- TODO: Should these be interned in some table to provide stronger uniqueness guarantees? + symbol :: ByteString -> Evaluator location value effects value + -- | Construct an abstract integral value. integer :: Integer -> Evaluator location value effects value + -- | Construct a floating-point value. + float :: Scientific -> Evaluator location value effects value + + -- | Construct a rational value. + rational :: Rational -> Evaluator location value effects value + + -- | Construct an N-ary tuple of multiple (possibly-disjoint) values + multiple :: [value] -> Evaluator location value effects value + + -- | Construct a key-value pair for use in a hash. + kvPair :: value -> value -> Evaluator location value effects value + + -- | Construct a hash out of pairs. + hash :: [(value, value)] -> Evaluator location value effects value + + -- | Construct the nil/null datatype. + null :: Evaluator location value effects value + + +-- | A 'Monad' abstracting the evaluation of (and under) binding constructs (functions, methods, etc). +-- +-- This allows us to abstract the choice of whether to evaluate under binders for different value types. +class (AbstractFunction location value effects, AbstractIntro value) => AbstractValue location value effects where -- | Lift a unary operator over a 'Num' to a function on 'value's. liftNumeric :: (forall a . Num a => a -> a) -> (value -> Evaluator location value effects value) @@ -90,46 +121,18 @@ class AbstractFunction location value effects => AbstractValue location value ef liftBitwise2 :: (forall a . (Integral a, Bits a) => a -> a -> a) -> (value -> value -> Evaluator location value effects value) - -- | Construct an abstract boolean value. - boolean :: Bool -> Evaluator location value effects value - - -- | Construct an abstract string value. - string :: ByteString -> Evaluator location value effects value - - -- | Construct a self-evaluating symbol value. - -- TODO: Should these be interned in some table to provide stronger uniqueness guarantees? - symbol :: ByteString -> Evaluator location value effects value - - -- | Construct a floating-point value. - float :: Scientific -> Evaluator location value effects value - - -- | Construct a rational value. - rational :: Rational -> Evaluator location value effects value - - -- | Construct an N-ary tuple of multiple (possibly-disjoint) values - multiple :: [value] -> Evaluator location value effects value - -- | Construct an array of zero or more values. array :: [value] -> Evaluator location value effects value - -- | Construct a key-value pair for use in a hash. - kvPair :: value -> value -> Evaluator location value effects value - - -- | Extract the contents of a key-value pair as a tuple. - asPair :: value -> Evaluator location value effects (value, value) - - -- | Construct a hash out of pairs. - hash :: [(value, value)] -> Evaluator location value effects value - -- | Extract a 'ByteString' from a given value. asString :: value -> Evaluator location value effects ByteString + -- | Extract the contents of a key-value pair as a tuple. + asPair :: value -> Evaluator location value effects (value, value) + -- | Eliminate boolean values. TODO: s/boolean/truthy ifthenelse :: value -> Evaluator location value effects a -> Evaluator location value effects a -> Evaluator location value effects a - -- | Construct the nil/null datatype. - null :: Evaluator location value effects value - -- | @index x i@ computes @x[i]@, with zero-indexing. index :: value -> value -> Evaluator location value effects value diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs index 5f381f3eb..3073cc4c3 100644 --- a/src/Data/Abstract/Type.hs +++ b/src/Data/Abstract/Type.hs @@ -101,6 +101,21 @@ instance Ord location => ValueRoots location Type where instance AbstractHole Type where hole = Hole +instance AbstractIntro Type where + unit = pure Unit + integer _ = pure Int + boolean _ = pure Bool + string _ = pure String + float _ = pure Float + symbol _ = pure Symbol + rational _ = pure Rational + multiple = pure . zeroOrMoreProduct + hash = pure . Hash + kvPair k v = pure (k :* v) + + null = pure Null + + instance ( Members '[ Allocator location Type , Fresh , NonDet @@ -146,27 +161,15 @@ instance ( Members '[ Allocator location Type , Reducer Type (Cell location Type) ) => AbstractValue location Type effects where - unit = pure Unit - integer _ = pure Int - boolean _ = pure Bool - string _ = pure String - float _ = pure Float - symbol _ = pure Symbol - rational _ = pure Rational - multiple = pure . zeroOrMoreProduct - array fields = do - var <- fresh - Array <$> foldr (\ t1 -> (unify t1 =<<)) (pure (Var var)) fields - hash = pure . Hash - kvPair k v = pure (k :* v) - - null = pure Null - klass _ _ _ = pure Object namespace _ _ = pure Unit scopedEnvironment _ = pure (Just emptyEnv) + array fields = do + var <- fresh + Array <$> foldr (\ t1 -> (unify t1 =<<)) (pure (Var var)) fields + asString t = unify t String $> "" asPair t = do t1 <- fresh diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 702908ffc..22434d97c 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -81,6 +81,24 @@ instance ( Members '[ Allocator location (Value location body) _ -> throwValueError (CallError op) +instance Show location => AbstractIntro (Value location body) where + unit = pure Unit + integer = pure . Integer . Number.Integer + boolean = pure . Boolean + string = pure . String + float = pure . Float . Number.Decimal + symbol = pure . Symbol + rational = pure . Rational . Number.Ratio + + multiple = pure . Tuple + + kvPair k = pure . KVPair k + hash = pure . Hash . map (uncurry KVPair) + + null = pure Null + + + -- | Construct a 'Value' wrapping the value arguments (if any). instance ( Members '[ Allocator location (Value location body) , LoopControl (Value location body) @@ -97,26 +115,11 @@ instance ( Members '[ Allocator location (Value location body) , Show location ) => AbstractValue location (Value location body) (Goto effects (Value location body) ': effects) where - unit = pure Unit - integer = pure . Integer . Number.Integer - boolean = pure . Boolean - string = pure . String - float = pure . Float . Number.Decimal - symbol = pure . Symbol - rational = pure . Rational . Number.Ratio - - multiple = pure . Tuple - array = pure . Array - - kvPair k = pure . KVPair k - - null = pure Null - asPair val | KVPair k v <- val = pure (k, v) | otherwise = throwValueError $ KeyValueError val - hash = pure . Hash . map (uncurry KVPair) + array = pure . Array klass n [] env = pure $ Class n env klass n supers env = do