70 lines
1.6 KiB
Racket
70 lines
1.6 KiB
Racket
#lang racket
|
|
|
|
(provide (all-defined-out))
|
|
|
|
;; an [LTL X] is one of
|
|
;; - (always [LTL X])
|
|
;; - (eventually [LTL X])
|
|
;; - (weak-until [LTL X] [LTL X])
|
|
;; - (strong-until [LTL X] [LTL X])
|
|
;; - (ltl-implies [LTL X] [LTL X])
|
|
;; - (ltl-and [Listof [LTL X]])
|
|
;; - (ltl-or [Listof [LTL X]])
|
|
;; - (ltl-not [LTL X])
|
|
;; - (atomic X)
|
|
;; - Bool
|
|
;; where X represents the type of atomic propositions
|
|
|
|
(struct always [p] #:transparent)
|
|
(struct eventually [p] #:transparent)
|
|
(struct atomic [p] #:transparent)
|
|
(struct weak-until [p q] #:transparent)
|
|
(struct strong-until [p q] #:transparent)
|
|
(struct ltl-implies [p q] #:transparent)
|
|
(struct ltl-and [p q] #:transparent)
|
|
(struct ltl-or [p q] #:transparent)
|
|
(struct ltl-not [p] #:transparent)
|
|
|
|
;; [LTL X] {X -> Y} -> [LTL Y]
|
|
(define (map-atomic ltl op)
|
|
(let loop ([ltl ltl])
|
|
(match ltl
|
|
[(always p)
|
|
(always (loop p))]
|
|
[(eventually p)
|
|
(eventually (loop p))]
|
|
[(weak-until p q)
|
|
(weak-until (loop p) (loop q))]
|
|
[(strong-until p q)
|
|
(strong-until (loop p) (loop q))]
|
|
[(ltl-implies p q)
|
|
(ltl-implies (loop p) (loop q))]
|
|
[(ltl-and p q)
|
|
(ltl-and (loop p) (loop q))]
|
|
[(ltl-or p q)
|
|
(ltl-or (loop p) (loop q))]
|
|
[(ltl-not p)
|
|
(ltl-not (loop p))]
|
|
[(atomic x)
|
|
(atomic (op x))]
|
|
[#t
|
|
#t]
|
|
[#f
|
|
#f])))
|
|
|
|
(define (&& . args)
|
|
(fold-bin-op ltl-and args #t))
|
|
|
|
(define (|| . args)
|
|
(fold-bin-op ltl-or args #f))
|
|
|
|
(define (fold-bin-op op args base)
|
|
(let loop ([args args])
|
|
(match args
|
|
['()
|
|
base]
|
|
[(list x y)
|
|
(op x y)]
|
|
[(cons fst rst)
|
|
(op fst (loop rst))])))
|