### Rules to create a 365-day calendar and set the proper
### train schedule for July 4. Operator version.

max-elaborations 5000

sp {initialize*calendar
    (state <s> ^superstate nil)
	-->                                       
    (<s> ^year <y>)
    (<y> ^value 2003)}

sp {initialize*months
    (state <s> ^year <y>)
	-->
    (<y> ^month.name january)
    (<y> ^month.name february)
    (<y> ^month.name march)
    (<y> ^month.name april)
    (<y> ^month.name may)
    (<y> ^month.name june)
    (<y> ^month.name july)
    (<y> ^month.name august)
    (<y> ^month.name september)
    (<y> ^month.name october)
    (<y> ^month.name november)
    (<y> ^month.name december)}

sp {initialize*31day*length
    (state <s> ^year.month <m>)
    (<m> ^name << january march may july august october december >> )
	-->
    (<m> ^days 31)}

sp {initialize*30day*length
    (state <s> ^year.month <m>)
    (<m> ^name << september april june november >> )
	-->
    (<m> ^days 30)}

sp {initialize*february*length
    (state <s> ^year.month <m>)
    (<m> ^name february)
	-->
    (<m> ^days 28)}

sp {initialize*first*days
    (state <s> ^year.month <m>)
	-->
    (<m> ^day <d>)
    (<d> ^date 1)}

sp {initialize*remaining*days
    (state <s> ^year.month <m>) 
    (<m> ^days <len>)
    (<m> ^day.date { <dt> < <len> } )
	-->
    (<m> ^day <d>)
    (<d> ^date ( + <dt> 1 ))}

sp {initialize*newyearsday
    (state <s> ^year <y>)
    (<y> ^value 2003)
    (<y> ^month <m>)
    (<m> ^name january)
    (<m> ^day <d>)
    (<d> ^date 1)
	-->
    (<d> ^dayofweek wednesday)}

sp {elaborate*daysofweek*onemonth
    (state <s> ^year.month <m>)
    (<m> ^day <d>)
    (<m> ^day <d2>)
    (<d> ^date <dt> ^dayofweek <wk>)
    (<d2> ^date { <dt2> > <dt> } )
  - (<d3> ^date { <dt3> > <dt>  < <dt2> } )
    (<s> ^nextday <n>)
    (<n> ^day <wk> ^next <nwk>)
	-->
    (<d2> ^dayofweek <nwk> )}

sp {elaborate*daysofweek*startnewmonth
    (state <s> ^year.month <m>)
    (<m> ^name <name1>)
    (state <s> ^year.month <m2>)
    (<m2> ^name { <name2> <> january } )
    (<s> ^nextmonth <nm>)
    (<nm> ^month <name1> ^next <name2>)
    (<m> ^days <len> ^day <d>)
    (<d> ^date <len> ^dayofweek <wk>)
    (<m2> ^days <len2> ^day <d2>)
    (<d2> ^date 1)
    (<s> ^nextday <n>)
    (<n> ^day <wk> ^next <nwk>)
	-->
    (<d2> ^dayofweek <nwk> )}

sp {holiday*july4th
    (state <s> ^year.month <m>)
    (<m> ^name july)
    (<m> ^day <d>)
    (<d> ^date 4)
	-->
    (<d> ^holiday true)}

sp {initialize*orderofdays
    (state <s> ^superstate nil)
	-->
    (<s> ^nextday <n1>)
    (<n1> ^day monday ^next tuesday)
    (<s> ^nextday <n2>)
    (<n2> ^day tuesday ^next wednesday)
    (<s> ^nextday <n3>)
    (<n3> ^day wednesday ^next thursday)
    (<s> ^nextday <n4>)
    (<n4> ^day thursday ^next friday)
    (<s> ^nextday <n5>)
    (<n5> ^day friday ^next saturday)
    (<s> ^nextday <n6>)
    (<n6> ^day saturday ^next sunday)
    (<s> ^nextday <n7>)
    (<n7> ^day sunday ^next monday)}

sp {initialize*orderofmonths
    (state <s> ^superstate nil)
	-->
    (<s> ^nextmonth <n1>)
    (<n1> ^month january ^next february)
    (<s> ^nextmonth <n2>)
    (<n2> ^month february ^next march)
    (<s> ^nextmonth <n3>)
    (<n3> ^month march ^next april)
    (<s> ^nextmonth <n4>)
    (<n4> ^month april ^next may)
    (<s> ^nextmonth <n5>)
    (<n5> ^month may ^next june)
    (<s> ^nextmonth <n6>)
    (<n6> ^month june ^next july)
    (<s> ^nextmonth <n7>)
    (<n7> ^month july ^next august)
    (<s> ^nextmonth <n8>)
    (<n8> ^month august ^next september)
    (<s> ^nextmonth <n9>)
    (<n9> ^month september ^next october)
    (<s> ^nextmonth <n10>)
    (<n10> ^month october ^next november)
    (<s> ^nextmonth <n11>)
    (<n11> ^month november ^next december)
    (<s> ^nextmonth <n12>)
    (<n12> ^month december ^next january)}

### Three rules to propose, apply and remove the operator
### schedule-friday-trains
sp {propose*schedule*fridaytrains
    (state <s> ^year.month.day <d>)
    (<d> ^dayofweek friday)
	-->
    (<s> ^operator <o> + =)
    (<o> ^name schedule-friday-trains
         ^day <d>)}

sp {apply*schedule*fridaytrains
    (state <s> ^year.month.day <d> ^operator <o>)
    (<o> ^name schedule-friday-trains
         ^day <d>)
	-->
    (<d> ^trains 9am 11am 1pm 3pm 5pm 7pm)
    (write (crlf) |July 4th trains| (crlf) )
    (write (crlf) 9am 11am 1pm 3pm 5pm 7pm (crlf) )
    (<o> ^completed yes)}

sp {apply*schedule*remove-schedulefriday
    (state <s> ^year.month.day <d> ^operator <o>)
    (<o> ^name schedule-friday-trains ^day <d>
         ^completed yes)
	-->
    (<s> ^operator <o> -)}

### Three rules to propose, apply and remove the operator
### schedule-holiday-trains
sp {propose*schedule*holidaytrains
    (state <s> ^year.month.day <d>)
    (<d> ^holiday true)
	-->
    (<s> ^operator <o> + > =)
    (<o> ^name schedule-holiday-trains ^day <d>)}

sp {apply*schedule*holidaytrains
    (state <s> ^year.month.day <d> ^operator <o>)
    (<o> ^name schedule-holiday-trains
         ^day <d>)
	-->
    (<d> ^trains 10am 2pm 6pm)
    (write (crlf) |July 4th trains| (crlf) )
    (write (crlf) 10am (crlf) 2pm (crlf) 6pm (crlf) )
    (<o> ^completed yes)}

sp {apply*schedule*remove-scheduleholiday
    (state <s> ^year.month.day <d> ^operator <o>)
    (<o> ^name schedule-holiday-trains ^day <d>
         ^completed yes)
	-->
    (<s> ^operator <o> -)}

sp {stop*soar
    (state <s> ^year.month <m>)
    (<m> ^day <d> ^name july)
    (<d> ^date 4 ^trains <t>)
	-->
    (halt)}