Commit a10a0f19 authored by László Domoszlai's avatar László Domoszlai

small optimization with selectors

git-svn-id: https://svn.cs.ru.nl/repos/clean-sapl/branches/hierarchical@622 cb785ff4-4565-4a15-8565-04c4fcf96d79
parent e1453b63
......@@ -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
......
......@@ -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)
......
definition module Sapl.Transform.AddSelectors
from Sapl.SaplStruct import :: SaplTerm
class addSelectors t :: !t -> t
instance addSelectors SaplTerm
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)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment