Something

0 constant nil

: cons ( y x -- pair )  2 cells allocate throw  dup >r  2!  r> ;

: >car ( pair -- first-addr ) ; immediate
: >cdr ( pair -- second-addr )  cell+ ;

: car  ( pair -- first )   >car @ ;
: cdr  ( pair -- second )  >cdr @ ;

: linked-list ( -- list )  align here nil , ;

: add-node ( node list -- )  tuck @  swap cons  swap ! ;

: last-node ( node -- last ) begin dup cdr while cdr repeat ;

: atom? ( node -- flag ) cdr nil = ;

: copy-list ( list1 list2 -- )
  >r  @ begin dup while  dup car r@ add-node  cdr repeat  drop r> drop ;

: .list ( list -- )  @ begin dup while  dup car .h  cdr repeat drop ;

: free-list ( list -- ) @ begin dup while dup cdr swap free throw repeat drop ; 

: join-lists ( list2 list1 -- ) @ swap @ swap last-node >cdr ! ;


\ String Constants:

: goat_str       s" Goat" ;
: is-billy_str   s" Is-Billy" ;
: gives-milk_str s" Gives-Milk" ;
: has-hair_str   s" Has-Hair" ;
: has-horns_str  s" Has-Horns" ;
: mammal_str     s" Mammal" ;


\ Facts:

linked-list constant gives-milk  ' gives-milk_str gives-milk add-node
linked-list constant has-hair    ' has-hair_str has-hair add-node
linked-list constant has-horns   ' has-horns_str has-horns add-node


\ Rules:

linked-list constant mammal
has-hair mammal add-node
gives-milk mammal add-node
' mammal_str mammal add-node

linked-list constant goat1
' is-billy_str goat1 add-node
' goat_str goat1 add-node

linked-list constant goat2
has-horns goat2 add-node
' mammal_str goat2 add-node
' goat_str goat2 add-node

\ Knowledgebase

linked-list constant CLAUSES
gives-milk CLAUSES add-node
has-hair CLAUSES add-node
has-horns CLAUSES add-node
mammal CLAUSES add-node
goat1 CLAUSES add-node
goat2 CLAUSES add-node

linked-list constant SOLVED

linked-list constant GOALS
' goat_str GOALS add-node