diff options
Diffstat (limited to 'prolog/problems/denotational_semantics')
16 files changed, 107 insertions, 348 deletions
diff --git a/prolog/problems/denotational_semantics/algol_3/common.py b/prolog/problems/denotational_semantics/algol_3/common.py deleted file mode 100644 index 8138484..0000000 --- a/prolog/problems/denotational_semantics/algol_3/common.py +++ /dev/null @@ -1,78 +0,0 @@ -id = 176 -number = 83 -visible = False -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 deleted file mode 100644 index 3b91a47..0000000 --- a/prolog/problems/denotational_semantics/algol_3/en.py +++ /dev/null @@ -1,32 +0,0 @@ -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 deleted file mode 100644 index 1107308..0000000 --- a/prolog/problems/denotational_semantics/algol_for_3/common.py +++ /dev/null @@ -1,92 +0,0 @@ -id = 178 -number = 85 -visible = False -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 deleted file mode 100644 index 2f46d36..0000000 --- a/prolog/problems/denotational_semantics/algol_for_3/en.py +++ /dev/null @@ -1,18 +0,0 @@ -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 deleted file mode 100644 index d98d2d2..0000000 --- a/prolog/problems/denotational_semantics/algol_if_3/common.py +++ /dev/null @@ -1,85 +0,0 @@ -id = 177 -number = 84 -visible = False -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 deleted file mode 100644 index bd5b732..0000000 --- a/prolog/problems/denotational_semantics/algol_if_3/en.py +++ /dev/null @@ -1,19 +0,0 @@ -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/en.py b/prolog/problems/denotational_semantics/en.py index 418b1e7..a245e15 100644 --- a/prolog/problems/denotational_semantics/en.py +++ b/prolog/problems/denotational_semantics/en.py @@ -1,2 +1,2 @@ name = 'Denotational semantics' -description = 'Adding meaning to grammars, writing a simple compiler for Algol-like programming language.' +description = 'Adding meaning to grammars for list-processing languages.' diff --git a/prolog/problems/denotational_semantics/prog_8puzzle_2/common.py b/prolog/problems/denotational_semantics/prog_8puzzle_2/common.py index 71875d4..c5b69da 100644 --- a/prolog/problems/denotational_semantics/prog_8puzzle_2/common.py +++ b/prolog/problems/denotational_semantics/prog_8puzzle_2/common.py @@ -1,6 +1,6 @@ id = 172 -number = 81 -visible = False +number = 30 +visible = True facts = None solution = '''\ @@ -14,3 +14,15 @@ instr172 --> [right]. instr172 --> [up]. instr172 --> [down]. ''' + +initial = '''\ +prog_8puzzle --> [begin], instructs, [end]. + +instructs --> instr. +instructs --> instr, instructs. + +instr --> [left]. +instr --> [right]. +instr --> [up]. +instr --> [down]. +''' diff --git a/prolog/problems/denotational_semantics/prog_8puzzle_2/en.py b/prolog/problems/denotational_semantics/prog_8puzzle_2/en.py index 7969ba4..a91e22e 100644 --- a/prolog/problems/denotational_semantics/prog_8puzzle_2/en.py +++ b/prolog/problems/denotational_semantics/prog_8puzzle_2/en.py @@ -2,8 +2,17 @@ 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> +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>''' +<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 index 13debcf..0e0d048 100644 --- a/prolog/problems/denotational_semantics/prog_8puzzle_3/common.py +++ b/prolog/problems/denotational_semantics/prog_8puzzle_3/common.py @@ -1,6 +1,6 @@ id = 173 -number = 82 -visible = False +number = 40 +visible = True facts = 'denotational_semantics_aux__predicates' solution = '''\ diff --git a/prolog/problems/denotational_semantics/prog_8puzzle_3/en.py b/prolog/problems/denotational_semantics/prog_8puzzle_3/en.py index 51aa81a..7a94c74 100644 --- a/prolog/problems/denotational_semantics/prog_8puzzle_3/en.py +++ b/prolog/problems/denotational_semantics/prog_8puzzle_3/en.py @@ -2,17 +2,38 @@ 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> +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> +<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>''' +<p> +Helper predicates (already defined): +</p> +<ul> +<li><code>findblank(List,I)</code> returns the 1-based index <code>I</code> of the element 0 in <code>List</code></li> +<li><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></li> +</ul> +''' hint = {} diff --git a/prolog/problems/denotational_semantics/prog_listswap_2/common.py b/prolog/problems/denotational_semantics/prog_listswap_2/common.py index e08337d..b3da01f 100644 --- a/prolog/problems/denotational_semantics/prog_listswap_2/common.py +++ b/prolog/problems/denotational_semantics/prog_listswap_2/common.py @@ -1,10 +1,10 @@ id = 175 -number = 79 -visible = False +number = 10 +visible = True facts = None solution = '''\ -program --> [begin], instructs175, [end]. +prog_listswap --> [begin], instructs175, [end]. instructs175 --> instr175. instructs175 --> instr175, instructs175. @@ -13,3 +13,15 @@ instr175 --> [left]. instr175 --> [right]. instr175 --> [swap]. ''' + +# nothing to do in this exercise +initial = '''\ +prog_listswap --> [begin], instructs, [end]. + +instructs --> instr. +instructs --> instr, instructs. + +instr --> [left]. +instr --> [right]. +instr --> [swap]. +''' diff --git a/prolog/problems/denotational_semantics/prog_listswap_2/en.py b/prolog/problems/denotational_semantics/prog_listswap_2/en.py index ad0e9b1..89907bd 100644 --- a/prolog/problems/denotational_semantics/prog_listswap_2/en.py +++ b/prolog/problems/denotational_semantics/prog_listswap_2/en.py @@ -2,9 +2,17 @@ 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> +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> +<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 index dfa7c86..3ad93e8 100644 --- a/prolog/problems/denotational_semantics/prog_listswap_3/common.py +++ b/prolog/problems/denotational_semantics/prog_listswap_3/common.py @@ -1,6 +1,6 @@ id = 174 -number = 80 -visible = False +number = 20 +visible = True facts = 'denotational_semantics_aux__predicates' solution = '''\ diff --git a/prolog/problems/denotational_semantics/prog_listswap_3/en.py b/prolog/problems/denotational_semantics/prog_listswap_3/en.py index b8e9769..e275335 100644 --- a/prolog/problems/denotational_semantics/prog_listswap_3/en.py +++ b/prolog/problems/denotational_semantics/prog_listswap_3/en.py @@ -2,16 +2,37 @@ 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> +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> +<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>''' +<p> +Helper predicates (already defined): +</p> +<ul> +<li><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></li> +</ul> +''' hint = {} diff --git a/prolog/problems/denotational_semantics/sl.py b/prolog/problems/denotational_semantics/sl.py index d0e8f1e..6a7f823 100644 --- a/prolog/problems/denotational_semantics/sl.py +++ b/prolog/problems/denotational_semantics/sl.py @@ -1,2 +1,2 @@ name = 'Denotacijske semantike' -description = 'Dodajanje pomena gramatikam, pisanje preprostega prevajalnika za programski jezik algolskega tipa.' +description = 'Dodajanje pomena gramatikam jezikov za delo s seznami.' |