Source code in the m2000 programming language

Module Dinesman_s_multiple_dwelling_problem {
	// this is the standard perimutation function
	// which create a lambda function:
	// pointer_to_array=Func(&BooleanVariable)
	// when BooleanVariable = true we get the last permutation
	Function PermutationStep (a as array) {
		c1=lambda (&f, a) ->{
			=a : f=true
		}
		integer m=len(a)
		if m=0 then Error "No items to make permutations"
		c=c1
		While m>1
			c1=lambda c2=c,p=0%, m=(,) (&f, a, clear as boolean=false) ->{
				if clear then m=(,)
				if len(m)=0 then m=a
				=cons(car(m),c2(&f, cdr(m)))
				if f then f=false:p++:  m=cons(cdr(m), car(m)) : if p=len(m) then p=0 : m=(,):: f=true
				}
			c=c1  
			m--
		End While
		=lambda c, a (&f, clear as boolean=false) -> {
			=c(&f, a, clear)
		}
	}
	boolean k
	object s=("Baker", "Cooper", "Fletcher", "Miller", "Smith")
	StepA=PermutationStep(s)
	while not k
		s=StepA(&k)
		if s#val$(4)= "Baker" then continue
		if s#val$(0)="Cooper" then continue
		if s#val$(0)="Fletcher" then continue
		if s#val$(4)="Fletcher" then continue
		if s#pos("Cooper")> s#pos("Miller") then continue
		if abs(s#pos("Smith")-s#pos("Fletcher"))=1 then continue
		if abs(s#pos("Cooper")-s#pos("Fletcher"))=1 then continue
		exit  // for one solution
	end while
	object c=each(s)
	while c
		Print array$(c)+" lives on floor "+(c^+1)
	end while
}
Dinesman_s_multiple_dwelling_problem

Module Using_AmbFunction {
	Enum Solution {First, Any=-1}
	Function Amb(way as Solution, failure) {
		read a
		c1=lambda i=0, a, (&any,  &ret) ->{
			any=(array(a,i),)
			ret=any
			i++
			ok=i=len(a)
			if ok then i=0
			=ok
		}
		m=stack.size
		if m=0 then Error "At least two arrays needed"
		c=c1
		while m>0 {
			read a
			c1=lambda c2=c, i=0, a,  (&any,  &ret) ->{
				any=(array(a,i),)
				ret=(,) :  ok=false :  anyother=(,)
				ok=c2(&anyother,  &ret)  
				ret=cons(ret, any)
				if ok then i++
				ok=i=len(a)
				if ok  then i=0 
				=ok
			}
			c=c1 :  m--
		}
		ok=false
		any=(,)
		flush
		while not ok
			ret=(,)
			ok=c(&any, &ret)
			s=stack(ret)
			if not failure(! s)  then data ret : if way>0 then ok=true
		End While
		if empty then
			ret=(("",),)
		else
			ret=array([])
		end if
		=ret
	}
	Range=lambda (a, f) ->{
		for i=a to f-1: data i: next
		=array([])
	}
	
	Baker=range(1, 5) 
	Cooper=range(2, 6)
	Fletcher=range(2, 5)
	Miller=range(1,6)
	Smith=range(1,6)
	
	failure=lambda   (Baker, Cooper, Fletcher, Miller, Smith)->{
		if Baker=Cooper or Baker=Fletcher or Baker=Miller or Baker=Smith then =true:exit
		if Cooper=Fletcher or Cooper =Miller or Cooper=Smith then =true:exit
		if Fletcher=Miller or Fletcher=Smith or Miller=Smith then =true:exit
		if Miller
	}
	all=amb(Any, failure, Baker, Cooper, Fletcher, Miller, Smith)
	k=each(all)
	s=("Baker", "Cooper", "Fletcher", "Miller", "Smith")
	while k
		z=array(k)
		zz=each(z, , -2)
		while zz
			? s#val$(zz^)+" ("+array(zz)+"), ";
		end while
		zz=each(z, -1)
		while zz
			? s#val$(zz^)+" ("+array(zz)+") "
		end while
	end while
}
Using_AmbFunction