Commit 66761bd1 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer

new optimization from John demands that bimaps are derived in the icl module.

flagged out bimap derivation in the bimap module.
this module an be thrown away.
added bimap derivation in modules who needed it.
fusion algorithm switched on for these modules using bimaps.
seems to work.
compiler crashed however for dynflows main module.


git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@778 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 8786ff14
......@@ -26,7 +26,7 @@ import BugReport
import Coffeemachine
import Newsgroups
import ChangeHandling
import WebShop
//import WebShop
//import ideExample
//Crisis response examples
......@@ -57,7 +57,7 @@ where
, exceptionHandlingExample
, changeHandlingExample
//, ideExample
, webShopExample
// , webShopExample
, ambulanceDispatchExamples
, ambulanceDispatchMapExamples
, changeExamples
......
......@@ -74,6 +74,6 @@ specifyIncident addr marker
//====
showSources :: Task Void
showSources
= loadDocumentFromFile "AmbulanceDispatchMap.icl" "src/Crisis Response/" >>=
\icl -> loadDocumentFromFile "AmbulanceDispatchMap.dcl" "src/Crisis Response/" >>=
= loadDocumentFromFile "AmbulanceDispatchMap.icl" "Crisis Response/" >>=
\icl -> loadDocumentFromFile "AmbulanceDispatchMap.dcl" "Crisis Response/" >>=
\dcl -> showStickyMessageAbout "Source Codes" [icl,dcl]
\ No newline at end of file
......@@ -10,6 +10,8 @@ derive gParse DynFormFlow, DynForm, DynFlow, FormType, FlowType, EditorInfo, A
derive gUpdate DynFormFlow, DynForm, DynFlow, FormType, FlowType, EditorInfo, AssignInfo, DynFormFlowStore, Elem
derive gVisualize DynFormFlow, DynForm, DynFlow, FormType, FlowType, EditorInfo, AssignInfo, DynFormFlowStore
derive bimap Maybe, (,)
Start :: *World -> *World
Start w = startEngine dynFormEditor w
......@@ -368,8 +370,12 @@ where
// translate (Or left right) = checkFlows left >>= \leftflow -> checkFlows right >>= \rightflow -> checkOr leftflow rightflow
// translate (And left right) = checkFlows left >>= \leftflow -> checkFlows right >>= \rightflow -> checkAnd leftflow rightflow
// checkOr (T ta :: T (Task a) a) (T tb :: T (Task a) a)
// = return (dynamic T (ta -||- tb) :: T (Task a) a)
checkOr (T ta :: T (Task a) a) (T tb :: T (Task a) a)
= return (mkdyn (T (ta -||- tb))) //(dynamic T (ta -||- tb) :: T (Task a) a)
where
mkdyn :: (T (Task a) a) -> Dynamic
mkdyn (T t) = dynamic (T t)
// checkOr (T ta :: T a b) (T tb :: T c d)
// = throw "Or: Cannot unify "
......
......@@ -21,6 +21,8 @@ derive gUpdate ProcessRef, Process, ProcessStatus, TaskProperties, TaskSystemPr
derive gPrint ProcessRef, Process, ProcessStatus, TaskProperties, TaskSystemProperties, TaskManagerProperties, TaskWorkerProperties, TaskPriority, TaskProgress, Timestamp
derive gParse ProcessRef, Process, ProcessStatus, TaskProperties, TaskSystemProperties, TaskManagerProperties, TaskWorkerProperties, TaskPriority, TaskProgress, Timestamp
derive bimap Maybe, (,)
class toProcessId a where toProcessId :: a -> ProcessId
instance toProcessId ProcessId
......
......@@ -9,7 +9,7 @@ from iTasks import class iTask
import GenPrint, GenParse, GenVisualize, GenUpdate
//Database identifier for storing a single value of type a
:: DBid a
::DBid a :== String
//Database identifier to a value of type a in a database with multiple values
:: DBRef a = DBRef Int
......@@ -19,6 +19,7 @@ derive gUpdate DBRef
derive gPrint DBRef
derive gParse DBRef
//Core database access functions
/**
......
......@@ -13,6 +13,8 @@ derive gUpdate DBRef
derive gPrint DBRef
derive gParse DBRef
derive bimap Maybe, (,)
::DBid a :== String
// Core db access
......
......@@ -21,6 +21,8 @@ import GenVisualize, GenUpdate
derive gPrint Either
derive gParse Either
derive bimap Maybe
//Task composition
(-||-) infixr 3 :: !(Task a) !(Task a) -> (Task a) | iTask a
(-||-) taska taskb
......
......@@ -11,6 +11,8 @@ derive gVisualize EmailAddress, Password, DateTime
derive gUpdate EmailAddress, Password, Note, DateTime
derive gLexOrd Currency
derive bimap Maybe, (,)
gVisualize{|Date|} old new vst=:{vizType,label,idPrefix,currentPath,useLabels,optional,valid}
= case vizType of
VEditorDefinition = ([TUIFragment (TUIDateField {TUIDateField|name = dp2s currentPath, id = dp2id idPrefix currentPath, value = value2s currentPath old, format = "d-m-Y", fieldLabel = label2s optional label, hideLabel = not useLabels})]
......
......@@ -10,6 +10,8 @@ derive gParse GoogleMap, GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
derive gVisualize GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType
derive gUpdate GoogleMapMarker, GoogleMapInfoWindow, GoogleMapType, GoogleStaticMap
derive bimap Maybe, (,)
:: TUIGoogleMap =
{ center :: Coordinate
, width :: Int
......
implementation module iTasks
\ No newline at end of file
implementation module iTasks
import Engine // basic iTask system creator
, EngineWrapperStandalone // standalone wrapper
//, EngineWrapperCGI // CGI wrapper
// Basic tasks
, InteractionTasks // tasks for interaction with users
, SystemTasks // tasks for interaction with the iTasks system itself
, StoreTasks // tasks for accessing the generic store
, UserDBTasks // tasks for accessing the user database
, SessionDBTasks // tasks for accessing the session database
, ProcessDBTasks // tasks for accessing the process database
, DateTimeTasks // tasks triggered by date and time
, ChangeTasks // Tasks for changing existing workflows
// Task combinators
, CoreCombinators // The core iTask combinators
, CommonCombinators // Set of additional useful iTask combinators
, LiftingCombinators // Lifting of other domains (e.g. World) to the iTask domain
, ExceptionCombinators // Handling exceptional situations
, TuningCombinators // Fine tuning of tasks
// Miscellaneous machinery
, GenBimap
, Util
, GenVisualize // Functions for generating GUIs
, GenUpdate // Functions for updating arbitrary values
//StdEnv modules
, StdInt
, StdBool
, StdString
, StdList
, StdOrdList
, StdTuple
, StdEnum
, StdOverloaded
, StdArray
, StdGeneric
, StdDynamic
//Generic modules
, GenPrint
, GenParse
\ No newline at end of file
......@@ -5,6 +5,8 @@ import Util, JSON, StdMisc
derive JSONEncode Config
derive JSONDecode Config
derive bimap Maybe, (,)
defaultConfig :: Config
defaultConfig =
{ clientPath = "..\\..\\Client\\build"
......
......@@ -8,6 +8,7 @@ import Types
from StdFunc import id
derive bimap (,)
defaultValue :: !*World -> (!a,!*World) | gUpdate{|*|} a
defaultValue world
......
......@@ -8,3 +8,4 @@ derive JSONDecode RPCDescription, RPCOperation, RPCInterface, RPCService, RPCCal
derive JSONEncode RPCExecute, RPCParamValue, RPCDescription, RPCOperation, RPCInterface, RPCService, RPCCallType,
RPCParam, RPCMessageType, RPCProtocol, RPCParameterType, RPCHttpMethod
derive bimap Maybe, (,)
\ No newline at end of file
......@@ -26,7 +26,7 @@ from JSON import JSONDecode, fromJSON
derive gPrint TaskState
derive gParse TaskState
derive gEq TaskState
derive bimap Maybe, (,)
derive JSONDecode RPCMessage
mkTSt :: String Config HTTPRequest Session ![Workflow] !*Store !*Store !*Store !*World -> *TSt
......
implementation module TaskTree
\ No newline at end of file
implementation module TaskTree
import StdMaybe, Either
import Types
import Html, Time
import RPC
from ProcessDB import :: ProcessStatus
from JSON import :: JSON
from TUIDefinition import :: TUIDef, :: TUIUpdate
......@@ -9,6 +9,8 @@ import JSON
derive JSONEncode TraceTree
derive JSONDecode TraceTree
derive bimap Maybe, (,)
traceProcesses :: [Process] -> HtmlTag
traceProcesses processes = mkTable processes
where
......
......@@ -9,6 +9,7 @@ derive gPrint Session, Document, Hidden, Static
derive gParse Session, Document, Hidden, Static
derive gVisualize Session
derive gUpdate Session
derive bimap Maybe, (,)
derive JSONEncode Document
derive JSONDecode Document
......
......@@ -11,6 +11,7 @@ import dynamic_string, graph_to_string_with_descriptors, graph_to_sapl_string
derive gPrint Maybe, Void, (,), (,,), (,,,), (,,,,), User
derive gParse Maybe, Void, (,), (,,), (,,,), (,,,,), User
derive bimap Maybe, (,)
iTaskId :: !TaskNr !String -> String
iTaskId tasknr postfix
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment