diff --git a/ast.scm b/ast.scm index 9d2db9cad09ff35c2f492b6894a4223530d8b352..a3c1fed703febcc84bdca7852206be5825504ff2 100644 --- a/ast.scm +++ b/ast.scm @@ -10,7 +10,7 @@ ->name ->Property* ->* <- <<- ->SubResources ->value ; common ->HWRoot ->SWRoot ; Root ->Comp* ->RealProperty* ; SWRoot - ->Impl* ->selected-impl ; Comp + ->Impl* ; Comp ->Mode* ->deployed-on ->selected-mode ; Impl ->Clause* ; Mode ->ReturnType ->comparator ; Clause @@ -31,7 +31,7 @@ (define (->RealProperty* n) (ast-child 'RealProperty* n)) (define (->name n) (ast-child 'name n)) (define (->Impl* n) (ast-child 'Impl* n)) - (define (->selected-impl n) (ast-child 'selectedimpl n)) +; (define (->selected-impl n) (ast-child 'selectedimpl n)) (define (->Property* n) (ast-child 'Property* n)) (define (->deployed-on n) (ast-child 'deployedon n)) (define (->selected-mode n) (ast-child 'selectedmode n)) @@ -77,6 +77,7 @@ (ast-rule 'Root->HWRoot-SWRoot-Request-config) (ast-rule 'SWRoot->Comp*-RealProperty*) + ; selectedimpl points to a Impl (ast-rule 'Comp->name-Impl*-selectedimpl-Property*) (ast-rule 'Impl->name-Mode*-reqcomps-deployedon-selectedmode) (ast-rule 'Mode->name-Clause*) diff --git a/basic-ag.scm b/basic-ag.scm index 306776b78db1d2d4979473231af8077383bb8a66..b9d73a39395841ccfa5d37c34656525eb4c3e78a 100644 --- a/basic-ag.scm +++ b/basic-ag.scm @@ -44,6 +44,7 @@ (define (<=request n) (att-value 'get-request n)) (define (=real n) (att-value 'real n)) (define (<=root n) (att-value 'get-root n)) + (define (=selected-impl n) (att-value 'selected-impl n)) (define (=selected? n) (att-value 'selected? n)) (define =target (case-lambda [(n name) (att-value 'target n name)] @@ -89,7 +90,7 @@ ; hw → search in deployedon for name and type (=provided-clause (->deployed-on (<=impl n)) propName target) ; sw → search in target-component - (=provided-clause (=mode-to-use (->selected-impl target)) propName))) + (=provided-clause (=mode-to-use (=selected-impl target)) propName))) (->MetaParameter* (<=request n)))))) ; Params from request, applied to the value function (ProvClause (lambda (n) (=eval n)))) @@ -100,7 +101,7 @@ (ag-rule clauses-met? (Root (lambda (n) (and (=clauses-met? (<=request n)) (for-all =clauses-met? (->* (->Comp* (->SWRoot n))))))) - (Comp (lambda (n) (=clauses-met? (->selected-impl n)))) + (Comp (lambda (n) (=clauses-met? (=selected-impl n)))) (Impl (lambda (n) (=clauses-met? (=mode-to-use n)))) (Mode (lambda (n) (for-all =clauses-met? (->* (->Clause* n))))) (ReqClause (lambda (n) ((comp->f (->comparator n)) (=eval n) (=actual-value n)))) @@ -225,7 +226,7 @@ objective-value (Root (lambda (n) (=objective-val (->SWRoot n)))) (SWRoot (lambda (n) (fold-left (lambda (total comp) (+ total (=objective-val comp))) 0 (->* (->Comp* (->SWRoot n)))))) - (Comp (lambda (n) (=objective-val (->selected-impl n)))) + (Comp (lambda (n) (=objective-val (=selected-impl n)))) (Impl (lambda (n) (=objective-val (=mode-to-use n)))) (Mode (lambda (n) (=eval (=provided-clause n (=objective-name n)))))) @@ -319,8 +320,14 @@ (Resource (lambda (n name) (or (string=? (->name n) name) (ast-find-child (lambda (i pe) (=search-pe pe name)) (->SubResources n)))))) + ; =selected-impl: Resolves the selected implementation of a component + (ag-rule + selected-impl + (Comp (lambda (n) (let ([si (ast-child 'selectedimpl n)]) + (and si (ast-find-child (lambda (j i) (string=? si (->name i))) (->Impl* n))))))) + ; =selected?: Returns #t, if the Implementation is selected by its component - (ag-rule selected? (Impl (lambda (n) (eq? (->selected-impl (<<- n)) n)))) + (ag-rule selected? (Impl (lambda (n) (eq? (=selected-impl (<<- n)) n)))) ; [DEBUGGING] Returns whether the ResourceType, the Resource is pointing to, is a container (ag-rule remote-container (Resource (lambda (n) (->container? (=type n))))) diff --git a/ui.scm b/ui.scm index 9312ba29622130421b205de49adf094982683e75..9feb76188a3399e485728d987c5003da02412f07 100644 --- a/ui.scm +++ b/ui.scm @@ -87,10 +87,10 @@ ; Given a component (or an impl) and a resource, change deployed-on of the selected impl ; of the given component (or the given impl) to the given resource, returning the old resource - (define (deploy-on x new-pe) (rewrite-terminal 'deployedon (if (ast-subtype? x 'Comp) (->selected-impl x) x) new-pe)) + (define (deploy-on x new-pe) (rewrite-terminal 'deployedon (if (ast-subtype? x 'Comp) (=selected-impl x) x) new-pe)) (define (use-next-impl comp) - (let* ([former-impl (->selected-impl comp)] + (let* ([former-impl (=selected-impl comp)] [former-index (ast-child-index former-impl)] [num-impls (ast-num-children (->Impl* comp))] [former-deployed (->deployed-on former-impl)] @@ -99,7 +99,7 @@ [first-new-mode (car (->* (->Mode* new-impl)))]) (rewrite-terminal 'deployedon former-impl #f) (rewrite-terminal 'selectedmode former-impl #f) - (rewrite-terminal 'selectedimpl comp new-impl) + (rewrite-terminal 'selectedimpl comp (->name new-impl)) (rewrite-terminal 'deployedon new-impl former-deployed) (rewrite-terminal 'selectedmode new-impl first-new-mode) ; use first mode new-impl))