diff --git a/ast.scm b/ast.scm
index a3c1fed703febcc84bdca7852206be5825504ff2..bc7482673a6294aa091ae191fdbec1bfd30534cb 100644
--- a/ast.scm
+++ b/ast.scm
@@ -11,7 +11,7 @@
->HWRoot ->SWRoot ; Root
->Comp* ->RealProperty* ; SWRoot
->Impl* ; Comp
- ->Mode* ->deployed-on ->selected-mode ; Impl
+ ->Mode* ; Impl
->Clause* ; Mode
->ReturnType ->comparator ; Clause
->ResourceType* ; HWRoot
@@ -31,10 +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 (->Property* n) (ast-child 'Property* n))
- (define (->deployed-on n) (ast-child 'deployedon n))
- (define (->selected-mode n) (ast-child 'selectedmode n))
(define (->Mode* n) (ast-child 'Mode* n))
(define (->Clause* n) (ast-child 'Clause* n))
(define (->ResourceType* n) (ast-child 'ResourceType* n))
diff --git a/basic-ag.scm b/basic-ag.scm
index b9d73a39395841ccfa5d37c34656525eb4c3e78a..f2a74bef36f45a9acd5a8d0035f4e9e83207c387 100644
--- a/basic-ag.scm
+++ b/basic-ag.scm
@@ -8,7 +8,7 @@
(mquat basic-ag)
(export add-basic-ags
=objective-val =objective-name =clauses-met?
- =mode-to-use =selected? =deployed? =hw?
+ =mode-to-use =selected-impl =selected? =deployed-on =hw?
=req-comp-map =req-comp-min =req-comp-all =real =target =type
=eval =eval-on =value-of =actual-value =value-attr =maximum
<=request <=impl <=comp
@@ -21,7 +21,7 @@
(define (=actual-value n) (att-value 'actual-value n))
(define (=clauses-met? n) (att-value 'clauses-met? n))
(define (<=comp n) (att-value 'get-comp n))
- (define (=deployed? n) (att-value 'deployed? n))
+ (define (=deployed-on n) (att-value 'deployed-on n))
(define (=eval n) (att-value 'eval n))
(define (=eval-on n pe) (att-value 'eval-on n pe))
(define (=hw? n) (att-value 'hw? n))
@@ -45,6 +45,7 @@
(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-mode n) (att-value 'selected-mode n))
(define (=selected? n) (att-value 'selected? n))
(define =target
(case-lambda [(n name) (att-value 'target n name)]
@@ -88,7 +89,7 @@
[target (<<- (=real (->ReturnType n)))])
((->value (if (ast-subtype? target 'ResourceType)
; hw → search in deployedon for name and type
- (=provided-clause (->deployed-on (<=impl n)) propName target)
+ (=provided-clause (=deployed-on (<=impl n)) propName target)
; sw → search in target-component
(=provided-clause (=mode-to-use (=selected-impl target)) propName)))
(->MetaParameter* (<=request n)))))) ; Params from request, applied to the value function
@@ -108,8 +109,11 @@
(ProvClause (lambda (n) #t)) ; Provision clauses are always fulfilled
(Request (lambda (n) (for-all =clauses-met? (->* (->Constraints n))))))
- ; =deployed?: Returns #t, if the Implementation is deployed somewhere
- (ag-rule deployed? (Impl (lambda (n) (ast-node? (->deployed-on n)))))
+ ; =deployed-on: Resolves the resource the implementation is deployed on; #f if not deployed anywhere
+ (ag-rule
+ deployed-on
+ (Impl (lambda (n) (let ([d (ast-child 'deployed-on n)])
+ (and d (=search-pe n d))))))
; =eval: Call the function of a Clause with the MetaParams-AST-node of the request and on the current deployed resource type
(ag-rule
@@ -119,7 +123,7 @@
; If inside a mode and impl of mode is selected, or outside of a mode ...
(att-value 'eval-on n (if (and (ast-subtype? (<<- n) 'Mode) (=selected? (<=impl n)))
; use the resource deployed-on...
- (->deployed-on (<=impl n))
+ (=deployed-on (<=impl n))
#f))))) ; ... else evaluate it with #f as target
; =eval: Call the function of a Clause with the MetaParams-AST-node of the request and on the given resource type
@@ -216,7 +220,7 @@
(ResourceType (lambda (n prop) (map (lambda (pe) (=lookup-clause pe prop)) (=resources-of n)))))
; =mode-to-use: Return either the selected-mode or the first mode
- (ag-rule mode-to-use (Impl (lambda (n) (or (->selected-mode n) (ast-child 1 (->Mode* n))))))
+ (ag-rule mode-to-use (Impl (lambda (n) (or (=selected-mode n) (ast-child 1 (->Mode* n))))))
; =objective-name: Get the name of the objective, defaults to pn-energy
(ag-rule objective-name (Root (lambda (n) (or (->objective (<=request n)) pn-energy))))
@@ -320,6 +324,12 @@
(Resource (lambda (n name) (or (string=? (->name n) name) (ast-find-child (lambda (i pe) (=search-pe pe name))
(->SubResources n))))))
+ ; =selected-mode: Resolves the selected mode of an implementation
+ (ag-rule
+ selected-mode
+ (Impl (lambda (n) (let ([sm (ast-child 'selectedmode n)])
+ (and sm (ast-find-child (lambda (i m) (string=? sm (->name m))) (->Mode* n)))))))
+
; =selected-impl: Resolves the selected implementation of a component
(ag-rule
selected-impl
@@ -335,9 +345,15 @@
; [DEBUGGING] Returns the unit of the RealProperty the PropertyRef is pointing to
(ag-rule remote-unit (PropertyRef (lambda (n) (->unit (=real n)))))
- ; [DEBUGGING] Returns the names of all implements of the Component the Request is pointing to
+ ; [DEBUGGING] Returns the names of all implementations of the Component the Request is pointing to
(ag-rule remote-impls (Request (lambda (n) (map ->name (->* (->Impl* (=target n)))))))
+ ; [DEBUGGING] Returns the names of all modes of the selected implementation the Component is pointing to
+ (ag-rule remote-modes (Comp (lambda (n) (let ([si (=selected-impl n)]) (if si (map ->name (->* (->Mode* si))) "No impl selected")))))
+
+ ; [DEBUGGING] Returns the property names of all clauses of the selected mode the Implementation is pointing to
+ (ag-rule remote-props (Impl (lambda (n) (let ([sm (=selected-mode n)]) (if sm (map (lambda (cl) (->name (=real (->ReturnType cl)))) (->* (->Clause* sm))) "No mode selected")))))
+
; =target: Resolves the component of a Request
(ag-rule
target
diff --git a/example-ast.scm b/example-ast.scm
index 52d073f9f617a0fbb8af503e73e15a55de30cc4b..7fe80ce0bb7d2144b0e20e384fa1aed8df5e8bac 100644
--- a/example-ast.scm
+++ b/example-ast.scm
@@ -47,8 +47,8 @@
(* 1.5 mp-size))))
rt-C2 (lambda _ 0.5) ;response-time
"dynamic-mode-2a"))] ;name of Mode
- (:Impl mquat-spec "Part-Impl2a" (list mode2a) (list) cubie1 mode2a))]
- [comp2 (:Comp mquat-spec "Depth2-Component" (list part-impl2a) part-impl2a (list rt-C2))]
+ (:Impl mquat-spec "Part-Impl2a" (list mode2a) (list) (->name cubie1) (->name mode2a)))]
+ [comp2 (:Comp mquat-spec "Depth2-Component" (list part-impl2a) (->name part-impl2a) (list rt-C2))]
[rt-C1 (make-simple-prop "response-time-C1" "ms" agg-sum)]
[c1-impl1a
(let
@@ -58,7 +58,7 @@
(lambda _ 20) ;energy
rt-C1 (lambda _ 0.2) ;response-time
"static-mode-1a"))] ;name of Mode
- (:Impl mquat-spec "Sample-Impl1a" (list mode1a) (list comp2) cubie1 mode1a))]
+ (:Impl mquat-spec "Sample-Impl1a" (list mode1a) (list comp2) (->name cubie1) (->name mode1a)))]
[c1-impl1b ; impl-1b is not deployed, default selected mode
(:Impl
mquat-spec "The-Sample-Impl1b"
@@ -88,7 +88,7 @@
rt-C1 (lambda _ 0.2) ;response-time
"default-mode-1c"))
(list comp2) #f #f)]
- [comp1 (:Comp mquat-spec "Example-Component" (list c1-impl1a c1-impl1b c1-impl1c) c1-impl1a (list rt-C1))])
+ [comp1 (:Comp mquat-spec "Example-Component" (list c1-impl1a c1-impl1b c1-impl1c) (->name c1-impl1a) (list rt-C1))])
(:Root mquat-spec
(:HWRoot mquat-spec (list Cubieboard) (list cubie1 cubie2) (list))
(:SWRoot mquat-spec (list comp1 comp2) (list energy))
@@ -104,4 +104,4 @@
(define cb1 (ast-child 1 (->SubResources (->HWRoot the-example-ast))))
(define cb2 (ast-child 2 (->SubResources (->HWRoot the-example-ast))))
- (define (print-the-example-ast) (display-ast the-example-ast 'remote-unit 'remote-container)))
+ (define (print-the-example-ast) (display-ast the-example-ast 'remote-unit 'remote-container 'remote-impls 'remote-modes 'remote-props)))
diff --git a/ilp-measurement.scm b/ilp-measurement.scm
index 0497220fb3afe323e99a3256f5b5490ea402589d..867c652de04489e6666710b754dd21dc20d3a536 100644
--- a/ilp-measurement.scm
+++ b/ilp-measurement.scm
@@ -300,7 +300,7 @@
req-comp-nr (lambda _ 0.8) ;req-comp-nr load-f
(lambda _ 20) (lambda _ 2) (lambda _ 7)) ;energy-f prov-f prev-f
;adjust request to target new comp
- (rewrite-terminal 'target (<=request ast) (find-create-comp ast new-comp-nr))))
+ (rewrite-terminal 'target (<=request ast) (->name (find-create-comp ast new-comp-nr)))))
(let* ([ast (cst id-s specs)]
[rt (ast-child 1 (->ResourceType* (->HWRoot ast)))]
[pe+parent (lambda (pe) (cons pe (<- pe)))]
diff --git a/ilp-test.scm b/ilp-test.scm
index da37dc73b3855833394c11e8c8817dc6dac3916e..4e7530a550707c4178dc82dc7ac68d9045e62450 100644
--- a/ilp-test.scm
+++ b/ilp-test.scm
@@ -700,16 +700,17 @@
(let* ([impl (find-create-impl comp-nr impl-nr (if req-comp-nr (list req-comp-nr) (list)))]
[find-prop-hw (lambda (name) (ast-find-child (lambda (i child) (string=? (->name (=real child)) name))
(->Property* (car (->* (->ResourceType* (->HWRoot ast)))))))]
- [find-prop-sw (lambda (name comp) (ast-find-child (lambda (i child) (string=? (->name (=real child)) name))
- (->Property* comp)))]
+ ; [find-prop-sw (lambda (name comp) (ast-find-child (lambda (i child) (string=? (->name (=real child)) name))
+ ; (->Property* comp)))]
[load (find-prop-hw pn-load)]
- [energy (find-prop-sw pn-energy (find-create-comp comp-nr))]
- [prev-p (and req-comp-nr (find-prop-sw (node-name "p" (list req-comp-nr)) (find-create-comp req-comp-nr)))]
- [this-p (find-prop-sw (node-name "p" (list comp-nr)) (find-create-comp comp-nr))]
+; [energy (find-prop-sw pn-energy (find-create-comp comp-nr))]
+; [prev-p (and req-comp-nr (find-prop-sw (node-name "p" (list req-comp-nr)) (find-create-comp req-comp-nr)))]
+; [this-p (find-prop-sw (node-name "p" (list comp-nr)) (find-create-comp comp-nr))]
[clauses (filter (lambda (c) c) (list (:ReqClause mquat-spec (:PropertyRef mquat-spec pn-load) comp-max-eq load-f)
(:ProvClause mquat-spec (:PropertyRef mquat-spec pn-energy) comp-max-eq energy-f)
- (:ProvClause mquat-spec (:PropertyRef mquat-spec (->name this-p)) comp-max-eq prov-f)
- (and req-comp-nr (:ReqClause mquat-spec (:PropertyRef mquat-spec (->name prev-p)) comp-max-eq prev-f))))]
+ (:ProvClause mquat-spec (:PropertyRef mquat-spec (node-name "p" (list comp-nr))) comp-max-eq prov-f)
+ (and req-comp-nr (:ReqClause mquat-spec (:PropertyRef mquat-spec (node-name "p" (list req-comp-nr)))
+ comp-max-eq prev-f))))]
[new (:Mode mquat-spec (node-name "m" (list mode-nr impl-nr comp-nr)) clauses)])
(rewrite-add (->Mode* impl) new) new))
(define (prov-obj val id) (+ val (/ id 1e3)))
@@ -737,7 +738,7 @@
(remove-req-constraints ast)
(save-ilp tmp-lp ast)
(add-mode 2 1 1 1 (lambda _ 0.8) (lambda _ 20) (lambda _ 2) (lambda _ 7))
- (rewrite-terminal 'target (<=request ast) (find-create-comp 2))]
+ (rewrite-terminal 'target (<=request ast) (->name (find-create-comp 2)))]
[(604) ; New component with one impl and one mode and using the existing comp
; High load on res-1, high load required for comp-1-modes, low load required for new comp/mode
; Expected outcome: mode-1-1-1 on res-1 and (new) mode-2-1-1 on res-2
@@ -747,7 +748,7 @@
(remove-req-constraints ast)
(save-ilp tmp-lp ast)
(add-mode 2 1 1 1 (lambda _ 0.8) (lambda _ 20) (lambda _ 2) (lambda _ 7))
- (rewrite-terminal 'target (<=request ast) (find-create-comp 2))]
+ (rewrite-terminal 'target (<=request ast) (->name (find-create-comp 2)))]
[(605) ; New component using the existing comp, with one impl and one mode. Request still targets old component.
; Expected outcome: mode-1-1-1 on either res-1 or res-2
(change-sw-req ast "load" comp-max-eq 0.8)
diff --git a/ilp_test.py b/ilp_test.py
index 049b18bca7b02261f5a19ed6595dbb7763fad39c..f5af734e60e7ba786787885bc9a52391d721d465 100644
--- a/ilp_test.py
+++ b/ilp_test.py
@@ -10,7 +10,7 @@ try:
from fabric.api import task
except ImportError:
from fabric_workaround import task
-import utils
+import utils, properties
from utils import local_quiet, assertTrue, assertTrueAssertion
NUM_PROCESSORS = 4
@@ -36,6 +36,11 @@ def do_run(call_impl, given_ranges):
if not ranges:
print 'No test matches {0}. Aborting.'.format(list(given_ranges))
sys.exit(1)
+
+ # disable profiling as it disturbs ilp output
+ properties.profiling.value = False
+ properties.profiling.write_value()
+
test_ids = []
for lb,ub in ranges:
test_ids.extend(range(lb,ub+1))
diff --git a/scheme.properties b/scheme.properties
index 23f04c9e4567d80ee97a622d772c5332f7f4f285..d6f1e33cdd801ee7df77979480cef07efe3494c4 100644
--- a/scheme.properties
+++ b/scheme.properties
@@ -5,7 +5,7 @@ timing = 0
log.info = 1
log.debug = 0
measure.lp.write = 0
-measure.profiling = 1
+measure.profiling = 0
measure.flush = 0
measure.non-cached = 0
measure.presleep = 2.0
diff --git a/ui.scm b/ui.scm
index 9feb76188a3399e485728d987c5003da02412f07..60cc242db9c1b9e46c99df8dbb8c32c54f53ed30 100644
--- a/ui.scm
+++ b/ui.scm
@@ -40,7 +40,7 @@
(list
(map (lambda (c) (->name c)) (ast-child 'reqcomps impl))
(if (=selected? impl) (string-append "*" name) name)
- (if (=deployed? impl) (->name (->deployed-on impl)) #f)
+ (if (=deployed-on impl) (->name (=deployed-on impl)) #f)
(if (=selected? impl) (M (=mode-to-use impl)) #f))
(I (cdr loi))))))])
(fold-left
@@ -87,21 +87,21 @@
; 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) (->name new-pe)))
(define (use-next-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)]
+ [former-deployed (=deployed-on former-impl)]
[new-index (+ (mod former-index num-impls) 1)]
[new-impl (ast-sibling new-index former-impl)]
[first-new-mode (car (->* (->Mode* new-impl)))])
(rewrite-terminal 'deployedon former-impl #f)
(rewrite-terminal 'selectedmode former-impl #f)
(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
+ (rewrite-terminal 'deployedon new-impl (->name former-deployed))
+ (rewrite-terminal 'selectedmode new-impl (->name first-new-mode)) ; use first mode
new-impl))
(define (display-part node . attributes)