small optimization with selectors

git-svn-id: https://svn.cs.ru.nl/repos/clean-sapl/branches/hierarchical@622 cb785ff4-4565-4a15-8565-04c4fcf96d79

src/Sapl/SaplStruct.dcl

@@ -19,6 +19,7 @@ import Data.Maybe
 			| SVar SaplVar
 			| SApplication SaplVar [SaplTerm]
 			| SIf SaplTerm SaplTerm SaplTerm
+			| SSelector SaplTerm
 			| SSelect SaplTerm [(SaplPattern, SaplTerm)]
 			| SLet SaplTerm [SaplLetDef]
 			| SAbortBody			

src/Sapl/Target/JS/CodeGeneratorJS.icl

@@ -9,9 +9,11 @@ implementation module Sapl.Target.JS.CodeGeneratorJS
  */
 
 import StdEnv, Data.Maybe, Data.Void, Text.StringAppender, Data.Map, Sapl.FastString
+import qualified Data.List as DL
 import Text.Unicode.Encodings.JS
 import Sapl.SaplTokenizer, Sapl.SaplParser, Sapl.Target.Flavour, Sapl.Optimization.StrictnessPropagation
 import Sapl.Transform.Let
+import Sapl.Transform.AddSelectors
 
 from Data.List import elem_by, partition
 
@@ -110,7 +112,7 @@ isTailRecursive var (SLet body _) = isTailRecursive var body
 isTailRecursive _ _ = False
 
 funcCoder :: !FuncType !CoderState !StringAppender -> StringAppender
-funcCoder (FTFunc name body args) s a = normalFunc name body args s a
+funcCoder (FTFunc name body args) s a = normalFunc name (addSelectors body) args s a
 funcCoder (FTMacro name body args) s a = normalFunc name body args s a
 funcCoder (FTCAF name body) s a = encodeCAF name body s a
 funcCoder (FTADT name args) s a = foldl (\a t = termCoder t s a) a args
@@ -579,6 +581,11 @@ where
 	termCoder :: !SaplTerm !CoderState !StringAppender -> StringAppender
 	termCoder t=:(SVar var) s a = termCoder var s a
 		
+	termCoder t=:(SSelector (SSelect expr [(PCons _ vs, SVar x)])) s a
+      # (idx, _) = foldl (\(idx, cnt) v -> if (eqVarByName x v) (cnt, cnt) (idx, cnt + 1)) (0, 0) vs
+      = a <++ "Sapl.feval(" <++ forceTermCoder expr {s & cs_intrfunc = Nothing} <++ "[" <++ idx + 2 <++ "])"
+	termCoder t=:(SSelector x) s a = termCoder x s a
+
 	termCoder t=:(SSelect expr patterns) s a | any (isConsPattern o fst) patterns
 		# a = a <++ "var ys=" <++ forceTermCoder expr {s & cs_intrfunc = Nothing} <++  ";"
 		= if (containsUnsafeSelect s t) (unsafe a) (safe a)

src/Sapl/Transform/AddSelectors.dcl

+definition module Sapl.Transform.AddSelectors
+
+from Sapl.SaplStruct import :: SaplTerm
+
+class addSelectors t :: !t -> t
+
+instance addSelectors SaplTerm

src/Sapl/Transform/AddSelectors.icl

+implementation module Sapl.Transform.AddSelectors
+
+import Sapl.SaplStruct
+import StdBool, StdList
+
+instance addSelectors SaplTerm where
+  addSelectors (SApplication v ts) = SApplication v (map addSelectors ts)
+  addSelectors (SIf c t e)  = SIf (addSelectors c) (addSelectors t) (addSelectors e)
+  addSelectors st=:(SSelect t ps=:[(PCons _ vs, SVar x)])
+    # t` = addSelectors t
+    | foldr (\v acc -> acc || eqVarByName v x) False vs = SSelector (SSelect t` ps)
+    | otherwise                                         = SSelect t` ps
+  addSelectors (SLet t lds) = SLet (addSelectors t) (map addSelectors lds)
+  addSelectors st = st
+
+instance addSelectors SaplLetDef where
+  addSelectors (SaplLetDef v t) = SaplLetDef v (addSelectors t)