Commit d525bab2 authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

the Default case is always the first in select

parent 2b85525f
......@@ -3,7 +3,7 @@ module precompiler
import Sapl.SaplParser
import Sapl.SaplTokenizer
import StdBool, StdList, StdFile, StdDebug
import StdBool, StdList, StdOrdList, StdFile, StdDebug
import Text.StringAppender, Text
import Data.Map
......@@ -22,6 +22,9 @@ import System.File
, currentFun :: String
}
selectCaseOrder (PDefault,_) _ = True
selectCaseOrder _ _ = False
newContext = {vars = newMap, localcount = 0, inspine = False, currentFun = ""}
registerArgs vars idx [] = vars
......@@ -64,14 +67,14 @@ sText text a = a <++ sNum (textSize text) <++ text
sTerm ctx (SLit lit) a = a <++ "L" <++ lit
sTerm ctx (SVar var) a = a <++ sVarApp ctx var
sTerm ctx (SApplication var terms) a = a <++ appType ctx var <++ sList (sTerm {ctx & inspine = False}) terms <++ sVar ctx var
sTerm ctx (SSelect expr cs) a = a <++ "S" <++ sTerm {ctx & inspine = False} expr <++ sList (sSelectCase ctx) cs
sTerm ctx (SSelect expr cs) a = a <++ "S" <++ sTerm {ctx & inspine = False} expr <++ sList (sSelectCase ctx) (sortBy selectCaseOrder cs)
sTerm ctx (SIf cond texpr fexpr) a = a <++ "I" <++ sTerm {ctx & inspine = False} cond <++ sTerm ctx texpr <++ sTerm ctx fexpr
isLocalVar ctx var = member (unpackVar var) ctx.vars
appType ctx var | isLocalVar ctx var
= "D"
appType {inspine, currentFun} var = if (inspine && unpackVar var == currentFun) "T" "A" // T: tail recursive
sSelectCase ctx (PCons varName params, expr) a
......
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