@@ 377,9 377,9 @@ do
State OpPure "@@" - - -
Defined OpPure "@" - - -
Merge OpControl "@@" evalmerge partmerge commutative
- Select OpControl "@@@" - - -
+ If OpControl "@@@" - - -
+ Any OpControl "@@" - - -
Bind OpInstr "@@" evalbind - -
- Not OpInstr "@" evalnot - -
CompositeInsert OpInstr "@@u*" - - -
CompositeConstruct OpInstr "@*" - - -
ConvertIntToReal OpInstr "@" - - -
@@ 493,7 493,7 @@ fn idstr (id)
struct Module
nodes : (Array RcNode)
- roots : (Set Id)
+ root : Id
# maps node specification to id
rnodes :
Map RcNode Id
@@ 651,6 651,12 @@ struct Module
'nodeId self
Node Op.State typeId default name
+ fn... getArgs (self, node : Id, index : u32, ...)
+ ops := (self.nodes @ node) . operands
+ va-map
+ inline (i)
+ copy (ops @ i)
+ \ index ...
fn... getArg (self, node : Id, index : u32)
copy ((self.nodes @ node) . operands @ index)
fn... getType (self, node : Id)
@@ 761,10 767,7 @@ struct Module
genvisitor
visit-id = visit
\ self node remap
- local newroots : (Set Id)
- for id in self.roots
- 'insert newroots (remap @ id)
- self.roots = newroots
+ self.root = remap @ self.root
self.rnodes_valid = false
'clear self.select_cache
@@ 799,7 802,8 @@ struct Module
'resize visited count 0
local queue : (Array Id)
- for id in self.roots
+ do
+ let id = self.root
visited @ id = 1
'append queue id
# tag all reachable nodes
@@ 896,6 900,53 @@ struct Module
self.nodes = newnodes
'remap self remap
+ fn... tolist
+ case (self, nodeId : Id)
+ returning list
+ local result = '()
+ inline append (...)
+ va-map
+ inline (s)
+ result = (cons s result)
+ ...
+ node := self.nodes @ nodeId
+ append (Symbol (tostring node.opCode))
+ let recur = this-function
+ do
+ inline append (result ...)
+ va-map
+ inline (s)
+ result = (cons s result)
+ ...
+ inline write-any (self v out)
+ append out v
+ inline write-enum (self v out)
+ append out (Symbol (tostring v))
+ vvv bind visit
+ genvisitor
+ visit-id =
+ inline "write-id" (self v out)
+ append out
+ recur self v
+ visit-input = write-enum
+ visit-output = write-enum
+ visit-i32 = write-any
+ visit-f32 = write-any
+ visit-bool = write-any
+ visit-string =
+ inline "write-string" (self v out)
+ append out (v as string)
+ visit-unknown =
+ inline "write-unknown" (self v out)
+ static-if ((typeof v) == u32)
+ append out " ?0x" (hex v)
+ else
+ append out " ?" (repr v)
+ visit self node result
+ 'reverse result
+ case (self)
+ this-function self (copy self.root)
+
fn... tostring
case (self, nodeId : Id, result : (mutable &String))
fn outidstr (id)
@@ 908,7 959,7 @@ struct Module
'append result s
...
node := self.nodes @ nodeId
- if (nodeId in self.roots)
+ if (nodeId == self.root)
write "(" (idstr nodeId) ") "
else
write (idstr nodeId)
@@ 1026,14 1077,20 @@ struct Module
isundef? self ('getArg self id 1)
isundef? self ('getArg self id 2)
+ fn isif? (self id)
+ ('getOp self id) == Op.If
+
fn unthen (self id)
returning Id Id
loop (cond id = ('constBool self true) id)
- if (('getOp self id) == Op.Select)
- if (isundef? self ('getArg self id 1))
- repeat ('and self cond ('getArg self id 0)) ('getArg self id 2)
- elseif (isundef? self ('getArg self id 2))
- repeat ('and self cond ('not self ('getArg self id 0))) ('getArg self id 1)
+ if (('getOp self id) == Op.If)
+ let tval fval =
+ 'getArg self id 1
+ 'getArg self id 2
+ if (isundef? self fval)
+ repeat ('and self cond ('getArg self id 0)) tval
+ elseif (isundef? self tval)
+ repeat ('and self cond ('not self ('getArg self id 0))) fval
break (copy cond) (copy id)
fn... getbool (self, id : Id)
@@ 1095,18 1152,19 @@ struct Module
assert (id != newid)
# update select statements that have become constant
let newid =
- if (('getOp self newid) == Op.Select)
+ if (('getOp self newid) == Op.If)
let cond = ('getArg self newid 0)
let b = ('getbool self cond)
+ let tval = ('getArg self newid 1)
+ let fval = ('getArg self newid 2)
if (b != 0)
- if (b > 0)
- 'getArg self newid 2
- else
- 'getArg self newid 1
+ if (b > 0) tval
+ else fval
+ elseif (tval == fval) tval
elseif
and
- ('getbool self ('getArg self newid 1)) == -1
- ('getbool self ('getArg self newid 2)) == 1
+ ('getbool self fval) == -1
+ ('getbool self tval) == 1
cond
else newid
else newid
@@ 1116,20 1174,20 @@ struct Module
else (copy id)
'define-symbols Module
- select =
- fn... "select" (self, cond : Id, fvalue : Id, tvalue : Id)
+ if =
+ fn... "if" (self, cond : Id, tvalue : Id, fvalue : Id)
returning Id
if ('isundef? self cond)
return ('undef self ('getType self tvalue))
- key := (tupleof cond fvalue tvalue)
+ key := (tupleof cond tvalue fvalue)
try
return
copy
'get self.select_cache key
else;
let result =
- loop (cond fvalue tvalue = cond fvalue tvalue)
- if (('getOp self cond) == Op.Select)
+ loop (cond tvalue fvalue = cond tvalue fvalue)
+ if (('getOp self cond) == Op.If)
# (select (select a b c) d e) -> (select a (select b d e) (select c d e))
let u v w =
'getArg self cond 0
@@ 1137,62 1195,58 @@ struct Module
'getArg self cond 2
repeat
u
- this-function self v fvalue tvalue
- this-function self w fvalue tvalue
- else
+ this-function self v tvalue fvalue
+ this-function self w tvalue fvalue
+ do #else
let b = ('getbool self cond)
let stmt =
if (b > 0) (copy tvalue)
elseif (b < 0) (copy fvalue)
else
+ let consttrue = ('constBool self true)
+ let tvalue =
+ do
+ local substmap : (Map Id Id)
+ 'set substmap cond consttrue
+ 'subst self tvalue substmap
let constfalse = ('constBool self false)
- let consttrue = ('constBool self true)
let fvalue =
do
local substmap : (Map Id Id)
'set substmap cond constfalse
'subst self fvalue substmap
- let tvalue =
- do
- local substmap : (Map Id Id)
- 'set substmap cond consttrue
- 'subst self tvalue substmap
- if (fvalue == tvalue)
+ if (tvalue == fvalue)
copy tvalue
- elseif ((fvalue == constfalse) & (tvalue == consttrue))
+ elseif ((tvalue == consttrue) & (fvalue == constfalse))
copy cond
else
'nodeId self
- Node Op.Select ('getType self tvalue) cond fvalue tvalue
+ Node Op.If ('getType self tvalue) cond tvalue fvalue
break stmt
'set self.select_cache key result
result
merge =
fn... "merge" (self, value1 : Id, value2 : Id)
+ #'any self value1 value2
let c1 value1 = ('unthen self value1)
let c2 value2 = ('unthen self value2)
let lcond1 = ('and self c1 ('not self c2))
let lcond2 = ('and self ('not self c1) c2)
- print ('tostring self c1)
- print ('tostring self value1)
- print ('tostring self c2)
- print ('tostring self value2)
- print;
'then self
'or self c1 c2
if (('getbool self lcond1) >= 0)
- 'select self lcond1 value2 value1
+ 'if self lcond1 value1 value2
else
- 'select self lcond2 value1 value2
+ 'if self lcond2 value2 value1
subbind =
fn... "subbind" (self, target : Id, source : Id)
returning Id
if ('isundef? self source)
return ('undef self ('voidType self))
- elseif (('getOp self source) == Op.Select)
- 'select self ('getArg self source 0)
+ elseif (('getOp self source) == Op.If)
+ 'if self ('getArg self source 0)
this-function self target ('getArg self source 1)
this-function self target ('getArg self source 2)
else
@@ 1202,12 1256,91 @@ struct Module
bind =
fn... "bind" (self, target : Id, source : Id)
let id = ('subbind self target source)
- if (not ('isundef? self source))
+ if ('isundef? self id) id
+ else
+ self.root =
+ do
+ if (self.root == NoId) id
+ else
+ 'any self (copy self.root) id
+ ;
+
+ any =
+ fn... "any" (self, value1 : Id, value2 : Id)
+ returning Id
+ let value1 value2 =
+ if (value1 > value2)
+ _ value2 value1
+ else
+ _ value1 value2
+ if ('isif? self value1)
+ # any(if(a,x,y),z) -> if(a,any(x,z),any(y,z))
+ let c t f = ('getArgs self value1 0 1 2)
+ 'if self c
+ this-function self t value2
+ this-function self f value2
+ elseif ('isif? self value2)
+ # any(x,if(y,z,w)) -> if(y,any(x,z),any(x,w))
+ let c t f = ('getArgs self value2 0 1 2)
+ 'if self c
+ this-function self value1 t
+ this-function self value1 f
+ elseif ('isundef? self value1) (copy value2)
+ elseif ('isundef? self value2) (copy value1)
+ else
+ 'nodeId self
+ Node Op.Any ('getType self value1) value1 value2
+ #
+ let c1 v1 = ('unthen self value1)
+ let c2 v2 = ('unthen self value2)
+ #
+ if c1
+ if c2
+ any v1 v2
+ v1
+ if c2 v2 undef
+ let true1 true2 = (('getbool self c1) > 0) (('getbool self c2) > 0)
+ if (true1 & true2)
+ if (('isif? self value1) & ('isif? self value2))
+ let arg1 arg2 = ('getArg self value1 0) ('getArg self value2 0)
+ if (arg1 == arg2)
+ # same condition
+ any(if(a,x,y),if(a,z,w)) -> if(a,any(x,z),any(y,w))
+ return
+ 'if self arg1
+ this-function self ('getArg self value1 1) ('getArg self value2 1)
+ this-function self ('getArg self value1 2) ('getArg self value2 2)
+ 'nodeId self
+ Node Op.Any ('getType self value1) value1 value2
+ elseif true1
+ 'if self c2
+ this-function self v1 v2
+ v1
+ elseif true2
+ 'if self c1
+ this-function self v1 v2
+ v2
+ else
+ 'if self c1
+ 'if self c2
+ this-function self v1 v2
+ v1
+ value2
+
+ #finalize =
+ fn... "finalize" (self)
+ let id =
+ fold (result = NoId) for id in self.roots
+ if (result == NoId) id
+ else
+ 'any self result id
+ if (id != NoId)
+ 'clear self.roots
'insert self.roots id
- ;
+
then =
fn... "then" (self, cond : Id, value : Id)
- 'select self cond ('undef self ('getType self value)) value
+ 'if self cond value ('undef self ('getType self value))
undef =
fn... "undef" (self, typeId : Id)
@@ 1216,24 1349,32 @@ struct Module
else =
fn... "else" (self, cond : Id, value : Id)
- 'select self cond value ('undef self ('getType self value))
+ 'if self cond ('undef self ('getType self value)) value
or =
fn... "or" (self, value1 : Id, value2 : Id)
if (value1 == value2)
return value1
- 'select self value1 value2 value1
+ 'if self value1 value1 value2
and =
fn... "and" (self, value1 : Id, value2 : Id)
returning Id
if (value1 == value2)
return value2
- 'select self value1 value1 value2
+ 'if self value1 value2 value1
not =
fn... "not" (self, _value : Id)
- 'select self _value ('constBool self true) ('constBool self false)
+ 'if self _value ('constBool self false) ('constBool self true)
+
+ xor =
+ fn... "xor" (self, value1 : Id, value2 : Id)
+ if (value1 == value2)
+ return ('constBool self false)
+ 'if self value1
+ 'not self value2
+ value2
################################################################################
@@ 1558,7 1699,7 @@ static-if main-module?
\ getType vectorType intToReal state constFloat fadd fmul fdiv sin cos
\ constComposite compositeInsert compositeConstruct constBool constString
\ parameter parameters function tupleType else bind then merge
- \ equal input load output constInt and or
+ \ equal input load output constInt and or not xor if
let string =
stringType;
@@ 1582,12 1723,13 @@ static-if main-module?
then exit? (constInt inttype 0)
bind prompt
- then (or setup exit?) (constString "> ")
+ then (merge setup (not exit?)) (constString "> ")
bind stdout
merge
then exit? (constString "exiting...\n")
else exit? readline
+ #if exit? (constString "exiting...\n") readline
#'toposort module
#'catsort module
@@ 1597,11 1739,16 @@ static-if main-module?
print;
'cull module
- #'toposort module
- #'distsort module
+ 'toposort module
+ 'distsort module
print
'tostring module
+ print
+ 'serialize
+ list
+ 'tolist module
+
#'printblocks module
#do