home .. forth .. misc mail list archive ..

Mind.Forth (Was: Re: presentation for SVFIG)



On 31 Mar 2000, Graeme Dunbar wrote (about Mind.Forth):

> I tried downloading this code (cut and paste the text
> from the web page as suggested) but I have not been able
> to get it to compile. I cured lots of bugs caused by
> missing spaces and end-of-lines in the translation from html 
> back to text but that has just left me with more obscure errors.

> Does anyone have a plain ASCII text version that they could
> send me please?

> Thanks.


>> Jeff Fox is not only alive and well, he is prominently named in
>> 
>> http://www.geocities.com/mentifex/mind4th.html (in thanks to Jeff
>> 
>> for his help; see last line of code) [...]

--------------- current source code of Mind.Forth PD AI --------------

From mentifex@freepcmail.com  Tue Feb  1 15:16:46 2000
X-FreePort-Flags:  R     
Received: from scn.org (root@scn [209.63.95.146])
	by scn4.scn.org (8.9.1/8.9.1) with ESMTP id PAA29928
	for <mentifex@mailhub.scn.org>; Tue, 1 Feb 2000 15:16:46 -0800 (PST)
Received: from freepcmail.com ([207.138.41.35])
	by scn.org (8.9.1/8.9.1) with SMTP id PAA19585
	for <mentifex@scn.org>; Tue, 1 Feb 2000 15:17:37 -0800 (PST)
Received: (qmail 8971 invoked by uid 99); 1 Feb 2000 23:18:03 -0000
Received: from pppa64-resaleseattle2-4r7170.saturn.bbn.com (HELO Default) (4.54.85.157)
  by 192.168.187.35 with SMTP; 1 Feb 2000 23:18:03 -0000
Message-ID: <000101bf6d0a$eca378a0$9d553604@Default>
From: "Arthur T. Murray" <mentifex@freepcmail.com>
To: <mentifex@scn.org>
Subject: 1feb2KA.f Mind.Forth
Date: Tue, 1 Feb 2000 15:20:23 -0800
MIME-Version: 1.0
Content-Type: text/plain;
	charset="iso-8859-1"
Content-Transfer-Encoding: 7bit
X-Priority: 3
X-MSMail-Priority: Normal
X-Mailer: Microsoft Outlook Express 4.72.3110.1
X-MimeOLE: Produced By Microsoft MimeOLE V4.72.3110.3

\ 1feb2KA.f -- modification of 18jan2Ka.f
\ This file may be named "Mind.f" or any "filename.f" you choose.
\ This file is to be run with Win32Forth by issuing three commands:
\ win32for.exe [RETURN]
\ fload Mind.f [RETURN]
\ ALIFE [RETURN]

DECIMAL
\ Mind.f variables
variable a ( activation )
variable attn ( "attention" )  0 attn !
variable bg ( beginning )  1 bg !
variable big ( size of arrays ) 1024 big !
variable blankt ( blank-time )  0 blankt !
variable c ( continuation-flag for "ear" array phonemes )
variable enx ( transfer-to-English-lexicon )
variable eot  ( end-of-text for tentative use in SENSORIUM )
variable f ( fiber )
variable fex ( fiber-out )
variable fin ( fiber-in )
variable g ( grammar category )  1 g !
variable hits  ( for eventual use in intensive searches )
( I = Index in loops )
variable len  ( length )
variable meme  ( concept )
variable midway ( in time )
variable motjuste ( best word )
variable mt  ( move-tag )  0 mt !
variable nen  ( English lexical concept number )  0 nen !
variable nlp  ( natural language processing )
variable nlt  ( not-later-than )  0 nlt !
variable onset ( of a word )
variable opt  ( option )
variable par  ( parse )  1 par !
variable ph  ( phoneme )
variable pos  ( part-of-speech )
variable pre  ( previous )
variable prevg  ( previous grammar category )
variable quota  ( for eventual use in intensive searches )
variable rv  ( recall-vector )
variable s ( source )
variable seq  ( subSEQuent )
variable spy  ( level of inspection )  48 spy !
variable t  ( time )  0 t !
variable tdec  ( time-decrement )
variable tse  ( time in string-effect )
variable tult  ( time-ultimate )
variable tv  ( time-of-voice for use with .echo )
variable unk ( "unknown" )
variable ut  ( ultimate-tag )  0 ut !


\ Standards for the sake of Mind.Forth portability.
\ :  CELL+  4+  ;
\ :  CELLS  4*  ;
\ Above two lines commented out for sake of Win32Forth.

\ Array code for memory channel arrays.
:  CHANNEL  ( size num -< name >- )
    CREATE
    OVER
    ,
    * CELLS
    ALLOT
    DOES>
    DUP @
    ROT *
    ROT +
    1 +
    CELLS
    + ;

\ Memory channel arrays.
big @  6  CHANNEL  psi{  ( Primitive concept array "psi" )
big @  6  CHANNEL   en{  ( United-Kingdom English lexicon "en" )
big @  6  CHANNEL  ear{  ( Auditory memory channel array "ear" )

\ DECAY and other erasures to clear memory.
:  DECAY  midway @  nlt @  DO
    I  1 psi{ @  21 >     IF    (  if "a" is more than 21 )
 16 I  1 psi{ !          THEN  (  cap preterites at 16   )
    I  1 psi{ @  0  >  IF       ( if "a" is more than zero )
 -1 I  1 psi{ +!       THEN  ( let "a" decay by minus one )
 -1   +LOOP
 spy @ 50 = IF ." D: nlt = " nlt @ .  THEN
;  \  Return to ALIFE main program loop.

\  :  PSI-CLEAR  0 t @ DO  0 I 1 psi{ !  -1  +LOOP  ;

:  TABULARASA  0 a !  BEGIN  big @  0  DO
  0 I  a @  psi{ !  0 I  a @  en{ !  0 I a @  ear{ !
   LOOP  1  a +!  a @  6  <  WHILE  REPEAT  ;  \  Return to ALIFE.


\  DAMPing functions.
:  PSI-DAMP  spy @ 50 > IF CR ."   PSI-DAMP: pre-damp a = "
   a @ . ." ; t = " t @ . ." ; nlt = " nlt @ .
         ." and meme = " meme @ . CR  THEN
 midway @  t @  DO  \  Cycle backwards through time.
        I  0  psi{ @ meme @  =    \  Look for "meme"...
 IF   0 I  1  psi{ !              \  dampen to zero.
 THEN  -1  +LOOP
;  \  Return to NOUN-PHRASE, PREDICATE.

:  EN-DAMP  midway @  t @  DO  0 I  1  en{ !  -1 +LOOP
 spy @ 50 > IF CR THEN  ;  \  Return to NOUN-PHRASE, PREDICATE.

:  EAR-DAMP midway @  t @  DO  0 I  1 ear{ !  -1 +LOOP
;  \  Return to SENSORIUM.

:  SUBJ-DAMP  midway @ nlt @  DO
        I  0  psi{ @  motjuste @  =  IF
        I  2  psi{ @  meme !
    midway @ nlt @  DO
        I  0  psi{ @  meme @  =  IF
        I  1  psi{ @  30 >  IF
     30 I  1  psi{ !  THEN  THEN  -1 +LOOP  THEN
     -1  +LOOP  ;  \  Return to PREDICATE.

:  OBJ-DAMP   midway @ nlt @  DO
        I  0  psi{ @  motjuste @  =  IF
        I  4  psi{ @  meme !
    midway @ nlt @  DO
        I  0  psi{ @  meme @  =  IF
        I  1  psi{ @  32 >  IF
     32 I  1  psi{ !  THEN  THEN  -1 +LOOP  THEN
     -1  +LOOP  ;  \  Return to PREDICATE.


\ .psi shows the contents of the deep mindcore "psi".
:  .psi  CR  ." Mindcore concepts and flags:"
 CR ." time: f a pre enx seq nlp "
 t @ 1+  midway @ DO  \  Look as far back as "midway".
 I  0  psi{ @ 0 >
 IF  CR I . ." : "
 I 0 psi{ @ . ." "        I 1 psi{ @ . ." " I 2 psi{ @ . ." "
 I 3 psi{ @ enx ! enx @ . I 4 psi{ @ . ." " I 5 psi{ @ . ." "
     enx @ 0 >
     IF ." to " I unk !  0 rv !  midway @ unk @  DO
     I 0 en{ @  enx @ =
         IF  I 5 en{ @ rv !  rv @ 0= NOT
             IF  BEGIN rv @ 0 ear{ @ EMIT 1 rv +! rv @ 0 ear{ @
             0=  UNTIL  ."  "
             THEN
         0 rv !  LEAVE  ( one engrammed word is enough )
         THEN  -1  +LOOP
     THEN
 THEN  LOOP  CR ." time: f a pre ukx seq nlp "  0 unk !
;  \  to be called by user or by diagnostics.


\ .en displays the English lexicon array "en{".
:  .en  CR ." en{ items when t = " t @ . ." : "
        CR ." t nen a g fin fex rv:"
  t  @  1+  midway @  DO
  I  0  en{ @  unk !  unk @  0 >  ( display positive data )
 IF     CR I . unk @ . ." "
  I 1 en{ @ . ." " I 2 en{ @ . ." " I 3 en{ @ . ." "
  I 4 en{ @ . ." " I 5 en{ @ rv !  rv @ . ."  to "  BEGIN
       rv @ 0 ear{ @ EMIT  1 rv +! rv @ 0 ear{ @ 0= UNTIL
  ."  "     0 rv !
 THEN  LOOP 0 unk !
        CR ." t nen a g fin fex rv" CR
;  \  called by user or programmer by entering:  .uk


\ .ear and .echo display the auditory memory channel.
:  .ear
 CR  ." ear at time " t @ . ." : ph a bg c u s"
    t @  1+  t @  20 -  DO  ( show the last 20 "phonemes" )
 CR  ." ear{ at time " I . ." "
    I  0 ear{ @  33  <
 IF ." "  ( show a blank )
 ELSE  I 0 ear{ @ EMIT ."  " I 1 ear{ @ . ." " I 2 ear{ @ . ." "
       I 3 ear{ @ .     ." " I 4 ear{ @ . ." " I 5 ear{ @ EMIT
 THEN                LOOP
;  \  called by user or programmer by entering:  .ear

:  .echo  CR  ." Robot: "
   t @ 1+  tv @  DO  \  Display ear{ from time-of-voice "tv".
   I 0 ear{ @     33 <  IF  ."  " THEN  ( show a blank )
   I 0 ear{ @ EMIT      LOOP  ;  \  Return to HCI, AUTONOMY.


\ SPREADACT spreads activation among concepts.
\ It follows "pre" and "seq" tags to find related concepts.
:  SPREADACT
     midway @  t @ 1+  DO  ( loop backwards to midway )
                            pre @  0  >
  IF         I  0  psi{ @   pre @  =
      IF
   attn @ -1 = IF  30 I  1  psi{ +!
      ELSE         24 I  1  psi{ +!
               THEN
      THEN
  THEN                      seq @  0  >
  IF         I  0  psi{ @   seq @  =
      IF
   attn @ -1 = IF  10 I  1  psi{ +!
      ELSE          7 I  1  psi{ +!
               THEN
      THEN
  THEN
  -1  +LOOP  ;  \  Return to ACTIVATE.


\ ACTIVATE activates recent nodes of a given concept.
:  ACTIVATE  spy @ 50 > IF
   CR ."     ACTIVATE: pre seq = " pre @ . seq @ .  CR
   CR ."     ACTIVATE: mt = " mt @ . ." at t = " t @ . THEN
   \ 18jan2000:  The use of nlt will now permit this module
   \ to give higher activations to old concepts than to input.
  midway @  nlt @  DO  ( loop backwards to midway )
            I  0 psi{ @ mt @ =  ( a node of the move-tag? )
 IF
    attn @ -1 =           ( during "attention" mode... )
    IF  20  I  1 psi{ !   ( increase the activation,   )
    ELSE 8  I  1 psi{ !  THEN
            I  2 psi{ @  pre !
            I  4 psi{ @  seq !
      SPREADACT  0  pre !  0 seq !  0 a !
 THEN
           -1  +LOOP  0 a !  spy @ 50 > IF  CR  THEN
;  \  Return to OLDCONCEPT, TRANSFORMATION.


\ INSTANTIATE creates a concept node with tags.
:  INSTANTIATE  ( concept fiber f )   f @  t @  0 psi{ !
  ( Set "a" activation level. )       a @  t @  1 psi{ +!
  ( Store PREvious associand. )     pre @  t @  2 psi{ !
  ( Store the EN-transfer tag. )    enx @  t @  3 psi{ !
  ( Store the subSEQuent tag. )     seq @  t @  4 psi{ !
  ( Store functional NLP code. )    nlp @  t @  5 psi{ !
 spy @ 50 > IF CR ."     INSTANTIATE  t :  f a pre ukx seq nlp "
               CR ."     INSTANTIATE " t @ . 58 EMIT ."  "
  t @ 0 psi{ @ . ." " t @ 1 psi{ @ . ." " t @ 2 psi{ @ . ." "
  t @ 3 psi{ @ . ." " t @ 4 psi{ @ . ." " t @ 5 psi{ @ .  CR
             THEN
  0 f !          0 enx !  0 seq !  0 nlp ! ( reset for safety )
;    \  Return to OLDCONCEPT or to NEWCONCEPT.


\ ATTACH creates a node on a lexicon array item.
:  ATTACH ( Concept number "nen". ) mt @  t @  0  en{ !
 ( Do not store the activation level; it is a transient. )
 ( Store the grammar category "g".)  g @  t @  2  en{ !
 ( Store mindcore IN tag. )        fin @  t @  3  en{ !
 ( Store mindcore EXit tag. )      fex @  t @  4  en{ !
 ( Store the recall vector "rv". )  rv @  t @  5  en{ !
 spy @ 51 > IF CR ."     ATTACH " t @ . ." : "
 t @ 0 en{ @ . ." " t @ 1 en{ @ . ." " t @ 2 en{ @ . ." "
 ." = rv to " 34 EMIT  rv @ a ! 40  1  DO
                   a @  0  ear{ @  EMIT
                   a @  3  ear{ @  0 = IF  LEAVE  THEN
                   a @  1+ a !  ( increment looping address )
      LOOP      0  a !  34 EMIT   CR
 ."     ATTACH  t: nen a g fin fex rv " THEN
;  \ Return to OLDCONCEPT or to NEWCONCEPT.


\ OLDCONCEPT deals with recognition of old concepts.
:  OLDCONCEPT  attn @ -1 = IF 32 a !  ELSE 8 a !  THEN
               par @ 3 = IF 5 g ! 5 nlp ! 4 par ! THEN
               par @ 2 = IF 8 g ! 8 nlp ! 3 par ! THEN
      par @ 1 = IF  0 pre ! 5 g ! 5 nlp ! 2 par ! THEN
 midway @ t @ DO I 0 en{ @ mt @ = IF I 3 en{ @ 0 > IF
 I 3 en{ @  fin ! LEAVE THEN  THEN  -1 +LOOP
 ATTACH  ( creates an ENglish node )
spy @ 50 > IF CR ."      OLDC: pre seq = " pre @ . seq @ . THEN
 attn @ -1 = IF spy @ 51 > IF ."     mt from fin " fin @ . THEN
 fin @ mt !            THEN  mt @ f !            mt @ enx !
  INSTANTIATE    0 nlp !  pre @ unk ! ACTIVATE unk @ pre ! 0 unk !
 \  The next lines store "seq" retroactively:
 midway @  t @  DO   I  0  psi{ @  pre @  =  IF
 mt @  I  4 psi{ !  LEAVE  THEN    -1  +LOOP
 mt @  pre ! ( for next nen ) par @ 3 > IF  0 pre ! 1 par ! THEN
 0 a !     ;  \  Return to RETRO.

\ NEWCONCEPT deals with learning of new concepts.
:  NEWCONCEPT   1 nen +!     par @ prevg !
     nen @ mt !     nen @ fin !  nen @ fex !
   par @ 3 = IF  5 g !  32 a !  5 nlp !  4 par !  THEN
   par @ 2 = IF  8 g !  32 a !  8 nlp !  3 par !  THEN
   par @ 1 = IF  5 g !  32 a !  5 nlp !  2 par !  THEN
  ATTACH ( creates ENglish node ) 0 fin !  0 fex !
  nen @ f !    nen @ enx !
  INSTANTIATE  0 nlp !  ( reset )
    midway @  t @  DO  \  Make nen "seq" of its "pre" concept.
                I  0 psi{ @  pre @ = IF
           nen @  I  4 psi{ !  LEAVE THEN
  -1 +LOOP nen @  pre !  \  So that the next "nen" has a "pre".
   par @ 3 > IF  1 par !  THEN  0 a !  ;  \ Return to RETRO.


\ STRING-EFFECT helps recognize words and morphemes.
:  STRING-EFFECT  \  increases a(ctivation) of next-in-line char
      tdec @  1+ tse !  \ tse = "time (in) string-effect"
       tse @  1  ear{ @  8 + a !  ( fetch a & increase by 8 )
  a @  tse @  1  ear{ !  \  Store the higher a(ctivation).
  0 a !  ;  \  Return to COMPARATOR.


\ COMPARATOR matches each phoneme against memory.
:  COMPARATOR
      0 mt !      blankt @  tdec !    blankt @  tse !
        midway @  blankt @  DO I 0 ear{ @ ph !
   unk @  ph @ = IF ( match? ) I 1 ear{ @ a !
             I 2 ear{ @ 1 = IF  8 a +!  THEN
        a @ 0 > IF  I 4 ear{ @ ut !
           ut @ 0 > IF
           I 3 ear{ @       1 = NOT IF  ut @ mt !  THEN
           4 ut @ 1 en{ !  ( increase activation )  0 ut !
           THEN
         STRING-EFFECT
       THEN  0 a !
  THEN  tse @ 1 +  tse !  tdec @ 1- tdec !
 -1  +LOOP  ;  \  Return to short term memory STM.


\ STM is "Short Term Memory" of auditory engrams.
:  STM
    unk @ 32 > IF  COMPARATOR  THEN  ( ASCII 32 = SPACE-bar )

    t @ 1-  0 ear{ @  0=  IF  1 bg !  THEN

    unk @  t @  0 ear{ !  \  Store the unk phoneme at time t
        0  t @  1 ear{ !  \  Store no a(ctivation) level.
     bg @  t @  2 ear{ !  \  b(e)g(inning)?  1 Yes or 0 No.
      c @  t @  3 ear{ !  \  c(ontinuation)? 1=Y or 0 = No.
     ut @  t @  4 ear{ !  \  u(ltimate) tag # to a concept.
      s @  t @  5 ear{ !  \  s(ource): internal -, external +

  unk @ 32 = IF t @ blankt !  THEN
;  \  Return to SENSORIUM.


\ RETRO goes back and tags a word that has just ended.
: RETRO  \ Called by SENSORIUM when incoming character = 32 SP
 t @ blankt !   t @  1 - tult !
 0 tult @ 3 ear{ !
 spy @ 51 > IF CR ."       RETRO: move-tag = " mt @ .  THEN
 mt @  0 >  IF  onset @ rv !  0 onset !
 mt @  tult @  4 ear{ !  \  Store the move-tag "mt".
   OLDCONCEPT   0 mt !  0 rv !
 ELSE  len @  0 >  IF  onset @  ( from SENSORIUM )  rv !
   NEWCONCEPT
 spy @ 53 > IF ."       RETRO: rv = " rv @ . CR  THEN
 nen @  tult @  4  ear{ !  \ Store new concept ultimate-tag.
                THEN
       THEN           EAR-DAMP
 0 len !  0 rv !
;  \  Return to SENSORIUM.

\ AUDITION handles the input of ASCII in lieu of phonemes.
:  UPSET  unk @ DUP  96 > IF  DUP 123 < IF 32 - THEN  THEN
          unk !   ;  \  UPSET returns to AUDITION.
:  AUDITION   attn @  -1  =
 IF   KEY?
      IF    KEY
      THEN  KEY  unk !  unk @  EMIT  ( Display input of user. )
 THEN
 \  If "attn" is off, the reentry process supplies "unk".
 UPSET  \  Converts input to upper case for ease of processing.
;  \  Return to SENSORIUM.


\ SENSORIUM handles the input of sensory perception.
:  SENSORIUM  EAR-DAMP  ( to clear auditory memory )
  t @ nlt !  \ 18jan2000:  A no-later-than demarcation so that
  \ fresh input can have lower activation than old reactivations.
  80  0  DO  \  Accept entry of at most 80 characters.
  AUDITION  ( retrieve the incoming or reentering phonemes )
   1 t +!   ( increment time "t" by one unit. )
 unk @ 13 = IF 1 bg ! 13 eot ! t @ blankt ! 32 unk ! 10 EMIT
  3 par ! THEN
 unk @ 27 = IF CR ." SENSORIUM: halt.  You may enter .psi .en .ear "
  CR ." to see the contents of psi, en, or ear." 0 unk ! QUIT THEN
 unk @ 32 =  ( space-bar )
 IF       RETRO  ( to adjust ending of a recognized word )
 THEN  1 bg !  1 c !  blankt @ 1 + onset !  t @ onset @ = bg !
 unk @ 32 >
 IF    1 len +!   STM   ( store character in Short Term Memory )
 THEN
 eot @ 13 = IF  0 attn ! 0 eot ! THEN
 attn @ IF  ELSE  3 prevg !  LEAVE THEN  ( 29aug1999 from expert )
 LOOP  ;  \  Return to ALIFE or to the reentry process.


\ PSI-1 is the first mindcore "psi bootstrap sequence.
:  PSI-1   \  Concept fiber:  f + a + pre + enx + seq + nlp
  1 t !  \  Then next line sets up the concept fiber for "I":
  9 f !  1 a !  0 pre !  9 enx !  37 seq ! 5 nlp ! INSTANTIATE

  6 t !  \ We establish the mindcore fiber of "know":
 37 f !  0 a !  9 pre ! 37 enx !  13 seq ! 8 nlp ! INSTANTIATE

 10 t !  \ We establish the mindcore fiber of "you" ("other"):
 13 f !  0 a ! 37 pre ! 13 enx !   0 seq ! 5 nlp ! INSTANTIATE
;  \  Return to the main BOOTSTRAP subroutine.
\  NLP: 1=adj 2=adv 3=conj 4=interj 5=noun 6=prep 7=pron 8=verb

\ EN-1 is the first English lexicon bootstrap sequence.
:  EN-1  \  Instantiating "I know you."

 \  "I" ( "self" ) is mindcore octave two, overall concept #9"
  9 mt !        5 g ! 13 fin !  9 fex !  1 rv !  1 t ! ATTACH

 \  "know" is mindcore octave five, concept #37:
 37 mt !        8 g ! 37 fin !  37 fex ! 3 rv !  6 t ! ATTACH

 \  "you" ( "other" ) is mindcore octave one, concept #13:
 13 mt !        5 g !  9 fin !  13 fex ! 8 rv ! 10 t ! ATTACH
  0 mt !  ;  \  Return to the main BOOTSTRAP subroutine.

\ EAR-1 is the first auditory engram bootstrap.
:  EAR-1  \  ASCII storage of words and tags in the array ear{.

 ( I )   1 t !  73 unk !  1 bg !  0 c !   9 ut ! 45 s !  STM

 ( K )   3 t !  75 unk !  1 bg !  1 c !   0 ut ! 45 s !  STM
 ( N )   4 t !  78 unk !  1 bg !  1 c !   0 ut !         STM
 ( O )   5 t !  79 unk !  1 bg !  1 c !   0 ut !         STM
 ( W )   6 t !  87 unk !  1 bg !  0 c !  37 ut !         STM

 ( Y )   8 t !  89 unk !  1 bg !  1 c !   0 ut ! 45 s !  STM
 ( O )   9 t !  79 unk !  1 bg !  1 c !   0 ut !         STM
 ( U )  10 t !  85 unk !  1 bg !  0 c !  13 ut !         STM
;  \  Return to the main BOOTSTRAP subroutine.


\ PSI-2 is the second mindcore "psi" bootstrap.
:  PSI-2
 15 t !  \  "you" ( other")
 13 f !  0 a !   0 pre ! 13 enx ! 39 seq ! 5 nlp ! INSTANTIATE

 19 t !  \  "see"
 39 f !  0 a !  13 pre ! 39 enx ! 10 seq ! 8 nlp ! INSTANTIATE

 22 t !  \  "me" ( "self" )
 10 f !  0 a !  39 pre ! 10 enx !  0 seq ! 5 nlp ! INSTANTIATE
; \  Return to the main BOOTSTRAP subroutine.

\ EN-2 is the second English lexicon bootstrap sequence.
:  EN-2
 \  "you" is mindcore octave two, concept #13:
 \  "you" going in goes to concept fin #9:  "I" ( self ):
 13 mt !        5 g !  9 fin ! 13 fex !  13 rv !  15 t ! ATTACH

 \ "see" is mindcore octave five, concept #39:
 39 mt !        8 g ! 39 fin ! 39 fex !  17 rv !  19 t ! ATTACH

 \ "me" ( "self" ) is mindcore octave two, concept #9:
 10 mt !        5 g ! 13 fin ! 10 fex !  21 rv !  22 t ! ATTACH

  0 mt !  0 a !        0 fin !  0 fex !

;  \  Return to the main BOOTSTRAP subroutine.

\ EAR-2 is the second auditory engram bootstrap.
:  EAR-2
 ( Y )   13 t ! 89 unk ! 1 bg ! 1 c !   0 ut ! 45 s !  STM
 ( O )   14 t ! 79 unk ! 0 bg ! 1 c !   0 ut !         STM
 ( U )   15 t ! 85 unk ! 0 bg ! 0 c !  13 ut !         STM

 ( S )   17 t ! 83 unk ! 1 bg ! 1 c !   0 ut ! 45 s !  STM
 ( E )   18 t ! 69 unk ! 0 bg ! 1 c !   0 ut !         STM
 ( E )   19 t ! 69 unk ! 0 bg ! 0 c !  39 ut !         STM

 ( M )   21 t ! 77 unk ! 1 bg ! 1 c !   0 ut ! 45 s !  STM
 ( E )   22 t ! 69 unk ! 0 bg ! 0 c !  10 ut !         STM
         23 t !                         0 ut !
;  \  Return to the main BOOTSTRAP subroutine.


\ BOOTSTRAP calls the user-written bootstrap sequences.
:  BOOTSTRAP

   EAR-1  \  "I know you"
   EN-1
   PSI-1

  EAR-2  \  "You see me"
  EN-2
  PSI-2

  1 t +!
  t @ nlt !  ( nlt may be basis for DAMP functions )
 64 nen !  \  Only assign concepts above the pre-set first 64.
;  \  Return to the main ALIFE loop.


\ FLUSHVECTOR flushes deep concepts up into syntax.
:  FLUSHVECTOR  0 a !
   midway @  t @ 1+  DO  \  Some psi have HOLODYNE "a"
                 I   1 psi{ @  0 > IF
                 I   1 psi{ @    a !
                 I   3 psi{ @  enx !  THEN
                               enx @  0  >  IF
   midway @  t @ 1+  DO
                 I   0  en{ @  enx @ = IF
             a @ I   1  en{ !          THEN
                -1  +LOOP  THEN  0 enx !  0 a !
                -1  +LOOP
;  \  Return to NOUN-PHRASE, PREDICATE.


\ SPEECH follows recall-vector "rv" to say phonemes.
:  SPEECH  ( for output of single words, not entire sentences )
   rv @ onset !  ( Save first rv as the onset of a word. )
  spy @ 51 >  IF  CR ."   SPEECH: " CR  THEN
 \ Next line assumes no word will be longer than 40 phonemes:
    40  1  DO   \  Perform this loop up to forty times.
  rv @  0  ear{ @ unk !  unk @ EMIT  ( say or display "rv" )

    45 s !  ( internal source "s"; 45 is ASCII for minus "-" )
    SENSORIUM  ( for reentry of a thought back into the mind )

  rv @  3 ear{ @ 0 = IF  LEAVE  THEN ( if end of word )

 \ With each loop, increase the recall-vector "rv" by one so as
 \ to retrieve each successive phoneme from the auditory memory:
  rv @  1+  rv !    LOOP   0 rv !
;  \  Return to NOUN-PHRASE, PREDICATE, etc.


\ NOUN-PHRASE finds the currently most active noun.
:  NOUN-PHRASE 5 opt ! 0 unk ! 0 mt ! 0 motjuste ! 0 rv ! 0 a !
   spy @ 50 = IF  .psi  THEN  ( diagnostic level 2: show concepts )
   FLUSHVECTOR  ( to move deep concepts up to English "en{" )
 midway @ t @ DO  I 1 en{ @  0 >  IF ( if en "a" is positive )
                  I 1 en{ @  a !  ( then store the "a" level )
                  I 2 en{ @  5 =  IF ( if "opt" part of sp. )
 a @ unk @  > IF  I 0 en{ @  mt !  ( move-tag of item )
                  I 5 en{ @  rv !  ( auditory recall-vector )
 a @ unk ! ( to test for an even higher "a" )  mt @ motjuste !
 spy @ 49 > IF CR ."     NOUN-PHRASE: most active a " a @ .
 ." is for mt " mt @ . ." with rv " rv @ . CR  THEN
             THEN                     THEN
   THEN  -1 +LOOP  mt @ meme ! PSI-DAMP  EN-DAMP
   SPEECH   0 a !  ;  \  Retrun to SUBJECT, PREDICATE.


\ SUBJECT assembles a phrase to be subject of verb.
:  SUBJECT
   spy @ -1 = IF  CR ." SUBJECT: "  THEN
   NOUN-PHRASE  ( finds "le mot juste" to be the subject )

 \ RETRO, invoked by SENSORIUM, will need to store in ear{ }
 \ the concept number of "motjuste" as a move-tag "mt":
   motjuste @ mt !  ( send the found move-tag into RETRO )

 \ A SPACE-bar will be needed in SENSORIUM to call RETRO:
   32 unk !  ( Set the "unk" variable to ASCII 32 SPACE-bar. )

 \ Although called separately during REENTRY of "le mot juste,"
   SENSORIUM  \  must now be called to receive a SPACE-bar.
;             \  Return to the ENGLISH module.


\ PREDICATE assembles a phrase of verb plus object.
:  PREDICATE  8 opt !  0 unk !  0 mt !  0 motjuste ! 2 par !
   FLUSHVECTOR  ( to move deep concepts up to English "en{" )
 spy @ 50 > IF CR ."    PREDICATE: "  THEN
midway @ t @ DO I  1 en{ @  0 > IF  ( if en "a" is positive )
                I  1 en{ @  a !  ( then store the "a" level )
                I  2 en{ @  8 = IF  ( a verb? )
 a @ unk @ > IF I  0 en{ @  mt !  ( move-tag of item )
                I  5 en{ @  rv !  ( auditory recall-vector )
 a @ unk ! ( to test for an even higher "a" )  mt @ motjuste !
 spy @ 50 > IF CR ."     PREDICATE: most active a " a @ .
 ." is for mt " mt @ . ." with rv " rv @ . THEN THEN THEN THEN
 -1 +LOOP  mt @ meme ! PSI-DAMP 32 EMIT SPEECH motjuste @ mt !
    EN-DAMP  32 unk !  SENSORIUM   SUBJ-DAMP
  3 par !    32 EMIT   NOUN-PHRASE  OBJ-DAMP
;  \  Return to the ENGLISH module.


\ ENGLISH is the syntax of an English sentence.
:  ENGLISH
   spy @ 50 = IF .psi ." Press RETURN " KEY  THEN
   0  attn !  \  Turns off "attention" during reentry mode.
   t @  tv !  \  Store current "t" as time-of-voice for ".echo".
 \  The AI fills in the next line by generating a thought:
 CR ." Robot: "

   SUBJECT    ( finds "le mot juste" to be the subject )

   PREDICATE  ( finds "le mot juste" for verb and for object )

   motjuste @ mt !  ( so that RETRO will invoke OLDCONCEPT )
  13 unk !  SENSORIUM  ( ASCII 13 CR to trip a call of RETRO )
;  \  Return to the TRANSFORMATION module.


\ DISCRIMINATE "squeezes out" subjects, verbs, etc.
:  DISCRIMINATE
 spy @ 50 = IF CR ." DISCRIMINATE: Active concept = " THEN
 0 a !  1 unk !
 midway @  t @ 1+  DO
 I  1 psi{ @    unk @ >  IF  ( if psi "a" is larger...)
 I  1 psi{ @      a !  ( ... hold the "a" level )
 I  0 psi{ @   meme !  ( ... hold the meme )
 I  2 psi{ @    pre !  ( ... hold its "pre"? )
 I  4 psi{ @    seq !  ( ... hold its "seq"? )
 I  5 psi{ @    nlp !  ( ... hold its part-of-speech )
   THEN  a @ unk !  ( next use "a" as the higher standard )
   -1  +LOOP  ( with each loop, possibly find a higher "a" )
 spy @ 50 = IF  meme @ . THEN
;  \  Return to TRANSFORMATION.

\ TRANSFORMATION calls a Chomskyan syntax structure.
:  TRANSFORMATION
   DISCRIMINATE  ( to pick and choose among active concepts )
 \ If no verb, push into ACTIVATE + SPREADACT to force a verb:
 meme @ mt !  nlp @ 8 = NOT IF
 spy @ 50 = IF  ." Xf. 1st call to ACTIVATE " THEN
 -1 attn !  SPREADACT  0 mt !  0 attn !
   DISCRIMINATE  THEN  \  to search again
 meme @ mt !  nlp @ 8 = NOT IF
 spy @ 50 = IF  ." Xf. 2nd call to ACTIVATE " THEN
 -1 attn !  SPREADACT  0 mt !  0 attn !
   DISCRIMINATE  THEN  \  to search again
 \ If the meme is an 8/verb, run it through ACTIVATE + SPREADACT
 \ in order to accentuate the activation of the subject:
 meme @ mt ! nlp @ 8 = IF ( if no verb on 3rd try, never mind )
 spy @ 50 = IF  ." Xf. verb ! Call ACTIVATE " THEN
 -1 attn !  SPREADACT  0 mt !  0 attn !  THEN  0 a !
   ENGLISH  ( that is, the syntactic structure of English )
;  \  Return to the main ALIFE loop.


\ HCI is the human-computer interface of Mind.Forth AI.
:  HCI  0 unk !  ( remove whatever value rode in here )
 spy @ 49 > IF .echo THEN  ( after diagnostic blur, show I/O )
 CR CR ." HCI: Please enter a diagnostic level from 1 to 9."
 CR ." For instance, 1 (no diagnostics) or 2 (troubleshooting)."
 CR ." Enter subject + transitive verb + object (no punctuation)."
 KEY unk !  unk @ 27 = IF CR ." Halt." QUIT THEN
 unk @ spy !
 ;  \  Return to the AUTONOMY subroutine.

\ AUTONOMY is the auto-pilot mode of stand-alone AI.
:  AUTONOMY
  \  spy @ 49 >  IF  .echo  THEN  ( show output of AI )
   CR CR ." Press TAB for user input, or ESC to quit:"
   75  1  DO
          ." ."  ( display a series of dots....)
   KEY? IF  KEY THEN KEY  unk !  -1 attn !
   unk @  27 = IF     CR ." Halt. "  QUIT  THEN
   unk @   9 = IF  CR CR ." AUTONOMY: Interruption by user."
   HCI  LEAVE  THEN
  \ ELSE  ( if no keypress )  0 attn !  ( bypass user entry )

  LOOP   CR  0 unk !
;  \  Return to the main program loop ALIFE.


\ ALIFE is the main program loop of Mind.Forth AI.
:  ALIFE  t @ blankt !  49 spy !  ." (clearing memory...)"
 CR ." There is no warranty for what this software does."
 TABULARASA  ( to erase all memory arrays )
 BOOTSTRAP  ( to load some initial concepts )
BEGIN   t @  200    >
IF      t @  200 -  midway !  ( for a range limit on searches )
ELSE    0           midway !  THEN
 DECAY
 TRANSFORMATION  ( to choose a Chomskyan syntactic structure )
 DECAY
 AUTONOMY        ( for independent operation, if no input )
 attn @  -1 =    ( while in attention mode, do the following )
 IF     t @  blankt ! CR ( keep track of moment before input )
  43 s !  ( ASCII 43 = "+" to designate "source" as external.)
  CR ." User: " ( a prompt for the user to type in a sentence )
  1 par !        ( expect a noun or pronoun )
  SENSORIUM      ( for sensory input from the environment )
  t @ 999 > IF CR ." Program timed out at 999 " QUIT THEN
  THEN AGAIN ; \ 7sep1999 footnote: Includes help from Jeff Fox.