#!/usr/local/bin/xmetoo -n
; ---------- SORTS --------------------------------------------

( deftype FSystem FF Id X )
;---------------------

( deftype X ALT File Dir )
;---------------------

( deftype File TUP
  ( F LIST STR )
)
;---------------------

( deftype Id STR )
;---------------------

( deftype Dir TUP
  ( D FSystem )
)
;---------------------

( deftype Path LIST X )
;---------------------

( deftype Paths LIST Path )
;---------------------
; ---------- STATE -------------------------------------------
; FS : FSystem;
; ---------- FUNCTIONS ---------------------------------------


( def ls lambda
  ( fs )
  ( dom fs )
)
;---------------------


( def allId lambda
  ( fs )
  ( UNION
    ( set
      ( let
        (
          ( x
            ( ap fs i )
          )
        )
        ( cond
          (
            ( is File x )
            ( makeset i )
          )
          (
            ( is Dir x )
            ( union
              ( makeset i )
              ( allId
                ( D x )
              )
            )
          )
        )
      )
      ( from i
        ( dom fs )
      )
    )
  )
)
;---------------------


( def mkdir lambda
  ( fs i p )
  ( if
    ( member p
      ( dirs fs )
    )
    ( plus fs
      ( if
        ( equal p
          ( makeseq )
        )
        ( makeff
          ( i
            ( Dir
              ( makeff )
            )
          )
        )
        ( let
          (
            ( j
              ( head p )
            )
            ( q
              ( tail p )
            )
            ( sfs
              ( D
                ( ap fs j )
              )
            )
          )
          ( makeff
            ( j
              ( Dir
                ( mkdir sfs i q )
              )
            )
          )
        )
      )
    ) fs
  )
)
;---------------------


( def create lambda
  ( fs i f p )
  ( if
    ( member p
      ( dirs fs )
    )
    ( plus fs
      ( if
        ( equal p
          ( makeseq )
        )
        ( makeff
          ( i
            ( File f )
          )
        )
        ( let
          (
            ( j
              ( head p )
            )
            ( q
              ( tail p )
            )
            ( sfs
              ( D
                ( ap fs j )
              )
            )
          )
          ( makeff
            ( j
              ( Dir
                ( create sfs i f q )
              )
            )
          )
        )
      )
    ) fs
  )
)
;---------------------


( def files lambda
  ( fs )
  ( UNION
    ( set
      ( let
        (
          ( x
            ( ap fs i )
          )
        )
        ( cond
          (
            ( is File x )
            ( makeset
              ( makeseq i )
            )
          )
          (
            ( is Dir x )
            ( set
              ( cons i p )
              ( from p
                ( files
                  ( D x )
                )
              )
            )
          )
        )
      )
      ( from i
        ( dom fs )
      )
    )
  )
)
;---------------------


( def dirs lambda
  ( fs )
  ( union
    ( makeset
      ( makeseq )
    )
    ( UNION
      ( set
        ( let
          (
            ( x
              ( ap fs i )
            )
          )
          ( cond
            (
              ( is File x )
              ( makeset )
            )
            (
              ( is Dir x )
              ( set
                ( cons i p )
                ( from p
                  ( dirs
                    ( D x )
                  )
                )
              )
            )
          )
        )
        ( from i
          ( dom fs )
        )
      )
    )
  )
)
;---------------------


( def applypath lambda
  ( fs p )
  ( if
    ( equal p
      ( makeseq )
    ) fs
    ( let
      (
        ( j
          ( head p )
        )
        ( q
          ( tail p )
        )
        ( sfs
          ( D
            ( ap fs j )
          )
        )
      )
      ( applypath sfs q )
    )
  )
)
;---------------------
; ---------- EVENTS --------------------------------------------


( def FORMAT lambda
  ( )
  ( def fs
    ( makeff )
  )
)
;---------------------


( def VI lambda
  ( i f p )
  ( if
    ( member p
      ( dirs fs )
    )
    ( def fs
      ( create fs i f p )
    )
    ( strcat "ERROR (precondition violated) in function " "VI" )
  )
)
;---------------------


( def LS lambda
  ( )
  ( ls fs )
)
;---------------------


( def CAT lambda
  ( p )
  ( if
    ( member p
      ( files fs )
    )
    ( let
      (
        ( sfs
          ( D
            ( applypath fs
              ( tail p )
            )
          )
        )
      )
      ( F
        ( ap sfs
          ( head p )
        )
      )
    )
    ( strcat "ERROR (precondition violated) in function " "CAT" )
  )
)
;---------------------


( def MKDIR lambda
  ( i p )
  ( if
    ( member p
      ( dirs fs )
    )
    ( def fs
      ( mkdir fs i p )
    )
    ( strcat "ERROR (precondition violated) in function " "MKDIR" )
  )
)
;---------------------
(!)