aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/c-util.boot8
-rw-r--r--src/interp/g-util.boot44
-rw-r--r--src/interp/nrungo.boot93
-rw-r--r--src/interp/slam.boot114
4 files changed, 155 insertions, 104 deletions
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index b030f3b3..552b007c 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1508,6 +1508,14 @@ mutateToBackendCode x ==
IDENTP u and GET(u,"ILAM") ~= nil =>
x.first := eval u
mutateToBackendCode x
+ u in '(LET LET_*) =>
+ vars := nil
+ for [var,init] in second x repeat
+ mutateToBackendCode init
+ $LocalVars := [var,:$LocalVars]
+ vars := [var,:vars]
+ mutateToBackendCode x.rest.rest
+ $LocalVars := setDifference($LocalVars,vars)
u in '(PROG LAMBDA) =>
newBindings := []
for y in second x repeat
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 8958843e..56ea3096 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -167,10 +167,52 @@ expandCollect ["%collect",:iters,body] ==
expandRepeat ["%repeat",:iters,body] ==
expandLoop(iters,body,["voidValue"])
+
+expandGreaterEqual ["%ge",:args] ==
+ [">=",:expandToVMForm args]
+
+expandGreater ["%gt",:args] ==
+ [">",:expandToVMForm args]
+
+expandLessEqual ["%le",:args] ==
+ ["<=",:expandToVMForm args]
+
+expandLess ["%lt",:args] ==
+ ["<",:expandToVMForm args]
+
+-- Logical operators
+
+expandNot ["%not",arg] ==
+ ["NOT",expandToVMForm arg]
+
+expandAnd ["%and",:args] ==
+ ["AND",:expandToVMForm args]
+
+expandOr ["%or",:args] ==
+ ["OR",:expandToVMForm args]
+
+-- Local variable bindings
+expandBind ["%bind",inits,body] ==
+ body := expandToVMForm body
+ inits := [[first x,expandToVMForm second x] for x in inits]
+ -- FIXME: we should consider turning LET* into LET or direct inlining.
+ ["LET*",inits,body]
+
++ Table of opcode-expander pairs.
$OpcodeExpanders == [
+ ["%not",:"expandNot"],
+ ["%and",:"expandAnd"],
+ ["%or",:"expandOr"],
+
["%collect",:"expandCollect"],
- ["%repeat",:"expandRepeat"]
+ ["%repeat",:"expandRepeat"],
+
+ ["%le",:"expandLessEqual"],
+ ["%lt",:"expandLess"],
+ ["%ge",:"expandGreaterEqual"],
+ ["%gt",:"expandGreater"],
+
+ ["%bind",:"expandBind"]
]
++ Return the expander of a middle-end opcode, or nil if there is none.
diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot
index c8ebc7f3..192d1128 100644
--- a/src/interp/nrungo.boot
+++ b/src/interp/nrungo.boot
@@ -328,96 +328,3 @@ NRTgetMinivectorIndex(u,op,sig,domVector) ==
for x in $minivector | EQ(x,u)] => k
$minivector := [:$minivector,u]
s
-
-NRTisRecurrenceRelation(op,body,minivectorName) ==
- -- returns [body p1 p2 ... pk] for a k-term recurrence relation
- -- where the n-th term is computed using the (n-1)st,...,(n-k)th
- -- whose values are initially computed using the expressions
- -- p1,...,pk respectively; body has #2,#3,... in place of
- -- f(k-1),f(k-2),...
-
- body isnt ['COND,:pcl] => false
- -- body should have a conditional expression which
- -- gives k boundary values, one general term plus possibly an
- -- "out of domain" condition
- --pcl is [:.,[ ''T,:mess]] and not (CONTAINED('throwMessage,mess) or
- -- CONTAINED('throwKeyedMsg,mess)) => NIL
- pcl := [x for x in pcl | not (x is [''T,:mess] and
- (CONTAINED('throwMessage,mess) or
- CONTAINED('throwKeyedMsg,mess)))]
- integer := eval $Integer
- iequalSlot:=compiledLookupCheck("=",[$Boolean,"$","$"],integer)
- lesspSlot:=compiledLookupCheck("<",[$Boolean,"$","$"],integer)
- notpSlot:= compiledLookupCheck("not",["$","$"],eval $Boolean)
- for [p,c] in pcl repeat
- p is ['SPADCALL,sharpVar,n1,['ELT,=minivectorName,slot]]
- and EQ(iequalSlot,$minivector.slot) =>
- initList:= [[n1,:c],:initList]
- sharpList := insert(sharpVar,sharpList)
- n:=n1
- miscList:= [[p,c],:miscList]
- miscList isnt [[generalPred,generalTerm]] or sharpList isnt [sharpArg] =>
- return false
- --first general term starts at n
-
- --Must have at least one special value; insist that they be consecutive
- null initList => false
- specialValues:= MSORT ASSOCLEFT initList
- or/[null integer? n for n in specialValues] => false
- minIndex:= "MIN"/specialValues
- not (and/[i=x for i in minIndex..(minIndex+n-1) for x in specialValues]) =>
- sayKeyedMsg("S2IX0005",
- ["append"/[['" ",sv] for sv in specialValues]])
- return nil
-
- --Determine the order k of the recurrence and index n of first general term
- k:= #specialValues
- n:= k+minIndex
- --Check general predicate
- predOk :=
- generalPred is '(QUOTE T) => true
- generalPred is ['SPADCALL,m,=sharpArg,['ELT,=minivectorName,slot]]
- and EQ(lesspSlot,$minivector.slot)=> m+1
- generalPred is ['SPADCALL,['SPADCALL,=sharpArg,m,
- ['ELT,=minivectorName,slot]], ['ELT,=minivectorName,notSlot]]
- and EQ(lesspSlot,$minivector.slot)
- and EQ(notpSlot,$minivector.notSlot) => m
- generalPred is ['NOT,['SPADCALL,=sharpArg,m,['ELT,=minivectorName, =lesspSlot]]]
- and EQ(lesspSlot,$minivector.slot) => m
- return nil
- integer? predOk and predOk ~= n =>
- sayKeyedMsg("S2IX0006",[n,m])
- return nil
-
- --Check general term for references to just the k previous values
- diffCell:=compiledLookupCheck("-",'($ $ $),integer)
- diffSlot := or/[i for i in 0.. for x in $minivector | EQ(x,diffCell)]
- or return nil
- --Check general term for references to just the k previous values
- sharpPosition := PARSE_-INTEGER SUBSTRING(sharpArg,1,nil)
- al:= mkDiffAssoc(op,generalTerm,k,sharpPosition,sharpArg,diffSlot,minivectorName)
- null al => false
- "$failed" in al => false
- body:= generalTerm
- for [a,:b] in al repeat
- body:= substitute(b,a,body)
- result:= [body,sharpArg,n-1,:nreverse [LASSOC(i,initList) or
- systemErrorHere('"NRTisRecurrenceRelation")
- for i in minIndex..(n-1)]]
-
-mkDiffAssoc(op,body,k,sharpPosition,sharpArg,diffSlot,vecname) ==
- -- returns alist which should not have any entries = $failed
- -- form substitution list of the form:
- -- ( ((f (,DIFFERENCE #1 1)) . #2) ((f (,DIFFERENCE #1 2)) . #3) ...)
- -- but also checking that all difference values lie in 1..k
- atom body => nil
- body is ['COND,:pl] =>
- "union"/[mkDiffAssoc(op,c,k,sharpPosition,sharpArg,diffSlot,vecname) for [p,c] in pl]
- body is [fn,:argl] =>
- (fn = op) and argl.(sharpPosition-1) is
- ['SPADCALL,=sharpArg,n,['ELT,=vecname,=diffSlot]] =>
- NUMP n and n > 0 and n <= k =>
- [[body,:$TriangleVariableList.n]]
- ['$failed]
- "union"/[mkDiffAssoc(op,x,k,sharpPosition,sharpArg,diffSlot,vecname) for x in argl]
- systemErrorHere '"mkDiffAssoc"
diff --git a/src/interp/slam.boot b/src/interp/slam.boot
index 0da00e00..c3f79904 100644
--- a/src/interp/slam.boot
+++ b/src/interp/slam.boot
@@ -38,6 +38,100 @@ namespace BOOT
++ List of compiled function names.
$compiledOpNameList := []
+
+isRecurrenceRelation(op,body,minivectorName) ==
+ -- returns [body p1 p2 ... pk] for a k-term recurrence relation
+ -- where the n-th term is computed using the (n-1)st,...,(n-k)th
+ -- whose values are initially computed using the expressions
+ -- p1,...,pk respectively; body has #2,#3,... in place of
+ -- f(k-1),f(k-2),...
+
+ body isnt ['COND,:pcl] => false
+ -- body should have a conditional expression which
+ -- gives k boundary values, one general term plus possibly an
+ -- "out of domain" condition
+ --pcl is [:.,[ ''T,:mess]] and not (CONTAINED('throwMessage,mess) or
+ -- CONTAINED('throwKeyedMsg,mess)) => NIL
+ pcl := [x for x in pcl | not (x is [''T,:mess] and
+ (CONTAINED('throwMessage,mess) or
+ CONTAINED('throwKeyedMsg,mess)))]
+ integer := eval $Integer
+ iequalSlot:=compiledLookupCheck("=",[$Boolean,"$","$"],integer)
+ lesspSlot:=compiledLookupCheck("<",[$Boolean,"$","$"],integer)
+ notpSlot:= compiledLookupCheck("not",["$","$"],eval $Boolean)
+ for [p,c] in pcl repeat
+ p is ['SPADCALL,sharpVar,n1,['ELT,=minivectorName,slot]]
+ and EQ(iequalSlot,$minivector.slot) =>
+ initList:= [[n1,:c],:initList]
+ sharpList := insert(sharpVar,sharpList)
+ n:=n1
+ miscList:= [[p,c],:miscList]
+ miscList isnt [[generalPred,generalTerm]] or sharpList isnt [sharpArg] =>
+ return false
+ --first general term starts at n
+
+ --Must have at least one special value; insist that they be consecutive
+ null initList => false
+ specialValues:= MSORT ASSOCLEFT initList
+ or/[null integer? n for n in specialValues] => false
+ minIndex:= "MIN"/specialValues
+ not (and/[i=x for i in minIndex..(minIndex+n-1) for x in specialValues]) =>
+ sayKeyedMsg("S2IX0005",
+ ["append"/[['" ",sv] for sv in specialValues]])
+ return nil
+
+ --Determine the order k of the recurrence and index n of first general term
+ k:= #specialValues
+ n:= k+minIndex
+ --Check general predicate
+ predOk :=
+ generalPred is '(QUOTE T) => true
+ generalPred is ['SPADCALL,m,=sharpArg,['ELT,=minivectorName,slot]]
+ and EQ(lesspSlot,$minivector.slot)=> m+1
+ generalPred is ['SPADCALL,['SPADCALL,=sharpArg,m,
+ ['ELT,=minivectorName,slot]], ['ELT,=minivectorName,notSlot]]
+ and EQ(lesspSlot,$minivector.slot)
+ and EQ(notpSlot,$minivector.notSlot) => m
+ generalPred is ['NOT,['SPADCALL,=sharpArg,m,['ELT,=minivectorName, =lesspSlot]]]
+ and EQ(lesspSlot,$minivector.slot) => m
+ return nil
+ integer? predOk and predOk ~= n =>
+ sayKeyedMsg("S2IX0006",[n,m])
+ return nil
+
+ --Check general term for references to just the k previous values
+ diffCell:=compiledLookupCheck("-",'($ $ $),integer)
+ diffSlot := or/[i for i in 0.. for x in $minivector | EQ(x,diffCell)]
+ or return nil
+ --Check general term for references to just the k previous values
+ sharpPosition := PARSE_-INTEGER SUBSTRING(sharpArg,1,nil)
+ al:= mkDiffAssoc(op,generalTerm,k,sharpPosition,sharpArg,diffSlot,minivectorName)
+ null al => false
+ "$failed" in al => false
+ body:= generalTerm
+ for [a,:b] in al repeat
+ body:= substitute(b,a,body)
+ result:= [body,sharpArg,n-1,:nreverse [LASSOC(i,initList) or
+ systemErrorHere('"isRecurrenceRelation")
+ for i in minIndex..(n-1)]]
+
+mkDiffAssoc(op,body,k,sharpPosition,sharpArg,diffSlot,vecname) ==
+ -- returns alist which should not have any entries = $failed
+ -- form substitution list of the form:
+ -- ( ((f (,DIFFERENCE #1 1)) . #2) ((f (,DIFFERENCE #1 2)) . #3) ...)
+ -- but also checking that all difference values lie in 1..k
+ atom body => nil
+ body is ['COND,:pl] =>
+ "union"/[mkDiffAssoc(op,c,k,sharpPosition,sharpArg,diffSlot,vecname) for [p,c] in pl]
+ body is [fn,:argl] =>
+ (fn = op) and argl.(sharpPosition-1) is
+ ['SPADCALL,=sharpArg,n,['ELT,=vecname,=diffSlot]] =>
+ NUMP n and n > 0 and n <= k =>
+ [[body,:$TriangleVariableList.n]]
+ ['$failed]
+ "union"/[mkDiffAssoc(op,x,k,sharpPosition,sharpArg,diffSlot,vecname) for x in argl]
+ systemErrorHere '"mkDiffAssoc"
+
reportFunctionCompilation(op,nam,argl,body,isRecursive) ==
-- for an alternate definition of this function which does not allow
-- dynamic caching, see SLAMOLD BOOT
@@ -49,7 +143,7 @@ reportFunctionCompilation(op,nam,argl,body,isRecursive) ==
argl := COPY argl -- play it safe for optimization
init :=
not(isRecursive and $compileRecurrence and #argl = 1) => nil
- NRTisRecurrenceRelation(nam,body,minivectorName)
+ isRecurrenceRelation(nam,body,minivectorName)
init => compileRecurrenceRelation(op,nam,argl,body,init)
cacheCount:= getCacheCount op
cacheCount = "all" => reportFunctionCacheAll(op,nam,argl,body)
@@ -179,8 +273,8 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
stateVar:= gensym()
stateVal:= gensym()
lastArg := INTERNL strconc('"#",STRINGIMAGE QSADD1 # argl)
- decomposeCode:=
- [["%LET",gIndex,["ELT",lastArg,0]],:[["%LET",g,["ELT",lastArg,i]]
+ decomposeBindings:=
+ [[gIndex,["ELT",lastArg,0]],:[[g,["ELT",lastArg,i]]
for g in gsList for i in 1..]]
gsRev:= reverse gsList
rotateCode:= [["%LET",p,q] for p in gsRev for q in [:rest gsRev,g]]
@@ -199,8 +293,8 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
["COND", [["EQL",sharpArg,gIndex],['RETURN,returnValue]]]
newValueCode:= ["%LET",g,substitute(gIndex,sharpArg,
EQSUBSTLIST(gsList,rest $TriangleVariableList,body))]
- ["PROGN",:decomposeCode,
- ["REPEAT",["WHILE",'T],["PROGN",endTest,advanceCode,
+ ["%bind",decomposeBindings,
+ ["%repeat",["WHILE",true],["PROGN",endTest,advanceCode,
newValueCode,:rotateCode]]]
fromScratchInit:=
[["%LET",gIndex,n],:[["%LET",g,x] for g in gsList for x in initCode]]
@@ -219,7 +313,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
extraArguments => ["hashTable",''EQUAL]
tripleCode
cacheResetCode := ["SETQ",stateNam,initialValueCode]
- ["COND",[["NULL",["AND",["BOUNDP",MKQ stateNam], _
+ ["COND",[["%not",["%and",["BOUNDP",MKQ stateNam], _
["CONSP",stateNam]]], _
["%LET",stateVar,cacheResetCode]], _
[''T, ["%LET",stateVar,stateNam]]]
@@ -234,12 +328,12 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) ==
mbody :=
preset := [initialSetCode,:initialResetCode,["%LET",max,["ELT",stateVar,0]]]
- phrase1:= [["AND",["%LET",max,["ELT",stateVar,0]],["GE",sharpArg,max]],
+ phrase1:= [["%and",["%LET",max,["ELT",stateVar,0]],["%ge",sharpArg,max]],
[auxfn,:argl,stateVar]]
- phrase2:= [["GT",sharpArg,["SETQ",max,["DIFFERENCE",max,k]]],
+ phrase2:= [["%gt",sharpArg,["SETQ",max,["DIFFERENCE",max,k]]],
["ELT",stateVar,["QSADD1",["QSDIFFERENCE",k,["DIFFERENCE",sharpArg,max]]]]]
- phrase3:= [["GT",sharpArg,n],[auxfn,:argl,["LIST",n,:initCode]]]
- phrase4:= [["GT",sharpArg,n-k],
+ phrase3:= [["%gt",sharpArg,n],[auxfn,:argl,["LIST",n,:initCode]]]
+ phrase4:= [["%gt",sharpArg,n-k],
["ELT",["LIST",:initCode],["QSDIFFERENCE",n,sharpArg]]]
phrase5:= ['(QUOTE T),['recurrenceError,MKQ op,sharpArg]]
['PROGN,:preset,['COND,phrase1,phrase2,phrase3,phrase4,phrase5]]