% $Id: Reducer.oz,v 1.11 2010/01/31 20:55:57 leavens Exp $ % A Reducer that shows execution of Oz statements in the declarative kernel % AUTHOR: Gary T. Leavens \insert 'Configuration.oz' \insert 'MV.oz' declare fun {ReductionsFor StmtAST} %% ENSURES: Result is a lazy list of configurations %% that result from starting with an initial configuration for StmtAST {Reducer 'start'#{InputToConfig StmtAST}} end fun {MakeReductions StmtAST Env Store} %% ENSURES: Result is a lazy list of configurations %% that result from starting with a configuration for StmtAST %% with the given environment and store {Reducer 'start'#{MakeConfig StmtAST Env Store}} end fun lazy {Reducer RuleName#Config} %% ENSURES: Result is a lazy list of RuleName#Config pairs %% starting with the given one. %% (The original RuleName could be 'start' or something similar.) RuleName#Config | if {IsTerminalConfig Config} orelse {Not {CanProgress Config}} then nil else local NewConfig = {NextRunnable Config} in {Reducer {Reduce1 NewConfig}} end end end fun {Reduce1 Config} %% REQUIRES: Config is not terminal %% ENSURES: Result is a pair RuleName#NewConfiguration %% for a single reduction step starting at Config local RunIndex = {RunIndexOfConfig Config} SelectedThread = {SelectedThreadOfConfig Config} Store = {StoreOfConfig Config} in case SelectedThread of runnable(skipStmt#_|Rest) then 'skip' # {ReplaceThread Config RunIndex runnable(Rest)} [] runnable(seqStmt(StmtList)#Env|Rest) then 'sequence' # {ReplaceThread Config RunIndex runnable({Append {Map StmtList fun {$ Stmt} (Stmt#Env) end} Rest})} [] runnable(localStmt(V Body)#Env|Rest) then 'local' # local X#Store2 = {AllocStore Store} in {ReplaceThreadAndStore Config RunIndex runnable(Body#{ExtendEnv Env V X}|Rest) Store2} end [] runnable(assignStmt(V1 varIdExp(V2))#Env|Rest) then 'var-var binding' # local Store2 = {UnifyLocs Store {ApplyEnv Env V1} {ApplyEnv Env V2}} in {ReplaceThreadAndStore Config RunIndex runnable(Rest) Store2} end [] runnable(assignStmt(V Exp)#Env|Rest) then 'value-creation' # local Store2 = {UnifyLocVal Store {ApplyEnv Env V} {MV Exp Env}} in {ReplaceThreadAndStore Config RunIndex runnable(Rest) Store2} end [] runnable(ifStmt(varIdExp(V) S1 S2)#Env|Rest) then local Loc = {ApplyEnv Env V} in if {Determined Store Loc} then case {Read Store Loc} of bool(true) then 'if-true' # {ReplaceThread Config RunIndex runnable(S1#Env|Rest)} [] bool(false) then 'if-false' # {ReplaceThread Config RunIndex runnable(S2#Env|Rest)} else 'if-error' # msg("Not a Boolean") end else 'if-suspend' # {ReplaceThread Config RunIndex suspended(ifStmt(varIdExp(V) S1 S2)#Env|Rest Loc)} end end [] runnable(caseStmt(varIdExp(V) Pattern S1 S2)#Env|Rest) then local Loc = {ApplyEnv Env V} in if {Not {Determined Store Loc}} then 'case-suspend' # {ReplaceThread Config RunIndex suspended(caseStmt(varIdExp(V) Pattern S1 S2)#Env|Rest Loc)} else local NoMatchRuleConfig = 'case-else' # {ReplaceThread Config RunIndex runnable(S2#Env|Rest)} recordPat(Atom FieldList) = Pattern Pairs = {FieldListToPairs FieldList} PatternAsRecord = {List.toRecord Atom Pairs} PatternVars = {Map Pairs fun {$ _#varIdExp(V)} V end} in case {Read Store Loc} of record(R) then local FieldNames = {Arity PatternAsRecord} % (sorts for us :-) in if {Label R} == Atom andthen {Arity R} == FieldNames then local Locs = {Record.toList R} in 'case-match' # {ReplaceThread Config RunIndex runnable(S1#{ExtendEnvList Env PatternVars Locs}|Rest)} end else NoMatchRuleConfig end end else NoMatchRuleConfig end end end end [] runnable(applyStmt(varIdExp(X) ArgExpList)#Env|Rest) andthen {All ArgExpList IsVarIdExp} then local Loc = {ApplyEnv Env X} in if {Not {Determined Store {ApplyEnv Env X}}} then 'application-suspend' # {ReplaceThread Config RunIndex suspended(applyStmt(varIdExp(X) ArgExpList)#Env|Rest Loc)} else ActualLocs = {Map ArgExpList fun {$ varIdExp(Y)} {ApplyEnv Env Y} end} in case {Read Store Loc} of closure(Formals Body ProcEnv) then if {Length Formals} \= {Length ArgExpList} then 'application-error' # msg("Application Error") else 'application' # {ReplaceThread Config RunIndex runnable(Body#{ExtendEnvList ProcEnv Formals ActualLocs}|Rest)} end [] primitive(OzPrim) then try local Store2 = {ApplyPrimitive OzPrim ActualLocs Store} in 'apply-primitive' # {ReplaceThreadAndStore Config RunIndex runnable(Rest) Store2} end catch needArgument(NeededLoc) then 'apply-primitive-suspend' # {ReplaceThread Config RunIndex suspended(applyStmt(varIdExp(X) ArgExpList)#Env|Rest NeededLoc)} end end end end else raise noRuleFor(SelectedThread) end end end end fun {IsVarIdExp E} %% ENSURES: Result is true if E is a variable Id Expression case E of varIdExp(_) then true else false end end fun {FieldListToPairs FieldList} %% ENSURES: Result is a list of pairs representing the fields in FieldList PosFields = {Filter FieldList IsPosField} NamedPairs = {Map {Filter FieldList IsNamedField} fun {$ colonFld(Name Val)} Name#Val end} PosPairs#_ = {FoldL PosFields fun {$ posFld(Val) L#I} (I+1#Val|L)#(I+1) end nil#0} in {Append PosPairs NamedPairs} end fun {IsPosField Field} %% ENSURES: Result is true if Field is a positional field case Field of posFld(...) then true else false end end fun {IsNamedField Field} %% ENSURES: Result is true if Field is a named field case Field of colonFld(...) then true else false end end % Primitives % Representation: % ::= numberPlus fun {ApplyPrimitive OzPrim Locs Store} %% ENSURES: Result is the store that results from applying the %% primitive to the locations given. %% Note that function primitives are really procedures that %% assign to their last argument's location case OzPrim of numberPlus andthen {Length Locs} == 3 then local Loc1|Loc2|Loc3|nil = Locs in if {Determined Store Loc1} andthen {Determined Store Loc2} then local num(Arg1Val) = {Read Store Loc1} num(Arg2Val) = {Read Store Loc2} in {UnifyLocVal Store Loc3 num(Arg1Val + Arg2Val)} end else % either Loc1 or Loc2 is undetermined if {Not {Determined Store Loc1}} then raise needArgument(Loc1) end else raise needArgument(Loc2) end end end end [] showInfo andthen {Length Locs} == 1 then local Loc1|nil = Locs in if {Determined Store Loc1} then {System.showInfo {StringForValue {Read Store Loc1}}} else % undetermined {System.showInfo "_"} end Store end else raise badPrimitiveApplication(OzPrim) end end end fun {StdEnvStore} %% ENSURES: Result is a standard environment containing the primtives EnvInit = {InitEnv} StoreInit = {EmptyStore} LocNumberPlus#Store0 = {AllocStore StoreInit} Store0_2 = {UnifyLocVal Store0 LocNumberPlus primitive(numberPlus)} LocShowInfo#Store1 = {AllocStore Store0_2} Store1_2 = {UnifyLocVal Store1 LocShowInfo primitive(showInfo)} StdEnv = {ExtendEnvList EnvInit ["Number.+" "System.showInfo"] [LocNumberPlus LocShowInfo]} in StdEnv#Store1_2 end fun {MakeStdReductions StmtAST} %% ENSURES: Result is a lazy list of configurations %% that result from starting with a configuration for StmtAST %% with a standard environment and store StdEnv#StdStore = {StdEnvStore} in {Reducer 'start'#{MakeConfig StmtAST StdEnv StdStore}} end