Commit a944c249 authored by Bas Lijnse's avatar Bas Lijnse

Added a new module Sapl.Target.CleanFlavour that contains the clean.f flavour...

Added a new module Sapl.Target.CleanFlavour that contains the clean.f flavour as a predefined Clean value
parent 461d2c66
......@@ -20,7 +20,7 @@ where
= checkInline
checkInline = case get n inlineFunctions of
(Just def) = if (nr_args < def.arity || i >= def.arity) False (def.strictness.[i] == '1')
(Just def) = if (nr_args < def.InlineFunDef.arity || i >= def.InlineFunDef.arity) False (def.strictness.[i] == '1')
= False
doStrictnessPropagation :: !ParserState !IsStrictArgFun ![FuncType] -> (![FuncType], !ParserState)
......@@ -108,4 +108,4 @@ where
walk sd t = (sd, t)
\ No newline at end of file
definition module Sapl.Target.CleanFlavour
/**
* Built in Flavour defintion for Clean.
* You can use this instead of having your program parse a clean.f flavour file at runtime each time
*/
from Sapl.Target.Flavour import :: Flavour
//The flavour definition for Clean
cleanFlavour :: Flavour
This diff is collapsed.
......@@ -43,9 +43,29 @@ from Data.Set import :: Set
*/
, inlineFunctions :: Map String InlineFunDef
}
//Serialized representation
:: FlavourRep = { fun_prefix :: String
, options :: [String]
, bifs :: [BIFRep]
}
:: BIFRep = { sapl_fun :: String
// number of arguments
, arity :: Int
// custom data constructor? (always inlined)
, data_cons :: Maybe Bool
// JavaScript function name, if the expression cannot be inloined
, ext_fun :: Maybe String
// JavaScript expression if inlinement is possible:
// the expression is at strict position and saturated
, inline_exp :: Maybe String
}
toFlavour :: !String -> Maybe Flavour
fromFlavourRep :: !FlavourRep -> Flavour
// Check if a given flag is set or not in the flavour file
isSet :: !Flavour !String -> Bool
......
implementation module Sapl.Target.Flavour
import StdList, StdFunc, StdArray
import Data.Maybe, Text.JSON, Text.StringAppender
import Data.Maybe, Data.Functor, Text.JSON, Text.StringAppender
import Sapl.SaplParser
from Data.Set import qualified fromList, member
import qualified Data.Map as DM
:: FlavourRep = { fun_prefix :: String
, options :: [String]
, bifs :: [BIFRep]
}
:: BIFRep = { sapl_fun :: String
// number of arguments
, arity :: Int
// custom data constructor? (always inlined)
, data_cons :: Maybe Bool
// JavaScript function name, if the expression cannot be inloined
, ext_fun :: Maybe String
// JavaScript expression if inlinement is possible:
// the expression is at strict position and saturated
, inline_exp :: Maybe String
}
derive JSONEncode FlavourRep, BIFRep
derive JSONDecode FlavourRep, BIFRep
......@@ -46,20 +29,15 @@ where
revstr ss = toString (reverse ss)
toFlavour :: !String -> Maybe Flavour
toFlavour str
= case mbRep of
Nothing = Nothing
Just rep = Just (toFlavour` rep)
where
mbRep :: Maybe FlavourRep
mbRep = fromJSON (fromString str)
toFlavour` rep
toFlavour str = fmap fromFlavourRep (fromJSON (fromString str))
fromFlavourRep :: !FlavourRep -> Flavour
fromFlavourRep rep
= { fun_prefix = rep.FlavourRep.fun_prefix
, options = 'Data.Set'.fromList rep.FlavourRep.options
, builtInFunctions = builtInFunctions
, inlineFunctions = inlineFunctions}
where
where
bifs = filter (\f -> isJust f.ext_fun) rep.bifs
bifList = map (\f -> (f.sapl_fun, (fromJust f.ext_fun, f.BIFRep.arity))) bifs
builtInFunctions = 'DM'.fromList bifList
......@@ -97,4 +75,4 @@ isSet f opt = 'Data.Set'.member opt f.Flavour.options
\ No newline at end of file
......@@ -50,7 +50,7 @@ newState f tramp p =
, cs_builtins = f.builtInFunctions
, cs_inlinefuncs = f.inlineFunctions
, cs_trampoline = tramp
, cs_prefix = f.fun_prefix
, cs_prefix = f.Flavour.fun_prefix
}
pushArgs :: !CoderState ![SaplTypedVar] -> CoderState
......@@ -431,7 +431,7 @@ where
= constructorInliner t constructor [] s a
// custom data constructors can be inlined even at non-strict position
| isJust mbInlineFun && inlineFun.data_cons && inlineFun.arity == 0
| isJust mbInlineFun && inlineFun.InlineFunDef.data_cons && inlineFun.InlineFunDef.arity == 0
= a <++ "(" <++ inlineFun.fun (\t a = termCoder t s a) (\t a = forceTermCoder t s a) [] <++ ")"
| isJust s.cs_inbody && not isLocalVar && isJust mbCAF
......@@ -544,17 +544,17 @@ where
= forceApp (\a -> a <++ forceTermCoder (SApplication (SVar name) (take functionArity args)) s <++ ",["
<++ termArrayCoder (drop functionArity args) "," {s & cs_intrfunc = Nothing} <++ "]") a
| isJust mbInlineFun && inlineFun.arity == length args
| isJust mbInlineFun && inlineFun.InlineFunDef.arity == length args
= a <++ "(" <++ inlineFun.fun
(\t a = termCoder t {s & cs_intrfunc = Nothing} a)
(\t a = forceTermCoder t {s & cs_intrfunc = Nothing} a) args <++ ")"
// more arguments than needed: split it
| isJust mbInlineFun && inlineFun.arity < length args
| isJust mbInlineFun && inlineFun.InlineFunDef.arity < length args
= forceApp (\a -> a <++ inlineFun.fun
(\t a = termCoder t {s & cs_intrfunc = Nothing} a)
(\t a = forceTermCoder t {s & cs_intrfunc = Nothing} a) (take inlineFun.arity args) <++ ",["
<++ termArrayCoder (drop inlineFun.arity args) "," {s & cs_intrfunc = Nothing} <++ "]") a
(\t a = forceTermCoder t {s & cs_intrfunc = Nothing} a) (take inlineFun.InlineFunDef.arity args) <++ ",["
<++ termArrayCoder (drop inlineFun.InlineFunDef.arity args) "," {s & cs_intrfunc = Nothing} <++ "]") a
// BINs return no thunk, there is no need for feval even in trampolining
// no prefix for built-in functions
......@@ -651,7 +651,7 @@ where
| isJust mbConstructor && constructor.nr_args == length args
= constructorInliner name constructor args s a
| isJust mbInlineFun && inlineFun.arity == length args
| isJust mbInlineFun && inlineFun.InlineFunDef.arity == length args
= a <++ "(" <++ inlineFun.fun
(\t a = termCoder t {s & cs_intrfunc = Nothing} a)
(\t a = forceTermCoder t {s & cs_intrfunc = Nothing} a) args <++ ")"
......@@ -736,7 +736,7 @@ where
= constructorInliner name constructor args s a
// custom data constructors can be inlined even at non-strict position
| isJust mbInlineFun && inlineFun.data_cons && inlineFun.arity == length args
| isJust mbInlineFun && inlineFun.InlineFunDef.data_cons && inlineFun.InlineFunDef.arity == length args
= a <++ "(" <++ inlineFun.fun
(\t a = termCoder t {s & cs_intrfunc = Nothing} a)
(\t a = forceTermCoder t {s & cs_intrfunc = Nothing} a) args <++ ")"
......
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