Control.ValueSequence added

package.json

@@ -10,7 +10,8 @@
     },
     "exportedModules": [ "Control.SearchTree", "Control.SearchTree.Generators",
                          "Control.SearchTree.Traversal",
-                         "Control.AllSolutions", "Control.Findall" ],
+                         "Control.AllSolutions", "Control.Findall",
+                         "Control.ValueSequence" ],
     "compilerCompatibility": {
         "pakcs": ">= 2.0.0",
         "kics2": ">= 2.0.0"

src/Control/SearchTree.curry

@@ -21,12 +21,13 @@ module Control.SearchTree
   , someValue, someValueWith
   ) where
 
+import IO              ( hFlush, stdout )
+import List            ( diagonal )
+
 #ifdef __PAKCS__
 import Control.Findall ( allValues )
 #endif
-import IO              ( hFlush, stdout )
-import List            ( diagonal )
-import ValueSequence
+import Control.ValueSequence
 
 --- A search tree is a value, a failure, or a choice between two search trees.
 data SearchTree a = Value a

src/Control/ValueSequence.curry

+------------------------------------------------------------------------------
+--- This library defines a data structure for sequence of values.
+--- It is used in search trees (module `SearchTree`) as well as in
+--- set functions (module `SetFunctions`).
+--- Using sequence of values (rather than standard lists of values)
+--- is necessary to get the behavior of set functions
+--- w.r.t. finite failures right, as described in the paper
+---
+--- > J. Christiansen, M. Hanus, F. Reck, D. Seidel:
+--- > A Semantics for Weakly Encapsulated Search in Functional Logic Programs
+--- > Proc. 15th International Conference on Principles and Practice
+--- > of Declarative Programming (PPDP'13), pp. 49-60, ACM Press, 2013
+---
+--- Note that the implementation for PAKCS is simplified in order to provide
+--- some functionality used by other modules.
+--- In particular, the intended semantics of failures is not provided
+--- in the PAKCS implementation.
+---
+--- @author  Fabian Reck
+--- @version January 2019
+------------------------------------------------------------------------------
+{-# LANGUAGE CPP #-}
+
+module Control.ValueSequence
+  ( ValueSequence, emptyVS, addVS, failVS, (|++|), vsToList )
+ where
+
+--- A value sequence is an abstract sequence of values.
+--- It also contains failure elements in order to implement the semantics
+--- of set functions w.r.t. failures in the intended manner (only in KiCS2).
+#ifdef __PAKCS__
+data ValueSequence a = EmptyVS | ConsVS a (ValueSequence a)
+#else
+external data ValueSequence _ -- external
+#endif
+
+--- An empty sequence of values.
+emptyVS :: ValueSequence a
+#ifdef __PAKCS__
+emptyVS = EmptyVS
+#else
+emptyVS external
+#endif
+
+--- Adds a value to a sequence of values.
+addVS :: a -> ValueSequence a -> ValueSequence a
+#ifdef __PAKCS__
+addVS = ConsVS
+#else
+addVS external
+#endif
+
+--- Adds a failure to a sequence of values.
+--- The argument is the encapsulation level of the failure.
+failVS :: Int -> ValueSequence a
+#ifdef __PAKCS__
+failVS _ = EmptyVS -- cannot be implemented in PAKCS!"
+#else
+failVS external
+#endif
+
+--- Concatenates two sequences of values.
+(|++|) :: ValueSequence a -> ValueSequence a -> ValueSequence a
+#ifdef __PAKCS__
+xs |++| ys = case xs of EmptyVS     -> ys
+                        ConsVS z zs -> ConsVS z (zs |++| ys)
+#else
+(|++|) external
+#endif
+
+--- Transforms a sequence of values into a list of values.
+vsToList :: ValueSequence a -> [a]
+#ifdef __PAKCS__
+vsToList EmptyVS       = []
+vsToList (ConsVS x xs) = x : vsToList xs
+#else
+vsToList external
+#endif

src/Control/ValueSequence.kics2

+-- #endimport - do not remove this line!
+
+external_d_OP_bar_plus_plus_bar
+  :: Curry_Prelude.Curry a
+  => C_ValueSequence a -> C_ValueSequence a
+  -> Cover -> ConstStore -> C_ValueSequence a
+external_d_OP_bar_plus_plus_bar l1 l2 _ _ = l1 |++| l2
+
+data C_ValueSequence a
+  = EmptyVS
+  | Values (Curry_Prelude.OP_List a)
+  | FailVS (Curry_Prelude.C_Int)
+  | Choice_VS  Cover ID (C_ValueSequence a) (C_ValueSequence a)
+  | Choices_VS Cover ID [C_ValueSequence a]
+  | Guard_VS Cover Constraints (C_ValueSequence a)
+
+instance Curry_Prelude.Curry (C_ValueSequence a) where
+
+instance Show (C_ValueSequence a) where
+  showsPrec = error "SearchTree: ValueSequence: showsPrec"
+
+instance Read (C_ValueSequence a) where
+  readsPrec = error "SearchTree: ValueSequence: readsPrec"
+
+instance Unifiable (C_ValueSequence a) where
+  (=.=)      = error "SearchTree: ValueSequence: (=.=)"
+  (=.<=)     = error "SearchTree: ValueSequence: (=.<=)"
+  bind       = error "SearchTree: ValueSequence: bind"
+  lazyBind   = error "SearchTree: ValueSequence: lazyBind"
+
+instance NonDet (C_ValueSequence a) where
+  choiceCons  = Choice_VS
+  choicesCons = Choices_VS
+  guardCons   = Guard_VS
+  failCons    = error "SearchTree: ValueSequence: failCons"
+  try         = error "SearchTree: ValueSequence: try"
+  match       = error "SearchTree: ValueSequence: match"
+
+instance Generable (C_ValueSequence a) where
+  generate = error "SearchTree: ValueSequence: generate"
+
+instance NormalForm (C_ValueSequence a) where
+ ($!!)          = error "SearchTree: ValueSequence: ($!!)"
+ ($##)          = error "SearchTree: ValueSequence: ($##)"
+ searchNF _ _ _ = error "SearchTree: ValueSequence: searchNF"
+
+external_d_C_emptyVS :: Cover -> ConstStore -> C_ValueSequence a
+external_d_C_emptyVS _ _ = EmptyVS
+
+external_d_C_addVS :: a -> C_ValueSequence a
+                   -> Cover -> ConstStore -> C_ValueSequence a
+external_d_C_addVS x vs _ _ = Values (Curry_Prelude.OP_Cons x (getValues vs))
+
+external_d_C_failVS :: Curry_Prelude.C_Int
+                    -> Cover -> ConstStore -> C_ValueSequence a
+external_d_C_failVS d@(Curry_Prelude.C_Int d') cd _
+  | fromInteger d' < cd = FailVS d
+  | otherwise           = Values (Curry_Prelude.OP_List)
+
+external_d_C_vsToList :: C_ValueSequence a -> Cover -> ConstStore -> Curry_Prelude.OP_List a
+external_d_C_vsToList (Values                       xs) _  _  = xs
+external_d_C_vsToList (FailVS  (Curry_Prelude.C_Int d)) _  _  = failCons (fromInteger d) defFailInfo
+external_d_C_vsToList (Choice_VS d i x y) cd cs
+  = choiceCons d i (external_d_C_vsToList x cd cs)
+                   (external_d_C_vsToList y cd cs)
+external_d_C_vsToList (Choices_VS d i xs) cd cs
+  = choicesCons d i (map (\x -> external_d_C_vsToList x cd cs) xs )
+external_d_C_vsToList (Guard_VS d c x) cd cs
+  = guardCons d c (external_d_C_vsToList x cd cs)
+
+(|++|) :: Curry_Prelude.Curry a => C_ValueSequence a -> C_ValueSequence a -> C_ValueSequence a
+EmptyVS             |++| vs = vs
+Values     xs       |++| vs = Values (Curry_Prelude.d_OP_plus_plus xs (getValues vs)
+  (error "ExternalSearchTree: |++| - nesting depth used") emptyCs)
+FailVS     d        |++| vs = failGreatest d vs
+Choice_VS  cd i x y |++| vs = choiceCons  cd i  (x |++| vs) (y |++| vs)
+Choices_VS cd i  xs |++| vs = choicesCons cd i  (map (|++| vs) xs)
+Guard_VS   cd cs xs |++| vs = guardCons   cd cs (xs |++| vs)
+
+getValues EmptyVS               = Curry_Prelude.OP_List
+getValues (FailVS            _) = Curry_Prelude.OP_List
+getValues (Values           xs) = xs
+getValues (Choice_VS  cd i x y) = choiceCons cd i (getValues x) (getValues y)
+getValues (Choices_VS cd i  xs) = choicesCons cd i (map getValues xs)
+getValues (Guard_VS   cd cs  x) = guardCons cd cs (getValues x)
+
+failGreatest d EmptyVS               = FailVS d
+failGreatest d (FailVS           d2) = FailVS
+  (Curry_Prelude.d_C_max
+    (Curry_Prelude.d_OP_uscore_inst_hash_Prelude_dot_Ord_hash_Prelude_dot_Int cd cs)
+    cd
+    cs
+    d
+    cd
+    cs
+    d2
+    cd
+    cs)
+  where cd = error "ExternalSearchTree: failGreatest - nesting depth used"
+        cs = emptyCs
+failGreatest _ vs@(Values         _) = vs
+failGreatest d (Choice_VS  cd i x y)
+  = choiceCons  cd i (failGreatest d x) (failGreatest d y)
+failGreatest d (Choices_VS cd i  xs)
+  = choicesCons cd i  (map (failGreatest d) xs)
+failGreatest d (Guard_VS   cd cs  x) = guardCons cd cs (failGreatest d x)