diff options
Diffstat (limited to 'prolog/problems/denotational_semantics')
14 files changed, 482 insertions, 0 deletions
diff --git a/prolog/problems/denotational_semantics/algol_3/common.py b/prolog/problems/denotational_semantics/algol_3/common.py new file mode 100644 index 0000000..fe6618d --- /dev/null +++ b/prolog/problems/denotational_semantics/algol_3/common.py @@ -0,0 +1,79 @@ +id = 176 +group = 'denotational_semantics' +number = 83 +visible = True +facts = None + +solution = '''\ +algol(fun(S0,S,apply176([printout=[]|S0],S,Minstructs))) --> + [begin], instructs176(Minstructs), [end]. + +instructs176(Minstr) --> instr176(Minstr). +instructs176(fun(S0,S, + (apply176(S0,S1,Minstr), + apply176(S1,S,Minstructs)))) + --> + instr176(Minstr), instructs176(Minstructs). + +instr176(Massign) --> assign176(Massign). +instr176(fun(S0,[printout = L1|S1], + (memb(X = V,S0), + del(printout = L0,S0,S1), + conc(L0,[V],L1)))) + --> + [print(X)]. +instr176(fun(S0,S, + loop176(S0,Mcond,Minstructs,S))) + --> + [while], cond176(Mcond), [do,begin], instructs176(Minstructs), [end]. + +assign176(fun(S0,[X = Value|S1], + (apply176(S0,Value,Mexpr), + del(X = _,S0,S1)))) + --> + var176(X), [:=], expr176(Mexpr). + +cond176( fun( S, TruthVal, + (apply176(S,Val1,ME1), + apply176(S,Val2,ME2), + (Val1 < Val2,!,TruthVal = true ; TruthVal = false)))) + --> + expr176(ME1), [<], expr176(ME2). + +var176(X) --> [X], {atom(X)}. + +expr176(fun(S,Value,eval(Expr,S,Value))) --> + [Expr]. + +apply176(In, Out, fun(In, Out, Goals)) :- + call(Goals). + +loop176( State0, Mcond, _, State0) :- + apply176( State0, false, Mcond), !. +loop176( S0, Mcond, MBody, S) :- + copy_term( MBody, MBodyCopy), + apply176( S0, S1, MBody), + loop176( S1, Mcond, MBodyCopy, S). + +eval176( N, _, N) :- + number176( N), !. +eval176( X, State, Val) :- % A program variable + atom( X), !, + memb( X = Val, State). +eval176( E1 + E2, State, Val) :- !, + eval176( E1, State, V1), + eval176( E2, State, V2), + Val is V1 + V2. +eval176( E1 - E2, State, Val) :- !, + eval176( E1, State, V1), + eval176( E2, State, V2), + Val is V1 - V2. +eval176( E1 * E2, State, Val) :- !, + eval176( E1, State, V1), + eval176( E2, State, V2), + Val is V1 * V2. +eval176( E1 / E2, State, Val) :- !, + eval176( E1, State, V1), + eval176( E2, State, V2), + Val is V1 / V2. +''' diff --git a/prolog/problems/denotational_semantics/algol_3/en.py b/prolog/problems/denotational_semantics/algol_3/en.py new file mode 100644 index 0000000..4b46b11 --- /dev/null +++ b/prolog/problems/denotational_semantics/algol_3/en.py @@ -0,0 +1,33 @@ +id = 176 +name = 'algol/3' +slug = 'interpreter for mini-algol' + +description = '''\ +<p>A DCG for mini-algol.</p> +<pre> + % apply a function to a starting state + ?- apply([a=2], Out, fun(_In, Out, eval(a+3, _In, Out))). + Out = 5. + + % a := a+b + % b := a-b + % a := a-b + ?- _Program = [begin,a,:=,a+b,b,:=,a-b,a,:=,a-b,end], + algol(_F, _Program, []), + apply([a=3,b=5], Output, _F). + Output = [a=5,b=3,printout=[]]. + + % a := 0 + % while a < 10 do + % begin + % print(a) + % a := a+1 + % end + ?- _Program = [begin,a,:=,0,while,a,<,10,do,begin,print(a),a,:=,a+1,end,end], + algol(_F, _Program, []), + apply([a=3], Output, _F). + Output = [a=10,printout=[0,1,2,3,4,5,6,7,8,9]]. +</pre> +''' + +hint = {} diff --git a/prolog/problems/denotational_semantics/algol_for_3/common.py b/prolog/problems/denotational_semantics/algol_for_3/common.py new file mode 100644 index 0000000..3917aa6 --- /dev/null +++ b/prolog/problems/denotational_semantics/algol_for_3/common.py @@ -0,0 +1,93 @@ +id = 178 +group = 'denotational_semantics' +number = 85 +visible = True +facts = None + +solution = '''\ +algol_for(fun(S0,S,apply178([printout=[]|S0],S,Minstructs))) --> + [begin], instructs178(Minstructs), [end]. + +instructs178(Minstr) --> instr178(Minstr). +instructs178(fun(S0,S, + (apply178(S0,S1,Minstr), + apply178(S1,S,Minstructs)))) + --> + instr178(Minstr), instructs178(Minstructs). + +instr178(Massign) --> assign178(Massign). +instr178(fun(S0,[printout = L1|S1], + (memb(X = V,S0), + del(printout = L0,S0,S1), + conc(L0,[V],L1)))) + --> + [print(X)]. +instr178(fun(S0,S, + loop178(S0,Mcond,Minstructs,S))) + --> + [while], cond178(Mcond), [do,begin], instructs178(Minstructs), [end]. +instr178(fun(S0, S, + (apply178(S0, S1, Minit), + for178(S1, Mcond, Mstep, Mbody, S)))) + --> + [for], assign178(Minit), [&], cond178(Mcond), [&], assign178(Mstep), [do, begin], instructs178(Mbody), [end]. + +assign178(fun(S0,[X = Value|S1], + (apply178(S0,Value,Mexpr), + del(X = _,S0,S1)))) + --> + var178(X), [:=], expr178(Mexpr). + +cond178( fun( S, TruthVal, + (apply178(S,Val1,ME1), + apply178(S,Val2,ME2), + (Val1 < Val2,!,TruthVal = true ; TruthVal = false)))) + --> + expr178(ME1), [<], expr178(ME2). + +var178(X) --> [X], {atom(X)}. + +expr178(fun(S,Value,eval(Expr,S,Value))) --> + [Expr]. + +apply178(In, Out, fun(In, Out, Goals)) :- + call(Goals). + +loop178( State0, Mcond, _, State0) :- + apply178( State0, false, Mcond), !. +loop178( S0, Mcond, MBody, S) :- + copy_term( MBody, MBodyCopy), + apply178( S0, S1, MBody), + loop178( S1, Mcond, MBodyCopy, S). + +for178(S0, Mcond, _, _, S0) :- + apply178(S0, false, Mcond), !. +for178(S0, Mcond, Mstep, Mbody, S) :- + copy_term(Mbody, Mbody2), + copy_term(Mstep, Mstep2), + apply178(S0, S1, Mbody), + apply178(S1, S2, Mstep), + for178(S2, Mcond, Mstep2, Mbody2, S). + +eval178( N, _, N) :- + number178( N), !. +eval178( X, State, Val) :- % A program variable + atom( X), !, + memb( X = Val, State). +eval178( E1 + E2, State, Val) :- !, + eval178( E1, State, V1), + eval178( E2, State, V2), + Val is V1 + V2. +eval178( E1 - E2, State, Val) :- !, + eval178( E1, State, V1), + eval178( E2, State, V2), + Val is V1 - V2. +eval178( E1 * E2, State, Val) :- !, + eval178( E1, State, V1), + eval178( E2, State, V2), + Val is V1 * V2. +eval178( E1 / E2, State, Val) :- !, + eval178( E1, State, V1), + eval178( E2, State, V2), + Val is V1 / V2. +''' diff --git a/prolog/problems/denotational_semantics/algol_for_3/en.py b/prolog/problems/denotational_semantics/algol_for_3/en.py new file mode 100644 index 0000000..3578b71 --- /dev/null +++ b/prolog/problems/denotational_semantics/algol_for_3/en.py @@ -0,0 +1,19 @@ +id = 178 +name = 'algol_for/3' +slug = 'interpreter for mini-algol with for-statement' + +description = '''\ +<p>Extend the given DCG for mini-algol to support the for-statement. Example:</p> +<pre> + % for a := 0 & a < 5 & a := a + 1 do + % begin + % print(a) + % end + ?- _Program = [begin,for,a,:=,0,&,a,<,5,&,a,:=,a+1,do,begin,print(a),end,end], + algol_for(_F, _Program, []), + apply([a=2], Output, _F). + Output = [a=5,printout=[0,1,2,3,4]]. +</pre> +''' + +hint = {} diff --git a/prolog/problems/denotational_semantics/algol_if_3/common.py b/prolog/problems/denotational_semantics/algol_if_3/common.py new file mode 100644 index 0000000..8ca92bc --- /dev/null +++ b/prolog/problems/denotational_semantics/algol_if_3/common.py @@ -0,0 +1,86 @@ +id = 177 +group = 'denotational_semantics' +number = 84 +visible = True +facts = None + +solution = '''\ +algol_if(fun(S0,S,apply177([printout=[]|S0],S,Minstructs))) --> + [begin], instructs177(Minstructs), [end]. + +instructs177(Minstr) --> instr177(Minstr). +instructs177(fun(S0,S, + (apply177(S0,S1,Minstr), + apply177(S1,S,Minstructs)))) + --> + instr177(Minstr), instructs177(Minstructs). + +instr177(Massign) --> assign177(Massign). +instr177(fun(S0,[printout = L1|S1], + (memb(X = V,S0), + del(printout = L0,S0,S1), + conc(L0,[V],L1)))) + --> + [print(X)]. +instr177(fun(S0,S, + loop177(S0,Mcond,Minstructs,S))) + --> + [while], cond177(Mcond), [do,begin], instructs177(Minstructs), [end]. +instr177(fun(S0, S, + (apply177(S0, true, Mcond), !, + apply177(S0, S, MinstructsA) + ; + apply177(S0, S, MinstructsB)))) + --> + [if], cond177(Mcond), [then], instructs177(MinstructsA), [else], instructs177(MinstructsB), [end]. + +assign177(fun(S0,[X = Value|S1], + (apply177(S0,Value,Mexpr), + del(X = _,S0,S1)))) + --> + var177(X), [:=], expr177(Mexpr). + +cond177( fun( S, TruthVal, + (apply177(S,Val1,ME1), + apply177(S,Val2,ME2), + (Val1 < Val2,!,TruthVal = true ; TruthVal = false)))) + --> + expr177(ME1), [<], expr177(ME2). + +var177(X) --> [X], {atom(X)}. + +expr177(fun(S,Value,eval(Expr,S,Value))) --> + [Expr]. + +apply177(In, Out, fun(In, Out, Goals)) :- + call(Goals). + +loop177( State0, Mcond, _, State0) :- + apply177( State0, false, Mcond), !. +loop177( S0, Mcond, MBody, S) :- + copy_term( MBody, MBodyCopy), + apply177( S0, S1, MBody), + loop177( S1, Mcond, MBodyCopy, S). + +eval177( N, _, N) :- + number177( N), !. +eval177( X, State, Val) :- % A program variable + atom( X), !, + memb( X = Val, State). +eval177( E1 + E2, State, Val) :- !, + eval177( E1, State, V1), + eval177( E2, State, V2), + Val is V1 + V2. +eval177( E1 - E2, State, Val) :- !, + eval177( E1, State, V1), + eval177( E2, State, V2), + Val is V1 - V2. +eval177( E1 * E2, State, Val) :- !, + eval177( E1, State, V1), + eval177( E2, State, V2), + Val is V1 * V2. +eval177( E1 / E2, State, Val) :- !, + eval177( E1, State, V1), + eval177( E2, State, V2), + Val is V1 / V2. +''' diff --git a/prolog/problems/denotational_semantics/algol_if_3/en.py b/prolog/problems/denotational_semantics/algol_if_3/en.py new file mode 100644 index 0000000..6bc0cb8 --- /dev/null +++ b/prolog/problems/denotational_semantics/algol_if_3/en.py @@ -0,0 +1,20 @@ +id = 177 +name = 'algol_if/3' +slug = 'interpreter for mini-algol with if-statement' + +description = '''\ +<p>Extend the given DCG for mini-algol to support the if-statement. You can assume that both branches are present in every if-statement. Example:</p> +<pre> + % if a < b then + % print(a) + % else + % print(b) + % end + ?- _Program = [begin,if,a,<,b,then,print(a),else,print(b),end,end], + algol_if(_F, _Program, []), + apply([a=3,b=5], Output, _F). + Output = [a=3,b=5,printout=[3]]. +</pre> +''' + +hint = {} diff --git a/prolog/problems/denotational_semantics/prog_8puzzle_2/common.py b/prolog/problems/denotational_semantics/prog_8puzzle_2/common.py new file mode 100644 index 0000000..4cc9c9e --- /dev/null +++ b/prolog/problems/denotational_semantics/prog_8puzzle_2/common.py @@ -0,0 +1,17 @@ +id = 172 +group = 'denotational_semantics' +number = 81 +visible = True +facts = None + +solution = '''\ +prog_8puzzle --> [begin], instructs172, [end]. + +instructs172 --> instr172. +instructs172 --> instr172, instructs172. + +instr172 --> [left]. +instr172 --> [right]. +instr172 --> [up]. +instr172 --> [down]. +''' diff --git a/prolog/problems/denotational_semantics/prog_8puzzle_2/en.py b/prolog/problems/denotational_semantics/prog_8puzzle_2/en.py new file mode 100644 index 0000000..eebf07b --- /dev/null +++ b/prolog/problems/denotational_semantics/prog_8puzzle_2/en.py @@ -0,0 +1,10 @@ +id = 172 +name = 'prog_8puzzle/2' +slug = '8-puzzle-solving language' + +description = '''\ +<p>Write a DCG for solving 8-puzzles. The first symbol in every word is <code>[begin]</code>, followed by any sequence of "instruction" symbols from the set {<code>left</code>, <code>right</code>, <code>up</code>, <code>down</code>}, and finally <code>[end]</code>. The starting symbol should be named <code>prog_8puzzle</code>.</p> + +<p>Example words: <code>[begin,left,down,right,end]</code>, <code>[begin,down,end]</code>.</p>''' + +hint = {} diff --git a/prolog/problems/denotational_semantics/prog_8puzzle_3/common.py b/prolog/problems/denotational_semantics/prog_8puzzle_3/common.py new file mode 100644 index 0000000..415dc17 --- /dev/null +++ b/prolog/problems/denotational_semantics/prog_8puzzle_3/common.py @@ -0,0 +1,37 @@ +id = 173 +group = 'denotational_semantics' +number = 82 +visible = True +facts = 'denotational_semantics_aux__predicates' + +solution = '''\ +prog_8puzzle(R0 --> R) --> + [begin], + { findblank(R0,C0) }, + instructs173(((R0,C0) --> (R,_C))), + [end]. + +instructs173((R0,C0) --> (R,C)) --> + instr173((R0,C0) --> (R,C)). +instructs173((R0,C0) --> (R,C)) --> + instr173((R0,C0) --> (R1,C1)), instructs173((R1,C1) --> (R,C)). + +instr173((R0,C0) --> (R,C)) --> + [left], {Pos is (C0-1) mod 3, + (Pos>0, C is C0-1, swap(R0,C0,C,R) + ; + Pos=0, C=C0, R=R0)}. +instr173((R0,C0) --> (R,C)) --> + [right], {Pos is (C0-1) mod 3, + (Pos<2, C is C0+1, swap(R0,C0,C,R) + ; + Pos=2, C=C0, R=R0)}. +instr173((R0,C0) --> (R,C)) --> + [up], { (C0>3, C is C0-3, swap(R0,C0,C,R) + ; + C0=<3, C=C0, R=R0)}. +instr173((R0,C0) --> (R,C)) --> + [down], { (C0=<6, C is C0+3, swap(R0,C0,C,R) + ; + C0>6, C=C0, R=R0)}. +''' diff --git a/prolog/problems/denotational_semantics/prog_8puzzle_3/en.py b/prolog/problems/denotational_semantics/prog_8puzzle_3/en.py new file mode 100644 index 0000000..c91b9e3 --- /dev/null +++ b/prolog/problems/denotational_semantics/prog_8puzzle_3/en.py @@ -0,0 +1,19 @@ +id = 173 +name = 'prog_8puzzle/3' +slug = '8-puzzle-solving language with semantics' + +description = '''\ +<p>Write a DCG for solving 8-puzzles. The syntax for this language should be the same as in the previous exercise: the first symbol in every word is <code>[begin]</code>, followed by any sequence of "instruction" symbols from the set {<code>left</code>, <code>right</code>, <code>up</code>, <code>down</code>}, and finally <code>[end]</code>. The starting symbol should be named <code>prog_8puzzle</code>.</p> + +<p>The meaning of a word (program) in this language has the form <code>In-->Out</code>, mapping from input to output states. Each state is a (permuted) list of numbers from 0 to 8, where 0 stands for the empty square and other numbers for the corresponding tiles. The first three numbers in the list correspond to the top row of the 8-puzzle, the next three numbers to the middle row, and the last three numbers to the last row. The meaning of instructions <code>left</code>, <code>right</code>, <code>up</code> and <code>down</code> is to move the blank tile in the given direction.</p> + +<pre> + ?- prog_8puzzle([0,1,2,3,4,5,6,7,8]-->Out, [begin,down,right,end], []). + Out = [3,1,2,4,0,5,6,7,8]. +</pre> + +<p>Helper predicates (already defined):<br /> + <code>findblank(List,I)</code> returns the 1-based index <code>I</code> of the element 0 in <code>List</code><br /> + <code>swap(List,I,J,NewList)</code> creates <code>NewList</code> by swapping elements <code>I</code> and <code>J</code> in <code>List</code></p>''' + +hint = {} diff --git a/prolog/problems/denotational_semantics/prog_listswap_2/common.py b/prolog/problems/denotational_semantics/prog_listswap_2/common.py new file mode 100644 index 0000000..ae1c220 --- /dev/null +++ b/prolog/problems/denotational_semantics/prog_listswap_2/common.py @@ -0,0 +1,16 @@ +id = 175 +group = 'denotational_semantics' +number = 79 +visible = True +facts = None + +solution = '''\ +program --> [begin], instructs175, [end]. + +instructs175 --> instr175. +instructs175 --> instr175, instructs175. + +instr175 --> [left]. +instr175 --> [right]. +instr175 --> [swap]. +''' diff --git a/prolog/problems/denotational_semantics/prog_listswap_2/en.py b/prolog/problems/denotational_semantics/prog_listswap_2/en.py new file mode 100644 index 0000000..4dd0ed5 --- /dev/null +++ b/prolog/problems/denotational_semantics/prog_listswap_2/en.py @@ -0,0 +1,11 @@ +id = 175 +name = 'prog_listswap/2' +slug = 'list-manipulation language' + +description = '''\ +<p>Write a DCG for manipulating list elements. The first symbol in every word is <code>[begin]</code>, followed by any sequence of "instruction" symbols from the set {<code>left</code>, <code>right</code>, <code>swap</code>}, and finally <code>[end]</code>. The starting symbol should be named <code>prog_listswap</code>.</p> + +<p>Example words: <code>[begin,right,swap,end]</code>, <code>[begin,right,left,end]</code>.</p> +''' + +hint = {} diff --git a/prolog/problems/denotational_semantics/prog_listswap_3/common.py b/prolog/problems/denotational_semantics/prog_listswap_3/common.py new file mode 100644 index 0000000..110890d --- /dev/null +++ b/prolog/problems/denotational_semantics/prog_listswap_3/common.py @@ -0,0 +1,24 @@ +id = 174 +group = 'denotational_semantics' +number = 80 +visible = True +facts = 'denotational_semantics_aux__predicates' + +solution = '''\ +prog_listswap(In-->Out) --> + [begin], instructs174((In,1)-->(Out,_)), [end]. + +instructs174((R0,C0)-->(R,C)) --> + instr174((R0,C0)-->(R,C)). +instructs174((R0,C0)-->(R,C)) --> + instr174((R0,C0)-->(R1,C1)), + instructs174((R1,C1)-->(R,C)). + +instr174((R0,C0)-->(R0,C)) --> + [left], { C0 > 1, C is C0 - 1 ; C0 =< 1, C is C0 }. +instr174((R0,C0)-->(R0,C)) --> + [right], { length(R0, LenR0), + ( C0 < LenR0, C is C0 + 1 ; C0 >= LenR0, C is C0 ) }. + +instr174((R0,C0)-->(R,C0)) --> + [swap], {swap(R0,C0,R)}.''' diff --git a/prolog/problems/denotational_semantics/prog_listswap_3/en.py b/prolog/problems/denotational_semantics/prog_listswap_3/en.py new file mode 100644 index 0000000..1a7cb79 --- /dev/null +++ b/prolog/problems/denotational_semantics/prog_listswap_3/en.py @@ -0,0 +1,18 @@ +id = 174 +name = 'prog_listswap/3' +slug = 'list-manipulation language with semantics' + +description = '''\ +<p>Write a DCG for manipulating list elements. The first symbol in every word is <code>[begin]</code>, followed by any sequence of "instruction" symbols from the set {<code>left</code>, <code>right</code>, <code>swap</code>}, and finally <code>[end]</code>. The starting symbol should be named <code>prog_listswap</code>.</p> + +<p>The meaning of a word (program) in this language has the form <code>In-->Out</code>, mapping from input to output lists. Besides the list contents, internal states also hold the current cursor position. The <code>left</code> and <code>right</code> instructions move the cursor one step in the given direction, while the <code>swap</code> instruction swaps the element under the cursor with its left neighbor (and fails if cursor is currently pointing to the first element of the list).</p> + +<pre> + ?- prog_listswap([1,2,3,4]-->Out, [begin,right,swap,end], []). + Out = [2,1,3,4]. +</pre> + +<p>Helper predicate (already defined):<br /> + <code>swap(List,I,NewList)</code> creates <code>NewList</code> by swapping the <code>I</code>th element with its left neighbor in <code>List</code></p>''' + +hint = {} |