-- GeNeRaTeD fOr: /home/thomas/repos/plancomps/CBS-beta/Unstable-Funcons-beta/Computations/Threads/Synchronising/Notifications/Notifications.cbs {-# LANGUAGE OverloadedStrings #-} module Funcons.Core.Computations.Threads.Synchronising.Notifications.Notifications where import Funcons.EDSL import Funcons.Operations hiding (Values,libFromList) entities = [] types = typeEnvFromList [] funcons = libFromList [("barrier-create",StrictFuncon stepBarrier_create),("barrier-sync",StrictFuncon stepBarrier_sync),("barrier-sync-else-wait",StrictFuncon stepBarrier_sync_else_wait),("condition-create",NullaryFuncon stepCondition_create),("condition-wait",StrictFuncon stepCondition_wait),("condition-wait-with-lock",StrictFuncon stepCondition_wait_with_lock),("condition-notify-all",StrictFuncon stepCondition_notify_all),("condition-notify-first",StrictFuncon stepCondition_notify_first),("rendezvous-create",StrictFuncon stepRendezvous_create),("rendezvous-sync",StrictFuncon stepRendezvous_sync),("rendezvous-sync-else-wait",StrictFuncon stepRendezvous_sync_else_wait),("rendezvous-waits",NullaryFuncon stepRendezvous_waits),("is-rendezvous-match",StrictFuncon stepIs_rendezvous_match),("rendezvous-first-match-thread",StrictFuncon stepRendezvous_first_match_thread),("rendezvous-first-match-drop",StrictFuncon stepRendezvous_first_match_drop)] barrier_create_ fargs = FApp "barrier-create" (fargs) stepBarrier_create fargs = evalRules [rewrite1] [] where rewrite1 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "pos-ints")] env rewriteTermTo (TApp "give" [TApp "sync-create" [TApp "sync-feature-create" [TName "sync-waiting-list"],TApp "sync-feature-create" [TName "sync-count"]],TApp "sequential" [TApp "assign" [TApp "sync-feature" [TName "given",TName "sync-count"],TVar "N"],TName "given"]]) env barrier_sync_ fargs = FApp "barrier-sync" (fargs) stepBarrier_sync fargs = evalRules [rewrite1] [] where rewrite1 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "SY") (TName "syncs")] env rewriteTermTo (TApp "thread-atomic" [TApp "give" [TApp "sync-feature" [TVar "SY",TName "sync-count"],TApp "else" [TApp "check-true" [TApp "is-equal" [TApp "assigned" [TName "given"],TFuncon (FValue (Nat 0))]],TApp "sequential" [TApp "check-true" [TApp "is-equal" [TApp "assigned" [TName "given"],TFuncon (FValue (Nat 1))]],TApp "assign" [TName "given",TFuncon (FValue (Nat 0))],TApp "thread-resume" [TApp "list-elements" [TApp "assigned" [TApp "sync-feature" [TVar "SY",TName "sync-waiting-list"]]]],TApp "assign" [TApp "sync-feature" [TVar "SY",TName "sync-waiting-list"],TApp "list" []]]]]]) env barrier_sync_else_wait_ fargs = FApp "barrier-sync-else-wait" (fargs) stepBarrier_sync_else_wait fargs = evalRules [rewrite1] [] where rewrite1 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "SY") (TName "syncs")] env rewriteTermTo (TApp "thread-atomic" [TApp "else" [TApp "barrier-sync" [TVar "SY"],TApp "sequential" [TApp "sync-waiting-list-add" [TVar "SY",TName "current-thread"],TApp "assign" [TApp "sync-feature" [TVar "SY",TName "sync-count"],TApp "checked" [TApp "nat-pred" [TApp "assigned" [TApp "sync-feature" [TVar "SY",TName "sync-count"]]]]],TApp "thread-suspend" [TName "current-thread"]]]]) env condition_create_ = FName "condition-create" stepCondition_create = evalRules [rewrite1] [] where rewrite1 = do let env = emptyEnv rewriteTermTo (TApp "sync-create" [TApp "sync-feature-create" [TName "sync-waiting-list"]]) env condition_wait_ fargs = FApp "condition-wait" (fargs) stepCondition_wait fargs = evalRules [rewrite1] [] where rewrite1 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "SY") (TName "syncs")] env rewriteTermTo (TApp "thread-atomic" [TApp "sequential" [TApp "sync-waiting-list-add" [TVar "SY",TName "current-thread"],TApp "thread-suspend" [TName "current-thread"]]]) env condition_wait_with_lock_ fargs = FApp "condition-wait-with-lock" (fargs) stepCondition_wait_with_lock fargs = evalRules [rewrite1] [] where rewrite1 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "SY") (TName "syncs"),VPAnnotated (VPMetaVar "L") (TName "syncs")] env rewriteTermTo (TApp "sequential" [TApp "thread-atomic" [TApp "sequential" [TApp "exclusive-lock-release" [TVar "L"],TApp "sync-waiting-list-add" [TVar "SY",TName "current-thread"],TApp "thread-suspend" [TName "current-thread"]]],TApp "exclusive-lock-sync-else-wait" [TVar "L"]]) env condition_notify_all_ fargs = FApp "condition-notify-all" (fargs) stepCondition_notify_all fargs = evalRules [rewrite1] [] where rewrite1 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "SY") (TName "syncs")] env rewriteTermTo (TApp "thread-atomic" [TApp "sequential" [TApp "thread-resume" [TApp "list-elements" [TApp "assigned" [TApp "sync-feature" [TVar "SY",TName "sync-waiting-list"]]]],TApp "assign" [TApp "sync-feature" [TVar "SY",TName "sync-waiting-list"],TApp "list" []]]]) env condition_notify_first_ fargs = FApp "condition-notify-first" (fargs) stepCondition_notify_first fargs = evalRules [rewrite1] [] where rewrite1 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "SY") (TName "syncs")] env rewriteTermTo (TApp "thread-atomic" [TApp "give" [TApp "sync-waiting-list-head-remove" [TVar "SY"],TApp "thread-resume" [TName "given"]]]) env rendezvous_create_ fargs = FApp "rendezvous-create" (fargs) stepRendezvous_create fargs = evalRules [rewrite1] [] where rewrite1 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "N") (TName "pos-ints")] env rewriteTermTo (TApp "give" [TApp "sync-create" [TApp "sync-feature-create" [TName "sync-waiting-list"],TApp "sync-feature-create" [TName "sync-count"]],TApp "sequential" [TApp "assign" [TApp "sync-feature" [TName "given",TName "sync-count"],TVar "N"],TName "given"]]) env rendezvous_sync_ fargs = FApp "rendezvous-sync" (fargs) stepRendezvous_sync fargs = evalRules [rewrite1] [] where rewrite1 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "SY") (TName "syncs"),VPAnnotated (VPMetaVar "V") (TName "ground-values")] env rewriteTermTo (TApp "give" [TApp "assigned" [TApp "sync-feature" [TVar "SY",TName "sync-waiting-list"]],TApp "sequential" [TApp "check-true" [TApp "is-rendezvous-match" [TName "given",TVar "V"]],TApp "assign" [TApp "sync-feature" [TVar "SY",TName "sync-waiting-list"],TApp "rendezvous-first-match-drop" [TName "given",TVar "V"]],TApp "thread-resume" [TApp "rendezvous-first-match-thread" [TName "given",TVar "V"]]]]) env rendezvous_sync_else_wait_ fargs = FApp "rendezvous-sync-else-wait" (fargs) stepRendezvous_sync_else_wait fargs = evalRules [rewrite1] [] where rewrite1 = do let env = emptyEnv env <- vsMatch fargs [VPAnnotated (VPMetaVar "SY") (TName "syncs"),VPAnnotated (VPMetaVar "V") (TName "ground-values")] env rewriteTermTo (TApp "thread-atomic" [TApp "else" [TApp "rendezvous-sync" [TVar "SY",TVar "V"],TApp "sequential" [TApp "sync-waiting-list-add" [TVar "SY",TApp "tuple" [TVar "V",TName "current-thread"]],TApp "thread-suspend" [TName "current-thread"]]]]) env rendezvous_waits_ = FName "rendezvous-waits" stepRendezvous_waits = evalRules [rewrite1] [] where rewrite1 = do let env = emptyEnv rewriteTermTo (TApp "tuples" [TName "ground-values",TName "thread-ids"]) env is_rendezvous_match_ fargs = FApp "is-rendezvous-match" (fargs) stepIs_rendezvous_match fargs = evalRules [rewrite1,rewrite2] [] where rewrite1 = do let env = emptyEnv env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (ADTVal "unicode-character" [FValue (Int 108)]),FValue (ADTVal "unicode-character" [FValue (Int 105)]),FValue (ADTVal "unicode-character" [FValue (Int 115)]),FValue (ADTVal "unicode-character" [FValue (Int 116)])]),PADT "tuple" [VPMetaVar "V'",VPMetaVar "TI"],VPSeqVar "P*" StarOp],VPAnnotated (VPMetaVar "V") (TName "values")] env rewriteTermTo (TApp "if-true-else" [TApp "is-equal" [TVar "V'",TVar "V"],TName "true",TApp "is-rendezvous-match" [TApp "list" [TVar "P*"],TVar "V"]]) env rewrite2 = do let env = emptyEnv env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (ADTVal "unicode-character" [FValue (Int 108)]),FValue (ADTVal "unicode-character" [FValue (Int 105)]),FValue (ADTVal "unicode-character" [FValue (Int 115)]),FValue (ADTVal "unicode-character" [FValue (Int 116)])])],VPAnnotated (VPMetaVar "V") (TName "values")] env rewriteTermTo (TName "false") env rendezvous_first_match_thread_ fargs = FApp "rendezvous-first-match-thread" (fargs) stepRendezvous_first_match_thread fargs = evalRules [rewrite1,rewrite2] [] where rewrite1 = do let env = emptyEnv env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (ADTVal "unicode-character" [FValue (Int 108)]),FValue (ADTVal "unicode-character" [FValue (Int 105)]),FValue (ADTVal "unicode-character" [FValue (Int 115)]),FValue (ADTVal "unicode-character" [FValue (Int 116)])]),PADT "tuple" [VPMetaVar "V'",VPMetaVar "TI"],VPSeqVar "P*" StarOp],VPAnnotated (VPMetaVar "V") (TName "values")] env rewriteTermTo (TApp "if-true-else" [TApp "is-equal" [TVar "V'",TVar "V"],TVar "TI",TApp "rendezvous-first-match-thread" [TApp "list" [TVar "P*"],TVar "V"]]) env rewrite2 = do let env = emptyEnv env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (ADTVal "unicode-character" [FValue (Int 108)]),FValue (ADTVal "unicode-character" [FValue (Int 105)]),FValue (ADTVal "unicode-character" [FValue (Int 115)]),FValue (ADTVal "unicode-character" [FValue (Int 116)])])],VPAnnotated (VPMetaVar "V") (TName "values")] env rewriteTermTo (TName "fail") env rendezvous_first_match_drop_ fargs = FApp "rendezvous-first-match-drop" (fargs) stepRendezvous_first_match_drop fargs = evalRules [rewrite1,rewrite2] [] where rewrite1 = do let env = emptyEnv env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (ADTVal "unicode-character" [FValue (Int 108)]),FValue (ADTVal "unicode-character" [FValue (Int 105)]),FValue (ADTVal "unicode-character" [FValue (Int 115)]),FValue (ADTVal "unicode-character" [FValue (Int 116)])]),PADT "tuple" [VPMetaVar "V'",VPMetaVar "TI"],VPSeqVar "P*" StarOp],VPAnnotated (VPMetaVar "V") (TName "values")] env rewriteTermTo (TApp "if-true-else" [TApp "is-equal" [TVar "V'",TVar "V"],TApp "list" [TVar "P*"],TApp "cons" [TApp "tuple" [TVar "V'",TVar "TI"],TApp "rendezvous-first-match-drop" [TApp "list" [TVar "P*"],TVar "V"]]]) env rewrite2 = do let env = emptyEnv env <- vsMatch fargs [PADT "datatype-value" [VPLit (ADTVal "list" [FValue (ADTVal "unicode-character" [FValue (Int 108)]),FValue (ADTVal "unicode-character" [FValue (Int 105)]),FValue (ADTVal "unicode-character" [FValue (Int 115)]),FValue (ADTVal "unicode-character" [FValue (Int 116)])])],VPAnnotated (VPMetaVar "V") (TName "values")] env rewriteTermTo (TName "fail") env