In [1]:
(require [hyPLCParser.plcparser [*]])
(import (hyPLCParser.plcparser (*)))
Show available operators
In [2]:
(print operators)
Evaluate clause. Both prefix and infix notation can be used on the clause:
In [3]:
#$(1 and? (or? 0 1) and? 1)
Out[3]:
Default boolean true values are: (1 True ⊤) but of course you can define any truth symbol appropriate for your usage:
In [9]:
(setv TrueTrueTrue True)
#$(and? 1 True ⊤ TrueTrueTrue)
Out[9]:
In addition to logical operators, you can add for example math operators and get a mixed prefix and infix notation support for them. Note that here we are using macro functions (defoperators, defmixfix, defmixfix-n) instead of reader macros (#>, #$):
In [10]:
(defoperators + -) ; is same as calling #>[+ -]
(print
; is same as calling reader macro: #$(1 + 1 - 1) -> 1
(defmixfix 1 + 1 - 1)
; is same as calling reader macro: [#$0 #$1 #$(0 + 1) #$(1 + 1) #$(1 + 2) #$(2 + 3) #$(3 + 5)] ->
; [0, 1, 1, 2, 3, 5, 8]
(defmixfix-n 0 1 (0 + 1) (1 + 1) (1 + 2) (2 + 3) (3 + 5))
)
With multiple operators and operands it easily becomes apparent the case when you need to define the order of precedence which simply means the order that each operation should be evaluated. Default order is from left to right. But with an optional defprecedence macro you can order evaluation as you wish:
In [6]:
; add support for operators by registering some
(defoperators + *)
; reset to default that is empty list which causes evaluation from left to right
(defprecedence)
(print
"1 + 2 * 3 -> ((1 + 2) * 3) -> (* (+ 1 2) 3) = "
(defmixfix 1 + 2 * 3))
; change the precedence list to first evaluate multiplication and then addition
(defprecedence * +)
(print
"1 + 2 * 3 -> (1 + (2 * 3)) -> (+ 1 (* 2 3)) = "
(defmixfix 1 + 2 * 3))
In [7]:
(assert (= #$(or? 0) False))
(assert (= #$(and? 0) False))
(assert (= #$(xor? 0) False))
(assert (= #$(nope? 1) False))
(assert (= #$(nand? 1) False))
(assert (= #$(nor? 1) False))
(assert (= #$(xnor? 1) False))
(assert (= #$(1) True))
(assert (= #$(0) False))
(assert (= #$(True) True))
(assert (= #$(False) False))
(assert (= #$1 True))
(assert (= #$0 False))
(assert (= #$True True))
(assert (= #$False False))
(assert (= #$() False))
(assert (= #$("") ""))
(assert (= #$(None) None))
(assert (= #$(¬ 0 False ⊥) True))
(assert (= #$(1 and? 1) True))
(assert (= #$(1 or? 0) True))
(assert (= #$(1 xor? 0) True))
(assert (= #$(1 nand? 1) False))
(assert (= #$(1 nor? 0) False))
(assert (= #$(1 xnor? 0) False))
(assert (= #$(¬ ⊤) False))
(assert (= #$( ⊥ ∨ ⊤ ) True))
(assert (= #$(1 xnor? 0) False))
(assert (= #$(⊕ 1 0) True))
(assert (= #$( (1 and? 0) and? (1 and? 1) ) False))
(assert (= #$(and? 1 1 (1 and? (and? 1 (1 nand? 1 nand? 1)))) True))
(try
(assert (= #$(and?) None)) ; Raises exception with Expression error! message
(except [e Exception] (print e)))
; empty the precedence list -> starting nesting from left side
(defprecedence)
;(assert (= operators-precedence []))
(assert (= #$(1 or? 1 xor? 1) False)) ; (xor? 1 (or? 1 1))
; set up precedence list -> nest xor first, then or
(defprecedence nope? nand? xnor? nor? and? xor? or?)
;(assert (= operators-precedence '[nope? nand? xnor? nor? and? xor? or?]))
(assert (= #$(1 or? 1 xor? 1) True)) ; (or? 1 (xor? 1 1))
; set up precedence list -> nest or first, then xor
; use math symbols instead of word symbols.
; this should work because internally functions are compared
(defprecedence ¬ ↑ ↔ ↓ ∧ ∨ ⊕)
;(assert (= operators-precedence '[¬ ↑ ↔ ↓ ∧ ∨ ⊕]))
(assert (= #$(1 or? 1 xor? 1) False)) ; (xor? 1 (or? 1 1))
(defoperators + *)
; use defmixfix macro to evaluate simple math clause
(assert (= (defmixfix (1 + 1) 2)))
; mix infix and prefix notation
(assert (= (defmixfix (1 + (* 1 2)) 3)))
In [8]:
; these two method behave a little bit different when using import / require
; actually eval-when-compile loses operators variable
;(eval-when-compile (setv operators []))
(eval-and-compile
(setv operators []
operators-precedence []))
; add operators to global variable so that on a parser loop
; we can use it on if clauses
; for singular usage: #>operator
; for multiple: #>[operator1 operator 2 ...]
(defreader > [items]
(do
; transforming singular value to a list for the next for loop
(if (not (coll? items)) (setv items [items]))
(for [item items]
; discard duplicates
(if-not (in item operators)
(.append operators item)))))
; set the order of precedence for oprators
; for singular usage: #<operator
; for multiple: #<[operator1 operator 2 ...]
; note that calling this macro will empty the previous list of precedence!
(defreader < [items]
(do
; (setv operators-precedence []) is not working here
; for some macro evaluation - complilation order reason
; so emptying the current operators-precedence list more verbose way
(if (pos? (len operators-precedence))
(while (pos? (len operators-precedence))
(.pop operators-precedence)))
; transforming singular value to a list for the next for loop
(if (not (coll? items)) (setv items [items]))
(for [item items]
; discard duplicates
(if-not (in item operators-precedence)
(.append operators-precedence item)))))
; define math boolean operands
(setv ⊤ 1)
(setv ⊥ 0)
; define operator function and math alias (op-symbol)
; plus set them to operators global list
(defmacro defoperator [op-name op-symbol params &rest body]
`(do
(defn ~op-name ~params ~@body)
#>~op-name
(setv ~op-symbol ~op-name)
#>~op-symbol))
; add custom or native operators to the list
; somebody might like this syntax more than using
; reader macro directly. so calling (defoperators + - * /)
; is same as calling #>[+ - * /]
(defmacro defoperators [&rest args] `#>~args)
; define true comparison function
(defn true? [value]
(or (= value 1) (= value True)))
; same as nor at the moment... not? is a reserved word
(defoperator nope? ¬ [&rest truth-list]
(not (any truth-list)))
; and operation : zero or more arguments, zero will return false,
; otherwise all items needs to be true
(defoperator and? ∧ [&rest truth-list]
(all (map true? truth-list)))
; negation of and
(defoperator nand? ↑ [&rest truth-list]
(not (apply and? truth-list)))
; or operation : zero or more arguments, zero will return false,
; otherwise at least one of the values needs to be true
(defoperator or? ∨ [&rest truth-list]
(any (map true? truth-list)))
; negation of or
(defoperator nor? ↓ [&rest truth-list]
(not (apply or? truth-list)))
; xor operation (parity check) : zero or more arguments, zero will return false,
; otherwise odd number of true's is true
(defoperator xor? ⊕ [&rest truth-list]
(setv boolean False)
(for [truth-value truth-list]
(if (true? truth-value)
(setv boolean (not boolean))))
boolean)
; negation of xor
(defoperator xnor? ↔ [&rest truth-list]
(not (apply xor? truth-list)))
; helper functions for defmixfix ($) macros.
(eval-and-compile
; this takes a list of items at least 3
; index must be bigger than 1 and smaller than the length of the list
; left and right side of the index will be picked to a new list where
; centermost item is moved to left and left to center
; [1 a 2 b 3 c 4] idx=3 -> [1 a [b 2 3] c 4]
(defn list-nest [lst idx]
(setv tmp
(doto
(list (take 1 (drop idx lst)))
(.append (get lst (dec idx)))
(.append (get lst (inc idx)))))
(doto
(list (take (dec idx) lst))
(.append tmp)
(.extend (list (drop (+ 2 idx) lst)))))
(defn one-not-operator? [code]
(and (= (len code) 1) (not (in (first code) operators))))
(defn second-operator? [code]
(and (pos? (len code)) (in (second code) operators)))
(defn first-operator? [code]
(and (> (len code) 1) (in (first code) operators)))
(defn third [lst]
(get lst 2)))
; macro to change precedence order of the operations.
; argument list will be passed to the #< readermacro which
; will reset arguments as an operators-precedence list
; example: (defprecedence and? xor? or?)
; or straight to reader macro way: #<[and? xor? or?]
; call (defprecedence) to empty the list to default state
; in that case left-wise order of precedence is used when evaluating
; the list of propositional logic or other symbols
(defmacro defprecedence [&rest args] `#<~args)
; macro that takes mixed prefix and infix notation clauses
; for evaluating their value. this is same as calling
; $ reader macro directly but might be more convenient way
; inside lips code to use than reader macro syntax
; there is no need to use parentheses with this macro
(defmacro defmixfix [&rest items] `#$~items)
; pass multiple (n) evaluation clauses. each of the must be
; wrapped by () parentheses
(defmacro defmixfix-n [&rest items]
(list-comp `#$~item [item items]))
; main parser loop for propositional logic clauses
(defreader $ [code]
(if
; scalar value
(not (coll? code)) code
; empty list
(zero? (len code)) False
; list with lenght of 1 and the single item not being the operator
(one-not-operator? code) `#$~@code
; list with three or more items, second is the operator
(second-operator? code)
(do
; the second operator on the list is the default index
(setv idx 1)
; loop over all operators
(for [op operators-precedence]
; set new index if operator is found from the code and break in that case
(if (in op code) (do (setv idx (.index code op)) (break))))
; make list nested based on the found index and evaluate again
`#$~(list-nest code idx))
; list with more than 1 items and the first item is the operator
(first-operator? code)
; take the first item i.e. operator and use
; rest of the items as arguments once evaluated by #$
`(~(first code) ~@(list-comp `#$~part [part (drop 1 code)]))
; possibly syntax error on clause
; might be caused by arbitrary usage of operators and operands
; something like: (1 1 and? 0 and?)
`(raise (Exception "Expression error!"))))
Copyright © 2017 Marko Manninen