Skip to content

Commit d16dc06

Browse files
RayZopfRayZopf
committed
patch (reworked) Render.hs, get less parentheses/brackets
fix issue [#3](https://code.google.com/p/lslforge/issues/detail?id=3) - make it work on OSGrid - fix cast of cast blame [pells...@gmail.com](https://code.google.com/u/101374969631348043816/) taken from RayZopf/LSLForge_patched@a037e49 RayZopf/LSLForge_patched@8a3fbc1
1 parent 0d27b7e commit d16dc06

File tree

1 file changed

+145
-61
lines changed

1 file changed

+145
-61
lines changed

‎lslforge/haskell/src/Language/Lsl/Render.hs‎

Lines changed: 145 additions & 61 deletions
Original file line numberDiff line numberDiff line change
@@ -142,72 +142,77 @@ renderCtxExpr (Ctx _ e) = renderExpression e
142142
renderCtxExprs prefix [] = blank
143143
renderCtxExprs prefix (e:es) = renderString prefix . renderCtxExpr e . renderCtxExprs "," es
144144

145-
renderExpression (IntLit i) = shows i
146-
renderExpression (FloatLit f) = shows f
147-
renderExpression (StringLit s) = renderString ('"':go s)
148-
where go [] = "\""
149-
go ('\\':s) = '\\':'\\':go s
150-
go ('\t':s) = '\\':'t':go s
151-
go ('\n':s) = '\\':'n':go s
152-
go ('"':s) = '\\':'"':go s
153-
go (c:s) = c:go s
154-
renderExpression (KeyLit k) = shows k
155-
renderExpression (VecExpr x y z) =
156-
renderChar '<' . renderCtxExpr x . renderChar ',' .
157-
renderCtxExpr y . renderChar ',' .
158-
renderCtxExpr z . renderChar '>'
159-
renderExpression (RotExpr x y z s) =
160-
renderChar '<' . renderCtxExpr x . renderChar ',' .
161-
renderCtxExpr y . renderChar ',' .
162-
renderCtxExpr z . renderChar ',' .
163-
renderCtxExpr s . renderChar '>'
164-
renderExpression (ListExpr l) =
165-
let r prefix [] = blank
166-
r prefix (i:is) = renderString prefix . renderCtxExpr i . r "," is
167-
in renderChar '[' . r "" l . renderChar ']'
168-
renderExpression (Add expr1 expr2) = renderBinExpr "+" expr1 expr2
169-
renderExpression (Sub expr1 expr2) = renderBinExpr "-" expr1 expr2
170-
renderExpression (Mul expr1 expr2) = renderBinExpr "*" expr1 expr2
171-
renderExpression (Div expr1 expr2) = renderBinExpr "/" expr1 expr2
172-
renderExpression (Mod expr1 expr2) = renderBinExpr "%" expr1 expr2
173-
renderExpression (BAnd expr1 expr2) = renderBinExpr "&" expr1 expr2
174-
renderExpression (Xor expr1 expr2) = renderBinExpr "^" expr1 expr2
175-
renderExpression (BOr expr1 expr2) = renderBinExpr "|" expr1 expr2
176-
renderExpression (Lt expr1 expr2) = renderBinExpr "<" expr1 expr2
177-
renderExpression (Gt expr1 expr2) = renderBinExpr ">" expr1 expr2
178-
renderExpression (Le expr1 expr2) = renderBinExpr "<=" expr1 expr2
179-
renderExpression (Ge expr1 expr2) = renderBinExpr ">=" expr1 expr2
180-
renderExpression (And expr1 expr2) = renderBinExpr "&&" expr1 expr2
181-
renderExpression (Or expr1 expr2) = renderBinExpr "||" expr1 expr2
182-
renderExpression (ShiftL expr1 expr2) = renderBinExpr "<<" expr1 expr2
183-
renderExpression (ShiftR expr1 expr2) = renderBinExpr ">>" expr1 expr2
184-
renderExpression (Inv expr) = renderChar '(' . renderChar '~' . renderCtxExpr expr . renderChar ')'
185-
renderExpression (Not expr) = renderChar '(' . renderChar '!' . renderCtxExpr expr . renderChar ')'
186-
renderExpression (Neg expr) = renderChar '(' . renderChar '-' . renderCtxExpr expr . renderChar ')'
187-
renderExpression (Call name exprs) = renderCtxName name . renderChar '(' . renderCtxExprs "" exprs . renderChar ')'
188-
renderExpression (Cast t expr) = renderString "((" . renderType t . renderChar ')' . renderCtxExpr expr . renderChar ')'
189-
renderExpression (Get var) = renderVarAccess var
145+
renderExpression ex = case ex of
146+
(IntLit i) -> shows i
147+
(FloatLit f) -> shows f
148+
(StringLit s) -> renderString ('"':go s)
149+
where go [] = "\""
150+
go ('\\':s) = '\\':'\\':go s
151+
go ('\t':s) = '\\':'t':go s
152+
go ('\n':s) = '\\':'n':go s
153+
go ('"':s) = '\\':'"':go s
154+
go (c:s) = c:go s
155+
(KeyLit k) -> shows k
156+
(VecExpr x y z) ->
157+
renderChar '<' . renderCtxExpr x . renderChar ',' .
158+
renderCtxExpr y . renderChar ',' .
159+
renderCtxExpr z . renderChar '>'
160+
(RotExpr x y z s) ->
161+
renderChar '<' . renderCtxExpr x . renderChar ',' .
162+
renderCtxExpr y . renderChar ',' .
163+
renderCtxExpr z . renderChar ',' .
164+
renderCtxExpr s . renderChar '>'
165+
(ListExpr l) ->
166+
let r prefix [] = blank
167+
r prefix (i:is) = renderString prefix . renderCtxExpr i . r "," is
168+
in renderChar '[' . r "" l . renderChar ']'
169+
(Add expr1 expr2) -> renderBinExpr "+" expr1 expr2 lo
170+
(Sub expr1 expr2) -> renderBinExpr "-" expr1 expr2 lo
171+
(Mul expr1 expr2) -> renderBinExpr "*" expr1 expr2 lo
172+
(Div expr1 expr2) -> renderBinExpr "/" expr1 expr2 lo
173+
(Mod expr1 expr2) -> renderBinExpr "%" expr1 expr2 lo
174+
(BAnd expr1 expr2) -> renderBinExpr "&" expr1 expr2 lo
175+
(Xor expr1 expr2) -> renderBinExpr "^" expr1 expr2 lo
176+
(BOr expr1 expr2) -> renderBinExpr "|" expr1 expr2 lo
177+
(Lt expr1 expr2) -> renderBinExpr "<" expr1 expr2 lo
178+
(Gt expr1 expr2) -> renderBinExpr ">" expr1 expr2 lo
179+
(Le expr1 expr2) -> renderBinExpr "<=" expr1 expr2 lo
180+
(Ge expr1 expr2) -> renderBinExpr ">=" expr1 expr2 lo
181+
(And expr1 expr2) -> renderBinExpr "&&" expr1 expr2 lo
182+
(Or expr1 expr2) -> renderBinExpr "||" expr1 expr2 lo
183+
(ShiftL expr1 expr2) -> renderBinExpr "<<" expr1 expr2 lo
184+
(ShiftR expr1 expr2) -> renderBinExpr ">>" expr1 expr2 lo
185+
(Inv expr) -> renderChar '~' . renderInParenIfLower expr lo
186+
(Not expr) -> renderChar '!' . renderInParenIfLower expr lo
187+
(Neg expr) -> renderChar '-' . renderInParenIfLower expr lo
188+
(Call name exprs) -> renderCtxName name . renderChar '(' . renderCtxExprs "" exprs . renderChar ')'
189+
(Cast t expr) -> renderChar '(' . renderType t . renderChar ')' .
190+
renderInParenIfLower expr lo
191+
(Get var) -> renderVarAccess var
190192
--renderExpression (Const var) = renderVarAccess var
191193
--renderExpression (Set var expr) = renderChar '(' . renderVarAccess var . renderString " = " . renderCtxExpr expr . renderChar ')'
192-
renderExpression (Set va expr) = renderAssignment va "=" expr
193-
renderExpression (IncBy va expr) = renderAssignment va "+=" expr
194-
renderExpression (DecBy va expr) = renderAssignment va "-=" expr
195-
renderExpression (MulBy va expr) = renderAssignment va "*=" expr
196-
renderExpression (DivBy va expr) = renderAssignment va "/=" expr
197-
renderExpression (ModBy va expr) = renderAssignment va "%=" expr
198-
renderExpression (Equal expr1 expr2) = renderBinExpr "==" expr1 expr2
199-
renderExpression (NotEqual expr1 expr2) = renderBinExpr "!=" expr1 expr2
200-
renderExpression (PostInc va) = renderInParens (renderVarAccess va . renderString "++")
201-
renderExpression (PostDec va) = renderInParens (renderVarAccess va . renderString "--")
202-
renderExpression (PreInc va) = renderInParens (renderString "++" . renderVarAccess va)
203-
renderExpression (PreDec va) = renderInParens (renderString "--" . renderVarAccess va)
194+
(Set va expr) -> renderAssignment va "=" expr
195+
(IncBy va expr) -> renderAssignment va "+=" expr
196+
(DecBy va expr) -> renderAssignment va "-=" expr
197+
(MulBy va expr) -> renderAssignment va "*=" expr
198+
(DivBy va expr) -> renderAssignment va "/=" expr
199+
(ModBy va expr) -> renderAssignment va "%=" expr
200+
(Equal expr1 expr2) -> renderBinExpr "==" expr1 expr2 lo
201+
(NotEqual expr1 expr2) -> renderBinExpr "!=" expr1 expr2 lo
202+
(PostInc va) -> renderVarAccess va . renderString "++"
203+
(PostDec va) -> renderVarAccess va . renderString "--"
204+
(PreInc va) -> renderString "++" . renderVarAccess va
205+
(PreDec va) -> renderString "--" . renderVarAccess va
206+
where
207+
lo = \ t -> isLower ex t || needsBooleanParens ex t || castCast ex t
204208

205209
renderInParens f = renderChar '(' . f . renderChar ')'
206210

207-
renderBinExpr op expr1 expr2 = renderChar '(' . renderCtxExpr expr1 . renderChar ' ' .
208-
renderString op . renderChar ' ' . renderCtxExpr expr2 . renderChar ')'
211+
renderBinExpr op expr1 expr2 f =
212+
renderInParenIfLower expr1 f . renderChar ' ' . renderString op . renderChar ' ' .
213+
renderInParenIfLower expr2 f
209214
renderAssignment va op expr =
210-
renderChar '(' . renderVarAccess va . renderChar ' ' . renderString op . renderChar ' ' . renderCtxExpr expr . renderChar ')'
215+
renderVarAccess va . renderChar ' ' . renderString op . renderChar ' ' . renderCtxExpr expr
211216
renderComponent All = blank
212217
renderComponent X = renderString ".x"
213218
renderComponent Y = renderString ".y"
@@ -233,4 +238,83 @@ renderPreText :: (Maybe SourceContext) -> String -> String
233238
renderPreText = maybe (renderString "\n") (renderString . srcPreText)
234239

235240
renderPreText1 :: (String -> String) -> (Maybe SourceContext) -> String -> String
236-
renderPreText1 f = maybe (renderString "\n" . f) (renderString . srcPreText)
241+
renderPreText1 f = maybe (renderString "\n" . f) (renderString . srcPreText)
242+
243+
-- Wrap with parentheses if lower precedence
244+
245+
renderInParenIfLower :: (Ctx Expr) -> ((Ctx Expr) -> Bool) -> String -> String
246+
renderInParenIfLower ce f =
247+
if f ce then renderChar '(' . renderCtxExpr ce . renderChar ')'
248+
else renderCtxExpr ce
249+
250+
needsBooleanParens :: Expr -> Ctx Expr -> Bool
251+
needsBooleanParens ex0 (Ctx _ ex1) =
252+
case ex0 of
253+
(And _ _) -> case ex1 of
254+
(Or _ _) -> True
255+
_ -> False
256+
(Or _ _) -> case ex1 of
257+
(And _ _) -> True
258+
_ -> False
259+
_ -> False
260+
261+
castCast :: Expr -> Ctx Expr -> Bool
262+
castCast ex0 (Ctx _ ex1) =
263+
case ex0 of
264+
(Cast _ _) -> case ex1 of
265+
(Cast _ _) -> True
266+
_ -> False
267+
_ -> False
268+
269+
-- Comparing Order of Precedence
270+
271+
isLower :: Expr -> (Ctx Expr) -> Bool
272+
isLower e0 (Ctx _ e1) = prec e0 < prec e1
273+
274+
-- Smaller number is higher precedence
275+
276+
prec :: Expr -> Int
277+
prec e =
278+
case e of
279+
(IntLit _) -> 0
280+
(FloatLit _) -> 0
281+
(StringLit _) -> 0
282+
(ListExpr _) -> 0
283+
(VecExpr _ _ _) -> 0
284+
(RotExpr _ _ _ _) -> 0
285+
(KeyLit _) -> 0
286+
(Call _ _) -> 0
287+
(Cast _ _) -> 1
288+
(Not _) -> 2
289+
(Inv _) -> 2
290+
(Neg _) -> 2
291+
(PostInc _) -> 2
292+
(PostDec _) -> 2
293+
(PreInc _) -> 2
294+
(PreDec _) -> 2
295+
(Mul _ _) -> 3
296+
(Div _ _) -> 3
297+
(Mod _ _) -> 3
298+
(Add _ _) -> 4
299+
(Sub _ _) -> 4
300+
(ShiftL _ _) -> 5
301+
(ShiftR _ _) -> 5
302+
(Lt _ _) -> 6
303+
(Le _ _) -> 6
304+
(Gt _ _) -> 6
305+
(Ge _ _) -> 6
306+
(Equal _ _) -> 7
307+
(NotEqual _ _) -> 7
308+
(BAnd _ _) -> 8
309+
(Xor _ _) -> 9
310+
(BOr _ _) -> 10
311+
(And _ _) -> 11 -- usually And is higher than Or,
312+
(Or _ _) -> 11 -- this seems bug of LSL Compiler. see SVC-779
313+
(Get _) -> 0
314+
(Set _ _) -> 12
315+
(IncBy _ _) -> 12
316+
(DecBy _ _) -> 12
317+
(MulBy _ _) -> 12
318+
(DivBy _ _) -> 12
319+
(ModBy _ _) -> 12
320+
_ -> 0

0 commit comments

Comments
 (0)