incrementalise map and filter by hand

When in doubt, cheat. My current automatic incrementalizer is unsound in
the face of recursive functions, so implement the buggers - map and
filter at this point - by hand. map is a bit crazy, as it turns out, so
it looks like the automatic incrementalizer thing is going to be
trickier than I've been letting myself imagine.

demo/B.hs

@@ -1,16 +1,9 @@
 module B where
-import Prelude hiding (map, filter)
+import Prelude
 import Inctime
 import InctimeHtml
 
 
-filter f []                 = []
-filter f (x:xs) | f x       = x:(filter f xs)
-                | otherwise = filter f xs
-
-map f [] = []
-map f (x:xs) = (f x):(map f xs)
-
 [] `append` a = a
 (x:xs) `append` a = x:(xs `append` a)
 
@@ -47,17 +40,15 @@ definitionsFrom (WordDefinitions _ ds) = ds
 
 wordsFromInputs inputs = map wordFrom (newWordInputs inputs)
 definitionsFromInputsFor w inputs = map definitionFrom (definitionInputsFor w inputs)
-wordDefinitions w inputs = WordDefinitions w (definitionsFromInputsFor w inputs)
+wordDefinitions inputs w = WordDefinitions w (definitionsFromInputsFor w inputs)
+definitions inputs = map (wordDefinitions inputs) (wordsFromInputs inputs)
 
 app_state inputs
-  = AppState { appStateNumWords = length (words inputs)
+  = AppState { appStateNumWords = length (wordsFromInputs inputs)
              , appStateNumDefinitions = elems_length (map definitionsFrom (definitions inputs))
-             , appStateWords = words inputs
+             , appStateWords = wordsFromInputs inputs
              , appStateDefinitions = definitions inputs
              }
-  where words inputs = wordsFromInputs inputs
-        definitions inputs = let f inputs w = wordDefinitions w inputs
-                              in map (f inputs) (words inputs)
 
 elems_length [] = 0
 elems_length (w:ws) = (length w) + (elems_length ws)

demo/Bmain.hs

@@ -12,20 +12,29 @@ deriving instance Show WordDefinitions_incrementalised
 main = do
   mapM putStrLn tests
 tests =
-  [show $ wordsFromInputs prior
+  ["# wordsFromInputs before and after"
+  ,show $ wordsFromInputs prior
   ,show $ applyInputChange (wordsFromInputs_incrementalised prior change)
                            (wordsFromInputs prior)
+  ,"# newDefinitionInputs before and after"
   ,show $ newDefinitionInputs prior
   ,show $ newDefinitionInputs_incrementalised prior change
+  ,"# definitionInputsFor \"Dog\" before and change"
   ,show $ definitionInputsFor "Dog" prior
   ,show $ definitionInputsFor_incrementalised "Dog" mkIncrementalisedIdentity prior change
+  ,"# definitionsFromInputsFor \"Dog\" before and change"
   ,show $ definitionsFromInputsFor "Dog" prior
   ,show $ definitionsFromInputsFor_incrementalised "Dog" mkIncrementalisedIdentity prior change
-  ,show $ wordDefinitions "Dog" prior
-  ,show $ wordDefinitions_incrementalised "Dog" mkIncrementalisedIdentity prior change
-  ,show $ applyInputChange (wordDefinitions_incrementalised "Dog"
-                                mkIncrementalisedIdentity prior change)
-                           (wordDefinitions "Dog" prior)
+  ,"# wordDefinitions \"Dog\" before, change, and after"
+  ,show $ wordDefinitions prior "Dog"
+  ,show $ wordDefinitions_incrementalised prior change "Dog" mkIncrementalisedIdentity
+  ,show $ applyInputChange (wordDefinitions_incrementalised prior change
+                                "Dog" mkIncrementalisedIdentity)
+                           (wordDefinitions prior "Dog")
+  ,"# definitions before and change"
+  ,show $ definitions prior
+  ,show $ definitions_incrementalised prior change
+  ,"# app_state before and after"
   ,show $ app_state prior
   ,show $ applyInputChange (app_state_incrementalised prior change) 
                            (app_state prior)]

support/Inctime.hs

@@ -75,7 +75,9 @@ unit_incrementalised = ()
 
 id_incrementalised = id
 
--- why are the foralls in this order? Because it seems to work.
+-- I'm not at all sure that the following work.
+
+-- why are the foralls in this order? Because it seems to typecheck.
 compose_incrementalised :: forall b. forall b_inc. (Incrementalised b b_inc) =>
                            forall c. forall c_inc. (Incrementalised c c_inc) =>
                            forall a. forall a_inc. (Incrementalised a a_inc) =>
@@ -89,6 +91,35 @@ apply_incrementalised :: forall a. forall a_inc. (Incrementalised a a_inc) =>
 apply_incrementalised f f_inc arg_inc = f_inc arg_inc
 
 
+map_incrementalised :: forall a a_inc. (Incrementalised a a_inc) =>
+                       forall b b_inc. (Incrementalised b b_inc) =>
+                       (a -> b) -> (a -> a_inc -> b_inc) ->
+                       [a] -> (BuiltinList_incrementalised a a_inc) ->
+                       (BuiltinList_incrementalised b b_inc)
+map_incrementalised f f_inc xs (BuiltinList_incrementalised_build_using_1 x) = 
+  BuiltinList_incrementalised_build_using_1 (f x)
+map_incrementalised f f_inc xs (BuiltinList_incrementalised)
+  = BuiltinList_incrementalised -- empty list, do nothing
+map_incrementalised f f_inc (h:t) (BuiltinListCons_incrementalised h_change t_change)
+  = BuiltinListCons_incrementalised (f_inc h h_change)
+                                    (map_incrementalised f f_inc t t_change)
+map_incrementalised f f_inc xs (BuiltinList_incrementalised_identity)
+  = let xs' = map (\a -> f_inc a mkIncrementalisedIdentity) xs
+     in case all isIncrementalisedIdentity xs' of
+          True -> BuiltinList_incrementalised_identity
+          False -> foldr BuiltinListCons_incrementalised
+                         BuiltinList_incrementalised
+                         xs'
+map_incrementalised f f_inc xs (BuiltinList_incrementalised_replace xs') = BuiltinList_incrementalised_replace $ map f xs'
+
+filter_incrementalised :: forall a a_inc. (Incrementalised a a_inc) =>
+                          (a -> Bool) -> (a -> a_inc -> Bool_incrementalised) ->
+                          [a] -> (BuiltinList_incrementalised a a_inc) ->
+                          (BuiltinList_incrementalised a a_inc)
+filter_incrementalised f f_inc xs (BuiltinList_incrementalised_build_using_1 x)
+  | f x = BuiltinList_incrementalised_build_using_1 x
+  | otherwise = BuiltinList_incrementalised_identity
+
 class Num_incrementalised base incrementalised | incrementalised -> base where
   plus_incrementalised_wrongcc :: incrementalised -> incrementalised -> incrementalised