From 2118e055d690fd2325f9fa4b24ec836ab0ee73ee Mon Sep 17 00:00:00 2001
From: rschoene <rene.schoene@tu-dresden.de>
Date: Wed, 4 May 2016 10:14:09 +0200
Subject: [PATCH] Request.target is now a real terminal.
---
ag-test.scm | 2 +-
ast-generation.scm | 2 +-
ast.scm | 4 ++--
basic-ag.scm | 22 +++++++++++++++++-----
example-ast.scm | 2 +-
ilp-measurement.scm | 2 +-
ilp.scm | 6 +++---
7 files changed, 26 insertions(+), 14 deletions(-)
diff --git a/ag-test.scm b/ag-test.scm
index 2a7d8ef..7b895cb 100644
--- a/ag-test.scm
+++ b/ag-test.scm
@@ -16,4 +16,4 @@
(define (do-it . args)
(let ([ast (create-system 10 0 3 4 5)])
- (display-ast ast 'remote-unit 'remote-container))))
+ (display-ast ast 'remote-unit 'remote-container 'remote-impls))))
diff --git a/ast-generation.scm b/ast-generation.scm
index 7306e97..696e63c 100644
--- a/ast-generation.scm
+++ b/ast-generation.scm
@@ -139,7 +139,7 @@
(define (create-request target-property)
(let* ([make-req (lambda (propname maxVal digits offset) (:ReqClause mquat-spec (:PropertyRef mquat-spec propname) comp-min-eq (rand maxVal digits offset)))]
- [target (<<- target-property)])
+ [target (->name (<<- target-property))])
(debug "create-request: target-property = " target-property)
(:Request
mquat-spec
diff --git a/ast.scm b/ast.scm
index bdda113..9d2db9c 100644
--- a/ast.scm
+++ b/ast.scm
@@ -17,7 +17,7 @@
->ResourceType* ; HWRoot
->container? ; ResourceType
->status ->ProvClause* ; Resource
- ->MetaParameter* ->target ->Constraints ->objective ; Request
+ ->MetaParameter* ->Constraints ->objective ; Request
->unit ->kind ->direction ->agg ; Property
:Root :RealProperty :PropertyRef
:SWRoot :Comp :Impl :Mode :ReqClause :ProvClause
@@ -43,7 +43,6 @@
(define (->container? n) (ast-child 'container n))
(define (->ProvClause* n) (ast-child 'ProvClause* n))
(define (->MetaParameter* n) (ast-child 'MetaParameter* n))
- (define (->target n) (ast-child 'target n))
(define (->Constraints n) (ast-child 'Constraints n))
(define (->objective n) (ast-child 'objective n))
(define (->ReturnType n) (ast-child 'ReturnType n))
@@ -91,6 +90,7 @@
(ast-rule 'ResourceType->name-container-Property*)
; typename points to a ResourceType
(ast-rule 'Resource->name-typename-status-Resource*<SubResources-ProvClause*)
+ ; target points to a Comp
(ast-rule 'Request->MetaParameter*-target-ReqClause*<Constraints-objective)
(ast-rule 'MetaParameter->name-value)
(ast-rule 'Property->)
diff --git a/basic-ag.scm b/basic-ag.scm
index 104b952..306776b 100644
--- a/basic-ag.scm
+++ b/basic-ag.scm
@@ -9,7 +9,7 @@
(export add-basic-ags
=objective-val =objective-name =clauses-met?
=mode-to-use =selected? =deployed? =hw?
- =req-comp-map =req-comp-min =req-comp-all =real =type
+ =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
=search-prov-clause =search-req-clause =search-pe =provided-clause
@@ -45,6 +45,9 @@
(define (=real n) (att-value 'real n))
(define (<=root n) (att-value 'get-root n))
(define (=selected? n) (att-value 'selected? n))
+ (define =target
+ (case-lambda [(n name) (att-value 'target n name)]
+ [(n) (att-value 'target n)]))
(define =type
(case-lambda [(n name) (att-value 'type n name)]
[(n) (att-value 'type n)]))
@@ -152,14 +155,14 @@
; =every-comp: Returns a list containing every component, that may be needed for the request
(ag-rule
every-comp
- (Root (lambda (n) (=every-comp (->target (<=request n)))))
+ (Root (lambda (n) (=every-comp (=target (<=request n)))))
(Comp (lambda (n) (cons n (fold-left (lambda (result c) (append (=every-comp c) result))
(list) (=req-comp-all n))))))
; =every-impl: Returns a list containing every implementation, that may be needed for the request
(ag-rule
every-impl
- (Root (lambda (n) (=every-impl (->target (<=request n)))))
+ (Root (lambda (n) (=every-impl (=target (<=request n)))))
(Comp (lambda (n) (append (->* (->Impl* n)) (fold-left (lambda (result c) (append (=every-impl c) result))
(list) (=req-comp-all n))))))
@@ -319,12 +322,21 @@
; =selected?: Returns #t, if the Implementation is selected by its component
(ag-rule selected? (Impl (lambda (n) (eq? (->selected-impl (<<- n)) n))))
- ; =remote-container: Returns whether the ResourceType, the Resource is pointing to, is a container
+ ; [DEBUGGING] Returns whether the ResourceType, the Resource is pointing to, is a container
(ag-rule remote-container (Resource (lambda (n) (->container? (=type n)))))
- ; =remote-unit: Returns the unit of the RealProperty the PropertyRef is pointing to
+ ; [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
+ (ag-rule remote-impls (Request (lambda (n) (map ->name (->* (->Impl* (=target n)))))))
+
+ ; =target: Resolves the component of a Request
+ (ag-rule
+ target
+ (Request (lambda (n) (=target (<=root n) (ast-child 'target n))))
+ (Root (lambda (n compname) (ast-find-child (lambda (i c) (string=? compname (->name c))) (->Comp* (->SWRoot n))))))
+
; =type: Resolves the type of a Resource
(ag-rule
type
diff --git a/example-ast.scm b/example-ast.scm
index 792df2e..52d073f 100644
--- a/example-ast.scm
+++ b/example-ast.scm
@@ -92,7 +92,7 @@
(:Root mquat-spec
(:HWRoot mquat-spec (list Cubieboard) (list cubie1 cubie2) (list))
(:SWRoot mquat-spec (list comp1 comp2) (list energy))
- (:Request mquat-spec (list (make-mp-size 50)) comp1
+ (:Request mquat-spec (list (make-mp-size 50)) (->name comp1)
(list (:ReqClause mquat-spec (make-ref rt-C1) comp-max-eq (lambda _ 0.3))) #f) #f)))
(define comp1 (ast-child 1 (->Comp* (->SWRoot the-example-ast))))
diff --git a/ilp-measurement.scm b/ilp-measurement.scm
index a833eb4..0497220 100644
--- a/ilp-measurement.scm
+++ b/ilp-measurement.scm
@@ -293,7 +293,7 @@
; 11 remove some modes
(define (run-complex-test id-s specs)
(define (new-request-comp ast)
- (let ([req-comp-nr (ast-child-index (->target (<=request ast)))]
+ (let ([req-comp-nr (ast-child-index (=target (<=request ast)))]
[new-comp-nr (+ 1 (ast-num-children (->Comp* (->SWRoot ast))))])
;params of add-mode: ast comp-nr impl-nr mode-nr req-comp-nr load-f energy-f prov-f prev-f
(add-mode ast new-comp-nr 1 1 ;comp-nr impl-nr mode-nr
diff --git a/ilp.scm b/ilp.scm
index e6d74c9..bf10c35 100644
--- a/ilp.scm
+++ b/ilp.scm
@@ -177,7 +177,7 @@
(list "-" (=ilp-binvar n) "=" 0)
(=every-container n))))))
- (ag-rule request-target? (Comp (lambda (n) (eq? (->target (<=request n)) n))))
+ (ag-rule request-target? (Comp (lambda (n) (eq? (=target (<=request n)) n))))
(ag-rule
ilp-objective
@@ -222,9 +222,9 @@
(lambda (n)
(att-value-compute 'ilp-nego-sw)
(cons (cons "request_target: " (fold-left (lambda (result impl) (cons* "+" (=ilp-binvar impl) result))
- (list "=" 1) (->* (->Impl* (->target n)))))
+ (list "=" 1) (->* (->Impl* (=target n)))))
(make-constraints
- (=ilp-nego-reqc (->target n) 'ProvClause comp-eq) ;provs
+ (=ilp-nego-reqc (=target n) 'ProvClause comp-eq) ;provs
(=ilp-nego-reqc n comp-max-eq) ;max-reqs
(=ilp-nego-reqc n comp-min-eq) #t))))) ;min-reqs,request?
(ag-rule
--
GitLab