mirror of
https://github.com/github/semantic.git
synced 2024-12-01 09:15:01 +03:00
Move most of the value introduction forms into a new AbstractIntro typeclass.
This commit is contained in:
parent
fb3f6fdc76
commit
bc14bf10b5
@ -1,6 +1,7 @@
|
|||||||
{-# LANGUAGE GADTs, Rank2Types #-}
|
{-# LANGUAGE GADTs, Rank2Types #-}
|
||||||
module Control.Abstract.Value
|
module Control.Abstract.Value
|
||||||
( AbstractValue(..)
|
( AbstractValue(..)
|
||||||
|
, AbstractIntro(..)
|
||||||
, AbstractFunction(..)
|
, AbstractFunction(..)
|
||||||
, AbstractHole(..)
|
, AbstractHole(..)
|
||||||
, Comparator(..)
|
, 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
|
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).
|
class Show value => AbstractIntro value where
|
||||||
--
|
|
||||||
-- 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
|
|
||||||
-- | Construct an abstract unit value.
|
-- | Construct an abstract unit value.
|
||||||
-- TODO: This might be the same as the empty tuple for some value types
|
-- TODO: This might be the same as the empty tuple for some value types
|
||||||
unit :: Evaluator location value effects value
|
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.
|
-- | Construct an abstract integral value.
|
||||||
integer :: Integer -> Evaluator location value effects 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.
|
-- | Lift a unary operator over a 'Num' to a function on 'value's.
|
||||||
liftNumeric :: (forall a . Num a => a -> a)
|
liftNumeric :: (forall a . Num a => a -> a)
|
||||||
-> (value -> Evaluator location value effects value)
|
-> (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)
|
liftBitwise2 :: (forall a . (Integral a, Bits a) => a -> a -> a)
|
||||||
-> (value -> value -> Evaluator location value effects value)
|
-> (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.
|
-- | Construct an array of zero or more values.
|
||||||
array :: [value] -> Evaluator location value effects value
|
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.
|
-- | Extract a 'ByteString' from a given value.
|
||||||
asString :: value -> Evaluator location value effects ByteString
|
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
|
-- | Eliminate boolean values. TODO: s/boolean/truthy
|
||||||
ifthenelse :: value -> Evaluator location value effects a -> Evaluator location value effects a -> Evaluator location value effects a
|
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 x i@ computes @x[i]@, with zero-indexing.
|
||||||
index :: value -> value -> Evaluator location value effects value
|
index :: value -> value -> Evaluator location value effects value
|
||||||
|
|
||||||
|
@ -101,6 +101,21 @@ instance Ord location => ValueRoots location Type where
|
|||||||
instance AbstractHole Type where
|
instance AbstractHole Type where
|
||||||
hole = Hole
|
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
|
instance ( Members '[ Allocator location Type
|
||||||
, Fresh
|
, Fresh
|
||||||
, NonDet
|
, NonDet
|
||||||
@ -146,27 +161,15 @@ instance ( Members '[ Allocator location Type
|
|||||||
, Reducer Type (Cell location Type)
|
, Reducer Type (Cell location Type)
|
||||||
)
|
)
|
||||||
=> AbstractValue location Type effects where
|
=> 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
|
klass _ _ _ = pure Object
|
||||||
namespace _ _ = pure Unit
|
namespace _ _ = pure Unit
|
||||||
|
|
||||||
scopedEnvironment _ = pure (Just emptyEnv)
|
scopedEnvironment _ = pure (Just emptyEnv)
|
||||||
|
|
||||||
|
array fields = do
|
||||||
|
var <- fresh
|
||||||
|
Array <$> foldr (\ t1 -> (unify t1 =<<)) (pure (Var var)) fields
|
||||||
|
|
||||||
asString t = unify t String $> ""
|
asString t = unify t String $> ""
|
||||||
asPair t = do
|
asPair t = do
|
||||||
t1 <- fresh
|
t1 <- fresh
|
||||||
|
@ -81,6 +81,24 @@ instance ( Members '[ Allocator location (Value location body)
|
|||||||
_ -> throwValueError (CallError op)
|
_ -> 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).
|
-- | Construct a 'Value' wrapping the value arguments (if any).
|
||||||
instance ( Members '[ Allocator location (Value location body)
|
instance ( Members '[ Allocator location (Value location body)
|
||||||
, LoopControl (Value location body)
|
, LoopControl (Value location body)
|
||||||
@ -97,26 +115,11 @@ instance ( Members '[ Allocator location (Value location body)
|
|||||||
, Show location
|
, Show location
|
||||||
)
|
)
|
||||||
=> AbstractValue location (Value location body) (Goto effects (Value location body) ': effects) where
|
=> 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
|
asPair val
|
||||||
| KVPair k v <- val = pure (k, v)
|
| KVPair k v <- val = pure (k, v)
|
||||||
| otherwise = throwValueError $ KeyValueError val
|
| otherwise = throwValueError $ KeyValueError val
|
||||||
|
|
||||||
hash = pure . Hash . map (uncurry KVPair)
|
array = pure . Array
|
||||||
|
|
||||||
klass n [] env = pure $ Class n env
|
klass n [] env = pure $ Class n env
|
||||||
klass n supers env = do
|
klass n supers env = do
|
||||||
|
Loading…
Reference in New Issue
Block a user