diff --git a/ast-generation.scm b/ast-generation.scm
index 696e63c48da32cda032c4e568ce8269ec5958ed6..a985a39a19c6f28047021959b0b2eab94f233319 100644
--- a/ast-generation.scm
+++ b/ast-generation.scm
@@ -128,7 +128,7 @@
[does-req? (and last-comp-nr (reqc name))])
(:Impl mquat-spec name
(call-n-times (lambda (mode) (make-mode comp lon mode does-req? (= 1 impl))) mode-per-impl) ; Mode*
- (if does-req? (list last-comp) (list)) #f #f))) ; reqcomps selected-mode deployed-on
+ (if does-req? (list (->name last-comp)) (list)) #f #f))) ; reqcomps selected-mode deployed-on
(define (make-comp comp) (:Comp mquat-spec (node-name "c" (list comp))
(call-n-times (lambda (impl) (make-impl comp impl)) impl-per-comp) #f
(prop comp)))
diff --git a/basic-ag.scm b/basic-ag.scm
index f2a74bef36f45a9acd5a8d0035f4e9e83207c387..0bf1ca4026adcdc3e393cf1d62eaa4b70249e871 100644
--- a/basic-ag.scm
+++ b/basic-ag.scm
@@ -44,6 +44,10 @@
(define (<=request n) (att-value 'get-request n))
(define (=real n) (att-value 'real n))
(define (<=root n) (att-value 'get-root n))
+ (define (=search-comp n name) (att-value 'search-comp n name))
+ (define (=search-prov-clause n name) (att-value 'search-clause n name 'ProvClause))
+ (define (=search-req-clause n name) (att-value 'search-clause n name 'ReqClause))
+ (define (=search-pe n name) (att-value 'search-pe n name))
(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))
@@ -53,6 +57,9 @@
(define =type
(case-lambda [(n name) (att-value 'type n name)]
[(n) (att-value 'type n)]))
+ (define (=value-attr n) (att-value 'value-attr n))
+ (define (=value-of n name) (att-value 'value-of n name))
+
(define (=every-pe n) (att-value 'every-pe n))
(define (=every-container n) (att-value 'every-container n))
(define (=every-res-type n) (att-value 'every-res-type n))
@@ -66,11 +73,6 @@
(att-value 'every-prov-clause n comp))
(define (=every-sw-clause n) (att-value 'every-sw-clause n))
(define (=every-hw-clause n) (att-value 'every-hw-clause n))
- (define (=search-prov-clause n name) (att-value 'search-clause n name 'ProvClause))
- (define (=search-req-clause n name) (att-value 'search-clause n name 'ReqClause))
- (define (=search-pe n name) (att-value 'search-pe n name))
- (define (=value-attr n) (att-value 'value-attr n))
- (define (=value-of n name) (att-value 'value-of n name))
(define (find-prop propname subtree)
(ast-find-child (lambda (i n) (and (ast-subtype? n 'RealProperty)
@@ -281,7 +283,7 @@
(add-to-al result-for-impl req impl))
result-for-comp (=req-comp-map impl))) ;fold over reqs of impl
(list) (->* (->Impl* n))))) ;fold over impls
- (Impl (lambda (n) (ast-child 'reqcomps n))))
+ (Impl (lambda (n) (map (lambda (compname) (=search-comp n compname)) (ast-child 'reqcomps n)))))
; =req-comp-min: Returns a minimal list of required components
(ag-rule
@@ -289,13 +291,13 @@
(Comp
(lambda (n)
(fold-left
- (lambda (result impl) (intersect-b #f result (ast-child 'reqcomps impl)))
+ (lambda (result impl) (intersect-b #f result (=req-comp-map impl)))
#f (->* (->Impl* n))))))
; =req-comp-all: Returns a list list of all possible required components
(ag-rule
req-comp-all
- (Comp (lambda (n) (fold-left (lambda (result impl) (union result (ast-child 'reqcomps impl))) (list) (->* (->Impl* n))))))
+ (Comp (lambda (n) (fold-left (lambda (result impl) (union result (=req-comp-map impl))) (list) (->* (->Impl* n))))))
; <=request: Get request from every node
(ag-rule get-request (Root (lambda (n) (ast-child 'Request n))))
@@ -317,6 +319,11 @@
(and (ast-subtype? clause subtype) (string=? (->name (=real (->ReturnType clause))) name)))
(->Clause* n)))))
+ ; =search-comp: Search for a component with the given name
+ (ag-rule
+ search-comp
+ (Root (lambda (n name) (ast-find-child (lambda (i c) (string=? (->name c) name)) (->Comp* (->SWRoot n))))))
+
; =search-pe: Search for a resource with the given name
(ag-rule
search-pe
@@ -345,8 +352,9 @@
; [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 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 implementations of the Component, either the Request or the impl requiring it, is pointing to
+ (ag-rule remote-impls (Request (lambda (n) (map ->name (->* (->Impl* (=target n))))))
+ (Impl (lambda (n) (map ->name (=req-comp-map 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")))))
diff --git a/example-ast.scm b/example-ast.scm
index 7fe80ce0bb7d2144b0e20e384fa1aed8df5e8bac..413ad70831a14c3a154cf2208f9c46498604f10c 100644
--- a/example-ast.scm
+++ b/example-ast.scm
@@ -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) (->name cubie1) (->name mode1a)))]
+ (:Impl mquat-spec "Sample-Impl1a" (list mode1a) (list (->name comp2)) (->name cubie1) (->name mode1a)))]
[c1-impl1b ; impl-1b is not deployed, default selected mode
(:Impl
mquat-spec "The-Sample-Impl1b"
@@ -87,7 +87,7 @@
(lambda _ 100) ;energy
rt-C1 (lambda _ 0.2) ;response-time
"default-mode-1c"))
- (list comp2) #f #f)]
+ (list (->name comp2)) #f #f)]
[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))
diff --git a/ilp-measurement.scm b/ilp-measurement.scm
index 867c652de04489e6666710b754dd21dc20d3a536..e8ead96e667821d5637232ccc81336d74fa16655 100644
--- a/ilp-measurement.scm
+++ b/ilp-measurement.scm
@@ -213,14 +213,14 @@
(or (ast-find-child (lambda (i child) (string=? (->name child) name)) l) (make-new))))
(define (find-create-comp ast comp-nr) (find-create ast (->Comp* (->SWRoot ast)) "c" (list comp-nr)
(lambda _ (add-comp ast comp-nr))))
- (define (add-impl ast comp-nr impl-nr reqcomps)
- (debug "#create new impl" comp-nr impl-nr reqcomps)
+ (define (add-impl ast comp-nr impl-nr reqcompnrs)
+ (debug "#create new impl" comp-nr impl-nr reqcompnrs)
(let ([new (:Impl mquat-spec (node-name "i" (list impl-nr comp-nr)) (list)
- (map (lambda (nr) (find-create-comp ast nr)) reqcomps) #f #f)])
+ (map (lambda (nr) (->name (find-create-comp ast nr))) reqcompnrs) #f #f)])
(rewrite-add (->Impl* (find-create-comp ast comp-nr)) new) new))
- (define (find-create-impl ast comp-nr impl-nr reqcomps) (find-create ast (->Impl* (find-create-comp ast comp-nr)) "i"
+ (define (find-create-impl ast comp-nr impl-nr reqcompnrs) (find-create ast (->Impl* (find-create-comp ast comp-nr)) "i"
(list impl-nr comp-nr)
- (lambda _ (add-impl ast comp-nr impl-nr reqcomps))))
+ (lambda _ (add-impl ast comp-nr impl-nr reqcompnrs))))
(define (add-mode ast comp-nr impl-nr mode-nr req-comp-nr load-f energy-f prov-f prev-f)
(debug "#create new mode" comp-nr impl-nr mode-nr req-comp-nr)
(let* ([impl (find-create-impl ast comp-nr impl-nr (if req-comp-nr (list req-comp-nr) (list)))]
diff --git a/ilp-test.scm b/ilp-test.scm
index 4e7530a550707c4178dc82dc7ac68d9045e62450..260d283df13dcd83b5a20f5a11cb7686959dd531 100644
--- a/ilp-test.scm
+++ b/ilp-test.scm
@@ -687,14 +687,14 @@
(let ([name (node-name prefix lon)])
(or (ast-find-child (lambda (i child) (string=? (->name child) name)) l) (make-new))))
(define (find-create-comp comp-nr) (find-create (->Comp* (->SWRoot ast)) "c" (list comp-nr) (lambda _ (add-comp comp-nr))))
- (define (add-impl comp-nr impl-nr reqcomps)
- (debug "#create new impl" comp-nr impl-nr reqcomps)
+ (define (add-impl comp-nr impl-nr reqcompnrs)
+ (debug "#create new impl" comp-nr impl-nr reqcompnrs)
(let ([new (:Impl mquat-spec (node-name "i" (list impl-nr comp-nr)) (list)
- (map (lambda (nr) (find-create-comp nr)) reqcomps) #f #f)])
+ (map (lambda (nr) (->name (find-create-comp nr))) reqcompnrs) #f #f)])
(rewrite-add (->Impl* (find-create-comp comp-nr)) new) new))
- (define (find-create-impl comp-nr impl-nr reqcomps) (find-create (->Impl* (find-create-comp comp-nr)) "i"
+ (define (find-create-impl comp-nr impl-nr reqcompnrs) (find-create (->Impl* (find-create-comp comp-nr)) "i"
(list impl-nr comp-nr)
- (lambda _ (add-impl comp-nr impl-nr reqcomps))))
+ (lambda _ (add-impl comp-nr impl-nr reqcompnrs))))
(define (add-mode comp-nr impl-nr mode-nr req-comp-nr load-f energy-f prov-f prev-f)
(debug "#create new mode" comp-nr impl-nr mode-nr req-comp-nr)
(let* ([impl (find-create-impl comp-nr impl-nr (if req-comp-nr (list req-comp-nr) (list)))]
diff --git a/ui.scm b/ui.scm
index 60cc242db9c1b9e46c99df8dbb8c32c54f53ed30..468345e9b77fc299f5ccd1e7a6a469d55cd4dec2 100644
--- a/ui.scm
+++ b/ui.scm
@@ -38,7 +38,7 @@
[name (->name impl)])
(cons
(list
- (map (lambda (c) (->name c)) (ast-child 'reqcomps impl))
+ (=req-comp-map impl)
(if (=selected? impl) (string-append "*" name) name)
(if (=deployed-on impl) (->name (=deployed-on impl)) #f)
(if (=selected? impl) (M (=mode-to-use impl)) #f))