I need some help according to follow problem which I have to implemented it using jSpin and promela language.
A home alarm system can be activated and deactivated using a personal
ID key or password, after activation the system enters a waiting
period of about 30 seconds, time that allows users to evacuate the
secured area after which the alarm is armed, also when an intrusion is
detected the alarm has a built in waiting period or delay of 15
seconds to allow the intruder to enter the password or swipe the card
key thus identifying himself, in case that the identification is not
made within the allocated 15 seconds the alarm will go off and will
be on until an id card or password is used to deactivate it.
Here is what I tried:
mtype = {sigact, sigdeact};
chan signal = [0] of {mtype};
chan password = [0] of { int };
/*chan syntax for declaring and initializing message passing channels*/
int count;
bool alarm_off = true; /*The initial state of the alarm is off*/
active proctype alarm()
{
off:
if
:: count >= 30 -> atomic {signal!sigdeact; count = 0;alarm_off = false; goto on;}
:: else -> atomic {count++; alarm_off = true; goto off;}
fi;
on:
if
:: count >=15 -> atomic { signal!sigact; count = 0;
alarm_off = false; goto off;}
:: else -> atomic {signal!sigact; alarm_off = true; goto pending;}
fi;
pending:
if
:: count >= 30 -> atomic {count = 0; alarm_off = false; goto on;}
:: count < 30 -> atomic {count++; alarm_off = false; goto pending;}
fi;
}
active proctype user()
{
password ! 1234 //1234 is the password I sent.
input: atomic { signal?sigact -> alarm_off = true; goto off; }
}
In the user proctype I send the password
password ! 1234
How can I verify if the password is 1234 and how can I adapt it to own cases ( on, off , pending) based on the verification ?
As the code in the example doesn't appear to follow the specification, at least in the way I understand it, I wrote an example from scratch.
Please note that the following model (source code) is purposely very verbose and redundant in its structure, so that its easier to recognise its logic blocks and --hopefully-- understand it. In practice, one would use some inline function to handle input. I also didn't use SIGACT, SIGDEACT which appeared in the original model, since I could not figure out who was supposed to read those messages neither from the original model (source code) nor from the specification.
#define ALARM_OFF 1
#define ALARM_COUNTDOWN 2
#define ALARM_ARMED 4
#define ALARM_INTRUSION 8
#define ALARM_FIRED 16
#define INPUT_SET_PASSWORD 1
#define INPUT_CHECK_PASSWORD 2
#define INPUT_INTRUDER 4
mtype = { SIGACT, SIGDEACT };
init {
chan alarm_out = [1] of { mtype };
chan alarm_in = [1] of { byte, short };
run alarm(alarm_in, alarm_out);
run user(alarm_in);
run event(alarm_in);
}
proctype alarm(chan input, output)
{
byte count;
byte state = ALARM_OFF;
short passwd = 1234;
short tmp = 0;
off:
if
:: nempty(input) ->
if
:: input?INPUT_SET_PASSWORD(tmp) ->
passwd = tmp;
:: input?INPUT_CHECK_PASSWORD(tmp) ->
if
:: tmp == passwd ->
atomic {
state = ALARM_COUNTDOWN;
count = 0;
goto countdown;
}
:: else ->
skip;
fi;
:: input?INPUT_INTRUDER(tmp) ->
skip;
fi;
:: empty(input) -> skip;
fi;
goto off;
countdown:
if
:: count < 30 ->
if
:: nempty(input) ->
if
:: input?INPUT_SET_PASSWORD(tmp) ->
skip; // error: cannot be done now (?)
:: input?INPUT_CHECK_PASSWORD(tmp) ->
if
:: tmp == passwd ->
atomic {
state = ALARM_OFF;
count = 0;
goto off;
}
:: else ->
skip; // error: incorrect password (?)
fi;
:: input?INPUT_INTRUDER(tmp) ->
skip;
fi;
:: empty(input) ->
skip;
fi;
:: else ->
atomic {
state = ALARM_ARMED;
count = 0;
goto armed;
}
fi;
count++;
goto countdown;
armed:
if
:: nempty(input) ->
if
:: input?INPUT_SET_PASSWORD(tmp) ->
skip; // error: cannot be done now (?)
:: input?INPUT_CHECK_PASSWORD(tmp) ->
if
:: tmp == passwd ->
atomic {
state = ALARM_OFF;
count = 0;
goto off;
}
:: else ->
skip; // error: incorrect password (?)
// maybe it should be handled like
// INPUT_INTRUDER(tmp)
fi;
:: input?INPUT_INTRUDER(tmp) ->
atomic {
state = ALARM_INTRUSION;
count = 0;
goto intruder_detected;
}
fi;
:: empty(input) ->
skip;
fi;
goto armed;
intruder_detected:
if
:: count < 15 ->
if
:: nempty(input) ->
if
:: input?INPUT_SET_PASSWORD(tmp) ->
skip; // error: cannot be done now (?)
:: input?INPUT_CHECK_PASSWORD(tmp);
if
:: tmp == passwd ->
atomic {
state = ALARM_ARMED;
count = 0;
goto armed;
}
:: else ->
skip; // error: incorrect password (?)
fi;
:: input?INPUT_INTRUDER(tmp) ->
skip;
fi;
:: empty(input) ->
skip;
fi;
:: count >= 15 ->
atomic {
state = ALARM_FIRED;
count = 0;
goto alarm_fired;
}
fi;
count++;
goto intruder_detected;
alarm_fired:
if
:: nempty(input) ->
if
:: input?INPUT_SET_PASSWORD(tmp) ->
skip; // error: cannot be done now (?)
:: input?INPUT_CHECK_PASSWORD(tmp);
if
:: tmp == passwd ->
atomic {
state = ALARM_OFF;
count = 0;
goto off;
}
:: else ->
skip; // error: incorrect password (?)
// warn user but keep alarm on
fi;
:: input?INPUT_INTRUDER(tmp) ->
skip;
fi;
:: empty(input) ->
skip;
fi;
goto alarm_fired;
};
proctype user(chan output)
{
output ! INPUT_CHECK_PASSWORD(1234);
};
proctype event(chan output)
{
output ! INPUT_INTRUDER(0);
};
So, basically you have to check both the input (if any!) and the value of count in order to perform a transition in the internal FSM of the alarm system.
In the example I added a proctype of name event which will randomly send a single INPUT_INTRUDER input signal to the alarm system. This, in combination with the user typing his own password, can be used to trigger the chain of events which would cause the alarm to fire.
Related
I'm writing a JIT compiler using haskell, LLVM-hs and OrcJIT. Here's my main file which compiles modules, adds them to the JIT and fetches and runs the internal main functions:
main :: IO ()
main =
withContext $ \ctx ->
withExecutionSession $ \es ->
withHostTargetMachine Reloc.PIC CodeModel.Default CodeGenOpt.None $ \tm ->
withSymbolResolver es myResolver $ \psr ->
withObjectLinkingLayer es (\_ -> return psr) $ \oll ->
withIRCompileLayer oll tm $ \ircl -> do
loadLibraryPermanently Nothing
repl ctx es tm ircl
where
myResolver :: SymbolResolver
myResolver = SymbolResolver $ \mangled -> do
ptr <- getSymbolAddressInProcess mangled
return $ Right $ JITSymbol
{ jitSymbolAddress = ptr
, jitSymbolFlags = defaultJITSymbolFlags { jitSymbolExported = True }
}
repl :: Context -> ExecutionSession -> TargetMachine -> IRCompileLayer ObjectLinkingLayer -> IO ()
repl ctx es tm cl = runInputT defaultSettings (loop C.initCmpState)
where
loop :: C.CmpState -> InputT IO ()
loop state =
getInputLine "% " >>= \minput -> case minput of
Nothing -> return ()
Just "q" -> return ()
Just input -> liftIO (process state input) >>= loop
process :: C.CmpState -> String -> IO C.CmpState
process state source =
case L.alexScanner source of
Left errStr -> putStrLn errStr >> return state
Right tokens -> case (P.parseTokens tokens) 0 of
P.ParseOk ast ->
let (res, state') = C.codeGen state (head ast) in
case res of
Left err -> putStrLn (show err) >> return state
Right () -> runDefinition (state' { C.externs = C.externs state }) >> return state'
{ C.globals = Map.empty
, C.instructions = []
}
runDefinition :: C.CmpState -> IO ()
runDefinition state = do
let globals = Map.elems (C.globals state)
let externs = Map.elems (C.externs state)
let instructions = reverse (C.instructions state)
let mainName = mkBSS "main.0"
let mainFn = GlobalDefinition $ functionDefaults
{ returnType = void
, name = Name mainName
, basicBlocks = [BasicBlock (mkName "entry") instructions (Do $ Ret Nothing [])]
}
case instructions of
[] -> do
let astmod = defaultModule
{ moduleDefinitions = externs ++ globals
}
M.withModuleFromAST ctx astmod $ \mod -> do
BS.putStrLn =<< M.moduleLLVMAssembly mod
withModuleKey es $ \modKey ->
addModule cl modKey mod
x -> do
let astmod = defaultModule
{ moduleDefinitions = externs ++ globals ++ [mainFn]
}
M.withModuleFromAST ctx astmod $ \mod -> do
BS.putStrLn =<< M.moduleLLVMAssembly mod
withModuleKey es $ \modKey ->
withModule cl modKey mod $ do
res <- (\mangled -> findSymbol cl mangled False) =<< mangleSymbol cl mainName
case res of
Left _ -> putStrLn ("Couldn't find: " ++ show mainName)
Right (JITSymbol fn _)-> do
run $ castPtrToFunPtr (wordPtrToPtr fn)
Isolated modules such as this print statement run correctly. Modules with a main function are removed from the JIT after being executed:
print(234);
; ModuleID = '<string>'
source_filename = "<string>"
#0 = constant [4 x i8] c"%d\0A\00"
declare i32 #printf(i8*, ...)
define void #main.0() {
entry:
%0 = call i32 (i8*, ...) #printf(i8* getelementptr inbounds ([4 x i8], [4 x i8]* #0, i32 0, i32 0), i32 234)
ret void
}
234
Assigning 4 to the symbol 'x' results in a module with a global variable, this module isn't deleted from the JIT:
x := 4;
; ModuleID = '<string>'
source_filename = "<string>"
#x = global i32 4
But attempting to print 'x' in the next statement results in a lookup failure for the main function:
print(x);
; ModuleID = '<string>'
source_filename = "<string>"
#x = external global i32
#0 = constant [4 x i8] c"%d\0A\00"
declare i32 #printf(i8*, ...)
define void #main.0() {
entry:
%0 = load i32, i32* #x
%1 = call i32 (i8*, ...) #printf(i8* getelementptr inbounds ([4 x i8], [4 x i8]* #0, i32 0, i32 0), i32 %0)
ret void
}
Couldn't find: "main.0"
It appears there's a problem accessing symbols across modules.
Things I've tried:
Accessing functions instead of variables
Changing my symbol resolver to use 'findSymbol' instead of 'getSymbolAddressInProcess' as in the llvm-hs-examples repo. This prevented any modules from running.
Downloading the llvm-hs-examples repo and running the 'orc' example. This also resulted in a symbol error!
Re-downloading the haskell toolchain and llvm/llvm-hs (9.0.1) on a new linux install.
I'd be extremely grateful for any help!
Solved! I was confused by the symbol resolver. It isn't used to retrieve symbols when using 'findSymbol' but in the compiling and linking stage of the JIT. 'getSymbolAddressInProcess' will search only for symbols within the host process (such as printf), not symbols defined within the JIT (such as x).
In order to use a module in the JIT which retrieves an external symbol 'x' from another module and 'printf' from the host process, a symbol resolver must be added which searches both the JIT compile layer and the host process for symbols:
myResolver :: IRCompileLayer ObjectLinkingLayer -> SymbolResolver
myResolver ircl = SymbolResolver $ \mangled -> do
symbol <- findSymbol ircl mangled False
case symbol of
Right _ -> return symbol
Left _ -> do
ptr <- getSymbolAddressInProcess mangled
return $ Right $ JITSymbol
{ jitSymbolAddress = ptr
, jitSymbolFlags = defaultJITSymbolFlags { jitSymbolExported = True }
}
I'm simulating an evaluator with Haskell. It should be simple but I couldn't debug.
Here I define State as a look-up function (String -> Int), an initial state (empty, exception variable evaluates 0), and extend to add new key (and it's value) to a base environment:
type State = String -> Int
extend :: State -> String -> Int -> State
extend base key val = \x -> if key == x
then val
else base key
empty :: State
empty = \x -> 0
when I test the program:
aState = extend empty "A" 5
bState = extend aState "B" 4
cState = extend bState "C" 3
I suppose that cState should be equivalent to a function:
\x -> if x == "C"
then 3
else if x == "B"
then 4
else if x == "A"
then 5
else 0
But instead, I get cState "B" == 0 and cState "A" == 0.
I can't see what is wrong with extend, could somebody explain to me?
In your else statement, you search key (rather than x) in every recursion: else base key. Fix it with:
extend :: State -> String -> Int -> State
extend base key val = \x -> if key == x
then val
else base x
BTW, you might write:
empty :: State
empty = \_ -> 0
since empty return 0 regardless of input.
I am new to Haskel and want to learn it. I want to print intermediate value in recursive function in haskell but i am stuck in parse error on input "=" on line b= b+50.
`main' t s a b c
| t > s = 0
| otherwise = do
print a
print b
print c
b = b + 50
c = b + 2 * a
main' (t+1) s (a+1) b c `
the C equivalent for this code is
int calculate(t,s,a,b,c)
{
printf( "%d,%d,%d",a,b,c);
if(t > s)
return 0;
else
{
b = b + 50;
c = b + 2 * a;
return calculate (t+1,s,a,b,c);
}
}
int main()
{
calculate(0,10,2,6,7);
return 0;
}`
Please help me to resolve this problem. It is not so difficult to do in C but I could not figure out how to do it in Haskel.
As PyRulez says in his comment, you need to use let syntax in do blocks. However, you are also going to run into issues because your function parameters, like all values in Haskell, are immutable. You will need to do something like:
let b' = b + 5
let c' = b' + 2 * a
If you only want to print some intermediate value, you don't need to have your function in the IO world:
you can use the Debug.Trace module:
import Debug.Trace
func :: Int -> Int -> Int -> Int -> Int
func 0 _ _ _ = 0
func t a b c = trace ("a="++(show a)++" b="++(show b)++" c="++(show c)) $ recurs
where recurs = func (t-1) (a+1) (b+50) (b+2*a)
it gives me:
> func 5 1 1 1
a=1 b=1 c=1
a=2 b=51 c=3
a=3 b=101 c=55
a=4 b=151 c=107
a=5 b=201 c=159
Starting from the Counter example in Reactive Banana Wx that uses a normal Int to keep the counter status:
let networkDescription :: forall t. Frameworks t => Moment t ()
networkDescription = do
eup <- event0 bup command
edown <- event0 bdown command
let
counter :: Behavior t Int
counter = accumB 0 $ ((+1) <$ eup) `union` (subtract 1 <$ edown)
sink output [text :== show <$> counter]
network <- compile networkDescription
actuate network
how can I replace and update the Int counter with a more generic data like:
data Counter = Counter {
count :: Int
} deriving (Show)
let
counter :: Behavior t Counter
counter = accumB Counter { count = 0 } $ ??????
sink output [text :== show <$> count counter]
I don't know how to refer to the internal count function with something like this:
count = count mycounter + 1
Any idea?
The type of accumB is:
accumB :: a -> Event t (a -> a) -> Behavior t a
So if you want to define a Behavior t Counter with it you need to use events that carry Counter -> Counter functions:
-- For the sake of convenience...
overCount :: (Int -> Int) -> Counter -> Counter
overCount f c = c { count = f (count c) }
counter = accumB Counter { count = 0 } $
(overCount (+1) <$ eup) `union` (overCount (subtract 1) <$ edown)
I'm trying to implement some language with x = 4 and pritn x, constructions using haskell happy
So far I've defined grammar like this
terms
: term { [$1] }
| term terms { $1 : $2 }
term
: var '=' int { Assign $1 $3 }
| print var { Print $2 }
When I run it over something like
x = 4
print x
y = 5
print y
I get
[Assign "x" 4, Print "x", Assign "y" 5, Print "y"]
Now I want to do actual implementation, but I don't know how to implement "assign"
Though I'm not good at haskell, from happy docs I saw "let" implementation and got the idea of some environment p passed and evaluated in
Exp : let var '=' Exp in Exp { \p -> $6 (($2,$4 p):p) }
| Exp1 { $1 }
Exp1 : Exp1 '+' Term { \p -> $1 p + $3 p }
| Exp1 '-' Term { \p -> $1 p - $3 p }
| Term { $1 }
Term : Term '*' Factor { \p -> $1 p * $3 p }
| Term '/' Factor { \p -> $1 p `div` $3 p }
| Factor { $1 }
Factor
: int { \p -> $1 }
| var { \p -> case lookup $1 p of
Nothing -> error "no var"
Just i -> i }
| '(' Exp ')' { $2 }
I guess "assign" implementation has to do something with this env, but I couldn't find any example. How can I implement assign and print or where can I find information or example of it?
You're quite close with the parser. But what you want to build is an interpreter for your little expression language separate from the parsing logic. The parser will just generate the AST for the program and then we'll evaluate it separately.
The code is actually quite small, but it's split across several modules so I put it here in this gist: https://gist.github.com/sdiehl/c2dd1880e0ec6b65a120
I presume your AST looks something like this:
data Expr
= Var String
| Num Int
| Print Expr
| Assign String Int
deriving (Eq,Show)
The parser looks right except I think you'll need to add a var production so expressions like print x and print 1 can both be well-formed in the syntax.
%token
int { TokenNum $$ }
var { TokenSym $$ }
print { TokenPrint }
'=' { TokenEq }
%%
terms
: term { [$1] }
| term terms { $1 : $2 }
term
: var { Var $1 }
| var '=' int { Assign $1 $3 }
| print term { Print $2 }
For the interpreter we'll use a StateT + IO monad to hold the assigned variables and invoke Haskell's print function for each Print function in our program. The state monad will hold an association list of variables to values. Assign will simply add a new reference to the list, and a Var reference will use the lookup function over the state.
data Value
= VInt Int
| VUnit
instance Show Value where
show (VInt x) = show x
type Eval = StateT Env IO
type Env = [(String, Value)]
eval1 :: Expr -> Eval Value
eval1 expr = case expr of
Num a -> return (VInt a)
Var a -> do
env <- get
case lookup a env of
Just val -> return val
Nothing -> error "Not in scope"
Print a -> do
a' <- eval1 a
liftIO $ print a'
return VUnit
Assign ref val -> do
modify $ \s -> (ref, VInt val) : s
return VUnit
eval :: [Expr] -> IO ()
eval xs = evalStateT (mapM_ eval1 xs) []
And that's about it.