mod

32 CONSTANT MAX-MOD-DEP

: (CREATE-MODULE-LIST) ( pub-wid "name" -- a-addr )
  CREATE HERE >R , 0 , MAX-MOD-DEP CELLS ALLOT R>
;

: (MODULE-PUB-WID) ( base-addr -- pub-wid-addr ) ;

: (MODULE-COUNT) ( base-addr -- count-addr )
  1 CELLS + 
;

: (MODULE-DEP-AT) ( base-addr i -- dep-addr )
  2 + CELLS + 
;

: (MODULE-DEP-ADD) ( other-mod-addr base-addr -- )
  DUP (MODULE-COUNT) DUP @ 
  SWAP OVER 1+ 
  DUP MAX-MOD-DEP >
  IF CR
    ." MODULE ERR: MODULE DEPENDENCY LIMIT EXCEEDED"
    CR ABORT 
  ENDIF
  SWAP ! (MODULE-DEP-AT) !
;

: (GET-MODULES) ( base-addr -- ... u )
  DUP (MODULE-PUB-WID) @
  SWAP 1 OVER (MODULE-COUNT)
  @ 0 U+DO
    OVER i (MODULE-DEP-AT) @
    SWAP >R SWAP >R
    RECURSE R> R> ROT +
  LOOP NIP
;

: (GET-MODULE) ( "name" -- base-addr )
  BL WORD DUP FIND 0= 
  IF 
    CR DROP COUNT S" MODULE ERR: [" 2SWAP S+ 
    S" ] NOT FOUND" S+ TYPE
    CR ABORT 
  ENDIF
  >R DROP R>
  >BODY
;

: BEGIN-MODULE ( "name" -- old-wid pub-wid base-addr )
  GET-CURRENT WORDLIST
  DUP (CREATE-MODULE-LIST)
  WORDLIST DUP SET-CURRENT
  >R GET-ORDER 1+ R> SWAP SET-ORDER
;

: END-MODULE ( old-wid pub-wid base-addr -- )
  2DROP SET-CURRENT GET-ORDER 1- NIP SET-ORDER
;

: IMPORT ( "name" -- u )
  GET-ORDER >R
  (GET-MODULE) (GET-MODULES)
  R> OVER >R +
  SET-ORDER R>
;

: END-IMPORT ( u -- )
  >R GET-ORDER
  R@ - R> SWAP
  >R 0 U+DO DROP LOOP
  R> SET-ORDER
;

: EXPORT ( pub-wid base-addr "name" -- pub-wid base-addr )
  PARSE-NAME 2DUP
  S" BEGIN-MODULE" str= IF
    2DROP GET-CURRENT WORDLIST DUP
    (CREATE-MODULE-LIST) 
    OVER SET-CURRENT EXIT
  ENDIF
  2DUP S" IMPORT" str= IF
    2DROP (GET-MODULE) OVER
    (MODULE-DEP-ADD) EXIT
  ENDIF
  2DUP S" :" str= IF
    2DROP GET-CURRENT >R
    OVER SET-CURRENT
    S" : " [CHAR] ; PARSE S+ S" ;" S+
    EVALUATE R> SET-CURRENT EXIT
  ENDIF
  CR
  S" MODULE ERR: [EXPORT " 2SWAP S+ 
  S" ] INVALID SYNTAX" S+ TYPE
  CR ABORT
;