;;; This has been converted to 2.0.
;;; Note: Names of disj primitive groupings are now global, so 
;;;  instead of naming the grouping type, if it is under concept X, 
;;;  the grouping has been renamed to X-type.

;;; Wines example

;;; Note: this sample knowledge base does not exactly mirror the
;;; knowledge base described in the paper "Living with CLASSIC:
;;; When and How to Use a KL-ONE-Like Language", but it is similar.

;;; Wines have properties, derivable from their generic types.
;;; Meals have courses, and courses require certain properties of
;;; their wines.

;;; To find a wine for a meal's course, create an individual for the
;;; course, and give it the appropriate properties (including a new
;;; individual to fill its drink role).  The proper properties for a wine
;;; for the course will propagate to the filler of the drink role for
;;; that course.  Just find the instances of the generic descriptor of
;;; that wine individual.

;;; Note: only some of the rules are named.

(cl-startup)

;; Turn off the debugging and warning messages:
(cl-set-classic-debug-level 0)
(cl-set-classic-warn-mode nil)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The roles

;; These attributes are also at-least 1. Store this on the concepts.
(cl-define-primitive-role 'color :attribute t)
(cl-define-primitive-role 'body :attribute t)
(cl-define-primitive-role 'flavor :attribute t)
(cl-define-primitive-role 'sugar :attribute t)
(cl-define-primitive-role 'region :attribute t)
(cl-define-primitive-role 'grape)
(cl-define-primitive-role 'maker :attribute t)
(cl-define-primitive-role 'drink :attribute t)
(cl-define-primitive-role 'food :attribute t)
(cl-define-primitive-role 'course)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; After defining the roles, define value restriction concepts and
;; individuals to be used in further definitions.

;; WINE-PROPERTY

(cl-define-disjoint-primitive-concept
  'wine-property 'classic-thing 'classic-thing-type)

;; Define these "property" concepts as the combination of
;; wine-property, and one-ofs with the given instances.
(cl-define-concept 'wine-color
		   '(and wine-property (one-of white rose red)))
(cl-define-concept 'wine-body
		   '(and wine-property (one-of light medium full)))
(cl-define-concept 'wine-flavor
		   '(and wine-property (one-of delicate moderate strong)))
(cl-define-concept 'wine-sugar
		   '(and wine-property (one-of sweet off-dry dry)))

(cl-populate 'wine-color '(white rose red))
(cl-populate 'wine-body '(light medium full))
(cl-populate 'wine-flavor '(delicate moderate strong))
(cl-populate 'wine-sugar '(sweet off-dry dry))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Define the other topmost concepts.

(cl-define-disjoint-primitive-concept
  'consumable-thing 'classic-thing 'classic-thing-type)
(cl-define-disjoint-primitive-concept
  'winery 'classic-thing 'classic-thing-type)
(cl-define-disjoint-primitive-concept
  'wine-region 'classic-thing 'classic-thing-type)

;; Consumable-things

(cl-define-disjoint-primitive-concept
  'edible-thing 'consumable-thing 'consumable-thing-type)
(cl-define-disjoint-primitive-concept
  'potable-liquid 'consumable-thing 'consumable-thing-type)


;; THE WINE-REGION CONCEPTS AND INSTANCES

;; The French wine regions

(cl-define-primitive-concept 'french-region 'wine-region)
(cl-define-primitive-concept 'loire-region 'french-region)
(cl-create-ind 'muscadet 'loire-region)
(cl-create-ind 'sancerre 'loire-region)
(cl-create-ind 'anjou 'loire-region)
(cl-create-ind 'tours 'loire-region)

(cl-define-primitive-concept 'bourgogne-region 'french-region)
(cl-create-ind 'meursault 'bourgogne-region)
;; Beaujolais is technically in the bourgogne region, but when people 
;; refer to a beaujolais wine, they mean a gamay grape, and if they 
;; refer to a burgundy (referring to red wine), they mean a pinot 
;; noir. Thus, we are making beaujolais a separate region from 
;; bourgogne-region. 
(cl-create-ind 'beaujolais 'french-region)
(cl-create-ind 'cotes-d-or 'bourgogne-region)

(cl-define-primitive-concept 'bordeaux-region 'french-region)
(cl-create-ind 'st-emilion 'bordeaux-region)
(cl-create-ind 'sauterne 'bordeaux-region)
(cl-define-primitive-concept 'medoc-region 'bordeaux-region)
(cl-create-ind 'margaux 'medoc-region)
(cl-create-ind 'pauillac 'medoc-region)

(cl-define-primitive-concept 'us-region 'wine-region)
(cl-define-primitive-concept 'californian-region 'us-region)
(cl-create-ind 'napa 'californian-region)
(cl-create-ind 'sonoma 'californian-region)
(cl-create-ind 'mendocino 'californian-region)
(cl-create-ind 'central-coast 'californian-region)
(cl-create-ind 'santa-cruz-mountains 'californian-region)
(cl-create-ind 'edna-valley 'californian-region)
(cl-create-ind 'santa-barbara 'californian-region)
(cl-create-ind 'arroyo-grande 'californian-region)

(cl-create-ind 'portugal 'wine-region)
(cl-create-ind 'germany 'wine-region)
(cl-create-ind 'alsace 'french-region)
(cl-define-primitive-concept 'australian-region 'wine-region)
(cl-create-ind 'south-australia 'australian-region)
(cl-create-ind 'new-zealand 'wine-region)

(cl-define-primitive-concept 'italian-region 'wine-region)
(cl-create-ind 'chianti 'italian-region)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; All the types of EDIBLE-THINGs (foods)

(cl-define-disjoint-primitive-concept
  'fruit 'edible-thing 'edible-thing-type)
(cl-define-disjoint-primitive-concept
  'sweet-fruit 'fruit 'fruit-sweetness)
(cl-define-disjoint-primitive-concept
  'non-sweet-fruit 'fruit 'fruit-sweetness)
(cl-define-disjoint-primitive-concept
  'dessert 'edible-thing 'edible-thing-type)
(cl-define-disjoint-primitive-concept
  'cheese/nuts-dessert 'dessert 'dessert-type)
(cl-define-disjoint-primitive-concept
  'sweet-dessert 'dessert 'dessert-type)
(cl-define-disjoint-primitive-concept
  'seafood 'edible-thing 'edible-thing-type)
(cl-define-disjoint-primitive-concept
  'shellfish 'seafood 'seafood-shells)
(cl-define-disjoint-primitive-concept
  'fish 'seafood 'seafood-shells)
(cl-define-disjoint-primitive-concept
  'oyster-shellfish 'shellfish 'shellfish-oysters)
(cl-define-disjoint-primitive-concept
  'non-oyster-shellfish 'shellfish 'shellfish-oysters)
(cl-define-disjoint-primitive-concept
  'bland-fish 'fish 'fish-spice)
(cl-define-disjoint-primitive-concept
  'non-bland-fish 'fish 'fish-spice)
(cl-define-disjoint-primitive-concept
  'fowl 'edible-thing 'edible-thing-type)

(cl-define-disjoint-primitive-concept
  'light-meat-fowl 'fowl 'fowl-darkness)
(cl-define-disjoint-primitive-concept
  'dark-meat-fowl 'fowl 'fowl-darkness)

(cl-define-disjoint-primitive-concept
  'meat 'edible-thing 'edible-thing-type)
(cl-define-disjoint-primitive-concept
  'red-meat 'meat 'meat-color)
(cl-define-disjoint-primitive-concept
  'non-red-meat 'meat 'meat-color)
(cl-define-disjoint-primitive-concept
  'spicy-red-meat 'red-meat 'red-meat-spiciness)
(cl-define-disjoint-primitive-concept
  'non-spicy-red-meat 'red-meat 'red-meat-spiciness)

(cl-define-disjoint-primitive-concept
  'pasta 'edible-thing 'edible-thing-type)
(cl-define-disjoint-primitive-concept
  'pasta-with-white-sauce 'pasta 'paste-sauce-color)
(cl-define-disjoint-primitive-concept
  'pasta-with-heavy-cream-sauce
  'pasta-with-white-sauce 'pasta-with-white-sauce-heaviness)
(cl-define-disjoint-primitive-concept
  'pasta-with-light-cream-sauce
  'pasta-with-white-sauce 'pasta-with-white-sauce-heaviness)

(cl-define-disjoint-primitive-concept
  'pasta-with-red-sauce 'pasta 'paste-sauce-color)
(cl-define-disjoint-primitive-concept
  'pasta-with-spicy-red-sauce
  'pasta-with-red-sauce 'pasta-with-red-sauce-spiciness)
(cl-define-disjoint-primitive-concept
  'pasta-with-non-spicy-red-sauce 
  'pasta-with-red-sauce 'pasta-with-red-sauce-spiciness)

(cl-define-disjoint-primitive-concept
  'other-tomato-based-food 'edible-thing 'edible-thing-type)

; THE EDIBLE-THING INSTANCES
(cl-create-ind 'oysters 'oyster-shellfish)
(cl-create-ind 'clams 'non-oyster-shellfish)
(cl-create-ind 'mussels 'non-oyster-shellfish)
(cl-create-ind 'crab 'non-oyster-shellfish)
(cl-create-ind 'lobster 'non-oyster-shellfish)
(cl-create-ind 'scrod 'bland-fish)
(cl-create-ind 'halibut 'bland-fish)
(cl-create-ind 'flounder 'bland-fish)
(cl-create-ind 'swordfish 'non-bland-fish)
(cl-create-ind 'tuna 'non-bland-fish)
(cl-create-ind 'chicken 'light-meat-fowl)
(cl-create-ind 'turkey 'light-meat-fowl)
(cl-create-ind 'duck 'dark-meat-fowl)
(cl-create-ind 'goose 'dark-meat-fowl)
(cl-create-ind 'pork 'non-red-meat)
(cl-create-ind 'garlicky-roast 'spicy-red-meat)
(cl-create-ind 'beef-curry 'spicy-red-meat)
(cl-create-ind 'veal 'non-spicy-red-meat)
(cl-create-ind 'steak 'non-spicy-red-meat)
(cl-create-ind 'roast-beef 'non-spicy-red-meat)
(cl-create-ind 'fettucine-alfredo 'pasta-with-heavy-cream-sauce)
(cl-create-ind 'pasta-with-white-clam-sauce
	       'pasta-with-light-cream-sauce)
(cl-create-ind 'fra-diavolo 'pasta-with-spicy-red-sauce)
(cl-create-ind 'spaghetti-with-tomato-sauce
	       'pasta-with-non-spicy-red-sauce)
(cl-create-ind 'bananas 'sweet-fruit)
(cl-create-ind 'peaches 'sweet-fruit)
(cl-create-ind 'mixed-fruit 'sweet-fruit)
(cl-create-ind 'apples 'non-sweet-fruit)
(cl-create-ind 'cheese 'cheese/nuts-dessert)
(cl-create-ind 'nuts 'cheese/nuts-dessert)
(cl-create-ind 'pie 'sweet-dessert)
(cl-create-ind 'cake 'sweet-dessert)
(cl-create-ind 'pizza 'other-tomato-based-food)

(cl-define-primitive-concept 'grape 'sweet-fruit)

;; These are not necessarily disjoint---we define them to have a
;; special category for grapes that are used in making wines:
(cl-define-primitive-concept 'wine-grape 'grape)
(cl-define-primitive-concept 'eating-grape 'grape)

(cl-create-ind 'chardonnay 'wine-grape)
(cl-create-ind 'chenin-blanc 'wine-grape)
(cl-create-ind 'sauvignon-blanc 'wine-grape)
(cl-create-ind 'semillon 'wine-grape)
(cl-create-ind 'riesling 'wine-grape)
(cl-create-ind 'cabernet-sauvignon 'wine-grape)
(cl-create-ind 'pinot-noir 'wine-grape)
(cl-create-ind 'pinot-blanc 'wine-grape)
(cl-create-ind 'zinfandel 'wine-grape)
(cl-create-ind 'merlot 'wine-grape)
(cl-create-ind 'gamay 'wine-grape)
(cl-create-ind 'sangiovese 'wine-grape)
(cl-create-ind 'cabernet-franc 'wine-grape)
(cl-create-ind 'malbec 'wine-grape)
(cl-create-ind 'petite-verdot 'wine-grape)
(cl-create-ind 'petite-syrah 'wine-grape)

(cl-create-ind 'thompson-seedless 'eating-grape)

;; The definition of wine contains the restrictions
;; (at-least 1 color), etc. for the attributes color, body, .... This
;; is needed now, since attributes now have an implicit at-least 
;; restriction of 0. 
(cl-define-primitive-concept
  'wine '(and potable-liquid
	      (at-least 1 color) (all color wine-color)
	      (at-least 1 body) (all body wine-body)
	      (at-least 1 flavor) (all flavor wine-flavor)
	      (at-least 1 sugar) (all sugar wine-sugar)
	      (at-least 1 region) (all region wine-region)
	      (at-least 1 grape) (all grape wine-grape)
	      (at-least 1 maker) (all maker winery)))

;; Meal-course and Meal are primitively disjoint from the other
;; consumable-things, and they also have restrictions.
;; The definition of meal-course contains the restrictions
;; (at-least 1 food), (at-least 1 drink), where food and drink have
;; been defined as attributes. This is needed now, since
;; attributes now have an implicit at-least restriction of 0.
;; These must be defined after wine, because meal-course uses wine as 
;; a restriction on the drink role.
(cl-define-disjoint-primitive-concept
  'meal-course
  '(and consumable-thing
	(at-least 1 food)
	(all food edible-thing)
	(at-least 1 drink)
	(all drink wine))
  'consumable-thing-type)
(cl-define-disjoint-primitive-concept
  'meal
  '(and consumable-thing
	(at-least 1 course)
	(all course meal-course))
  'consumable-thing-type)

(cl-define-concept 'red-wine '(and wine (fills color red)))
(cl-define-concept 'rose-wine '(and wine (fills color rose)))
(cl-define-concept 'white-wine '(and wine (fills color white)))
(cl-define-concept 'white-non-sweet-wine '(and white-wine
					       (all sugar (one-of dry off-dry))))
(cl-define-concept 'full-bodied-wine '(and wine (fills body full)))
(cl-define-concept 'dry-wine '(and wine (fills sugar dry)))
(cl-define-concept 'dry-white-wine '(and dry-wine white-wine))
(cl-define-concept 'dry-red-wine '(and dry-wine red-wine))
(cl-define-concept 'sweet-wine '(and wine (fills sugar sweet)))
(cl-define-primitive-concept 'dessert-wine '(and wine 
						 (all sugar (one-of off-dry sweet))))



;;  THE WINE VARIETIES

(cl-define-concept 'chardonnay
		   '(and wine
		         (fills grape chardonnay)
		         (at-most 1 grape)))
(cl-add-rule 'chardonnay-color @c{chardonnay} '(fills color white))
(cl-add-rule 'chardonnay-body
	     @c{chardonnay} '(all body (one-of full medium)))
(cl-add-rule 'chardonnay-flavor
	     @c{chardonnay} '(all flavor (one-of strong moderate)))
(cl-define-concept 'chenin-blanc
		   '(and wine
		         (fills grape chenin-blanc)
		         (at-most 1 grape)))
(cl-add-rule 'chenin-blanc-color @c{chenin-blanc} '(fills color white))
(cl-add-rule 'chenin-blanc-body
	     @c{chenin-blanc} '(all body (one-of full medium)))
(cl-add-rule 'chenin-blanc-flavor
	     @c{chenin-blanc} '(fills flavor moderate))
(cl-add-rule 'chenin-blanc-sugar
	     @c{chenin-blanc} '(all sugar (one-of dry off-dry)))
(cl-define-concept 'semillon-or-sauvignon-blanc
		   '(and wine (all grape (one-of semillon sauvignon-blanc))))
(cl-add-rule 'semillon-or-sauvignon-blanc-color
	     @c{semillon-or-sauvignon-blanc} '(fills color white))
(cl-add-rule 'semillon-or-sauvignon-blanc-body
	     @c{semillon-or-sauvignon-blanc}
	     '(all body (one-of medium full)))
(cl-define-concept 'sauvignon-blanc
		   '(and semillon-or-sauvignon-blanc
		         (fills grape sauvignon-blanc)
		         (at-most 1 grape)))
(cl-define-concept 'semillon
		   '(and semillon-or-sauvignon-blanc
		         (fills grape semillon)
		         (at-most 1 grape)))

(cl-define-concept 'riesling
		   '(and wine
		         (fills grape riesling)
		         (at-most 1 grape)))
(cl-add-rule 'riesling-color @c{riesling} '(fills color white))

(cl-define-concept 'dry-riesling '(and riesling (fills sugar dry)))
(cl-add-rule 'dry-riesling-color @c{dry-riesling} '(fills color white))
(cl-add-rule 'dry-riesling-body @c{dry-riesling} '(all body (one-of light medium)))
(cl-add-rule 'dry-riesling-flavor @c{dry-riesling} '(fills flavor delicate))

(cl-define-concept 'sweet-riesling '(and riesling (fills sugar sweet)))
(cl-add-rule 'sweet-riesling-dessert-wine @c{sweet-riesling} 'dessert-wine)
;(cl-add-rule 'sweet-riesling-color @c{sweet-riesling} '(fills color white))
(cl-add-rule 'sweet-riesling-body @c{sweet-riesling} '(fills body full))
(cl-add-rule 'sweet-riesling-flavor @c{sweet-riesling}
	     '(all flavor (one-of moderate strong)))

(cl-define-concept 'cabernet-sauvignon
		   '(and wine
		         (fills grape cabernet-sauvignon)
		         (at-most 1 grape)))
(cl-add-rule 'cabernet-sauvignon-color
	     @c{cabernet-sauvignon} '(fills color red))
(cl-add-rule 'cabernet-sauvignon-flavor
	     @c{cabernet-sauvignon}
	     '(all flavor (one-of moderate strong)))
(cl-add-rule 'cabernet-sauvignon-body
	     @c{cabernet-sauvignon}
	     '(all body (one-of medium full)))
(cl-add-rule 'cabernet-sauvignon-sugar
	     @c{cabernet-sauvignon}
	     '(fills sugar dry))
(cl-define-concept 'pinot-noir
		   '(and wine
		         (fills grape pinot-noir)
		         (at-most 1 grape)))
(cl-add-rule 'pinot-noir-color @c{pinot-noir} '(fills color red))
;(cl-add-rule 'pinot-noir-body
;	     @c{pinot-noir}
;	     '(all body (one-of light medium)))
;(cl-add-rule 'pinot-noir-flavor
;	     @c{pinot-noir}
;	     '(all flavor (one-of moderate delicate)))
(cl-define-concept 'pinot-blanc
		   '(and wine
		         (fills grape pinot-blanc)
		         (at-most 1 grape)))
(cl-add-rule 'pinot-blanc-color @c{pinot-blanc} '(fills color white))

(cl-define-concept 'zinfandel
		   '(and wine
		         (fills grape zinfandel)
		         (at-most 1 grape)))
(cl-add-rule 'zinfandel-color @c{zinfandel} '(fills color red))
(cl-add-rule 'zinfandel-body
	     @c{zinfandel}
	     '(all body (one-of full medium)))
(cl-add-rule 'zinfandel-flavor
	     @c{zinfandel}
	     '(all flavor (one-of moderate strong)))
(cl-add-rule 'zinfandel-sugar
	     @c{zinfandel}
	     '(fills sugar dry))
(cl-define-concept 'merlot
		   '(and wine
                         (fills grape merlot)
                         (at-most 1 grape)))
(cl-add-rule 'merlot-color @c{merlot} '(fills color red))
(cl-add-rule 'merlot-flavor @c{merlot} '(all flavor (one-of moderate delicate)))
(cl-add-rule 'merlot-body @c{merlot} '(all body (one-of light medium)))
(cl-add-rule 'merlot-sugar @c{merlot} '(fills sugar dry))

(cl-define-concept 'gamay
		   '(and wine
		         (fills grape gamay)
		         (at-most 1 grape)))

(cl-define-concept 'meritage
		   '(and wine
		     (all grape 
		      (one-of cabernet-sauvignon cabernet-franc
		       malbec petite-verdot merlot))
		     (at-least 2 grape)))
(cl-define-concept 'table-wine
		   '(and wine  (fills sugar dry)))
(cl-define-concept 'red-table-wine
		   '(and table-wine (fills color red)))
(cl-define-concept 'white-table-wine
		   '(and table-wine (fills color white)))

(cl-add-rule 'meritage-color @c{meritage} '(fills color red))
(cl-define-concept 'cabernet-franc
		   '(and wine
		         (fills grape cabernet-franc)
		         (at-most 1 grape)))
(cl-add-rule 'cabernet-franc-color @c{cabernet-franc} '(fills color red))
(cl-add-rule 'cabernet-franc-flavor @c{cabernet-franc} '(fills flavor moderate ))
(cl-add-rule 'cabernet-franc-body @c{cabernet-franc} '(fills body medium))
(cl-add-rule 'cabernet-franc-sugar @c{cabernet-franc} '(fills sugar dry))

(cl-define-concept 'petite-syrah
		   '(and wine
		         (fills grape petite-syrah)
		         (at-most 1 grape)))
(cl-add-rule 'petite-syrah-color @c{petite-syrah} '(fills color red))
(cl-add-rule 'petite-syrah-flavor @c{petite-syrah} 
	     '(all flavor (one-of moderate strong )))
(cl-add-rule 'petite-syrah-body @c{petite-syrah} '(all body (one-of medium full)))
(cl-add-rule 'petite-syrah-sugar @c{petite-syrah} '(fills sugar dry))

; BORDEAUX
(cl-define-concept 'bordeaux '(and wine (all region bordeaux-region)))
(cl-define-concept 'white-bordeaux '(and bordeaux white-wine))
(cl-add-rule 'white-bordeaux-grape
	     @c{white-bordeaux} '(all grape (one-of semillon sauvignon-blanc)))
(cl-define-concept 'red-bordeaux '(and bordeaux red-wine))
(cl-add-rule 'red-bordeaux-grape
	     @c{red-bordeaux} '(all grape (one-of cabernet-sauvignon merlot)))
;; All wines have a harvest, but we are only using harvest for bordeaux.
(cl-define-disjoint-primitive-concept
  'early-harvest 'wine 'wine-harvest)
(cl-add-rule 'early-harvest-sugar @c{early-harvest}
	     '(all sugar (one-of dry off-dry)))
(cl-define-disjoint-primitive-concept
 'late-harvest 'wine 'wine-harvest)
(cl-add-rule 'late-harvest-sugar @c{late-harvest} '(fills sugar sweet))
(cl-add-rule 'late-harvest-flavor @c{late-harvest}
	     '(all flavor (one-of moderate strong)))

;; subconcepts of BORDEAUX
(cl-define-concept 'st-emilion '(and bordeaux (fills region st-emilion)))
(cl-add-rule 'st-emilion-color @c{st-emilion} '(fills color red))
(cl-add-rule 'st-emilion-flavor @c{st-emilion} '(fills flavor strong))
(cl-add-rule 'st-emilion-grape @c{st-emilion}
	     '(and (fills grape cabernet-sauvignon) (at-most 1 grape)))
(cl-define-primitive-concept 'sauterne '(and bordeaux (fills region sauterne)))
(cl-add-rule 'sauterne-body @c{sauterne} '(fills body medium))
(cl-add-rule 'sauterne-color @c{sauterne} '(fills color white))
(cl-add-rule 'sauterne-harvest @c{sauterne} 'late-harvest)

; MEDOC: a subconcept of BORDEAUX
(cl-define-concept 'medoc '(and bordeaux (all region medoc-region)))
(cl-add-rule 'medoc-color @c{medoc} '(fills color red))
(cl-add-rule 'medoc-sugar @c{medoc} '(fills sugar dry))

(cl-define-concept 'pauillac '(and medoc (fills region pauillac)))
(cl-add-rule 'pauillac-body @c{pauillac} '(fills body full))
(cl-add-rule 'pauillac-flavor @c{pauillac} '(fills flavor strong))
(cl-add-rule 'pauillac-grape @c{pauillac}
	     '(and (fills grape cabernet-sauvignon) (at-most 1 grape)))

(cl-define-concept 'margaux '(and medoc (fills region margaux)))
(cl-add-rule 'margaux-flavor @c{margaux} '(fills flavor delicate))
(cl-add-rule 'margaux-grape @c{margaux}
	     '(and (fills grape merlot) (at-most 1 grape)))


; BURGUNDY
(cl-define-concept 'burgundy '(and wine (all region bourgogne-region)))
(cl-add-rule 'burgundy-sugar @c{burgundy} '(fills sugar dry))
(cl-define-concept 'white-burgundy '(and burgundy white-wine))
(cl-add-rule 'white-burgundy-grape @c{white-burgundy}
	     '(and (fills grape chardonnay) (at-most 1 grape)))
(cl-define-concept 'red-burgundy '(and burgundy red-wine))
(cl-add-rule 'red-burgundy-grape @c{red-burgundy}
	     '(and (fills grape pinot-noir) (at-most 1 grape)))

(cl-define-concept 'cotes-d-or '(and red-burgundy (fills region cotes-d-or)))
(cl-add-rule 'cotes-d-or-flavor @c{cotes-d-or} '(fills flavor moderate))

(cl-define-concept 'meursault '(and white-burgundy (fills region meursault)))
(cl-add-rule 'meursault-body @c{meursault} '(fills body full))

; BEAUJOLAIS
(cl-define-concept 'beaujolais '(and wine (fills region beaujolais)))
(cl-add-rule 'beaujolais-grape @c{beaujolais}
	     '(and (fills grape gamay) (at-most 1 grape)))
(cl-add-rule 'beaujolais-color @c{beaujolais} '(fills color red))
(cl-add-rule 'beaujolais-body @c{beaujolais} '(fills body light))
(cl-add-rule 'beaujolais-sugar @c{beaujolais} '(fills sugar dry))
(cl-add-rule 'beaujolais-flavor @c{beaujolais} '(fills flavor delicate))

;LOIRE
(cl-define-concept 'loire '(and wine (all region loire-region)))
(cl-define-concept 'white-loire '(and loire white-wine))
(cl-add-rule 'white-loire-grape
	     @c{white-loire}
	     '(all grape (one-of chenin-blanc pinot-blanc sauvignon-blanc)))
(cl-define-concept 'muscadet '(and loire (fills region muscadet)))
(cl-add-rule 'muscadet-grape @c{muscadet}
	     '(and (fills grape pinot-blanc) (at-most 1 grape)))
(cl-add-rule 'muscadet-body @c{muscadet} '(fills body light))
(cl-add-rule 'muscadet-flavor @c{muscadet} '(fills flavor delicate))
(cl-add-rule 'muscadet-sugar @c{muscadet} '(fills sugar dry))

(cl-define-concept 'sancerre '(and loire (fills region sancerre)))
(cl-add-rule 'sancerre-grape @c{sancerre}
	     '(and (fills grape sauvignon-blanc) (at-most 1 grape)))
(cl-add-rule 'sancerre-body @c{sancerre} '(fills body medium))
(cl-add-rule 'sancerre-sugar @c{sancerre} '(fills sugar off-dry))
(cl-add-rule 'sancerre-flavor @c{sancerre} '(fills flavor delicate))

(cl-define-concept 'tours '(and loire (fills region tours)))
;; all the other characteristics are associated with chenin-blanc.
(cl-add-rule 'tours-grape @c{tours}
	     '(and (fills grape chenin-blanc) (at-most 1 grape)))

(cl-define-concept 'anjou '(and loire (fills region anjou)))
;; Leave off the grape for anjou, because anjou is a strange case 
;; where the grape is cabernet-sauvignon and the color is rose. All 
;; wines thought of as cabernet-sauvignons are red.
;; Also, just deal with the rose anjous here, not the white ones.
;(cl-add-rule 'anjou-grape
;	     @c{anjou} '(all grape (one-of chenin-blanc cabernet-sauvignon)))
(cl-add-rule 'anjou-color @c{anjou} '(fills color rose))
(cl-add-rule 'anjou-body @c{anjou} '(fills body light))
(cl-add-rule 'anjou-flavor @c{anjou} '(fills flavor delicate))
(cl-add-rule 'anjou-sugar @c{anjou} '(fills sugar off-dry))
		   

; ALSATIAN
(cl-define-concept 'alsatian-wine '(and wine (fills region alsace)))

; AMERICAN
(cl-define-concept 'american-wine '(and wine (all region us-region)))
(cl-define-concept 'california-wine '(and wine (all region californian-region)))

; GERMAN
(cl-define-concept 'german-wine '(and wine (fills region germany)))

; ITALIAN
(cl-define-concept 'italian-wine '(and wine (all region italian-region)))
(cl-define-primitive-concept 'chianti '(and italian-wine (fills region chianti)))
(cl-add-rule 'chianti-color @c{chianti} '(fills color red))
(cl-add-rule 'chianti-grape @c{chianti} '(fills grape sangiovese))
(cl-add-rule 'chianti-body @c{chianti} '(all body (one-of light medium)))
(cl-add-rule 'chianti-flavor @c{chianti} '(fills flavor moderate))
(cl-add-rule 'chianti-sugar @c{chianti} '(fills sugar dry))


; PORTUGUESE
(cl-define-primitive-concept 'port '(and red-wine (fills region portugal)))
(cl-add-rule 'port-body @c{port} '(fills body full))
(cl-add-rule 'port-flavor @c{port} '(fills flavor strong))
(cl-add-rule 'port-sugar @c{port} '(fills sugar sweet))

(cl-define-concept 'ice-wine
		   '(and late-harvest dessert-wine
			 (fills color white)))
(cl-add-rule 'ice-wine-body @c{ice-wine} '(all body (one-of medium full)))
(cl-add-rule 'ice-wine-flavor @c{ice-wine} '(all flavor (one-of moderate strong)))

;; THE WINE INSTANCES

(cl-create-ind 'forman 'winery)
(cl-create-ind 'forman-chardonnay
	       '(and chardonnay
		     (fills body full) (fills flavor moderate)
		     (fills sugar dry) (fills maker forman)
		     (fills region napa)))
(cl-create-ind 'forman-cabernet-sauvignon
	       '(and cabernet-sauvignon
		     (fills body medium) (fills flavor strong)
		     (fills sugar dry) (fills maker forman)
		     (fills region napa)))
(cl-create-ind 'page-mill-winery 'winery)
(cl-create-ind 'page-mill-winery-cabernet-sauvignon
	       '(and cabernet-sauvignon
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker page-mill-winery)
		     (fills region napa)))
(cl-create-ind 'mount-eden-vineyard 'winery)
(cl-create-ind 'mount-eden-vineyard-edna-valley-chardonnay
	       '(and chardonnay
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker mount-eden-vineyard)
		     (fills region edna-valley)))
(cl-create-ind 'mount-eden-vineyard-estate-pinot-noir
	       '(and pinot-noir
		     (fills body full) (fills flavor strong)
		     (fills sugar dry) (fills maker mount-eden-vineyard)
		     (fills region santa-cruz-mountains)))
(cl-create-ind 'corton-montrachet 'winery)
(cl-create-ind 'corton-montrachet-white-burgundy
	       '(and white-burgundy
		     (fills body full) (fills flavor strong)
		     (fills sugar dry) (fills maker corton-montrachet)))
(cl-create-ind 'puligny-montrachet 'winery)
(cl-create-ind 'puligny-montrachet-white-burgundy
	       '(and white-burgundy
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker puligny-montrachet)))
(cl-create-ind 'clos-de-vougeot 'winery)
(cl-create-ind 'clos-de-vougeot-cotes-d-or
	       '(and cotes-d-or
		     (fills maker clos-de-vougeot)))
(cl-create-ind 'selaks 'winery)
(cl-create-ind 'selaks-sauvignon-blanc
	       '(and sauvignon-blanc
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker selaks)
		     (fills region new-zealand)))
(cl-create-ind 'corbans 'winery)
(cl-create-ind 'corbans-sauvignon-blanc
	       '(and sauvignon-blanc
		     (fills body medium) (fills flavor strong)
		     (fills sugar dry) (fills maker corbans)
		     (fills region new-zealand)))
(cl-create-ind 'handley 'winery)
(cl-create-ind 'stonleigh 'winery)
(cl-create-ind 'stonleigh-sauvignon-blanc
	       '(and sauvignon-blanc
		     (fills body medium) (fills flavor delicate)
		     (fills sugar dry) (fills maker stonleigh)
		     (fills region new-zealand)))
(cl-create-ind 'corbans-private-bin-sauvignon-blanc
	       '(and sauvignon-blanc
		     (fills body full) (fills flavor strong)
		     (fills sugar dry) (fills maker corbans)
		     (fills region new-zealand)))
(cl-create-ind 'kalin-cellars 'winery)
(cl-create-ind 'kalin-cellars-semillon
	       '(and semillon
		     (fills body full) (fills flavor strong)
		     (fills sugar dry) (fills maker kalin-cellars)
		     (all region californian-region)))
(cl-create-ind 'congress-springs 'winery)
(cl-create-ind 'congress-springs-semillon
	       '(and semillon
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker congress-springs)
		     (all region californian-region)))
(cl-create-ind 'mountadam 'winery)
(cl-create-ind 'mountadam-riesling
	       '(and dry-riesling
		     (fills body medium) (fills flavor delicate)
		     (fills sugar dry) (fills maker mountadam)
		     (fills region south-australia)))
(cl-create-ind 'mountadam-chardonnay
	       '(and chardonnay
		     (fills body full) (fills flavor strong)
		     (fills sugar dry) (fills maker mountadam)
		     (fills region south-australia)))
(cl-create-ind 'mountadam-pinot-noir
	       '(and pinot-noir
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker mountadam)
		     (fills region south-australia)))
(cl-create-ind 'bancroft 'winery)
(cl-create-ind 'bancroft-chardonnay
	       '(and chardonnay
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker bancroft)
		     (fills region napa)))
(cl-create-ind 'peter-mccoy 'winery)
(cl-create-ind 'peter-mccoy-chardonnay
	       '(and chardonnay
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker peter-mccoy)
		     (fills region sonoma)))
(cl-create-ind 'ventana 'winery)
(cl-create-ind 'corbans-dry-white-riesling
	       '(and riesling
		     (fills body medium) (fills flavor moderate)
		     (fills sugar off-dry) (fills maker corbans)
		     (fills region new-zealand)))
(cl-create-ind 'gary-farrell 'winery)
(cl-create-ind 'gary-farrell-merlot
	       '(and merlot
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker gary-farrell)
		     (fills region sonoma)))
(cl-create-ind 'longridge 'winery)
(cl-create-ind 'longridge-merlot
	       '(and merlot
		     (fills body light) (fills flavor moderate)
		     (fills sugar dry) (fills maker longridge)
		     (fills region new-zealand)))
(cl-create-ind 'schloss-volrad 'winery)
(cl-create-ind 'schloss-volrad-trochenbierenauslese-riesling
	       '(and sweet-riesling 
		     (fills body full) (fills flavor moderate)
		     (fills sugar sweet) (fills maker schloss-volrad)
		     (fills region germany)))
(cl-create-ind 'schloss-rothermel 'winery)
(cl-create-ind 'schloss-rothermel-trochenbierenauslese-riesling
	       '(and sweet-riesling 
		     (fills body full) (fills flavor strong)
		     (fills sugar sweet) (fills maker schloss-rothermel)
		     (fills region germany)))
(cl-create-ind 'foxen 'winery)
(cl-create-ind 'foxen-chenin-blanc
	       '(and chenin-blanc
		     (fills body full) (fills flavor moderate)
		     (fills sugar dry)(fills maker foxen)
		     (fills region santa-barbara)))
(cl-create-ind 'ventana-chenin-blanc
	       '(and chenin-blanc
		     (fills body medium) (fills flavor moderate)
		     (fills sugar off-dry)(fills maker ventana)
		     (fills region central-coast)))
(cl-create-ind 'selaks-ice-wine
	       '(and ice-wine
		     (fills color white) (fills body medium)
		     (fills flavor moderate)
		     (fills maker selaks)
		     (fills region new-zealand)))
(cl-create-ind 'marietta 'winery)
(cl-create-ind 'marietta-cabernet-sauvignon
	       '(and cabernet-sauvignon
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker marietta)
		     (fills region sonoma)))
(cl-create-ind 'marietta-zinfandel
	       '(and zinfandel
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker marietta)
		     (fills region sonoma)))
(cl-create-ind 'marietta-petite-syrah
	       '(and petite-syrah
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker marietta)
		     (fills region sonoma)))
(cl-create-ind 'marietta-old-vines-red
	       '(and red-table-wine
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker marietta)
		     (fills region sonoma)))
(cl-create-ind 'sean-thackrey 'winery)
(cl-create-ind 'sean-thackrey-sirius-petite-syrah
	       '(and petite-syrah
		     (fills body full) (fills flavor strong)
		     (fills sugar dry) (fills maker sean-thackrey)
		     (fills region napa)))
;(cl-create-ind 'b-r-cohn 'winery)
(cl-create-ind 'santa-cruz-mountain-vineyard 'winery)
(cl-create-ind 'santa-cruz-mountain-vineyard-cabernet-sauvignon
	       '(and cabernet-sauvignon
		     (fills body full) (fills flavor strong)
		     (fills sugar dry) (fills maker santa-cruz-mountain-vineyard)
		     (fills region santa-cruz-mountains)))
(cl-create-ind 'cotturi 'winery)
(cl-create-ind 'cotturi-zinfandel
	       '(and zinfandel
		     (fills body full) (fills flavor strong)
		     (fills sugar dry) (fills maker cotturi)
		     (fills region sonoma)))
;(cl-create-ind 'mazocco 'winery)
(cl-create-ind 'elyse 'winery)
(cl-create-ind 'elyse-zinfandel
	       '(and zinfandel
		     (fills body full) (fills flavor moderate)
		     (fills sugar dry) (fills maker elyse)
		     (fills region napa)))
;(cl-create-ind 'rosenblum 'winery)
(cl-create-ind 'saucelito-canyon 'winery)
(cl-create-ind 'saucelito-canyon-zinfandel
	       '(and zinfandel
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker saucelito-canyon)
		     (fills region arroyo-grande)))
;(cl-create-ind 'sea-ridge 'winery)
(cl-create-ind 'lane-tanner 'winery)
(cl-create-ind 'lane-tanner-pinot-noir
	       '(and pinot-noir
		     (fills body light) (fills flavor delicate)
		     (fills sugar dry) (fills maker lane-tanner)
		     (fills region santa-barbara)))
(cl-create-ind 'whitehall-lane 'winery)
(cl-create-ind 'whitehall-lane-cabernet-franc
	       '(and cabernet-franc
		     (fills body medium) (fills flavor moderate)
		     (fills sugar dry) (fills maker whitehall-lane)
		     (fills region napa)))
(cl-create-ind 'whitehall-lane-primavera
	       '(and dessert-wine
		     (fills body light) (fills flavor delicate)
		     (fills sugar sweet) (fills maker whitehall-lane)
		     (fills region napa)))
(cl-create-ind 'kathryn-kennedy 'winery)
(cl-create-ind 'kathryn-kennedy-lateral
	       '(and meritage
		     (fills body medium) (fills flavor delicate)
		     (fills sugar dry) (fills maker kathryn-kennedy)
		     (all region californian-region)))
(cl-create-ind 'taylor 'winery)
(cl-create-ind 'taylor-port '(and port (fills maker taylor)))
(cl-create-ind 'chateau-lafite-rothschild 'winery)		
(cl-create-ind 'chateau-lafite-rothschild-pauillac
	       '(and pauillac (fills maker chateau-lafite-rothschild)))
(cl-create-ind 'chateau-margaux-winery 'winery)
(cl-create-ind 'chateau-margaux
	       '(and margaux (fills maker chateau-margaux-winery)))
(cl-create-ind 'chateau-cheval-blanc 'winery)
(cl-create-ind 'chateau-cheval-blanc-st-emilion
	       '(and st-emilion (fills maker chateau-cheval-blanc)))
(cl-create-ind 'chateau-morgon 'winery)
(cl-create-ind 'chateau-morgon-beaujolais
	       '(and beaujolais (fills maker chateau-morgon)))
(cl-create-ind 'chateau-d-ychem 'winery)
(cl-create-ind 'chateau-d-ychem-sauterne
	       '(and sauterne (fills maker chateau-d-ychem)
		     (fills flavor strong)
		     (fills grape semillon sauvignon-blanc)))
(cl-create-ind 'chateau-de-meursault 'winery)
(cl-create-ind 'chateau-de-meursault-meursault
	       '(and meursault (fills maker chateau-de-meursault)
		     (fills flavor moderate)))
(cl-create-ind 'sevre-et-maine 'winery)
(cl-create-ind 'sevre-et-maine-muscadet
	       '(and muscadet (fills maker sevre-et-maine)))
(cl-create-ind 'clos-de-la-poussie 'winery)
(cl-create-ind 'clos-de-la-poussie-sancerre
	       '(and sancerre (fills maker clos-de-la-poussie)))
(cl-create-ind 'd-anjou 'winery)
(cl-create-ind 'rose-d-anjou '(and anjou (fills maker d-anjou)))
(cl-create-ind 'mcguinnesso 'winery)
(cl-create-ind 'chianti-classico '(and chianti (fills maker mcguinnesso)
				       (fills body medium)))

;; The following example gives a useful/manageable amount of 
;; information when explaining the wine individuals. It explains the 
;; fillers and the one-of restrictions.
#|
(cl-clear-exp @i{corton-montrachet-white-burgundy})
(cl-set-up-exp @i{corton-montrachet-white-burgundy} :aspect 'fills)
(cl-set-up-exp @i{corton-montrachet-white-burgundy} :aspect 'one-of)
(cl-print-exp @i{corton-montrachet-white-burgundy})
|#

; THE MEAL-COURSE TYPES

; FRUITS
(cl-define-concept 'fruit-course 
		   '(and meal-course (all food fruit)))
(cl-add-rule 'fruit-wine-color @c{fruit-course} '(all drink (fills color white)))
(cl-add-rule 'fruit-wine-body @c{fruit-course} '(all drink (fills body medium)))

(cl-define-concept 'sweet-fruit-course 
		   '(and meal-course (all food sweet-fruit)))
(cl-add-rule 'sweet-fruit-wine-flavor @c{sweet-fruit-course}
	     '(all drink (fills flavor moderate)))
(cl-add-rule 'sweet-fruit-wine-sugar @c{sweet-fruit-course}
	     '(all drink (fills sugar sweet)))
(cl-define-concept 'non-sweet-fruit-course 
		   '(and meal-course (all food non-sweet-fruit)))
(cl-add-rule 'non-sweet-fruit-wine-flavor @c{non-sweet-fruit-course}
	     '(all drink (fills flavor delicate)))
(cl-add-rule 'non-sweet-fruit-wine-sugar @c{non-sweet-fruit-course}
	     '(all drink (fills sugar off-dry)))

; DESSERTS
(cl-define-concept 'dessert-course
		   '(and meal-course (all food dessert)))
(cl-add-rule 'dessert-drink-body @c{dessert-course}
	     '(all drink (fills body full)))
(cl-add-rule 'dessert-drink-flavor @c{dessert-course}
	     '(all drink (fills flavor strong)))
(cl-add-rule 'dessert-drink-sugar @c{dessert-course}
	     '(all drink (fills sugar sweet)))

(cl-define-concept 'cheese/nuts-dessert-course 
		   '(and meal-course (all food cheese/nuts-dessert)))
(cl-add-rule 'cheese/nuts-dessert-drink-color
	     @c{cheese/nuts-dessert-course}
	     '(all drink (fills color red)))
(cl-define-concept 'sweet-dessert-course 
		   '(and meal-course (all food sweet-dessert)))
(cl-add-rule 'sweet-dessert-wine-color @c{sweet-dessert-course}
	     '(all drink (fills color white)))

; SEAFOOD
(cl-define-concept 'seafood-course 
		   '(and meal-course (all food seafood)))
(cl-add-rule 'seafood-wine-color @c{seafood-course}
	     '(all drink (fills color white)))
(cl-define-concept 'shellfish-course 
		   '(and meal-course (all food shellfish)))
(cl-add-rule 'shellfish-wine-body @c{shellfish-course}
	     '(all drink (fills body full)))
(cl-add-rule 'shellfish-wine-flavor @c{shellfish-course}
	     '(all drink (all flavor (one-of moderate strong))))
(cl-define-concept 'oyster-shellfish-course 
		   '(and meal-course (all food oyster-shellfish)))
(cl-add-rule 'oyster-shellfish-wine-sugar
	     @c{oyster-shellfish-course}
	     '(all drink (fills sugar sweet)))
(cl-define-concept 'non-oyster-shellfish-course 
		   '(and meal-course (all food non-oyster-shellfish)))
(cl-add-rule 'non-oyster-shellfish-wine-sugar
	     @c{non-oyster-shellfish-course}
	     '(all drink (fills sugar dry)))
(cl-define-concept 'fish-course 
		   '(and meal-course (all food fish)))
(cl-add-rule 'fish-wine-body @c{fish-course}
	     '(all drink (fills body medium)))
(cl-add-rule 'fish-wine-sugar @c{fish-course}
	     '(all drink (fills sugar dry)))

(cl-define-concept 'bland-fish-course 
		   '(and meal-course (all food bland-fish)))
(cl-add-rule 'bland-fish-wine-flavor @c{bland-fish-course}
	     '(all drink (fills flavor delicate)))
(cl-define-concept 'non-bland-fish-course 
		   '(and meal-course (all food non-bland-fish)))
(cl-add-rule 'non-bland-fish-wine-flavor @c{non-bland-fish-course}
	     '(all drink (fills flavor moderate)))

; MEAT
(cl-define-concept 'red-meat-course
		   '(and meal-course (all food red-meat)))
(cl-add-rule 'red-meat-wine-color @c{red-meat-course}
	     '(all drink (fills color red)))
(cl-define-concept 'non-spicy-red-meat-course 
		   '(and meal-course (all food non-spicy-red-meat)))
(cl-add-rule 'non-spicy-red-meat-wine-color @c{non-spicy-red-meat-course}
	     '(all drink (fills color red)))
(cl-add-rule 'non-spicy-red-meat-wine-body @c{non-spicy-red-meat-course}
	     '(all drink (fills body medium)))
(cl-add-rule 'non-spicy-red-meat-wine-flavor @c{non-spicy-red-meat-course}
	     '(all drink (all flavor (one-of strong moderate))))
(cl-add-rule 'non-spicy-red-meat-wine-sugar @c{non-spicy-red-meat-course}
	     '(all drink (fills sugar dry)))

(cl-define-concept 'spicy-red-meat-course 
		   '(and meal-course (all food spicy-red-meat)))
(cl-add-rule 'spicy-red-meat-wine-color @c{spicy-red-meat-course}
	     '(all drink (fills color red)))
(cl-add-rule 'spicy-red-meat-wine-body @c{spicy-red-meat-course}
	     '(all drink (fills body full)))
(cl-add-rule 'spicy-red-meat-wine-flavor @c{spicy-red-meat-course}
	     '(all drink (fills flavor moderate)))
(cl-add-rule 'spicy-red-meat-wine-sugar @c{spicy-red-meat-course}
	     '(all drink (fills sugar dry)))

(cl-define-concept 'non-red-meat-course
		   '(and meal-course (all food non-red-meat)))
(cl-add-rule 'non-red-meat-wine-color @c{non-red-meat-course}
	     '(all drink (fills color white)))
(cl-add-rule 'non-red-meat-wine-body @c{non-red-meat-course}
	     '(all drink (fills body medium)))
(cl-add-rule 'non-red-meat-wine-flavor @c{non-red-meat-course}
	     '(all drink (fills flavor strong)))
(cl-add-rule 'non-red-meat-wine-sugar @c{non-red-meat-course}
	     '(all drink (fills sugar dry)))

(cl-define-concept 'light-meat-fowl-course
		   '(and meal-course (all food light-meat-fowl)))
(cl-add-rule 'light-meat-fowl-wine-color @c{light-meat-fowl-course}
	     '(all drink (fills color white)))
(cl-add-rule 'light-meat-fowl-wine-body @c{light-meat-fowl-course}
	     '(all drink (fills body medium)))
(cl-add-rule 'light-meat-fowl-wine-flavor @c{light-meat-fowl-course}
	     '(all drink (fills flavor moderate)))
(cl-add-rule 'light-meat-fowl-wine-sugar @c{light-meat-fowl-course}
	     '(all drink (fills sugar dry)))

;; Classic does not have defaults.  This rule forces you to drink
;; red wine with a dark meat fowl course - it doesn't give you
;; the choice of drinking white, medium, moderate, dry wine instead.
(cl-define-concept 'dark-meat-fowl-course
		   '(and meal-course (all food dark-meat-fowl)))
(cl-add-rule 'dark-meat-fowl-wine-color @c{dark-meat-fowl-course}
	     '(all drink (fills color red)))
(cl-add-rule 'dark-meat-fowl-wine-body @c{dark-meat-fowl-course}
	     '(all drink (fills body light)))
(cl-add-rule 'dark-meat-fowl-wine-flavor @c{dark-meat-fowl-course}
	     '(all drink (fills flavor delicate)))
(cl-add-rule 'dark-meat-fowl-wine-sugar @c{dark-meat-fowl-course}
	     '(all drink (fills sugar dry)))

(cl-define-concept 'pasta-with-heavy-cream-course
		   '(and meal-course (all food pasta-with-heavy-cream-sauce)))
(cl-add-rule 'pasta-with-heavy-cream-wine-color @c{pasta-with-heavy-cream-course}
	     '(all drink (fills color white)))
(cl-add-rule 'pasta-with-heavy-cream-wine-body @c{pasta-with-heavy-cream-course}
	     '(all drink (fills body medium)))
(cl-add-rule 'pasta-with-heavy-cream-wine-flavor @c{pasta-with-heavy-cream-course}
	     '(all drink (fills flavor moderate)))
(cl-add-rule 'pasta-with-heavy-cream-wine-sugar @c{pasta-with-heavy-cream-course}
	     '(all drink (fills sugar dry)))

(cl-define-concept 'pasta-with-light-cream-course
		   '(and meal-course (all food pasta-with-light-cream-sauce)))
(cl-add-rule 'pasta-with-light-cream-wine-color @c{pasta-with-light-cream-course}
	     '(all drink (fills color white)))
(cl-add-rule 'pasta-with-light-cream-wine-body @c{pasta-with-light-cream-course}
	     '(all drink (fills body light)))
(cl-add-rule 'pasta-with-light-cream-wine-flavor @c{pasta-with-light-cream-course}
	     '(all drink (fills flavor delicate)))
(cl-add-rule 'pasta-with-light-cream-wine-sugar @c{pasta-with-light-cream-course}
	     '(all drink (fills sugar dry)))

(cl-define-concept 'pasta-with-spicy-red-sauce-course
		   '(and meal-course (all food pasta-with-spicy-red-sauce)))
(cl-add-rule 'pasta-with-spicy-red-sauce-wine-color
	     @c{pasta-with-spicy-red-sauce-course}
	     '(all drink (fills color red)))
(cl-add-rule 'pasta-with-spicy-red-sauce-wine-body
	     @c{pasta-with-spicy-red-sauce-course}
	     '(all drink (fills body full)))
(cl-add-rule 'pasta-with-spicy-red-sauce-wine-flavor
	     @c{pasta-with-spicy-red-sauce-course}
	     '(all drink (fills flavor strong)))
(cl-add-rule 'pasta-with-spicy-red-sauce-wine-sugar
	     @c{pasta-with-spicy-red-sauce-course}
	     '(all drink (fills sugar dry)))

(cl-define-concept 'pasta-with-non-spicy-red-sauce-course
		   '(and meal-course (all food pasta-with-non-spicy-red-sauce)))
(cl-add-rule 'pasta-with-non-spicy-red-sauce-wine-color
	     @c{pasta-with-non-spicy-red-sauce-course}
	     '(all drink (fills color red)))
(cl-add-rule 'pasta-with-non-spicy-red-sauce-wine-body
	     @c{pasta-with-non-spicy-red-sauce-course}
	     '(all drink (fills body medium)))
(cl-add-rule 'pasta-with-non-spicy-red-sauce-wine-flavor
	     @c{pasta-with-non-spicy-red-sauce-course}
	     '(all drink (fills flavor moderate)))
(cl-add-rule 'pasta-with-non-spicy-red-sauce-wine-sugar
	     @c{pasta-with-non-spicy-red-sauce-course}
	     '(all drink (fills sugar dry)))
(cl-define-concept 'other-tomato-based-food-course
		   '(and meal-course (all food other-tomato-based-food)))
(cl-add-rule 'other-tomato-based-food-wine-color
	     @c{other-tomato-based-food-course}
	     '(all drink (fills color red)))
(cl-add-rule 'other-tomato-based-food-wine-body
	     @c{other-tomato-based-food-course}
	     '(all drink (fills body medium)))
(cl-add-rule 'other-tomato-based-food-wine-flavor
	     @c{other-tomato-based-food-course}
	     '(all drink (fills flavor moderate)))
(cl-add-rule 'other-tomato-based-food-wine-sugar
	     @c{other-tomato-based-food-course}
	     '(all drink (fills sugar dry)))
;; zins in particular are recommended

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Convenient Functions 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun no-winery (x)
  (null (cl-fillers x (cl-named-role 'maker))))

(defun wines (x)
  ;; Gives a list of wines which are compatible with the restrictions 
  ;; on this wine.
  (remove-if #'no-winery (cl-concept-instances (cl-create-ind-descriptor x))))

(defun grapes (x)
  ;; Gives a list of grapes which are compatible with the restrictions 
  ;; on this wine.
  (let* ((grape-list nil)
	 (inds (wines x)))
    (dolist (y inds)
      (setq grape-list
	    (remove-duplicates
	     (append grape-list
		     (cl-fillers y (cl-named-role 'grape))))))
     grape-list))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Examples                                                                ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

#|
;; An example of getting the instances of an unclassified concept:
(cl-concept-instances (cl-normalize-concept
		       (cl-parse-expression '(and bordeaux red-wine))))

(cl-create-ind 'm1a '(and spicy-red-meat-course (fills drink w1a)))
(wines @w1a)
(cl-create-ind 'm2a '(and non-red-meat-course (fills drink w2a)))
(wines @w2a)
(cl-create-ind 'm3a '(and dark-meat-fowl-course (fills drink w3a)))
(wines @w3a)
(cl-create-ind 'm6 '(and meal-course (fills food duck) (fills drink w6) )) 
(wines @w6)
(cl-create-ind 'm7 '(and meal-course (fills food turkey) (fills drink w7) ))
(wines @w7)
(cl-create-ind 'm8 '(and meal-course (fills food goose) (fills drink w8) ))
(wines @w8)
(cl-create-ind 'm9 '(and meal-course (fills food flounder) (fills drink w9) ))
(wines @w9)
(cl-create-ind 'm10 '(and meal-course (fills food swordfish) (fills drink w10) ))
(wines @w10)

;;; Demo
(cl-concept-instances @c{white-wine})
  list -ir white-wine
(cl-print-ind @forman-chardonnay)
  print forman-chardonnay
(cl-create-ind 'new-wine '(and wine (fills body full) (fills flavor moderate)))
  create -i -name new-wine -exp (and wine (fills body full) (fills flavor moderate))
(cl-print-ind @new-wine)
  print new-wine
(cl-define-concept 'mod-or-strong-wine '(and wine (all flavor (one-of moderate strong))))
  create -c -name mod-or-strong-wine -exp (and wine (all flavor (one-of moderate strong)))
(cl-concept-instances @mod-or-strong-wine)
  list -i mod-or-strong-wine
(cl-concept-ancestors @mod-or-strong-wine)
  list -rp mod-or-strong-wine
(cl-create-ind 'm1 '(and meal-course (fills food crab) (fills drink w1)))
  create -i -name m1 -exp (and meal-course (fills food crab) (fills drink w1))
(cl-instance? @m1 @seafood-course)
  list -ri seafood-course
(cl-ind-ancestors @m1)
(cl-print-concept (cl-create-ind-descriptor @w1))
  pr w1
(wines @w1)
;; No role fillers for flavor, but there is some partial info:
(cl-fillers @w1 @r{flavor})
(cl-print-concept (cl-all @w1 @r{flavor}))

;; 2 meal-courses -- 1 drink
(cl-create-ind 'm24 '(and meal-course (fills food oysters) (fills drink w24)))
  cr -i -name m24 -exp (and meal-course (fills food oysters) (fills drink w24))
(cl-print-concept (cl-create-ind-descriptor @w24))
(wines @w24)
(cl-create-ind 'm25 '(and meal-course (fills food cake) (fills drink w24)))
  cr -i -name m25 -exp (and meal-course (fills food cake) (fills drink w24))
(cl-print-concept (cl-create-ind-descriptor @w24))
(wines @w24)

(cl-concept-find-compatible (cl-create-ind-descriptor @w1) @c{wine})
(cl-concept-find-compatible (cl-create-ind-descriptor @new-wine) @c{wine})
(cl-concept-find-compatible @mod-or-strong-wine @c{wine})

::::
;; New demo
::::

list -ir white-wine
print forman-chardonnay
create -c -name new-wine -exp (and wine
				   (fills body full)
				   (fills flavor moderate))
print new-wine
create -c -name mod-or-strong-wine -exp (and wine
					     (all flavor (one-of moderate strong)))
;; the instances of mod-or-strong-wine:
list -i mod-or-strong-wine  
;; the ancestors of mod-or-strong-wine:
list -rp mod-or-strong-wine 
create -i -name m1 -exp (and meal-course
			     (fills food crab)
			     (fills drink w1))
list -ri seafood-course
print w1

(wines @w1)

;; This only shows that info was propagated from m1:
;(cl-exp @w1 :aspect 'fills)
(cl-exp @m1 :aspect 'fills) ;; restrs on drink role: rules

;; print a rule
(cl-print-rule (cl-named-rule 'shellfish-wine-body))

;; show why a rule fired on an individual

(cl-exp-rule-firing @m1 (cl-named-rule 'seafood-wine-color))
(cl-exp-rule-firing @m1 (cl-named-rule 'shellfish-wine-body))
(cl-exp-rule-firing @m1 (cl-named-rule 'non-oyster-shellfish-wine-sugar))
(cl-print-rule (cl-named-rule 'shellfish-wine-body))
(cl-print-concept @c{shellfish-course})

;; 2 meal-courses -- 1 drink
create -i -name m24 -exp (and meal-course
			      (fills food oysters)
			      (fills drink w24))
(wines @w24)
create -i -name m25 -exp (and meal-course
			      (fills food cake)
			      (fills drink w24))
(wines @w24)

;; Shows that w24 got fillers from both m24 and m25
(cl-exp @w24 :aspect 'fills)

;; Shows that seafood-wine-color rule, etc., fired on m24
(cl-exp @m24 :aspect 'fills)
(cl-print-rule (cl-named-rule 'shellfish-wine-body))

;; Shows that rules on sweet-dessert-course, etc., fired.
(cl-exp @m25 :aspect 'fills)

;; Add a third meal-course to the SAME wine and generate an error

(multiple-value-setq (a1 b1 c1 d1)
  (cl-create-ind 'm28 '(and meal-course (fills food clams) 
			(fills drink w24))))
(cl-exp d1 :role-path c1)           ;; c1 is bound to (list @r{sugar})
;; From the above, we see two fillers for the sugar role on the wine.
;; They were propagated from 3 different meal-courses.  Explain how the meal
;; courses got those restrictions.
;; Explain why m24's drink's sugar has its filler
(cl-exp @m24 :role-path (list @r{drink} @r{sugar}) :aspect 'fills)
;; Explain why m25's drink's sugar has its filler
(cl-exp @m25 :role-path (list @r{drink} @r{sugar}) :aspect 'fills)
;; Explain why the error object for the meal-course named m28 has the 
;; filler Dry for its drink's sugar role.
(cl-exp (cl-error-object 'm28) :role-path 
	(list @r{drink} @r{sugar}) :aspect 'fills :aspect-filler @dry)


generate - at-least 2 sons, at-least 2 daughter, <3 children (because of a rule)
explain conflict
|#