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

use Data.Map qualified (per request of Jurrien)

git-svn-id: https://svn.cs.ru.nl/repos/clean-sapl/branches/hierarchical@625 cb785ff4-4565-4a15-8565-04c4fcf96d79
parent a10a0f19
implementation module Sapl.Linker.LazyLinker
import StdEnv, Data.Maybe, Data.Map, Text
import StdEnv, Data.Maybe, Text
import Sapl.SaplTokenizer, Sapl.Linker.SaplLinkerShared, Text.StringAppender
import qualified Data.Map as DM
from Sapl.FastString import charIndexBackwards
from Data.Set import newSet
......@@ -65,16 +67,16 @@ generateLoaderState dirs mods exclude world
// Add individual modules (extension doesn't matter in this case)
# ms = toPairTopLevel "" mods ++ ms
# omap = fromList os
# mmap = fromList ms
# mmap = delList exclude mmap
# omap = 'DM'.fromList os
# mmap = 'DM'.fromList ms
# mmap = 'DM'.delList exclude mmap
// If an override doesn't actually override anything, move it to normal modules
# onlyoverride = toList (delList (map fst (toList mmap)) omap)
# omap = delList (map fst onlyoverride) omap
# mmap = putList onlyoverride mmap
# onlyoverride = 'DM'.toList ('DM'.delList (map fst ('DM'.toList mmap)) omap)
# omap = 'DM'.delList (map fst onlyoverride) omap
# mmap = 'DM'.putList onlyoverride mmap
= (((mmap, omap, [], 0), newMap, newSet), world)
= (((mmap, omap, [], 0), 'DM'.newMap, newSet), world)
where
findModules module_directory world
......@@ -123,7 +125,7 @@ where
*/
lazy_loader :: LoaderState String FuncTypeMap *World -> *(Maybe LineType, FuncTypeMap, LoaderState, *World)
lazy_loader ls=:(mmap, bmmap, messages, id) fn lmap world
# line = get fn lmap
# line = 'DM'.get fn lmap
| isJust line
= (line, lmap, ls, world)
......@@ -133,17 +135,17 @@ where
= (Nothing, lmap, ls, world)
// is it already loaded?
# (mpath, mmap) = delU m mmap
# (mpath, mmap) = 'DM'.delU m mmap
| isNothing mpath
= (Nothing, lmap, ls, world)
# (lmap, id, messages, world) = read_module (fromJust mpath) lmap messages id world
// read built-in module if avalaible
# (bmpath, bmmap) = delU m bmmap
# (bmpath, bmmap) = 'DM'.delU m bmmap
# (lmap, id, messages, world) =
if (isJust bmpath)
(read_module (fromJust bmpath) lmap messages id world)
(lmap, id, messages, world)
// try to get the line information again
= (get fn lmap, lmap, (mmap,bmmap,messages,id), world)
= ('DM'.get fn lmap, lmap, (mmap,bmmap,messages,id), world)
implementation module Sapl.SaplParser
import StdEnv, Data.Map, Data.Void, Data.Error
import StdEnv, Data.Void, Data.Error
import Sapl.SaplTokenizer, Sapl.SaplStruct, Sapl.FastString
from Data.Map import :: Map
import qualified Data.Map as DM
(>>=) infixl 1
(>>=) f g = \st0 ->
case f st0 of
......@@ -23,19 +26,19 @@ mandatory errmsg (Nothing, ts)
incLevel a :== \s -> Ok (a, {s & ps_level = s.ps_level + 1})
decLevel a :== \s -> Ok (a, {s & ps_level = s.ps_level - 1})
getLevel :== \s -> Ok (s.ps_level, s)
addFunction name args :== \s -> Ok (name, {s & ps_functions = put (unpackVar name) args s.ps_functions})
addCAF name :== \s -> Ok (name, {s & ps_CAFs = put (unpackVar name) Void s.ps_CAFs})
defaultState = {ps_level = 0, ps_constructors = newMap, ps_functions = newMap, ps_CAFs = newMap, ps_genFuns = []}
addFunction name args :== \s -> Ok (name, {s & ps_functions = 'DM'.put (unpackVar name) args s.ps_functions})
addCAF name :== \s -> Ok (name, {s & ps_CAFs = 'DM'.put (unpackVar name) Void s.ps_CAFs})
defaultState = {ps_level = 0, ps_constructors = 'DM'.newMap, ps_functions = 'DM'.newMap, ps_CAFs = 'DM'.newMap, ps_genFuns = []}
addConstructor name def :== \s -> Ok (name, {s & ps_constructors = put (unpackVar name) def s.ps_constructors})
checkConstructor name :== \s -> Ok (isJust (get name s.ps_constructors), s)
addConstructor name def :== \s -> Ok (name, {s & ps_constructors = 'DM'.put (unpackVar name) def s.ps_constructors})
checkConstructor name :== \s -> Ok (isJust ('DM'.get name s.ps_constructors), s)
addGenFun fun :== \s -> Ok (fun, {s & ps_genFuns = [fun:s.ps_genFuns]})
addConstructors conses = \s -> Ok (conses, {s & ps_constructors = foldl adddef s.ps_constructors conses})
where
nr_cons = length conses
adddef m (SaplConstructor name idx as)
= put (unpackVar name) {index = idx, nr_cons = nr_cons, nr_args = length as, args = as} m
= 'DM'.put (unpackVar name) {index = idx, nr_cons = nr_cons, nr_args = length as, args = as} m
// Add Tuple constructor if necessary
addTupleCons name | startsWith "_Tuple" name && size name > 6 =
......@@ -294,6 +297,6 @@ mergeParserStates pst1 (Just pst2)
ps_CAFs = mergeMaps pst2.ps_CAFs pst1.ps_CAFs,
ps_genFuns = []}
where
mergeMaps m1 m2 = putList (toList m2) m1
mergeMaps m1 m2 = 'DM'.putList ('DM'.toList m2) m1
mergeParserStates pst1 Nothing = pst1
implementation module Sapl.Target.Flavour
import StdList, StdFunc, StdArray
import Data.Maybe, Text.JSON, Data.Map, Text.StringAppender
import Data.Maybe, 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]
......@@ -61,11 +62,11 @@ 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 = fromList bifList
builtInFunctions = 'DM'.fromList bifList
ifs = filter (\f -> isJust f.inline_exp) rep.bifs
ifList = map toInlineFunDef ifs
inlineFunctions = fromList ifList
inlineFunctions = 'DM'.fromList ifList
toInlineFunDef f
= (f.sapl_fun, { InlineFunDef
......
......@@ -8,8 +8,9 @@ implementation module Sapl.Target.JS.CodeGeneratorJS
*
*/
import StdEnv, Data.Maybe, Data.Void, Text.StringAppender, Data.Map, Sapl.FastString
import StdEnv, Data.Maybe, Data.Void, Text.StringAppender, Sapl.FastString
import qualified Data.List as DL
import qualified Data.Map as DM
import Text.Unicode.Encodings.JS
import Sapl.SaplTokenizer, Sapl.SaplParser, Sapl.Target.Flavour, Sapl.Optimization.StrictnessPropagation
import Sapl.Transform.Let
......@@ -185,7 +186,7 @@ where
make_app_args :: !SaplVar ![SaplTerm] !CoderState !StringAppender -> StringAppender
make_app_args func args s a
= case get (unpackVar func) s.cs_functions of
= case 'DM'.get (unpackVar func) s.cs_functions of
Just func_args = a <++ maa_ func_args args 0 s
= a <++ maa_ [] args 0 s
where
......@@ -293,7 +294,7 @@ where
get_cons_or_die s cons = maybe (abort ("Data constructor "+++cons+++" cannot be found!"))
id
(get cons s.cs_constructors)
('DM'.get cons s.cs_constructors)
splitDefaultPattern :: ![(SaplPattern, SaplTerm)] -> (![(SaplPattern, SaplTerm)], !Maybe SaplTerm)
splitDefaultPattern patterns
......@@ -377,10 +378,10 @@ where
= condForce s.cs_trampoline (\a -> a <++ escapeName s.cs_prefix name <++ "()") a
= force (termCoder t s) a
where
mbConstructor = get name s.cs_constructors
mbConstructor = 'DM'.get name s.cs_constructors
constructor = fromJust mbConstructor
function_args = get name s.cs_functions
isCAF = isJust (get name s.cs_CAFs)
function_args = 'DM'.get name s.cs_functions
isCAF = isJust ('DM'.get name s.cs_CAFs)
forceTermCoder (StrictVar name level) s a = forceTermCoder (NormalVar name level) s a
......@@ -389,7 +390,7 @@ where
= constructorInliner t constructor [] s a
= a <++ termCoder t s
where
mbConstructor = get name s.cs_constructors
mbConstructor = 'DM'.get name s.cs_constructors
constructor = fromJust mbConstructor
trampolineCoder (StrictVar name level) s a = trampolineCoder (NormalVar name level) s a
......@@ -414,13 +415,13 @@ where
// else: use the defined name if its a built-in function, otherwise its a variable...
// no prefix for built-in functions
= a <++ (maybe var_name (escapeName "" o fst) (get name s.cs_builtins))
= a <++ (maybe var_name (escapeName "" o fst) ('DM'.get name s.cs_builtins))
where
mbInlineFun = get name s.cs_inlinefuncs
mbInlineFun = 'DM'.get name s.cs_inlinefuncs
inlineFun = fromJust mbInlineFun
mbConstructor = get name s.cs_constructors
mbConstructor = 'DM'.get name s.cs_constructors
constructor = fromJust mbConstructor
mbCAF = get name s.cs_CAFs
mbCAF = 'DM'.get name s.cs_CAFs
// TODO: doc
findLocalVar [(NormalVar cn level):cs] = if (cn == name) level (findLocalVar cs)
......@@ -428,11 +429,11 @@ where
findLocalVar [] = 0
isLocalVar = elem_by eqVarByName t s.cs_current_vars //isMember t s.cs_current_vars
isFunction = isJust (get t s.cs_functions)
isFunction = isJust ('DM'.get t s.cs_functions)
isStrictFunction = a || b
where
a = maybe False (any isStrictVar) (get name s.cs_functions)
b = maybe False (\{args} -> any isStrictVar args) (get name s.cs_constructors)
a = maybe False (any isStrictVar) ('DM'.get name s.cs_functions)
b = maybe False (\{args} -> any isStrictVar args) ('DM'.get name s.cs_constructors)
var_name a # decl_level = findLocalVar s.cs_current_vars
= case decl_level of
......@@ -527,16 +528,16 @@ where
where
func_name a = a <++ escapeName s.cs_prefix (unpackVar name) // skip level information
mbConstructor = get (unpackVar name) s.cs_constructors
mbConstructor = 'DM'.get (unpackVar name) s.cs_constructors
constructor = fromJust mbConstructor
mbInlineFun = get (unpackVar name) s.cs_inlinefuncs
mbInlineFun = 'DM'.get (unpackVar name) s.cs_inlinefuncs
inlineFun = fromJust mbInlineFun
mbFunction = get (unpackVar name) s.cs_functions
mbFunction = 'DM'.get (unpackVar name) s.cs_functions
functionArgs = fromJust mbFunction
functionArity = length functionArgs
tr_function_args = fromJust (get (unpackVar (fromJust s.cs_intrfunc)) s.cs_functions)
builtin = get (unpackVar name) s.cs_builtins
tr_function_args = fromJust ('DM'.get (unpackVar (fromJust s.cs_intrfunc)) s.cs_functions)
builtin = 'DM'.get (unpackVar name) s.cs_builtins
make_tr_app args s a
= a <++ "var " <++ mta_1 tr_function_args args 0 s <++ ";"
......@@ -571,9 +572,9 @@ where
= a <++ termCoder t s
where
mbConstructor = get (unpackVar name) s.cs_constructors
mbConstructor = 'DM'.get (unpackVar name) s.cs_constructors
constructor = fromJust mbConstructor
mbInlineFun = get (unpackVar name) s.cs_inlinefuncs
mbInlineFun = 'DM'.get (unpackVar name) s.cs_inlinefuncs
inlineFun = fromJust mbInlineFun
trampolineCoder t s a = termCoder t s a
......@@ -653,11 +654,11 @@ where
<++ termArrayCoder args "," s
<++ "]]"
where
mbConstructor = get (unpackVar name) s.cs_constructors
mbConstructor = 'DM'.get (unpackVar name) s.cs_constructors
constructor = fromJust mbConstructor
func_name name a = a <++ escapeName s.cs_prefix (unpackVar name) // skip level information
mbInlineFun = get (unpackVar name) s.cs_inlinefuncs
mbInlineFun = 'DM'.get (unpackVar name) s.cs_inlinefuncs
inlineFun = fromJust mbInlineFun
termCoder (SLit lit) s a = termCoder lit s 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