Commit 83c511af authored by Steffen Michels's avatar Steffen Michels

fixed imports of Data.Map and removed dependency on Data.Void

parent d1d7aa7f
definition module Sapl.SaplParser
import Sapl.SaplTokenizer, Sapl.SaplStruct
import Data.Void, Data.Error
import Data.Error
from Data.Map import :: Map
// Cannot be abstract because code generator uses it
:: ParserState = { ps_level :: Int
, ps_constructors :: Map String ConstructorDef
, ps_functions :: Map String [SaplTypedVar]
, ps_CAFs :: Map String Void
, ps_CAFs :: Map String ()
, ps_genFuns :: [FuncType] // generated functions during parsing
}
......
implementation module Sapl.SaplParser
import StdEnv, Data.Void, Data.Error
import StdEnv, Data.Error
import Sapl.SaplTokenizer, Sapl.SaplStruct, Sapl.FastString
from Data.Map import :: Map
......@@ -27,7 +27,7 @@ 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 = 'DM'.put (unpackVar name) args s.ps_functions})
addCAF name :== \s -> Ok (name, {s & ps_CAFs = 'DM'.put (unpackVar name) Void s.ps_CAFs})
addCAF name :== \s -> Ok (name, {s & ps_CAFs = 'DM'.put (unpackVar name) () 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 = 'DM'.put (unpackVar name) def s.ps_constructors})
......@@ -43,7 +43,7 @@ where
// Add Tuple constructor if necessary
addTupleCons name | startsWith "_Tuple" name && size name > 6 =
checkConstructor name
>>= \b = if b (returnS Void) (addConstructor (NormalVar name 0) newdef >>| addGenFun newadt >>| returnS Void)
>>= \b = if b (returnS ()) (addConstructor (NormalVar name 0) newdef >>| addGenFun newadt >>| returnS ())
where
(newadt, newdef) = gendefs name
......@@ -61,7 +61,7 @@ where
= TypedVar (StrictVar "_" 0) NoType
= TypedVar (NormalVar "_" 0) NoType
addTupleCons _ = returnS Void
addTupleCons _ = returnS ()
read_int [TLit (LInt lit):ts] = returnS (Just lit, ts)
read_int ts = returnS (Nothing, ts)
......
implementation module Sapl.SaplStruct
import StdEnv
import Data.Map, Data.Void, Data.Error
import Data.Error, Data.Maybe
import Sapl.SaplTokenizer
ltVarByName :: !SaplVar !SaplVar -> Bool
......
......@@ -8,7 +8,7 @@ implementation module Sapl.Target.JS.CodeGeneratorJS
*
*/
import StdEnv, Data.Maybe, Data.Void, Text.StringAppender, Sapl.FastString
import StdEnv, Data.Maybe, Text.StringAppender, Sapl.FastString
import qualified Data.List as DL
import qualified Data.Map as DM
import Text.Unicode.Encodings.JS
......@@ -29,7 +29,7 @@ from Data.List import elem_by, partition
, cs_current_vars :: ![SaplTypedVar]
, cs_constructors :: !Map String ConstructorDef
, cs_functions :: !Map String [SaplTypedVar]
, cs_CAFs :: !Map String Void
, cs_CAFs :: !Map String ()
, cs_builtins :: !Map String (String, Int)
, cs_inlinefuncs :: !Map String InlineFunDef
, cs_trampoline :: !Bool
......@@ -114,7 +114,7 @@ isTailRecursive _ _ = False
strictnessMap :: !SaplType !CoderState -> Int
strictnessMap NoType _ = 0
strictnessMap (Type cons) {cs_constructors}
= case get cons cs_constructors of
= case 'DM'.get cons cs_constructors of
Nothing = 0
(Just {args}) = toInt args 0
where
......@@ -800,8 +800,8 @@ generateJS f tramp saplsrc mbPst
# a = if tramp (a <++ "ON") (a <++ "OFF")
// Lift + generated update functions
# (funcs, genfuns) = foldl (upd (isStrictArgFlavour f newpst)) ([], newMap) funcs
# funcs = reverse funcs ++ elems genfuns
# (funcs, genfuns) = foldl (upd (isStrictArgFlavour f newpst)) ([], 'DM'.newMap) funcs
# funcs = reverse funcs ++ 'DM'.elems genfuns
# a = foldl (\a curr = a <++ funcCoder curr state) (a <++ "*/") funcs
= Ok (a, newpst)
......@@ -809,7 +809,7 @@ generateJS f tramp saplsrc mbPst
where
upd :: (String Int Int -> Bool) ([FuncType], Map String FuncType) FuncType -> ([FuncType], Map String FuncType)
upd sf (nfs, genfuns) fun
= let (nfun, ngenfuns) = prepareFun sf fun genfuns in ([nfun:nfs], union genfuns ngenfuns)
= let (nfun, ngenfuns) = prepareFun sf fun genfuns in ([nfun:nfs], 'DM'.union genfuns ngenfuns)
exprGenerateJS :: !Flavour !Bool !String !(Maybe ParserState) !StringAppender -> (MaybeErrorString (String, StringAppender, ParserState))
exprGenerateJS f tramp saplsrc mbPst out
......@@ -819,7 +819,7 @@ exprGenerateJS f tramp saplsrc mbPst out
# state = newState f tramp newpst
// Lift + generated update functions. TODO: do not skip generated functions
# (body, _) = prepareExpr (isStrictArgFlavour f newpst) body newMap
# (body, _) = prepareExpr (isStrictArgFlavour f newpst) body 'DM'.newMap
# a = termCoder body {state & cs_inbody=Just (TypedVar (NormalVar "__dummy" 0) NoType)} newAppender
# out = foldl (\a curr = a <++ funcCoder curr state) out s.ps_genFuns
......
definition module Sapl.Target.JS.Lifting
import Sapl.SaplStruct
import Data.Map
from Data.Map import :: Map
// Returns True if a term can be inlined, i.e. no separate statement is needed
inline :: !SaplTerm -> Bool
......
......@@ -2,7 +2,8 @@ implementation module Sapl.Target.JS.Lifting
import StdEnv
import Sapl.SaplStruct
import Data.Map
from Data.Map import :: Map
import qualified Data.Map as DM
inline :: !SaplTerm -> Bool
inline (SLet _ _) = False
......@@ -90,10 +91,10 @@ where
# (expr, st, edefs) = walkTerm expr doNotLift False st
# (updates, st, udefs) = walkUpdates updates st
// Generate new fun and lift it in the same time
# (genfun, _) = prepareFun sf (genUpdateFun (SUpdate expr ty updates)) newMap
# (genfun, _) = prepareFun sf (genUpdateFun (SUpdate expr ty updates)) 'DM'.newMap
# funname = extractName genfun
= (SApplication (SVar funname) [expr:map snd updates],
{st & genfuns = put (unpackVar funname) genfun st.genfuns}, edefs ++ udefs)
{st & genfuns = 'DM'.put (unpackVar funname) genfun st.genfuns}, edefs ++ udefs)
where
extractName (FTFunc (TypedVar name _) _ _) = name
......
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