Commit e6552907 authored by Bas Lijnse's avatar Bas Lijnse

Merge branch 'fix-imports' into 'hierarchical'

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

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