Quelle  Haskell.thy

(*  Title:      Tools/Haskell/Haskell.thy
    Author:     Makarius
    UUID:       0e3ceb40-61a8-4f78-a6c7-ae4892dd80b3

Support for Isabelle tools in Haskell.
*)

theory Haskell
  imports Main
begin

generate_file "Isabelle/Bytes.hs" = ‹
 - Title: Isabelle/Bytes.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  byte strings.

  🍋‹$ISABELLE_HOME/src/Pure/General/bytes.ML›
  🍋‹$ISABELLE_HOME/src/Pure/General/bytes.scala›.
 }

 -# LANGUAGE TypeApplications #-}

  Isabelle.Bytes (
 Bytes,
 make, unmake, pack, unpack,
 empty, null, length, index, all, any,
 head, last, take, drop, isPrefixOf, isSuffixOf, try_unprefix, try_unsuffix,
 concat, space, spaces, char, all_char, any_char, byte, singleton
 
 

  Prelude hiding (null, length, all, any, head, last, take, drop, concat)

  qualified Data.ByteString.Short as ShortByteString
  Data.ByteString.Short (ShortByteString)
  qualified Data.ByteString as ByteString
  Data.ByteString (ByteString)
  qualified Data.List as List
  Data.Word (Word8)
  Data.Array (Array, array, (!))


  Bytes = ShortByteString

  :: ByteString -> Bytes
  = ShortByteString.toShort

  :: Bytes -> ByteString
  = ShortByteString.fromShort

  :: [Word8] -> Bytes
  = ShortByteString.pack

  :: Bytes -> [Word8]
  = ShortByteString.unpack

  :: Bytes
  = ShortByteString.empty

  :: Bytes -> Bool
  = ShortByteString.null

  :: Bytes -> Int
  = ShortByteString.length

  :: Bytes -> Int -> Word8
  = ShortByteString.index

  :: (Word8 -> Bool) -> Bytes -> Bool
  p = List.all p . unpack

  :: (Word8 -> Bool) -> Bytes -> Bool
  p = List.any p . unpack

  :: Bytes -> Word8
  bytes = index bytes 0

  :: Bytes -> Word8
  bytes = index bytes (length bytes - 1)

  :: Int -> Bytes -> Bytes
  n bs
 | n == 0 = empty
 | n >= length bs = bs
 | otherwise = pack (List.take n (unpack bs))

  :: Int -> Bytes -> Bytes
  n bs
 | n == 0 = bs
 | n >= length bs = empty
 | otherwise = pack (List.drop n (unpack bs))

  :: Bytes -> Bytes -> Bool
  bs1 bs2 =
 n1 <= n2 && List.all (\i -> index bs1 i == index bs2 i) [0 .. n1 - 1]
 where n1 = length bs1; n2 = length bs2

  :: Bytes -> Bytes -> Bool
  bs1 bs2 =
 n1 <= n2 && List.all (\i -> index bs1 i == index bs2 (i + k)) [0 .. n1 - 1]
 where n1 = length bs1; n2 = length bs2; k = n2 - n1

  :: Bytes -> Bytes -> Maybe Bytes
  bs1 bs2 =
 if isPrefixOf bs1 bs2 then Just (drop (length bs1) bs2)
 else Nothing

  :: Bytes -> Bytes -> Maybe Bytes
  bs1 bs2 =
 if isSuffixOf bs1 bs2 then Just (take (length bs2 - length bs1) bs2)
 else Nothing

  :: [Bytes] -> Bytes
  = mconcat

  :: Word8
  = 32

  :: Array Int Bytes
  = array (0, 64) [(i, pack (replicate i space)) | i <- [0 .. 64]]

  :: Int -> Bytes
  n =
 if n < 64 then small_spaces ! n
 else concat ((small_spaces ! (n `mod` 64)) : replicate (n `div` 64) (small_spaces ! 64))

  :: Word8 -> Char
  = toEnum . fromEnum

  :: (Char -> Bool) -> Bytes -> Bool
  pred = all (pred . char)

  :: (Char -> Bool) -> Bytes -> Bool
  pred = any (pred . char)

  :: Char -> Word8
  = toEnum . fromEnum

  :: Array Word8 Bytes
  =
 array (minBound, maxBound)
 [(i, make (ByteString.singleton i)) | i <- [minBound .. maxBound]]

  :: Word8 -> Bytes
  b = singletons ! b
 ›

generate_file "Isabelle/UTF8.hs" = ‹
 - Title: Isabelle/UTF8.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  on UTF-8.

  🍋‹$ISABELLE_HOME/src/Pure/General/utf8.ML›
  🍋‹$ISABELLE_HOME/src/Pure/General/utf8.scala›.
 }

 -# LANGUAGE MultiParamTypeClasses #-}
 -# LANGUAGE TypeSynonymInstances #-}
 -# LANGUAGE FlexibleInstances #-}
 -# LANGUAGE InstanceSigs #-}

  Isabelle.UTF8 (
 setup, setup3,
 Recode (..)
 
 

  qualified System.IO as IO
  Data.Text (Text)
  qualified Data.Text as Text
  qualified Data.Text.Encoding as Encoding
  qualified Data.Text.Encoding.Error as Error

  Data.ByteString (ByteString)

  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)

  :: IO.Handle -> IO ()
  h = do
 IO.hSetEncoding h IO.utf8
 IO.hSetNewlineMode h IO.noNewlineTranslation

  :: IO.Handle -> IO.Handle -> IO.Handle -> IO ()
  h1 h2 h3 = do
 setup h1
 setup h2
 setup h3

  Recode a b where
 encode :: a -> b
 decode :: b -> a

  Recode Text ByteString where
 encode :: Text -> ByteString
 encode = Encoding.encodeUtf8
 decode :: ByteString -> Text
 decode = Encoding.decodeUtf8With Error.lenientDecode

  Recode Text Bytes where
 encode :: Text -> Bytes
 encode = Bytes.make . encode
 decode :: Bytes -> Text
 decode = decode . Bytes.unmake

  Recode String ByteString where
 encode :: String -> ByteString
 encode = encode . Text.pack
 decode :: ByteString -> String
 decode = Text.unpack . decode

  Recode String Bytes where
 encode :: String -> Bytes
 encode = encode . Text.pack
 decode :: Bytes -> String
 decode = Text.unpack . decode
 ›

generate_file "Isabelle/Library.hs" = ‹
 - Title: Isabelle/Library.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  library of Isabelle idioms.

  🍋‹$ISABELLE_HOME/src/Pure/General/basics.ML›
  🍋‹$ISABELLE_HOME/src/Pure/library.ML›.
 }

 -# LANGUAGE OverloadedStrings #-}
 -# LANGUAGE TypeSynonymInstances #-}
 -# LANGUAGE FlexibleInstances #-}
 -# LANGUAGE InstanceSigs #-}

  Isabelle.Library (
 (|>), (|->), (#>), (#->),

 fold, fold_rev, fold_map, single, the_single, singletonM,
 map_index, get_index, separate,

 StringLike, STRING (..), TEXT (..), BYTES (..),
 show_bytes, show_text,

 proper_string, enclose, quote, space_implode, implode_space, commas, commas_quote,
 cat_lines, space_explode, split_lines, trim_line, trim_split_lines,

 getenv, getenv_strict)
 

  System.Environment (lookupEnv)
  Data.Maybe (fromMaybe)
  qualified Data.Text as Text
  Data.Text (Text)
  qualified Data.Text.Lazy as Lazy
  Data.String (IsString)
  qualified Data.List.Split as Split
  qualified Isabelle.Symbol as Symbol
  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)
  qualified Isabelle.UTF8 as UTF8


 - functions -}

 |>) :: a -> (a -> b) -> b
  |> f = f x

 |->) :: (a, b) -> (a -> b -> c) -> c
 x, y) |-> f = f x y

 #>) :: (a -> b) -> (b -> c) -> a -> c
 f #> g) x = x |> f |> g

 #->) :: (a -> (c, b)) -> (c -> b -> d) -> a -> d
 f #-> g) x = x |> f |-> g


 - lists -}

  :: (a -> b -> b) -> [a] -> b -> b
  _ [] y = y
  f (x : xs) y = fold f xs (f x y)

  :: (a -> b -> b) -> [a] -> b -> b
  _ [] y = y
  f (x : xs) y = f x (fold_rev f xs y)

  :: (a -> b -> (c, b)) -> [a] -> b -> ([c], b)
  _ [] y = ([], y)
  f (x : xs) y =
 let
 (x', y') = f x y
 (xs', y'') = fold_map f xs y'
 in (x' : xs', y'')

  :: a -> [a]
  x = [x]

  :: [a] -> a
  [x] = x
  _ = undefined

  :: Monad m => ([a] -> m [b]) -> a -> m b
  f x = the_single 🪙 f [x]

  :: ((Int, a) -> b) -> [a] -> [b]
  f = map_aux 0
 where
 map_aux _ [] = []
 map_aux i (x : xs) = f (i, x) : map_aux (i + 1) xs

  :: (a -> Maybe b) -> [a] -> Maybe (Int, b)
  f = get_aux 0
 where
 get_aux _ [] = Nothing
 get_aux i (x : xs) =
 case f x of
 Nothing -> get_aux (i + 1) xs
 Just y -> Just (i, y)

  :: a -> [a] -> [a]
  s (x : xs@(_ : _)) = x : s : separate s xs
  _ xs = xs;


 - string-like interfaces -}

  (IsString a, Monoid a, Eq a, Ord a) => StringLike a where
 space_explode :: Char -> a -> [a]
 trim_line :: a -> a

  :: Int -> (Int -> Char) -> (Int -> a -> a) -> a -> a
  n at trim s =
 if n >= 2 && at (n - 2) == '\r' && at (n - 1) == '\n' then trim (n - 2) s
 else if n >= 1 && Symbol.is_ascii_line_terminator (at (n - 1)) then trim (n - 1) s
 else s

  StringLike String where
 space_explode :: Char -> String -> [String]
 space_explode c = Split.split (Split.dropDelims (Split.whenElt (== c)))
 trim_line :: String -> String
 trim_line s = gen_trim_line (length s) (s !!) take s

  StringLike Text where
 space_explode :: Char -> Text -> [Text]
 space_explode c str =
 if Text.null str then []
 else if Text.all (/= c) str then [str]
 else map Text.pack $ space_explode c $ Text.unpack str
 trim_line :: Text -> Text
 trim_line s = gen_trim_line (Text.length s) (Text.index s) Text.take s

  StringLike Lazy.Text where
 space_explode :: Char -> Lazy.Text -> [Lazy.Text]
 space_explode c str =
 if Lazy.null str then []
 else if Lazy.all (/= c) str then [str]
 else map Lazy.pack $ space_explode c $ Lazy.unpack str
 trim_line :: Lazy.Text -> Lazy.Text
 trim_line = Lazy.fromStrict . trim_line . Lazy.toStrict

  StringLike Bytes where
 space_explode :: Char -> Bytes -> [Bytes]
 space_explode c str =
 if Bytes.null str then []
 else if Bytes.all_char (/= c) str then [str]
 else
 explode (Bytes.unpack str)
 where
 explode rest =
 case span (/= (Bytes.byte c)) rest of
 (_, []) -> [Bytes.pack rest]
 (prfx, _ : rest') -> Bytes.pack prfx : explode rest'
 trim_line :: Bytes -> Bytes
 trim_line s = gen_trim_line (Bytes.length s) (Bytes.char . Bytes.index s) Bytes.take s

  StringLike a => STRING a where make_string :: a -> String
  STRING String where make_string = id
  STRING Text where make_string = Text.unpack
  STRING Lazy.Text where make_string = Lazy.unpack
  STRING Bytes where make_string = UTF8.decode

  StringLike a => TEXT a where make_text :: a -> Text
  TEXT String where make_text = Text.pack
  TEXT Text where make_text = id
  TEXT Lazy.Text where make_text = Lazy.toStrict
  TEXT Bytes where make_text = UTF8.decode

  StringLike a => BYTES a where make_bytes :: a -> Bytes
  BYTES String where make_bytes = UTF8.encode
  BYTES Text where make_bytes = UTF8.encode
  BYTES Lazy.Text where make_bytes = UTF8.encode . Lazy.toStrict
  BYTES Bytes where make_bytes = id

  :: Show a => a -> Bytes
  = make_bytes . show

  :: Show a => a -> Text
  = make_text . show


 - strings -}

  :: StringLike a => a -> Maybe a
  s = if s == "" then Nothing else Just s

  :: StringLike a => a -> a -> a -> a
  lpar rpar str = lpar <> str <> rpar

  :: StringLike a => a -> a
  = enclose "\"" "\""

  :: StringLike a => a -> [a] -> a
  s = mconcat . separate s

  :: StringLike a => [a] -> a
  = space_implode " "

 , commas_quote :: StringLike a => [a] -> a
  = space_implode ", "
  = commas . map quote

  :: StringLike a => a -> [a]
  = space_explode '\n'

  :: StringLike a => [a] -> a
  = space_implode "\n"

  :: StringLike a => a -> [a]
  = trim_line #> split_lines #> map trim_line


 - getenv -}

  :: Bytes -> IO Bytes
  x = do
 y <- lookupEnv (make_string x)
 return $ make_bytes $ fromMaybe "" y

  :: Bytes -> IO Bytes
  x = do
 y <- getenv x
 if Bytes.null y then
 errorWithoutStackTrace $ make_string ("Undefined Isabelle environment variable: " <> quote x)
 else return y
 ›


generate_file "Isabelle/Symbol.hs" = ‹
 - Title: Isabelle/Symbols.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  text symbols.

  🍋‹$ISABELLE_HOME/src/Pure/General/symbol.ML›
  🍋‹$ISABELLE_HOME/src/Pure/General/symbol_explode.ML›.
 }

 -# LANGUAGE OverloadedStrings #-}

  Isabelle.Symbol (
 Symbol, eof, is_eof, not_eof,

 is_ascii_letter, is_ascii_digit, is_ascii_hex, is_ascii_quasi,
 is_ascii_blank, is_ascii_line_terminator, is_ascii_letdig,
 is_ascii_identifier,

 explode
 
 

  Data.Word (Word8)
  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)


 - type -}

  Symbol = Bytes

  :: Symbol
  = ""

 , not_eof :: Symbol -> Bool
  = Bytes.null
  = not . is_eof


 - ASCII characters -}

  :: Char -> Bool
  c = 'A' <= c && c <= 'Z' || 'a' <= c && c <= 'z'

  :: Char -> Bool
  c = '0' <= c && c <= '9'

  :: Char -> Bool
  c = '0' <= c && c <= '9' || 'A' <= c && c <= 'F' || 'a' <= c && c <= 'f'

  :: Char -> Bool
  c = c == '_' || c == '\''

  :: Char -> Bool
  c = c `elem` (" \t\n\11\f\r" :: String)

  :: Char -> Bool
  c = c == '\r' || c == '\n'

  :: Char -> Bool
  c = is_ascii_letter c || is_ascii_digit c || is_ascii_quasi c

  :: String -> Bool
  s =
 not (null s) && is_ascii_letter (head s) && all is_ascii_letdig s


 - explode symbols: ASCII, UTF8, named -}

  :: Word8 -> Bool
  b = b >= 128

  :: Word8 -> Bool
  b = 128 <= b && b < 192

  :: Word8 -> Bool
  b = 128 <= b && b < 160

 |>) :: a -> (a -> b) -> b
  |> f = f x

  :: Bytes -> [Symbol]
  string = scan 0
 where
 byte = Bytes.index string
 substring i j =
 if i == j - 1 then Bytes.singleton (byte i)
 else Bytes.pack (map byte [i .. j - 1])

 n = Bytes.length string
 test pred i = i < n && pred (byte i)
 test_char pred i = i < n && pred (Bytes.char (byte i))
 many pred i = if test pred i then many pred (i + 1) else i
 maybe_char c i = if test_char (== c) i then i + 1 else i
 maybe_ascii_id i =
 if test_char is_ascii_letter i
 then many (is_ascii_letdig . Bytes.char) (i + 1)
 else i

 scan i =
 if i < n then
 let
 b = byte i
 c = Bytes.char b
 in
 {-encoded newline-}
 if c == '\r' then "\n" : scan (maybe_char '\n' (i + 1))
 {-pseudo utf8: encoded ascii control-}
 else if b == 192 && test is_utf8_control (i + 1) && not (test is_utf8 (i + 2))
 then Bytes.singleton (byte (i + 1) - 128) : scan (i + 2)
 {-utf8-}
 else if is_utf8 b then
 let j = many is_utf8_trailer (i + 1)
 in substring i j : scan j
 {-named symbol-}
 else if c == '\\' && test_char (== '<') (i + 1) then
 let j = (i + 2) |> maybe_char '^' |> maybe_ascii_id |> maybe_char '>'
 in substring i j : scan j
 {-single character-}
 else Bytes.singleton b : scan (i + 1)
 else []
 ›

generate_file "Isabelle/Buffer.hs" = ‹
 - Title: Isabelle/Buffer.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  buffer of byte strings.

  🍋‹$ISABELLE_HOME/src/Pure/General/buffer.ML›.
 }

  Isabelle.Buffer (T, empty, add, content, build, build_content)
 

  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)
  Isabelle.Library


  T = Buffer [Bytes]

  :: T
  = Buffer []

  :: Bytes -> T -> T
  b (Buffer bs) = Buffer (if Bytes.null b then bs else b : bs)

  :: T -> Bytes
  (Buffer bs) = Bytes.concat (reverse bs)

  :: (T -> T) -> T
  f = f empty

  :: (T -> T) -> Bytes
  f = build f |> content
 ›

generate_file "Isabelle/Value.hs" = ‹
 - Title: Isabelle/Value.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  values, represented as string.

  🍋‹$ISABELLE_HOME/src/Pure/General/value.ML›.
 }

 -# LANGUAGE OverloadedStrings #-}

  Isabelle.Value
 (print_bool, parse_bool, parse_nat, print_int, parse_int, print_real, parse_real)
 

  qualified Data.List as List
  qualified Text.Read as Read
  Isabelle.Bytes (Bytes)
  Isabelle.Library


 - bool -}

  :: Bool -> Bytes
  True = "true"
  False = "false"

  :: Bytes -> Maybe Bool
  "true" = Just True
  "false" = Just False
  _ = Nothing


 - nat -}

  :: Bytes -> Maybe Int
  s =
 case Read.readMaybe (make_string s) of
 Just n | n >= 0 -> Just n
 _ -> Nothing


 - int -}

  :: Int -> Bytes
  = show_bytes

  :: Bytes -> Maybe Int
  = Read.readMaybe . make_string


 - real -}

  :: Double -> Bytes
  x =
 let s = show x in
 case span (/= '.') s of
 (a, '.' : b) | List.all (== '0') b -> make_bytes a
 _ -> make_bytes s

  :: Bytes -> Maybe Double
  = Read.readMaybe . make_string
 ›

generate_file "Isabelle/Properties.hs" = ‹
 - Title: Isabelle/Properties.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  lists.

  🍋‹$ISABELLE_HOME/src/Pure/General/properties.ML›.
 }

  Isabelle.Properties (Entry, T, defined, get, get_value, put, remove)
 

  qualified Data.List as List
  Isabelle.Bytes (Bytes)


  Entry = (Bytes, Bytes)
  T = [Entry]

  :: T -> Bytes -> Bool
  props name = any (\(a, _) -> a == name) props

  :: T -> Bytes -> Maybe Bytes
  props name = List.lookup name props

  :: (Bytes -> Maybe a) -> T -> Bytes -> Maybe a
  parse props name = maybe Nothing parse (get props name)

  :: Entry -> T -> T
  entry props = entry : remove (fst entry) props

  :: Bytes -> T -> T
  name props =
 if defined props name then filter (\(a, _) -> a /= name) props
 else props
 ›

generate_file "Isabelle/Markup.hs" = ‹
 - Title: Isabelle/Markup.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

 -abstract markup elements.

  🍋‹$ISABELLE_HOME/src/Pure/PIDE/markup.ML›.
 }

 -# LANGUAGE OverloadedStrings #-}
 -# OPTIONS_GHC -fno-warn-missing-signatures #-}

  Isabelle.Markup (
 T, empty, is_empty, properties,

 nameN, name, xnameN, xname, kindN,

 bindingN, binding, entityN, entity, defN, refN,

 completionN, completion, no_completionN, no_completion,

 lineN, end_lineN, offsetN, end_offsetN, labelN, fileN, idN, positionN, position,
 position_properties, def_name,

 expressionN, expression,

 pathN, path, urlN, url, docN, doc,

 markupN, consistentN, unbreakableN, indentN, widthN,
 blockN, block, breakN, break, fbreakN, fbreak, itemN, item,

 wordsN, words,

 tfreeN, tfree, tvarN, tvar, freeN, free, skolemN, skolem, boundN, bound, varN, var,
 numeralN, numeral, literalN, literal, delimiterN, delimiter, inner_stringN, inner_string,
 inner_cartoucheN, inner_cartouche,
 token_rangeN, token_range,
 sortingN, sorting, typingN, typing, class_parameterN, class_parameter,

 antiquotedN, antiquoted, antiquoteN, antiquote,

 paragraphN, paragraph, text_foldN, text_fold,

 keyword1N, keyword1, keyword2N, keyword2, keyword3N, keyword3, quasi_keywordN, quasi_keyword,
 improperN, improper, operatorN, operator, stringN, string, alt_stringN, alt_string,
 verbatimN, verbatim, cartoucheN, cartouche, commentN, comment, comment1N, comment1,
 comment2N, comment2, comment3N, comment3,

 forkedN, forked, joinedN, joined, runningN, running, finishedN, finished,
 failedN, failed, canceledN, canceled, initializedN, initialized, finalizedN, finalized,
 consolidatingN, consolidating, consolidatedN, consolidated,

 writelnN, writeln, stateN, state, informationN, information, tracingN, tracing,
 warningN, warning, legacyN, legacy, errorN, error, reportN, report, no_reportN, no_report,

 intensifyN, intensify,
 Output, no_output)
 

  Prelude hiding (words, error, break)
  Data.Map.Strict (Map)
  qualified Data.Map.Strict as Map

  Isabelle.Library
  qualified Isabelle.Properties as Properties
  qualified Isabelle.Value as Value
  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)


 - basic markup -}

  T = (Bytes, Properties.T)

  :: T
  = ("", [])

  :: T -> Bool
  ("", _) = True
  _ = False

  :: Properties.T -> T -> T
  more_props (elem, props) =
 (elem, fold_rev Properties.put more_props props)

  :: Bytes -> T
  name = (name, [])

  :: Bytes -> Bytes -> Bytes -> T
  name prop = \s -> (name, [(prop, s)])


 - misc properties -}

  :: Bytes
  = ‹Markup.nameN›

  :: Bytes -> T -> T
  a = properties [(nameN, a)]

  :: Bytes
  = ‹Markup.xnameN›

  :: Bytes -> T -> T
  a = properties [(xnameN, a)]

  :: Bytes
  = ‹Markup.kindN›


 - formal entities -}

  :: Bytes
  = ‹Markup.bindingN›
  :: T
  = markup_elem bindingN

  :: Bytes
  = ‹Markup.entityN›
  :: Bytes -> Bytes -> T
  kind name =
 (entityN,
java.lang.NullPointerException: Cannot invoke "String.equals(Object)" because "brackoff" is null
 (if Bytes.null kind then [] else [(kindN, kind)]))

  :: Bytes
  = ‹Markup.defN›

  :: Bytes
  = ‹Markup.refN›


 - completion -}

  :: Bytes
  = ‹Markup.completionN›
  :: T
  = markup_elem completionN

  :: Bytes
  = ‹Markup.no_completionN›
  :: T
  = markup_elem no_completionN


 - position -}

 , end_lineN :: Bytes
  = ‹Markup.lineN›
  = ‹Markup.end_lineN›

 , end_offsetN :: Bytes
  = ‹Markup.offsetN›
  = ‹Markup.end_offsetN›

 , fileN, idN :: Bytes
  = ‹Markup.labelN›
  = ‹Markup.fileN›
  = ‹Markup.idN›

  :: Bytes
  = ‹Markup.positionN›
  :: T
  = markup_elem positionN

  :: [Bytes]
  = [lineN, offsetN, end_offsetN, labelN, fileN, idN]


 - position "def" names -}

  :: Bytes -> Bytes
  a = "def_" <> a

  :: Map Bytes Bytes
  = Map.fromList $ map (\a -> (a, make_def a)) position_properties

  :: Bytes -> Bytes
  a =
 case Map.lookup a def_names of
 Just b -> b
 Nothing -> make_def a


 - expression -}

  :: Bytes
  = ‹Markup.expressionN›

  :: Bytes -> T
  kind = (expressionN, if kind == "" then [] else [(kindN, kind)])


 - external resources -}

  :: Bytes
  = ‹Markup.pathN›
  :: Bytes -> T
  = markup_string pathN nameN

  :: Bytes
  = ‹Markup.urlN›
  :: Bytes -> T
  = markup_string urlN nameN

  :: Bytes
  = ‹Markup.docN›
  :: Bytes -> T
  = markup_string docN nameN


 - pretty printing -}

 , consistentN, unbreakableN, indentN :: Bytes
  = ‹Markup.markupN›
  = ‹Markup.consistentN›
  = ‹Markup.unbreakableN›
  = ‹Markup.indentN›

  :: Bytes
  = ‹Markup.widthN›

  :: Bytes
  = ‹Markup.blockN›
  :: Bool -> Int -> T
  c i =
 (blockN,
java.lang.NullPointerException: Cannot invoke "String.equals(Object)" because "brackoff" is null
 (if i /= 0 then [(indentN, Value.print_int i)] else []))

  :: Bytes
  = ‹Markup.breakN›
  :: Int -> Int -> T
  w i =
 (breakN,
java.lang.NullPointerException: Cannot invoke "String.equals(Object)" because "brackoff" is null
 (if i /= 0 then [(indentN, Value.print_int i)] else []))

  :: Bytes
  = ‹Markup.fbreakN›
  :: T
  = markup_elem fbreakN

  :: Bytes
  = ‹Markup.itemN›
  :: T
  = markup_elem itemN


 - text properties -}

  :: Bytes
  = ‹Markup.wordsN›
  :: T
  = markup_elem wordsN


 - inner syntax -}

  :: Bytes
  = ‹Markup.tfreeN›
  :: T
  = markup_elem tfreeN

  :: Bytes
  = ‹Markup.tvarN›
  :: T
  = markup_elem tvarN

  :: Bytes
  = ‹Markup.freeN›
  :: T
  = markup_elem freeN

  :: Bytes
  = ‹Markup.skolemN›
  :: T
  = markup_elem skolemN

  :: Bytes
  = ‹Markup.boundN›
  :: T
  = markup_elem boundN

  :: Bytes
  = ‹Markup.varN›
  :: T
  = markup_elem varN

  :: Bytes
  = ‹Markup.numeralN›
  :: T
  = markup_elem numeralN

  :: Bytes
  = ‹Markup.literalN›
  :: T
  = markup_elem literalN

  :: Bytes
  = ‹Markup.delimiterN›
  :: T
  = markup_elem delimiterN

  :: Bytes
  = ‹Markup.inner_stringN›
  :: T
  = markup_elem inner_stringN

  :: Bytes
  = ‹Markup.inner_cartoucheN›
  :: T
  = markup_elem inner_cartoucheN


  :: Bytes
  = ‹Markup.token_rangeN›
  :: T
  = markup_elem token_rangeN


  :: Bytes
  = ‹Markup.sortingN›
  :: T
  = markup_elem sortingN

  :: Bytes
  = ‹Markup.typingN›
  :: T
  = markup_elem typingN

  :: Bytes
  = ‹Markup.class_parameterN›
  :: T
  = markup_elem class_parameterN


 - antiquotations -}

  :: Bytes
  = ‹Markup.antiquotedN›
  :: T
  = markup_elem antiquotedN

  :: Bytes
  = ‹Markup.antiquoteN›
  :: T
  = markup_elem antiquoteN


 - text structure -}

  :: Bytes
  = ‹Markup.paragraphN›
  :: T
  = markup_elem paragraphN

  :: Bytes
  = ‹Markup.text_foldN›
  :: T
  = markup_elem text_foldN


 - outer syntax -}

  :: Bytes
  = ‹Markup.keyword1N›
  :: T
  = markup_elem keyword1N

  :: Bytes
  = ‹Markup.keyword2N›
  :: T
  = markup_elem keyword2N

  :: Bytes
  = ‹Markup.keyword3N›
  :: T
  = markup_elem keyword3N

  :: Bytes
  = ‹Markup.quasi_keywordN›
  :: T
  = markup_elem quasi_keywordN

  :: Bytes
  = ‹Markup.improperN›
  :: T
  = markup_elem improperN

  :: Bytes
  = ‹Markup.operatorN›
  :: T
  = markup_elem operatorN

  :: Bytes
  = ‹Markup.stringN›
  :: T
  = markup_elem stringN

  :: Bytes
  = ‹Markup.alt_stringN›
  :: T
  = markup_elem alt_stringN

  :: Bytes
  = ‹Markup.verbatimN›
  :: T
  = markup_elem verbatimN

  :: Bytes
  = ‹Markup.cartoucheN›
  :: T
  = markup_elem cartoucheN

  :: Bytes
  = ‹Markup.commentN›
  :: T
  = markup_elem commentN


 - comments -}

  :: Bytes
  = ‹Markup.comment1N›
  :: T
  = markup_elem comment1N

  :: Bytes
  = ‹Markup.comment2N›
  :: T
  = markup_elem comment2N

  :: Bytes
  = ‹Markup.comment3N›
  :: T
  = markup_elem comment3N


 - command status -}

 , joinedN, runningN, finishedN, failedN, canceledN,
 initializedN, finalizedN, consolidatingN, consolidatedN :: Bytes
  = ‹Markup.forkedN›
  = ‹Markup.joinedN›
  = ‹Markup.runningN›
  = ‹Markup.finishedN›
  = ‹Markup.failedN›
  = ‹Markup.canceledN›
  = ‹Markup.initializedN›
  = ‹Markup.finalizedN›
  = ‹Markup.consolidatingN›
  = ‹Markup.consolidatedN›

 , joined, running, finished, failed, canceled,
 initialized, finalized, consolidating, consolidated :: T
  = markup_elem forkedN
  = markup_elem joinedN
  = markup_elem runningN
  = markup_elem finishedN
  = markup_elem failedN
  = markup_elem canceledN
  = markup_elem initializedN
  = markup_elem finalizedN
  = markup_elem consolidatingN
  = markup_elem consolidatedN


 - messages -}

  :: Bytes
  = ‹Markup.writelnN›
  :: T
  = markup_elem writelnN

  :: Bytes
  = ‹Markup.stateN›
  :: T
  = markup_elem stateN

  :: Bytes
  = ‹Markup.informationN›
  :: T
  = markup_elem informationN

  :: Bytes
  = ‹Markup.tracingN›
  :: T
  = markup_elem tracingN

  :: Bytes
  = ‹Markup.warningN›
  :: T
  = markup_elem warningN

  :: Bytes
  = ‹Markup.legacyN›
  :: T
  = markup_elem legacyN

  :: Bytes
  = ‹Markup.errorN›
  :: T
  = markup_elem errorN

  :: Bytes
  = ‹Markup.reportN›
  :: T
  = markup_elem reportN

  :: Bytes
  = ‹Markup.no_reportN›
  :: T
  = markup_elem no_reportN

  :: Bytes
  = ‹Markup.intensifyN›
  :: T
  = markup_elem intensifyN


 - output -}

  Output = (Bytes, Bytes)

  :: Output
  = ("", "")
 ›

generate_file "Isabelle/Position.hs" = ‹
 - Title: Isabelle/Position.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  positions starting from 1; values <= 0 mean "absent". Count Isabelle
 , not UTF8 bytes nor UTF16 characters. Position range specifies a
 -open interval offset .. end_offset (exclusive).

  🍋‹$ISABELLE_HOME/src/Pure/General/position.ML›.
 }

 -# LANGUAGE OverloadedStrings #-}

  Isabelle.Position (
 T, line_of, column_of, offset_of, end_offset_of, label_of, file_of, id_of,
 start, none, label, put_file, file, file_only, put_id, id, id_only,
 symbol, symbol_explode, symbol_explode_string, shift_offsets,
 of_properties, properties_of, def_properties_of, entity_markup, make_entity_markup,
 Report, Report_Text, is_reported, is_reported_range, here,
 Range, no_range, no_range_position, range_position, range
 
 

  Prelude hiding (id)
  Data.Maybe (isJust, fromMaybe)
  Data.Bifunctor (first)
  qualified Isabelle.Properties as Properties
  qualified Isabelle.Bytes as Bytes
  qualified Isabelle.Value as Value
  Isabelle.Bytes (Bytes)
  qualified Isabelle.Markup as Markup
  qualified Isabelle.YXML as YXML
  Isabelle.Library
  qualified Isabelle.Symbol as Symbol
  Isabelle.Symbol (Symbol)


 - position -}

  T =
 Position {
 _line :: Int,
 _column :: Int,
 _offset :: Int,
 _end_offset :: Int,
 _label :: Bytes,
 _file :: Bytes,
 _id :: Bytes }
 deriving (Eq, Ord)

 , invalid :: Int -> Bool
  i = i > 0
  = not . valid

  :: Int -> Maybe Int
  i = if valid i then Just i else Nothing

  :: Int -> Int -> Int
  i i' = if valid i then i' else i


 - fields -}

 , column_of, offset_of, end_offset_of :: T -> Maybe Int
  = maybe_valid . _line
  = maybe_valid . _column
  = maybe_valid . _offset
  = maybe_valid . _end_offset

  :: T -> Maybe Bytes
  = proper_string . _label

  :: T -> Maybe Bytes
  = proper_string . _file

  :: T -> Maybe Bytes
  = proper_string . _id


 - make position -}

  :: T
  = Position 1 1 1 0 Bytes.empty Bytes.empty Bytes.empty

  :: T
  = Position 0 0 0 0 Bytes.empty Bytes.empty Bytes.empty

  :: Bytes -> T -> T
  label pos = pos { _label = label }

  :: Bytes -> T -> T
  file pos = pos { _file = file }

  :: Bytes -> T
  file = put_file file start

  :: Bytes -> T
  file = put_file file none

  :: Bytes -> T -> T
  id pos = pos { _id = id }

  :: Bytes -> T
  id = put_id id start

  :: Bytes -> T
  id = put_id id none


 - count position -}

  :: Symbol -> Int -> Int
  "\n" line = if_valid line (line + 1)
  _ line = line

  :: Symbol -> Int -> Int
  "\n" column = if_valid column 1
  s column = if Symbol.not_eof s then if_valid column (column + 1) else column

  :: Symbol -> Int -> Int
  s offset = if Symbol.not_eof s then if_valid offset (offset + 1) else offset

  :: Symbol -> T -> T
  s pos =
 pos {
 _line = count_line s (_line pos),
 _column = count_column s (_column pos),
 _offset = count_offset s (_offset pos) }

  :: BYTES a => a -> T -> T
  = fold symbol . Symbol.explode . make_bytes

  :: String -> T -> T
  = symbol_explode


 - shift offsets -}

  :: Int -> T -> T
  shift pos = pos { _offset = offset', _end_offset = end_offset' }
 where
 offset = _offset pos
 end_offset = _end_offset pos
 offset' = if invalid offset || invalid shift then offset else offset + shift
 end_offset' = if invalid end_offset || invalid shift then end_offset else end_offset + shift


 - markup properties -}

  :: Properties.T -> Bytes -> Bytes
  props name = fromMaybe "" (Properties.get_value Just props name)

  :: Properties.T -> Bytes -> Int
  props name = fromMaybe 0 (Properties.get_value Value.parse_int props name)

  :: Properties.T -> T
  props =
 none {
 _line = get_int props Markup.lineN,
 _offset = get_int props Markup.offsetN,
 _end_offset = get_int props Markup.end_offsetN,
 _label = get_string props Markup.labelN,
 _file = get_string props Markup.fileN,
 _id = get_string props Markup.idN }

  :: Bytes -> Bytes -> Properties.T
  k s = if Bytes.null s then [] else [(k, s)]

  :: Bytes -> Int -> Properties.T
  k i = if invalid i then [] else [(k, Value.print_int i)]

  :: T -> Properties.T
  pos =
 int_entry Markup.lineN (_line pos) ++
 int_entry Markup.offsetN (_offset pos) ++
 int_entry Markup.end_offsetN (_end_offset pos) ++
 string_entry Markup.labelN (_label pos) ++
 string_entry Markup.fileN (_file pos) ++
 string_entry Markup.idN (_id pos)

  :: T -> Properties.T
  = properties_of #> map (first Markup.def_name)

  :: Bytes -> (Bytes, T) -> Markup.T
  kind (name, pos) =
 Markup.entity kind name |> Markup.properties (def_properties_of pos)

  :: Bool -> Int -> Bytes -> (Bytes, T) -> Markup.T
  def serial kind (name, pos) =
 let
 props =
 if def then (Markup.defN, Value.print_int serial) : properties_of pos
 else (Markup.refN, Value.print_int serial) : def_properties_of pos
 in Markup.entity kind name |> Markup.properties props


 - reports -}

  Report = (T, Markup.T)
  Report_Text = (Report, Bytes)

  :: T -> Bool
  pos = isJust (offset_of pos) && isJust (id_of pos)

  :: T -> Bool
  pos = is_reported pos && isJust (end_offset_of pos)


 - here: user output -}

  :: T -> Bytes
  pos = if Bytes.null s2 then "" else s1 <> m1 <> s2 <> m2
 where
 props = properties_of pos
 (m1, m2) = YXML.output_markup (Markup.properties props Markup.position)
 (s1, s2) =
 case (line_of pos, file_of pos) of
 (Just i, Nothing) -> (" ", "(line " <> Value.print_int i <> ")")
 (Just i, Just name) -> (" ", "(line " <> Value.print_int i <> " of " <> quote name <> ")")
 (Nothing, Just name) -> (" ", "(file " <> quote name <> ")")
 _ -> if is_reported pos then ("", "\092🍋") else ("", "")


 - range -}

  Range = (T, T)

  :: Range
  = (none, none)

  :: T -> T
  pos = pos { _end_offset = 0 }

  :: Range -> T
  (pos, pos') = pos { _end_offset = _offset pos' }

  :: Range -> Range
  (pos, pos') = (range_position (pos, pos'), no_range_position pos')
 ›

generate_file "Isabelle/XML.hs" = ‹
 - Title: Isabelle/XML.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  XML trees and representation of ML values.

  🍋‹$ISABELLE_HOME/src/Pure/PIDE/xml.ML›.
 }

 -# LANGUAGE OverloadedStrings #-}
 -# OPTIONS_GHC -fno-warn-missing-signatures #-}

  Isabelle.XML (Attributes, Body, Tree(..), wrap_elem, unwrap_elem, content_of)
 

  Isabelle.Library
  qualified Isabelle.Properties as Properties
  qualified Isabelle.Markup as Markup
  qualified Isabelle.Buffer as Buffer
  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)


 - types -}

  Attributes = Properties.T
  Body = [Tree]
  Tree = Elem (Markup.T, Body) | Text Bytes


 - wrapped elements -}

  :: ((Markup.T, Body), [Tree]) -> Tree
  (((a, atts), body1), body2) =
 Elem ((‹XML.xml_elemN›, (‹XML.xml_nameN›, a) : atts), Elem ((‹XML.xml_bodyN›, []), body1) : body2)

  :: Tree -> Maybe ((Markup.T, Body), [Tree])
 
 (Elem ((‹XML.xml_elemN›, (‹XML.xml_nameN›, a) : atts), Elem ((‹XML.xml_bodyN›, []), body1) : body2)) =
 Just (((a, atts), body1), body2)
  _ = Nothing


 - text content -}

  :: Tree -> Buffer.T -> Buffer.T
  tree =
 case unwrap_elem tree of
 Just (_, ts) -> fold add_content ts
 Nothing ->
 case tree of
 Elem (_, ts) -> fold add_content ts
 Text s -> Buffer.add s

  :: Body -> Bytes
  = Buffer.build_content . fold add_content


 - string representation -}

  :: Char -> String
  '<' = "<"
  '>' = ">"
  '&' = "&"
  '\'' = "'"
  '\"' = """
  c = [c]

  :: Bytes -> Bytes
  = make_bytes . concatMap (encode_char . Bytes.char) . Bytes.unpack

  Show Tree where
 show tree =
 make_string $ Buffer.build_content (show_tree tree)
 where
 show_tree (Elem ((name, atts), [])) =
 Buffer.add "<" #> Buffer.add (show_elem name atts) #> Buffer.add "/>"
 show_tree (Elem ((name, atts), ts)) =
 Buffer.add "<" #> Buffer.add (show_elem name atts) #> Buffer.add ">" #>
 fold show_tree ts #>
 Buffer.add "</" #> Buffer.add name #> Buffer.add ">"
 show_tree (Text s) = Buffer.add (encode_text s)

 show_elem name atts =
 implode_space (name : map (\(a, x) -> a <> "=\"" <> encode_text x <> "\"") atts)
 ›

generate_file "Isabelle/XML/Encode.hs" = ‹
 - Title: Isabelle/XML/Encode.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  as data representation language.

  🍋‹$ISABELLE_HOME/src/Pure/PIDE/xml.ML›.
 }

 -# LANGUAGE OverloadedStrings #-}
 -# OPTIONS_GHC -fno-warn-missing-signatures #-}

  Isabelle.XML.Encode (
 A, T, V, P,

 int_atom, bool_atom, unit_atom,

 tree, properties, string, int, bool, unit, pair, triple, list, option, variant
 
 

  Data.Maybe (fromJust)

  Isabelle.Library
  Isabelle.Bytes (Bytes)
  qualified Isabelle.Value as Value
  qualified Isabelle.Properties as Properties
  qualified Isabelle.XML as XML


  A a = a -> Bytes
  T a = a -> XML.Body
  V a = a -> Maybe ([Bytes], XML.Body)
  P a = a -> [Bytes]


 - atomic values

  :: A Int
  = Value.print_int

  :: A Bool
  False = "0"
  True = "1"

  :: A ()
  () = ""


 - structural nodes

  ts = XML.Elem ((":", []), ts)

  = map_index (\(i, x) -> (int_atom i, x))

  (tag, (xs, ts)) = XML.Elem ((int_atom tag, vector xs), ts)


 - representation of standard types

  :: T XML.Tree
  t = [t]

  :: T Properties.T
  props = [XML.Elem ((":", props), [])]

  :: T Bytes
  "" = []
  s = [XML.Text s]

  :: T Int
  = string . int_atom

  :: T Bool
  = string . bool_atom

  :: T ()
  = string . unit_atom

  :: T a -> T b -> T (a, b)
  f g (x, y) = [node (f x), node (g y)]

  :: T a -> T b -> T c -> T (a, b, c)
  f g h (x, y, z) = [node (f x), node (g y), node (h z)]

  :: T a -> T [a]
  f xs = map (node . f) xs

  :: T a -> T (Maybe a)
  _ Nothing = []
  f (Just x) = [node (f x)]

  :: [V a] -> T a
  fs x = [tagged (fromJust (get_index (\f -> f x) fs))]
 ›

generate_file "Isabelle/XML/Decode.hs" = ‹
 - Title: Isabelle/XML/Decode.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  as data representation language.

  🍋‹$ISABELLE_HOME/src/Pure/PIDE/xml.ML›.
 }

 -# LANGUAGE OverloadedStrings #-}
 -# OPTIONS_GHC -fno-warn-missing-signatures #-}

  Isabelle.XML.Decode (
 A, T, V, P,

 int_atom, bool_atom, unit_atom,

 tree, properties, string, int, bool, unit, pair, triple, list, option, variant
 
 

  Isabelle.Library
  Isabelle.Bytes (Bytes)
  qualified Isabelle.Value as Value
  qualified Isabelle.Properties as Properties
  qualified Isabelle.XML as XML


  A a = Bytes -> a
  T a = XML.Body -> a
  V a = ([Bytes], XML.Body) -> a
  P a = [Bytes] -> a

  = error "Malformed XML atom"
  = error "Malformed XML body"


 - atomic values -}

  :: A Int
  s =
 case Value.parse_int s of
 Just i -> i
 Nothing -> err_atom

  :: A Bool
  "0" = False
  "1" = True
  _ = err_atom

  :: A ()
  "" = ()
  _ = err_atom


 - structural nodes -}

  (XML.Elem ((":", []), ts)) = ts
  _ = err_body

  atts =
 map_index (\(i, (a, x)) -> if int_atom a == i then x else err_atom) atts

  (XML.Elem ((name, atts), ts)) = (int_atom name, (vector atts, ts))
  _ = err_body


 - representation of standard types -}

  :: T XML.Tree
  [t] = t
  _ = err_body

  :: T Properties.T
  [XML.Elem ((":", props), [])] = props
  _ = err_body

  :: T Bytes
  [] = ""
  [XML.Text s] = s
  _ = err_body

  :: T Int
  = int_atom . string

  :: T Bool
  = bool_atom . string

  :: T ()
  = unit_atom . string

  :: T a -> T b -> T (a, b)
  f g [t1, t2] = (f (node t1), g (node t2))
  _ _ _ = err_body

  :: T a -> T b -> T c -> T (a, b, c)
  f g h [t1, t2, t3] = (f (node t1), g (node t2), h (node t3))
  _ _ _ _ = err_body

  :: T a -> T [a]
  f ts = map (f . node) ts

  :: T a -> T (Maybe a)
  _ [] = Nothing
  f [t] = Just (f (node t))
  _ _ = err_body

  :: [V a] -> T a
  fs [t] = (fs !! tag) (xs, ts)
 where (tag, (xs, ts)) = tagged t
  _ _ = err_body
 ›

generate_file "Isabelle/YXML.hs" = ‹
 - Title: Isabelle/YXML.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  text representation of XML trees. Suitable for direct
  into plain text.

  🍋‹$ISABELLE_HOME/src/Pure/PIDE/yxml.ML›.
 }

 -# LANGUAGE OverloadedStrings #-}
 -# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-incomplete-patterns #-}

  Isabelle.YXML (charX, charY, strX, strY, detect, output_markup,
 buffer_body, buffer, string_of_body, string_of, parse_body, parse)
 

  qualified Data.List as List
  Data.Word (Word8)

  Isabelle.Library
  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)
  qualified Isabelle.Markup as Markup
  qualified Isabelle.XML as XML
  qualified Isabelle.Buffer as Buffer


 - markers -}

 , charY :: Word8
  = 5
  = 6

 , strY, strXY, strXYX :: Bytes
  = Bytes.singleton charX
  = Bytes.singleton charY
  = strX <> strY
  = strXY <> strX

  :: Bytes -> Bool
  = Bytes.any (\c -> c == charX || c == charY)


 - output -}

  :: Markup.T -> Markup.Output
  markup@(name, atts) =
 if Markup.is_empty markup then Markup.no_output
 else (strXY <> name <> Bytes.concat (map (\(a, x) -> strY <> a <> "=" <> x) atts) <> strX, strXYX)

  (a, x) =
 Buffer.add strY #> Buffer.add a #> Buffer.add "=" #> Buffer.add x

  :: XML.Body -> Buffer.T -> Buffer.T
  = fold buffer

  :: XML.Tree -> Buffer.T -> Buffer.T
  (XML.Elem ((name, atts), ts)) =
 Buffer.add strXY #> Buffer.add name #> fold buffer_attrib atts #> Buffer.add strX #>
 buffer_body ts #>
 Buffer.add strXYX
  (XML.Text s) = Buffer.add s

  :: XML.Body -> Bytes
  = Buffer.build_content . buffer_body

  :: XML.Tree -> Bytes
  = string_of_body . single


 - parse -}

 - split: fields or non-empty tokens

  :: Bool -> Word8 -> [Word8] -> [[Word8]]
  _ _ [] = []
  fields sep str = splitting str
 where
 splitting rest =
 case span (/= sep) rest of
 (_, []) -> cons rest []
 (prfx, _ : rest') -> cons prfx (splitting rest')
 cons item = if fields || not (null item) then (:) item else id


 - structural errors

  :: Bytes -> a
  msg = error (make_string ("Malformed YXML: " <> msg))

  = err "bad attribute"
  = err "bad element"

  :: Bytes -> a
  name =
 if Bytes.null name then err "unbalanced element"
 else err ("unbalanced element " <> quote name)


 - stack operations

  x ((elem, body) : pending) = (elem, x : body) : pending

  name atts pending =
 if Bytes.null name then err_element
 else ((name, atts), []) : pending

  (((name, atts), body) : pending) =
 if Bytes.null name then err_unbalanced name
 else add (XML.Elem ((name, atts), reverse body)) pending


 - parsing

  s =
 case List.elemIndex (Bytes.byte '=') s of
 Just i | i > 0 -> (Bytes.pack $ take i s, Bytes.pack $ drop (i + 1) s)
 _ -> err_attribute

  [[], []] = pop
  ([] : name : atts) = push (Bytes.pack name) (map parse_attrib atts)
  txts = fold (add . XML.Text . Bytes.pack) txts

  :: Bytes -> XML.Body
  source =
 case fold parse_chunk chunks [((Bytes.empty, []), [])] of
 [((name, _), result)] | Bytes.null name -> reverse result
 ((name, _), _) : _ -> err_unbalanced name
 where chunks = source |> Bytes.unpack |> split False charX |> map (split True charY)

  :: Bytes -> XML.Tree
  source =
 case parse_body source of
 [result] -> result
 [] -> XML.Text ""
 _ -> err "multiple results"
 ›

generate_file "Isabelle/Completion.hs" = ‹
 - Title: Isabelle/Completion.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  of names.

  🍋‹$ISABELLE_HOME/src/Pure/General/completion.ML›.
 }

 -# LANGUAGE OverloadedStrings #-}

  Isabelle.Completion (
 Name, T, names, none, make, markup_element, markup_report, make_report
 ) where

  qualified Isabelle.Bytes as Bytes
  qualified Isabelle.Name as Name
  Isabelle.Name (Name)
  qualified Isabelle.Properties as Properties
  qualified Isabelle.Markup as Markup
  Isabelle.XML.Classes
  qualified Isabelle.XML as XML
  qualified Isabelle.YXML as YXML


  Names = [(Name, (Name, Name))] -- external name, kind, internal name
  T = Completion Properties.T Int Names -- position, total length, names

  :: Int -> Properties.T -> Names -> T
  limit props names = Completion props (length names) (take limit names)

  :: T
  = names 0 [] []

  :: Int -> (Name, Properties.T) -> ((Name -> Bool) -> Names) -> T
  limit (name, props) make_names =
 if name /= "" && name /= "_" then
 names limit props (make_names (Bytes.isPrefixOf (Name.clean name)))
 else none

  :: T -> (Markup.T, XML.Body)
  (Completion props total names) =
 if not (null names) then
 (Markup.properties props Markup.completion, encode (total, names))
 else (Markup.empty, [])

  :: [T] -> Name
  [] = Bytes.empty
  elems =
 YXML.string_of $ XML.Elem (Markup.report, map (XML.Elem . markup_element) elems)

  :: Int -> (Name, Properties.T) -> ((Name -> Bool) -> Names) -> Name
  limit name_props make_names =
 markup_report [make limit name_props make_names]
 ›

generate_file "Isabelle/File.hs" = ‹
 - Title: Isabelle/File.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

 -system operations.

  🍋‹$ISABELLE_HOME/src/Pure/General/file.ML›.
 }

  Isabelle.File (read, write, append) where

  Prelude hiding (read)
  qualified System.IO as IO
  qualified Data.ByteString as ByteString
  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)

  :: IO.FilePath -> IO Bytes
  path = Bytes.make 🪙 IO.withFile path IO.ReadMode ByteString.hGetContents

  :: IO.FilePath -> Bytes -> IO ()
  path bs = IO.withFile path IO.WriteMode (\h -> ByteString.hPut h (Bytes.unmake bs))

  :: IO.FilePath -> Bytes -> IO ()
  path bs = IO.withFile path IO.AppendMode (\h -> ByteString.hPut h (Bytes.unmake bs))
 ›

generate_file "Isabelle/Pretty.hs" = ‹
 - Title: Isabelle/Pretty.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  pretty printing module.

  🍋‹$ISABELLE_HOME/src/Pure/General/pretty.ML›.
 }

 -# LANGUAGE OverloadedStrings #-}
 -# OPTIONS_GHC -fno-warn-missing-signatures #-}

  Isabelle.Pretty (
 T, symbolic, formatted, unformatted,

 str, brk_indent, brk, fbrk, breaks, fbreaks, blk, block, strs, markup, mark, mark_str, marks_str,
 item, text_fold, keyword1, keyword2, text, paragraph, para, quote, cartouche, separate,
 commas, enclose, enum, list, str_list, big_list)
 

  qualified Data.List as List

  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)
  Isabelle.Library hiding (enclose, quote, separate, commas)
  qualified Isabelle.Buffer as Buffer
  qualified Isabelle.Markup as Markup
  qualified Isabelle.XML as XML
  qualified Isabelle.YXML as YXML


  T =
 Block Markup.T Bool Int [T]
 | Break Int Int
 | Str Bytes


 - output -}

  s = if Bytes.null s then [] else [XML.Text s]

  markup body =
 if Markup.is_empty markup then body
 else [XML.Elem (markup, body)]

  :: T -> XML.Body
  (Block markup consistent indent prts) =
 concatMap symbolic prts
 |> symbolic_markup block_markup
 |> symbolic_markup markup
 where block_markup = if null prts then Markup.empty else Markup.block consistent indent
  (Break wd ind) = [XML.Elem (Markup.break wd ind, symbolic_text (Bytes.spaces wd))]
  (Str s) = symbolic_text s

  :: T -> Bytes
  = YXML.string_of_body . symbolic

  :: T -> Bytes
  = Buffer.build_content . out
 where
 out (Block markup _ _ prts) =
 let (bg, en) = YXML.output_markup markup
 in Buffer.add bg #> fold out prts #> Buffer.add en
 out (Break _ wd) = Buffer.add (Bytes.spaces wd)
 out (Str s) = Buffer.add s


 - derived operations to create formatting expressions -}

  n | n < 0 = 0
  n = n

  :: BYTES a => a -> T
  = Str . make_bytes

  :: Int -> Int -> T
  wd ind = Break (force_nat wd) ind

  :: Int -> T
  wd = brk_indent wd 0

  :: T
  = Str "\n"

 , fbreaks :: [T] -> [T]
  = List.intersperse (brk 1)
  = List.intersperse fbrk

  :: (Int, [T]) -> T
  (indent, es) = Block Markup.empty False (force_nat indent) es

  :: [T] -> T
  prts = blk (2, prts)

  :: BYTES a => [a] -> T
  = block . breaks . map str

  :: Markup.T -> [T] -> T
  m = Block m False 0

  :: Markup.T -> T -> T
  m prt = if m == Markup.empty then prt else markup m [prt]

  :: BYTES a => (Markup.T, a) -> T
  (m, s) = mark m (str s)

  :: BYTES a => ([Markup.T], a) -> T
  (ms, s) = fold_rev mark ms (str s)

  :: [T] -> T
  = markup Markup.item

  :: [T] -> T
  = markup Markup.text_fold

 , keyword2 :: BYTES a => a -> T
  name = mark_str (Markup.keyword1, name)
  name = mark_str (Markup.keyword2, name)

  :: BYTES a => a -> [T]
  = breaks . map str . filter (not . Bytes.null) . space_explode ' ' . make_bytes

  :: [T] -> T
  = markup Markup.paragraph

  :: BYTES a => a -> T
  = paragraph . text

  :: T -> T
  prt = blk (1, [Str "\"", prt, Str "\""])

  :: T -> T
  prt = blk (1, [Str "\92‹", prt, Str "\92›"])

  :: BYTES a => a -> [T] -> [T]
  sep = List.intercalate [str sep, brk 1] . map single

  :: [T] -> [T]
  = separate ("," :: Bytes)

  :: BYTES a => a -> a -> [T] -> T
  lpar rpar prts = block (str lpar : prts <> [str rpar])

  :: BYTES a => a -> a -> a -> [T] -> T
  sep lpar rpar = enclose lpar rpar . separate sep

  :: BYTES a => a -> a -> [T] -> T
  = enum ","

  :: BYTES a => a -> a -> [a] -> T
  lpar rpar = list lpar rpar . map str

  :: BYTES a => a -> [T] -> T
  name prts = block (fbreaks (str name : prts))
 ›

generate_file "Isabelle/Name.hs" = ‹
 - Title: Isabelle/Name.hs
 Author: Makarius

  of basic logical entities (variables etc.).

  🍋‹$ISABELLE_HOME/src/Pure/name.ML›.
 }

 -# LANGUAGE OverloadedStrings #-}

  Isabelle.Name (
 Name,
 uu, uu_, aT,
 clean_index, clean, internal, skolem, is_internal, is_skolem, dest_internal, dest_skolem,
 Context, declare, declare_renamed, is_declared, declared, context, make_context,
 variant, variant_list
 
 

  Data.Maybe (fromMaybe)
  Data.Map.Strict (Map)
  qualified Data.Map.Strict as Map
  Data.Word (Word8)
  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)
  qualified Isabelle.Symbol as Symbol
  Isabelle.Library


  Name = Bytes


 - common defaults -}

 , uu_, aT :: Name
  = "uu"
  = "uu_"
  = "'a"


 - internal names -- NB: internal subsumes skolem -}

  :: Word8
  = Bytes.byte '_'

 , skolem :: Name -> Name
  x = x <> "_"
  x = x <> "__"

 , is_skolem :: Name -> Bool
  = Bytes.isSuffixOf "_"
  = Bytes.isSuffixOf "__"

 , dest_skolem :: Name -> Maybe Name
  = Bytes.try_unsuffix "_"
  = Bytes.try_unsuffix "__"

  :: (Name, Int) -> (Name, Int)
  (x, i) =
 case dest_internal x of
 Nothing -> (x, i)
 Just x' -> clean_index (x', i + 1)

  :: Name -> Name
  x = fst (clean_index (x, 0))


 - context for used names -}

  Context = Context (Map Name (Maybe Name)) {-declared names with latest renaming-}

  :: Name -> Context -> Context
  x (Context names) =
 Context (
 let a = clean x
 in if Map.member a names then names else Map.insert a Nothing names)

  :: (Name, Name) -> Context -> Context
  (x, x') (Context names) =
 Context (Map.insert (clean x) (Just (clean x')) names)

  :: (Name, Name) -> Context -> Context
  (x, x') =
 (if clean x /= clean x' then declare_renaming (x, x') else id) #> declare x'

  :: Context -> Name -> Bool
  (Context names) x = Map.member x names

  :: Context -> Name -> Maybe (Maybe Name)
  (Context names) a = Map.lookup a names

  :: Context
  = Context Map.empty |> fold declare ["", "'"]

  :: [Name] -> Context
  used = fold declare used context


 - generating fresh names -}

  :: Name -> Name
  str = str <> "a"

  :: Name -> Name
  str =
 let
 a = Bytes.byte 'a'
 z = Bytes.byte 'z'
 bump (b : bs) | b == z = a : bump bs
 bump (b : bs) | a <= b && b < z = b + 1 : bs
 bump bs = a : bs

 rev = reverse (Bytes.unpack str)
 part2 = reverse (takeWhile (Symbol.is_ascii_quasi . Bytes.char) rev)
 part1 = reverse (bump (drop (length part2) rev))
 in Bytes.pack (part1 <> part2)

  :: Name -> Context -> (Name, Context)
  name ctxt =
 let
 vary x =
 case declared ctxt x of
 Nothing -> x
 Just x' -> vary (bump_string (fromMaybe x x'))

 (x, n) = clean_index (name, 0)
 (x', ctxt') =
 if not (is_declared ctxt x) then (x, declare x ctxt)
 else
 let
 x0 = bump_init x
 x' = vary x0
 ctxt' = ctxt |> declare_renamed (x0, x')
 in (x', ctxt')
 in (x' <> Bytes.pack (replicate n underscore), ctxt')

  :: [Name] -> [Name] -> [Name]
  used names = fst (make_context used |> fold_map variant names)
 ›

generate_file "Isabelle/Term.hs" = ‹
 - Title: Isabelle/Term.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  terms, types, sorts.

  🍋‹$ISABELLE_HOME/src/Pure/term.scala›.
 }

 -# LANGUAGE OverloadedStrings #-}

  Isabelle.Term (
 Indexname, Sort, Typ(..), Term(..),
 Free, lambda, declare_frees, incr_boundvars, subst_bound, dest_lambda, strip_lambda,
 type_op0, type_op1, op0, op1, op2, typed_op0, typed_op1, typed_op2, binder,
 dummyS, dummyT, is_dummyT, propT, is_propT, (-->), dest_funT, (--->),
 aconv, list_comb, strip_comb, head_of
 
 

  Isabelle.Library
  qualified Isabelle.Name as Name
  Isabelle.Name (Name)

  5 -->
  --->


 - types and terms -}

  Indexname = (Name, Int)

  Sort = [Name]

  Typ =
 Type (Name, [Typ])
 | TFree (Name, Sort)
 | TVar (Indexname, Sort)
 deriving (Show, Eq, Ord)

  Term =
 Const (Name, [Typ])
 | Free (Name, Typ)
 | Var (Indexname, Typ)
 | Bound Int
 | Abs (Name, Typ, Term)
 | App (Term, Term)
 | OFCLASS (Typ, Name)
 deriving (Show, Eq, Ord)


 - free and bound variables -}

  Free = (Name, Typ)

  :: Free -> Term -> Term
  (name, typ) body = Abs (name, typ, abstract 0 body)
 where
 abstract lev (Free (x, ty)) | name == x && typ == ty = Bound lev
 abstract lev (Abs (a, ty, t)) = Abs (a, ty, abstract (lev + 1) t)
 abstract lev (App (t, u)) = App (abstract lev t, abstract lev u)
 abstract _ t = t

  :: Term -> Name.Context -> Name.Context
  (Free (x, _)) = Name.declare x
  (Abs (_, _, b)) = declare_frees b
  (App (t, u)) = declare_frees t #> declare_frees u
  _ = id

  :: Int -> Term -> Term
  inc = if inc == 0 then id else incr 0
 where
 incr lev (Bound i) = if i >= lev then Bound (i + inc) else Bound i
 incr lev (Abs (a, ty, b)) = Abs (a, ty, incr (lev + 1) b)
 incr lev (App (t, u)) = App (incr lev t, incr lev u)
 incr _ t = t

  :: Term -> Term -> Term
  arg = subst 0
 where
 subst lev (Bound i) =
 if i < lev then Bound i
 else if i == lev then incr_boundvars lev arg
 else Bound (i - 1)
 subst lev (Abs (a, ty, b)) = Abs (a, ty, subst (lev + 1) b)
 subst lev (App (t, u)) = App (subst lev t, subst lev u)
 subst _ t = t

  :: Name.Context -> Term -> Maybe (Free, Term)
  names (Abs (x, ty, b)) =
 let
 (x', _) = Name.variant x (declare_frees b names)
 v = (x', ty)
 in Just (v, subst_bound (Free v) b)
  _ _ = Nothing

  :: Name.Context -> Term -> ([Free], Term)
  names tm =
 case dest_lambda names tm of
 Just (v, t) ->
 let (vs, t') = strip_lambda names t'
 in (v : vs, t')
 Nothing -> ([], tm)


 - type and term operators -}

  :: Name -> (Typ, Typ -> Bool)
  name = (mk, is)
 where
 mk = Type (name, [])
 is (Type (c, _)) = c == name
 is _ = False

  :: Name -> (Typ -> Typ, Typ -> Maybe Typ)
  name = (mk, dest)
 where
 mk ty = Type (name, [ty])
 dest (Type (c, [ty])) | c == name = Just ty
 dest _ = Nothing

  :: Name -> (Typ -> Typ -> Typ, Typ -> Maybe (Typ, Typ))
  name = (mk, dest)
 where
 mk ty1 ty2 = Type (name, [ty1, ty2])
 dest (Type (c, [ty1, ty2])) | c == name = Just (ty1, ty2)
 dest _ = Nothing

  :: Name -> (Term, Term -> Bool)
  name = (mk, is)
 where
 mk = Const (name, [])
 is (Const (c, _)) = c == name
 is _ = False

  :: Name -> (Term -> Term, Term -> Maybe Term)
  name = (mk, dest)
 where
 mk t = App (Const (name, []), t)
 dest (App (Const (c, _), t)) | c == name = Just t
 dest _ = Nothing

  :: Name -> (Term -> Term -> Term, Term -> Maybe (Term, Term))
  name = (mk, dest)
 where
 mk t u = App (App (Const (name, []), t), u)
 dest (App (App (Const (c, _), t), u)) | c == name = Just (t, u)
 dest _ = Nothing

  :: Name -> (Typ -> Term, Term -> Maybe Typ)
  name = (mk, dest)
 where
 mk ty = Const (name, [ty])
 dest (Const (c, [ty])) | c == name = Just ty
 dest _ = Nothing

  :: Name -> (Typ -> Term -> Term, Term -> Maybe (Typ, Term))
  name = (mk, dest)
 where
 mk ty t = App (Const (name, [ty]), t)
 dest (App (Const (c, [ty]), t)) | c == name = Just (ty, t)
 dest _ = Nothing

  :: Name -> (Typ -> Term -> Term -> Term, Term -> Maybe (Typ, Term, Term))
  name = (mk, dest)
 where
 mk ty t u = App (App (Const (name, [ty]), t), u)
 dest (App (App (Const (c, [ty]), t), u)) | c == name = Just (ty, t, u)
 dest _ = Nothing

  :: Name -> (Free -> Term -> Term, Name.Context -> Term -> Maybe (Free, Term))
  name = (mk, dest)
 where
 mk (a, ty) b = App (Const (name, [ty]), lambda (a, ty) b)
 dest names (App (Const (c, _), t)) | c == name = dest_lambda names t
 dest _ _ = Nothing


 - type operations -}

  :: Sort
  = [""]

  :: Typ; is_dummyT :: Typ -> Bool
 dummyT, is_dummyT) = type_op0 ‹🍋‹dummy››

  :: Typ; is_propT :: Typ -> Bool
 propT, is_propT) = type_op0 ‹🍋‹prop››

 -->) :: Typ -> Typ -> Typ; dest_funT :: Typ -> Maybe (Typ, Typ)
 (-->), dest_funT) = type_op2 ‹🍋‹fun››

 --->) :: [Typ] -> Typ -> Typ
 ] ---> b = b
 a : as) ---> b = a --> (as ---> b)


 - term operations -}

  :: Term -> Term -> Bool
  (App (t1, u1)) (App (t2, u2)) = aconv t1 t2 && aconv u1 u2
  (Abs (_, ty1, t1)) (Abs (_, ty2, t2)) = aconv t1 t2 && ty1 == ty2
  a1 a2 = a1 == a2

  :: Term -> [Term] -> Term
  f [] = f
  f (t : ts) = list_comb (App (f, t)) ts

  :: Term -> (Term, [Term])
  tm = strip (tm, [])
 where
 strip (App (f, t), ts) = strip (f, t : ts)
 strip x = x

  :: Term -> Term
  (App (f, _)) = head_of f
  u = u
 ›

generate_file "Isabelle/Pure.hs" = ‹
 - Title: Isabelle/Term.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  for Isabelle/Pure logic.

  🍋‹$ISABELLE_HOME/src/Pure/logic.ML›.
 }

 -# LANGUAGE OverloadedStrings #-}

  Isabelle.Pure (
 mk_forall_op, dest_forall_op, mk_forall, dest_forall,
 mk_equals, dest_equals, mk_implies, dest_implies
 
 

  qualified Isabelle.Name as Name
  Isabelle.Term

  :: Typ -> Term -> Term; dest_forall_op :: Term -> Maybe (Typ, Term)
 mk_forall_op, dest_forall_op) = typed_op1 ‹🍋‹Pure.all››

  :: Free -> Term -> Term; dest_forall :: Name.Context -> Term -> Maybe (Free, Term)
 mk_forall, dest_forall) = binder ‹🍋‹Pure.all››

  :: Typ -> Term -> Term -> Term; dest_equals :: Term -> Maybe (Typ, Term, Term)
 mk_equals, dest_equals) = typed_op2 ‹🍋‹Pure.eq››

  :: Term -> Term -> Term; dest_implies :: Term -> Maybe (Term, Term)
 mk_implies, dest_implies) = op2 ‹🍋‹Pure.imp››
 ›

generate_file "Isabelle/HOL.hs" = ‹
 - Title: Isabelle/Term.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  for Isabelle/HOL logic.

  🍋‹$ISABELLE_HOME/src/HOL/Tools/hologic.ML›.
 }

 -# LANGUAGE OverloadedStrings #-}

  Isabelle.HOL (
 boolT, is_boolT, mk_trueprop, dest_trueprop,
 mk_setT, dest_setT, mk_mem, dest_mem,
 mk_eq, dest_eq, true, is_true, false, is_false,
 mk_not, dest_not, mk_conj, dest_conj, mk_disj, dest_disj,
 mk_imp, dest_imp, mk_iff, dest_iff,
 mk_all_op, dest_all_op, mk_ex_op, dest_ex_op,
 mk_all, dest_all, mk_ex, dest_ex,
 mk_undefined, dest_undefined
 
 

  qualified Isabelle.Name as Name
  Isabelle.Term


  :: Typ; is_boolT :: Typ -> Bool
 boolT, is_boolT) = type_op0 ‹🍋‹bool››

  :: Term -> Term; dest_trueprop :: Term -> Maybe Term
 mk_trueprop, dest_trueprop) = op1 ‹🍋‹Trueprop››

  :: Typ -> Typ; dest_setT :: Typ -> Maybe Typ
 mk_setT, dest_setT) = type_op1 ‹🍋‹set››

  :: Typ -> Term -> Term -> Term; dest_mem :: Term -> Maybe (Typ, Term, Term)
 mk_mem, dest_mem) = typed_op2 ‹🍋‹Set.member››

  :: Typ -> Term -> Term -> Term; dest_eq :: Term -> Maybe (Typ, Term, Term)
 mk_eq, dest_eq) = typed_op2 ‹🍋‹HOL.eq››

  :: Term; is_true :: Term -> Bool
 true, is_true) = op0 ‹🍋‹True››

  :: Term; is_false :: Term -> Bool
 false, is_false) = op0 ‹🍋‹False››

  :: Term -> Term; dest_not :: Term -> Maybe Term
 mk_not, dest_not) = op1 ‹🍋‹Not››

  :: Term -> Term -> Term; dest_conj :: Term -> Maybe (Term, Term)
 mk_conj, dest_conj) = op2 ‹🍋‹conj››

  :: Term -> Term -> Term; dest_disj :: Term -> Maybe (Term, Term)
 mk_disj, dest_disj) = op2 ‹🍋‹disj››

  :: Term -> Term -> Term; dest_imp :: Term -> Maybe (Term, Term)
 mk_imp, dest_imp) = op2 ‹🍋‹implies››

  :: Term -> Term -> Term
  = mk_eq boolT

  :: Term -> Maybe (Term, Term)
  tm =
 case dest_eq tm of
 Just (ty, t, u) | ty == boolT -> Just (t, u)
 _ -> Nothing

  :: Typ -> Term -> Term; dest_all_op :: Term -> Maybe (Typ, Term)
 mk_all_op, dest_all_op) = typed_op1 ‹🍋‹All››

  :: Typ -> Term -> Term; dest_ex_op :: Term -> Maybe (Typ, Term)
 mk_ex_op, dest_ex_op) = typed_op1 ‹🍋‹Ex››

  :: Free -> Term -> Term; dest_all :: Name.Context -> Term -> Maybe (Free, Term)
 mk_all, dest_all) = binder ‹🍋‹All››

  :: Free -> Term -> Term; dest_ex :: Name.Context -> Term -> Maybe (Free, Term)
 mk_ex, dest_ex) = binder ‹🍋‹Ex››

  :: Typ -> Term; dest_undefined :: Term -> Maybe Typ
 mk_undefined, dest_undefined) = typed_op0 ‹🍋‹undefined››
 ›

generate_file "Isabelle/Term_XML/Encode.hs" = ‹
 - Title: Isabelle/Term_XML/Encode.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  data representation of lambda terms.

  🍋‹$ISABELLE_HOME/src/Pure/term_xml.ML›.
 }

 -# LANGUAGE LambdaCase #-}

  Isabelle.Term_XML.Encode (indexname, sort, typ, term)
 

  Isabelle.Library
  Isabelle.XML.Encode
  Isabelle.Term

  :: P Indexname
  (a, b) = if b == 0 then [a] else [a, int_atom b]

  :: T Sort
  = list string

  :: T Typ
  ty =
 ty |> variant
 [\case { Type (a, b) -> Just ([a], list typ b); _ -> Nothing },
 \case { TFree (a, b) -> Just ([a], sort b); _ -> Nothing },
 \case { TVar (a, b) -> Just (indexname a, sort b); _ -> Nothing }]

  :: T Typ
  ty = if is_dummyT ty then [] else typ ty

  :: T Term
  t =
 t |> variant
 [\case { Const (a, b) -> Just ([a], list typ b); _ -> Nothing },
 \case { Free (a, b) -> Just ([a], var_type b); _ -> Nothing },
 \case { Var (a, b) -> Just (indexname a, var_type b); _ -> Nothing },
 \case { Bound a -> Just ([], int a); _ -> Nothing },
 \case { Abs (a, b, c) -> Just ([a], pair typ term (b, c)); _ -> Nothing },
 \case { App a -> Just ([], pair term term a); _ -> Nothing },
 \case { OFCLASS (a, b) -> Just ([b], typ a); _ -> Nothing }]
 ›

generate_file "Isabelle/Term_XML/Decode.hs" = ‹
 - Title: Isabelle/Term_XML/Decode.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  data representation of lambda terms.

  🍋‹$ISABELLE_HOME/src/Pure/term_xml.ML›.
 }

 -# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

  Isabelle.Term_XML.Decode (indexname, sort, typ, term)
 

  Isabelle.Library
  Isabelle.XML.Decode
  Isabelle.Term


  :: P Indexname
  [a] = (a, 0)
  [a, b] = (a, int_atom b)

  :: T Sort
  = list string

  :: T Typ
  ty =
 ty |> variant
 [\([a], b) -> Type (a, list typ b),
 \([a], b) -> TFree (a, sort b),
 \(a, b) -> TVar (indexname a, sort b)]

  :: T Typ
  [] = dummyT
  body = typ body

  :: T Term
  t =
 t |> variant
 [\([a], b) -> Const (a, list typ b),
 \([a], b) -> Free (a, var_type b),
 \(a, b) -> Var (indexname a, var_type b),
 \([], a) -> Bound (int a),
 \([a], b) -> let (c, d) = pair typ term b in Abs (a, c, d),
 \([], a) -> App (pair term term a),
 \([a], b) -> OFCLASS (typ b, a)]
 ›

generate_file "Isabelle/XML/Classes.hs" = ‹
 - generated by Isabelle -}

 - Title: Isabelle/XML/Classes.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  classes for XML data representation.
 }

 -# LANGUAGE FlexibleInstances #-}

  Isabelle.XML.Classes
 (Encode_Atom(..), Decode_Atom(..), Encode (..), Decode (..))
 

  qualified Isabelle.XML as XML
  qualified Isabelle.XML.Encode as Encode
  qualified Isabelle.XML.Decode as Decode
  qualified Isabelle.Term_XML.Encode as Encode
  qualified Isabelle.Term_XML.Decode as Decode
  qualified Isabelle.Properties as Properties
  Isabelle.Bytes (Bytes)
  Isabelle.Term (Typ, Term)


  Encode_Atom a where encode_atom :: Encode.A a
  Decode_Atom a where decode_atom :: Decode.A a

  Encode_Atom Int where encode_atom = Encode.int_atom
  Decode_Atom Int where decode_atom = Decode.int_atom

  Encode_Atom Bool where encode_atom = Encode.bool_atom
  Decode_Atom Bool where decode_atom = Decode.bool_atom

  Encode_Atom () where encode_atom = Encode.unit_atom
  Decode_Atom () where decode_atom = Decode.unit_atom


  Encode a where encode :: Encode.T a
  Decode a where decode :: Decode.T a

  Encode Bytes where encode = Encode.string
  Decode Bytes where decode = Decode.string

  Encode Int where encode = Encode.int
  Decode Int where decode = Decode.int

  Encode Bool where encode = Encode.bool
  Decode Bool where decode = Decode.bool

  Encode () where encode = Encode.unit
  Decode () where decode = Decode.unit

  (Encode a, Encode b) => Encode (a, b)
 where encode = Encode.pair encode encode
  (Decode a, Decode b) => Decode (a, b)
 where decode = Decode.pair decode decode

  (Encode a, Encode b, Encode c) => Encode (a, b, c)
 where encode = Encode.triple encode encode encode
  (Decode a, Decode b, Decode c) => Decode (a, b, c)
 where decode = Decode.triple decode decode decode

  Encode a => Encode [a] where encode = Encode.list encode
  Decode a => Decode [a] where decode = Decode.list decode

  Encode a => Encode (Maybe a) where encode = Encode.option encode
  Decode a => Decode (Maybe a) where decode = Decode.option decode

  Encode XML.Tree where encode = Encode.tree
  Decode XML.Tree where decode = Decode.tree

  Encode Properties.T where encode = Encode.properties
  Decode Properties.T where decode = Decode.properties

  Encode Typ where encode = Encode.typ
  Decode Typ where decode = Decode.typ

  Encode Term where encode = Encode.term
  Decode Term where decode = Decode.term
 ›

generate_file "Isabelle/UUID.hs" = ‹
 - Title: Isabelle/UUID.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  unique identifiers.

  🍋‹$ISABELLE_HOME/src/Pure/General/uuid.scala›.
 }

  Isabelle.UUID (T, random, print, parse)
 

  Prelude hiding (print)

  Data.UUID (UUID)
  qualified Data.UUID as UUID
  Data.UUID.V4 (nextRandom)

  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)


  T = UUID

  :: IO T
  = nextRandom

  :: T -> Bytes
  = Bytes.make . UUID.toASCIIBytes

  :: Bytes -> Maybe T
  = UUID.fromASCIIBytes . Bytes.unmake
 ›

generate_file "Isabelle/Byte_Message.hs" = ‹
 - Title: Isabelle/Byte_Message.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

 -oriented messages.

  🍋‹$ISABELLE_HOME/src/Pure/PIDE/byte_message.ML›
  🍋‹$ISABELLE_HOME/src/Pure/PIDE/byte_message.scala›.
 }

 -# LANGUAGE OverloadedStrings #-}
 -# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

  Isabelle.Byte_Message (
 write, write_line,
 read, read_block, read_line,
 make_message, write_message, read_message,
 exchange_message, exchange_message0,
 make_line_message, write_line_message, read_line_message,
 read_yxml, write_yxml
 )
 

  Prelude hiding (read)
  Data.Maybe
  qualified Data.ByteString as ByteString
  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)
  qualified Isabelle.Symbol as Symbol
  qualified Isabelle.UTF8 as UTF8
  qualified Isabelle.XML as XML
  qualified Isabelle.YXML as YXML

  Network.Socket (Socket)
  qualified Network.Socket.ByteString as Socket

  Isabelle.Library
  qualified Isabelle.Value as Value


 - output operations -}

  :: Socket -> [Bytes] -> IO ()
  socket = Socket.sendMany socket . map Bytes.unmake

  :: Socket -> Bytes -> IO ()
  socket s = write socket [s, "\n"]


 - input operations -}

  :: Socket -> Int -> IO Bytes
  socket n = read_body 0 []
 where
 result = Bytes.concat . reverse
 read_body len ss =
 if len >= n then return (result ss)
 else
 (do
 s <- Socket.recv socket (min (n - len) 8192)
 case ByteString.length s of
 0 -> return (result ss)
 m -> read_body (len + m) (Bytes.make s : ss))

  :: Socket -> Int -> IO (Maybe Bytes, Int)
  socket n = do
 msg <- read socket n
 let len = Bytes.length msg
 return (if len == n then Just msg else Nothing, len)

  :: Socket -> IO (Maybe Bytes)
  socket = read_body []
 where
 result = trim_line . Bytes.pack . reverse
 read_body bs = do
 s <- Socket.recv socket 1
 case ByteString.length s of
 0 -> return (if null bs then Nothing else Just (result bs))
 1 ->
 case ByteString.head s of
 10 -> return (Just (result bs))
 b -> read_body (b : bs)


 - messages with multiple chunks (arbitrary content) -}

  :: [Int] -> [Bytes]
  ns = [space_implode "," (map Value.print_int ns), "\n"]

  :: [Bytes] -> [Bytes]
  chunks = make_header (map Bytes.length chunks) <> chunks

  :: Socket -> [Bytes] -> IO ()
  socket = write socket . make_message

  :: Bytes -> [Int]
  line =
 let
 res = map Value.parse_nat (space_explode ',' line)
 in
 if all isJust res then map fromJust res
 else error ("Malformed message header: " <> quote (UTF8.decode line))

  :: Socket -> Int -> IO Bytes
  socket n = do
 res <- read_block socket n
 return $
 case res of
 (Just chunk, _) -> chunk
 (Nothing, len) ->
java.lang.NullPointerException: Cannot invoke "String.equals(Object)" because "brackoff" is null
 show len <> " of " <> show n <> " bytes")

  :: Socket -> IO (Maybe [Bytes])
  socket = do
 res <- read_line socket
 case res of
 Just line -> Just 🪙 mapM (read_chunk socket) (parse_header line)
 Nothing -> return Nothing

  :: Socket -> [Bytes] -> IO (Maybe [Bytes])
  socket msg = do
 write_message socket msg
 read_message socket

  :: Socket -> [Bytes] -> IO ()
  socket msg = do
 _ <- exchange_message socket msg
 return ()


 - hybrid messages: line or length+block (with content restriction)

  :: Bytes -> Bool
  msg =
 not (Bytes.null msg) && Bytes.all_char (\c -> '0' <= c && c <= '9') msg

  :: Bytes -> Bool
  msg =
 not (Bytes.null msg) && Symbol.is_ascii_line_terminator (Bytes.char $ Bytes.last msg)

  :: Bytes -> [Bytes]
  msg =
 let n = Bytes.length msg in
 if is_length msg || is_terminated msg then
 error ("Bad content for line message:\n" <> take 100 (UTF8.decode msg))
 else
 (if n > 100 || Bytes.any_char (== '\n') msg then make_header [n + 1] else []) <> [msg, "\n"]

  :: Socket -> Bytes -> IO ()
  socket = write socket . make_line_message

  :: Socket -> IO (Maybe Bytes)
  socket = do
 opt_line <- read_line socket
 case opt_line of
 Nothing -> return Nothing
 Just line ->
 case Value.parse_nat line of
 Nothing -> return $ Just line
 Just n -> fmap trim_line . fst 🪙 read_block socket n


  :: Socket -> IO (Maybe XML.Body)
  socket = do
 res <- read_line_message socket
 return (YXML.parse_body 🪙 res)

  :: Socket -> XML.Body -> IO ()
  socket body =
 write_line_message socket (YXML.string_of_body body)
 ›

generate_file "Isabelle/Isabelle_Thread.hs" = ‹
 - Title: Isabelle/Isabelle_Thread.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

 -specific thread management.

  🍋‹$ISABELLE_HOME/src/Pure/Concurrent/isabelle_thread.ML›
  🍋‹$ISABELLE_HOME/src/Pure/Concurrent/isabelle_thread.scala›.
 }

 -# LANGUAGE NamedFieldPuns #-}

  Isabelle.Isabelle_Thread (
 ThreadId, Result,
 find_id,
 properties, change_properties,
 add_resource, del_resource, bracket_resource,
 is_stopped, expose_stopped, stop,
 my_uuid, stop_uuid,
 Fork, fork_finally, fork)
 

  Data.Unique
  Data.IORef
  System.IO.Unsafe

  qualified Data.List as List
  Control.Monad (when, forM_)
  Data.Map.Strict (Map)
  qualified Data.Map.Strict as Map
  Control.Exception as Exception
  Control.Concurrent (ThreadId)
  qualified Control.Concurrent as Concurrent
  Control.Concurrent.Thread (Result)
  qualified Control.Concurrent.Thread as Thread
  qualified Isabelle.UUID as UUID
  qualified Isabelle.Properties as Properties


 - thread info -}

  Resources = Map Unique (IO ())
  Info = Info {uuid :: UUID.T, props :: Properties.T, stopped :: Bool, resources :: Resources}
  Infos = Map ThreadId Info

  :: Infos -> ThreadId -> Maybe Info
  infos id = Map.lookup id infos

  :: ThreadId -> UUID.T -> Infos -> (Infos, ())
  id uuid infos = (Map.insert id (Info uuid [] False Map.empty) infos, ())


 - global state -}

 -# NOINLINE global_state #-}
  :: IORef Infos
  = unsafePerformIO (newIORef Map.empty)

  :: UUID.T -> IO (Maybe ThreadId)
  uuid = do
 state <- readIORef global_state
 return $ fst 🪙 List.find (\(_, Info{uuid = uuid'}) -> uuid == uuid') (Map.assocs state)

  :: ThreadId -> IO (Maybe Info)
  id = do
 state <- readIORef global_state
 return $ lookup_info state id

  :: ThreadId -> (Info -> Info) -> IO (Maybe Info)
  id f =
 atomicModifyIORef' global_state
 (\infos ->
 case lookup_info infos id of
 Nothing -> (infos, Nothing)
 Just info ->
 let info' = f info
 in (Map.insert id info' infos, Just info'))

  :: ThreadId -> IO ()
  id =
 atomicModifyIORef' global_state (\infos -> (Map.delete id infos, ()))


 - thread properties -}

  :: IO (Maybe Info)
  = do
 id <- Concurrent.myThreadId
 get_info id

  :: IO Properties.T
  = maybe [] props 🪙 my_info

  :: (Properties.T -> Properties.T) -> IO ()
  f = do
 id <- Concurrent.myThreadId
 map_info id (\info -> info {props = f (props info)})
 return ()


 - managed resources -}

  :: IO () -> IO Unique
  resource = do
 id <- Concurrent.myThreadId
 u <- newUnique
 map_info id (\info -> info {resources = Map.insert u resource (resources info)})
 return u

  :: Unique -> IO ()
  u = do
 id <- Concurrent.myThreadId
 map_info id (\info -> info {resources = Map.delete u (resources info)})
 return ()

  :: IO () -> IO a -> IO a
  resource body =
 Exception.bracket (add_resource resource) del_resource (const body)


 - stop -}

  :: IO Bool
  = maybe False stopped 🪙 my_info

  :: IO ()
  = do
 stopped <- is_stopped
 when stopped $ throw ThreadKilled

  :: ThreadId -> IO ()
  id = do
 info <- map_info id (\info -> info {stopped = True})
 let ops = case info of Nothing -> []; Just Info{resources} -> map snd (Map.toDescList resources)
 sequence_ ops


 - UUID -}

  :: IO (Maybe UUID.T)
  = fmap uuid 🪙 my_info

  :: UUID.T -> IO ()
  uuid = do
 id <- find_id uuid
 forM_ id stop


 - fork -}

  Fork a = (ThreadId, UUID.T, IO (Result a))

  :: IO a -> (Either SomeException a -> IO b) -> IO (Fork b)
  body finally = do
 uuid <- UUID.random
java.lang.NullPointerException: Cannot invoke "String.equals(Object)" because "brackoff" is null
 Exception.mask (\restore ->
 Thread.forkIO
 (Exception.try
 (do
 id <- Concurrent.myThreadId
 atomicModifyIORef' global_state (init_info id uuid)
 restore body)
 >>= (\res -> do id <- Concurrent.myThreadId; delete_info id; finally res)))
 return (id, uuid, result)

  :: IO a -> IO (Fork a)
  body = fork_finally body Thread.result
 ›

generate_file "Isabelle/Server.hs" = ‹
 - Title: Isabelle/Server.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  server on localhost.
 }

 -# LANGUAGE OverloadedStrings #-}

  Isabelle.Server (
 localhost_name, localhost_prefix, localhost, publish_text, publish_stdout,
 server, connection
 
 

  Control.Monad (forever, when)
  qualified Control.Exception as Exception
  Network.Socket (Socket)
  qualified Network.Socket as Socket
  qualified System.IO as IO
  qualified Data.ByteString.Char8 as Char8

  Isabelle.Library
  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)
  qualified Isabelle.UUID as UUID
  qualified Isabelle.Byte_Message as Byte_Message
  qualified Isabelle.Isabelle_Thread as Isabelle_Thread


 - server address -}

  :: Bytes
  = "127.0.0.1"

  :: Bytes
  = localhost_name <> ":"

  :: Socket.HostAddress
  = Socket.tupleToHostAddress (127, 0, 0, 1)

  :: Bytes -> Bytes -> UUID.T -> Bytes
  name address password =
java.lang.NullPointerException: Cannot invoke "String.equals(Object)" because "brackoff" is null
 " (password " <> quote (show_bytes password) <> ")"

  :: Bytes -> Bytes -> UUID.T -> IO ()
  name address password =
 Char8.putStrLn (Bytes.unmake $ publish_text name address password)


 - server -}

  :: (Bytes -> UUID.T -> IO ()) -> (Socket -> IO ()) -> IO ()
  publish handle =
 Socket.withSocketsDo $ Exception.bracket open (Socket.close . fst) (uncurry loop)
 where
 open :: IO (Socket, Bytes)
 open = do
 server_socket <- Socket.socket Socket.AF_INET Socket.Stream Socket.defaultProtocol
 Socket.bind server_socket (Socket.SockAddrInet 0 localhost)
 Socket.listen server_socket 50

 port <- Socket.socketPort server_socket
 let address = localhost_name <> ":" <> show_bytes port
 password <- UUID.random
 publish address password

 return (server_socket, UUID.print password)

 loop :: Socket -> Bytes -> IO ()
 loop server_socket password = forever $ do
 (connection, _) <- Socket.accept server_socket
 Isabelle_Thread.fork_finally
 (do
 line <- Byte_Message.read_line connection
 when (line == Just password) $ handle connection)
 (\finally -> do
 Socket.close connection
 case finally of
 Left exn -> IO.hPutStrLn IO.stderr $ Exception.displayException exn
 Right () -> return ())
 return ()


 - client connection -}

  :: String -> Bytes -> (Socket -> IO a) -> IO a
  port password client =
 Socket.withSocketsDo $ do
 addr <- resolve
 Exception.bracket (open addr) Socket.close body
 where
 resolve = do
 let hints =
 Socket.defaultHints {
 Socket.addrFlags = [Socket.AI_NUMERICHOST, Socket.AI_NUMERICSERV],
 Socket.addrSocketType = Socket.Stream }
 head 🪙 Socket.getAddrInfo (Just hints) (Just $ make_string localhost_name) (Just port)

 open addr = do
 socket <- Socket.socket (Socket.addrFamily addr) (Socket.addrSocketType addr)
 (Socket.addrProtocol addr)
 Socket.connect socket $ Socket.addrAddress addr
 return socket

 body socket = do
 Byte_Message.write_line socket password
 client socket
 ›

generate_file "Isabelle/Time.hs" = ‹
 - Title: Isabelle/Time.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  based on milliseconds.

  🍋‹~~/src/Pure/General/time.scala›
 }

 -# LANGUAGE OverloadedStrings #-}

  Isabelle.Time (
 Time, seconds, minutes, ms, zero, is_zero, is_relevant,
 get_seconds, get_minutes, get_ms, message, now
 
 

  Text.Printf (printf)
  Data.Time.Clock.POSIX (getPOSIXTime)
  Isabelle.Bytes (Bytes)
  Isabelle.Library


  Time = Time Int

  Eq Time where Time a == Time b = a == b
  Ord Time where compare (Time a) (Time b) = compare a b
  Num Time where
 fromInteger = Time . fromInteger
 Time a + Time b = Time (a + b)
 Time a - Time b = Time (a - b)
 Time a * Time b = Time (a * b)
 abs (Time a) = Time (abs a)
 signum (Time a) = Time (signum a)

  :: Double -> Time
  s = Time (round (s * 1000.0))

  :: Double -> Time
  m = Time (round (m * 60000.0))

  :: Int -> Time
  = Time

  :: Time
  = ms 0

  :: Time -> Bool
  (Time ms) = ms == 0

  :: Time -> Bool
  (Time ms) = ms >= 1

  :: Time -> Double
  (Time ms) = fromIntegral ms / 1000.0

  :: Time -> Double
  (Time ms) = fromIntegral ms / 60000.0

  :: Time -> Int
  (Time ms) = ms

  Show Time where
 show t = printf "%.3f" (get_seconds t)

  :: Time -> Bytes
  t = make_bytes (show t) <> "s"

  :: IO Time
  = do
 t <- getPOSIXTime
 return $ Time (round (realToFrac t * 1000.0 :: Double))
 ›

generate_file "Isabelle/Timing.hs" = ‹
 - Title: Isabelle/Timing.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  for time measurement.

  🍋‹~~/src/Pure/General/timing.ML›
  🍋‹~~/src/Pure/General/timing.scala›
 }

  Isabelle.Timing (
 Timing (..), zero, is_zero, is_relevant
 
 

  qualified Isabelle.Time as Time
  Isabelle.Time (Time)

  Timing = Timing {elapsed :: Time, cpu :: Time, gc :: Time}
 deriving (Show, Eq)

  :: Timing
  = Timing Time.zero Time.zero Time.zero

  :: Timing -> Bool
  t = Time.is_zero (elapsed t) && Time.is_zero (cpu t) && Time.is_zero (gc t)

  :: Timing -> Bool
  t = Time.is_relevant (elapsed t) || Time.is_relevant (cpu t) || Time.is_relevant (gc t)
 ›

generate_file "Isabelle/Bash.hs" = ‹
 - Title: Isabelle/Bash.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  for GNU bash.

  🍋‹$ISABELLE_HOME/src/Pure/System/bash.ML›
 }

 -# LANGUAGE OverloadedStrings #-}

  Isabelle.Bash (
 string, strings,

 Params,
 get_script, get_input, get_cwd, get_putenv, get_redirect,
 get_timeout, get_description,
 script, input, cwd, putenv, redirect, timeout, description,
 server_run, server_kill,
 server_uuid, server_interrupt, server_failure, server_result
 
 

  Text.Printf (printf)
  qualified Isabelle.Symbol as Symbol
  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)
  qualified Isabelle.Time as Time
  Isabelle.Time (Time)
  Isabelle.Library


 - concrete syntax -}

  :: Bytes -> Bytes
  str =
 if Bytes.null str then "\"\""
 else str |> Bytes.unpack |> map trans |> Bytes.concat
 where
 trans b =
 case Bytes.char b of
 '\t' -> "$'\\t'"
 '\n' -> "$'\\n'"
 '\f' -> "$'\\f'"
 '\r' -> "$'\\r'"
 c ->
 if Symbol.is_ascii_letter c || Symbol.is_ascii_digit c || c `elem` ("+,-./:_" :: String)
 then Bytes.singleton b
 else if b < 32 || b >= 127 then make_bytes (printf "$'\\x%02x'" b :: String)
 else "\\" <> Bytes.singleton b

  :: [Bytes] -> Bytes
  = implode_space . map string


 - server parameters -}

  Params = Params {
 _script :: Bytes,
 _input :: Bytes,
 _cwd :: Maybe Bytes,
 _putenv :: [(Bytes, Bytes)],
 _redirect :: Bool,
 _timeout :: Time,
 _description :: Bytes}
 deriving (Show, Eq)

  :: Params -> Bytes
  = _script

  :: Params -> Bytes
  = _input

  :: Params -> Maybe Bytes
  = _cwd

  :: Params -> [(Bytes, Bytes)]
  = _putenv

  :: Params -> Bool
  = _redirect

  :: Params -> Time
  = _timeout

  :: Params -> Bytes
  = _description

  :: Bytes -> Params
  script = Params script "" Nothing [] False Time.zero ""

  :: Bytes -> Params -> Params
  input params = params { _input = input }

  :: Bytes -> Params -> Params
  cwd params = params { _cwd = Just cwd }

  :: [(Bytes, Bytes)] -> Params -> Params
  putenv params = params { _putenv = putenv }

  :: Params -> Params
  params = params { _redirect = True }

  :: Time -> Params -> Params
  timeout params = params { _timeout = timeout }

  :: Bytes -> Params -> Params
  description params = params { _description = description }


 - server messages -}

 , server_kill :: Bytes
  = ‹Bash.server_run›;
  = ‹Bash.server_kill›;

 , server_interrupt, server_failure, server_result :: Bytes
  = ‹Bash.server_uuid›;
  = ‹Bash.server_interrupt›;
  = ‹Bash.server_failure›;
  = ‹Bash.server_result›;
 ›

generate_file "Isabelle/Process_Result.hs" = ‹
 - Title: Isabelle/Process_Result.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  of system process.

  🍋‹~~/src/Pure/System/process_result.ML›
  🍋‹~~/src/Pure/System/process_result.scala›
 }

 -# LANGUAGE OverloadedStrings #-}

  Isabelle.Process_Result (
 ok_rc, error_rc, failure_rc, interrupt_rc , timeout_rc,

 T, make, rc, out_lines, err_lines, timing, timing_elapsed, out, err, ok, check
 
 

  Isabelle.Time (Time)
  qualified Isabelle.Timing as Timing
  Isabelle.Timing (Timing)
  Isabelle.Bytes (Bytes)
  Isabelle.Library


 , error_rc, failure_rc, interrupt_rc , timeout_rc :: Int
  = 0
  = 1
  = 2
  = 130
  = 142

  T =
 Process_Result {
 _rc :: Int,
 _out_lines :: [Bytes],
 _err_lines :: [Bytes],
 _timing :: Timing}
 deriving (Show, Eq)

  :: Int -> [Bytes] -> [Bytes] -> Timing -> T
  = Process_Result

  :: T -> Int
  = _rc

  :: T -> [Bytes]
  = _out_lines

  :: T -> [Bytes]
  = _err_lines

  :: T -> Timing
  = _timing

  :: T -> Time
  = Timing.elapsed . timing

  :: T -> Bytes
  = trim_line . cat_lines . out_lines

  :: T -> Bytes
  = trim_line . cat_lines . err_lines

  :: T -> Bool
  result = rc result == ok_rc

  :: T -> T
  result = if ok result then result else error (make_string $ err result)
 ›

generate_file "Isabelle/Options.hs" = ‹
 - Title: Isabelle/Options.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  options with external string representation.

  🍋‹~~/src/Pure/System/options.ML›
  🍋‹~~/src/Pure/System/options.scala›
 }

 -# LANGUAGE OverloadedStrings #-}
 -# LANGUAGE InstanceSigs #-}

  Isabelle.Options (
 boolT, intT, realT, stringT, unknownT,

 T, typ, bool, int, real, seconds, string,
 decode
 
 

  qualified Data.Map.Strict as Map
  Data.Map.Strict (Map)
  qualified Isabelle.Properties as Properties
  Isabelle.Bytes (Bytes)
  qualified Isabelle.Value as Value
  qualified Isabelle.Time as Time
  Isabelle.Time (Time)
  Isabelle.Library
  qualified Isabelle.XML.Decode as Decode
  Isabelle.XML.Classes (Decode (..))


 - representation -}

  :: Bytes
  = "bool"

  :: Bytes
  = "int"

  :: Bytes
  = "real"

  :: Bytes
  = "string"

  :: Bytes
  = "unknown"

  Opt = Opt {
 _pos :: Properties.T,
 _name :: Bytes,
 _typ :: Bytes,
 _value :: Bytes }

  T = Options (Map Bytes Opt)


 - check -}

  :: T -> Bytes -> Opt
  (Options map) name =
 case Map.lookup name map of
 Just opt | _typ opt /= unknownT -> opt
 _ -> error (make_string ("Unknown system option " <> quote name))

  :: T -> Bytes -> Bytes -> Opt
  options name typ =
 let
 opt = check_name options name
 t = _typ opt
 in
 if t == typ then opt
 else error (make_string ("Ill-typed system option " <> quote name <> " : " <> t <> " vs. " <> typ))


 - get typ -}

  :: T -> Bytes -> Bytes
  options name = _typ (check_name options name)


 - get value -}

  :: Bytes -> (Bytes -> Maybe a) -> T -> Bytes -> a
  typ parse options name =
 let opt = check_type options name typ in
 case parse (_value opt) of
 Just x -> x
 Nothing ->
java.lang.NullPointerException: Cannot invoke "String.equals(Object)" because "brackoff" is null
 " : " <> typ <> " =\n" <> quote (_value opt)))

  :: T -> Bytes -> Bool
  = get boolT Value.parse_bool

  :: T -> Bytes -> Int
  = get intT Value.parse_int

  :: T -> Bytes -> Double
  = get realT Value.parse_real

  :: T -> Bytes -> Time
  options = Time.seconds . real options

  :: T -> Bytes -> Bytes
  = get stringT Just


 - decode -}

  Decode T where
 decode :: Decode.T T
 decode =
 let
 decode_entry :: Decode.T (Bytes, Opt)
 decode_entry body =
 let
 (pos, (name, (typ, value))) =
 Decode.pair Decode.properties (Decode.pair Decode.string (Decode.pair Decode.string Decode.string)) body
 in (name, Opt { _pos = pos, _name = name, _typ = typ, _value = value })
 in Options . Map.fromList . Decode.list decode_entry
 ›

generate_file "Isabelle/Isabelle_System.hs" = ‹
 - Title: Isabelle/Isabelle_System.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  system support.

  🍋‹~~/src/Pure/System/isabelle_system.ML›
  🍋‹~~/src/Pure/System/isabelle_system.scala›
 }

 -# LANGUAGE OverloadedStrings #-}

  Isabelle.Isabelle_System (
 bash_process, bash_process0
 
 

  Data.Maybe (fromMaybe)
  Control.Exception (throw, AsyncException (UserInterrupt))
  Network.Socket (Socket)
  qualified Isabelle.Bytes as Bytes
  Isabelle.Bytes (Bytes)
  qualified Isabelle.Byte_Message as Byte_Message
  qualified Isabelle.Time as Time
  Isabelle.Timing (Timing (..))
  qualified Isabelle.Options as Options
  qualified Isabelle.Bash as Bash
  qualified Isabelle.Process_Result as Process_Result
  qualified Isabelle.XML.Encode as Encode
  qualified Isabelle.YXML as YXML
  qualified Isabelle.Value as Value
  qualified Isabelle.Server as Server
  qualified Isabelle.Isabelle_Thread as Isabelle_Thread
  Isabelle.Library


 - bash_process -}

  :: Bytes -> Bytes -- FIXME dummy
  = id

  :: Options.T -> Bash.Params -> IO Process_Result.T
  options = bash_process0 address password
 where
 address = Options.string options "bash_process_address"
 password = Options.string options "bash_process_password"

  :: Bytes -> Bytes -> Bash.Params -> IO Process_Result.T
  address password params = do
 Server.connection port password
 (\socket -> do
 isabelle_tmp <- getenv "ISABELLE_TMP"
 Byte_Message.write_message socket (run isabelle_tmp)
 loop Nothing socket)
 where
 port =
 case Bytes.try_unprefix Server.localhost_prefix address of
 Just port -> make_string port
 Nothing -> errorWithoutStackTrace "Bad bash_process server address"

 script = Bash.get_script params
 input = Bash.get_input params
 cwd = Bash.get_cwd params
 putenv = Bash.get_putenv params
 redirect = Bash.get_redirect params
 timeout = Bash.get_timeout params
 description = Bash.get_description params

 run :: Bytes -> [Bytes]
 run isabelle_tmp =
 [Bash.server_run, script, input,
 YXML.string_of_body (Encode.option (Encode.string . absolute_path) cwd),
 YXML.string_of_body
 (Encode.list (Encode.pair Encode.string Encode.string)
 (("ISABELLE_TMP", isabelle_tmp) : putenv)),
 Value.print_bool redirect,
 Value.print_real (Time.get_seconds timeout),
 description]

 kill :: Maybe Bytes -> IO ()
 kill maybe_uuid = do
 case maybe_uuid of
 Just uuid ->
 Server.connection port password (\socket ->
 Byte_Message.write_message socket [Bash.server_kill, uuid])
 Nothing -> return ()

 err = errorWithoutStackTrace "Malformed result from bash_process server"
 the = fromMaybe err

 loop :: Maybe Bytes -> Socket -> IO Process_Result.T
 loop maybe_uuid socket = do
 result <- Isabelle_Thread.bracket_resource (kill maybe_uuid) (Byte_Message.read_message socket)
 case result of
 Just [head, uuid] | head == Bash.server_uuid -> loop (Just uuid) socket
 Just [head] | head == Bash.server_interrupt -> throw UserInterrupt
 Just [head, msg] | head == Bash.server_failure -> errorWithoutStackTrace $ make_string msg
 Just (head : a : b : c : d : lines) | head == Bash.server_result ->
 let
 rc = the $ Value.parse_int a
 elapsed = Time.ms $ the $ Value.parse_int b
 cpu = Time.ms $ the $ Value.parse_int c
 timing = Timing elapsed cpu Time.zero
 n = the $ Value.parse_int d
 out_lines = take n lines
 err_lines = drop n lines
 in return $ Process_Result.make rc out_lines err_lines timing
 _ -> err
 ›

generate_file "Isabelle/Cache.hs" = ‹
 - Title: Isabelle/Cache.hs
 Author: Makarius
 LICENSE: BSD 3-clause (Isabelle)

  for slow computations.
 }

  Isabelle.Cache (
 T, init, apply, prune
 
 

  Prelude hiding (init)
  Data.IORef
  Data.Map.Strict (Map)
  qualified Data.Map.Strict as Map
  qualified Data.List as List

  Isabelle.Time (Time)
  qualified Isabelle.Time as Time


  Entry v = Entry {_value :: v, _access :: Time, _timing :: Time}

  T k v = Cache (IORef (Map k (Entry v)))

  :: IO (T k v)
  = Cache 🪙 newIORef Map.empty

  :: Ord k => T k v -> k -> Entry v -> IO v
  (Cache ref) x e = do
 atomicModifyIORef' ref (\entries ->
 let
 entry =
 case Map.lookup x entries of
 Just e' | _access e' > _access e -> e'
 _ -> e
 in (Map.insert x entry entries, _value entry))

  :: Ord k => T k v -> k -> IO v -> IO v
  cache@(Cache ref) x body = do
 start <- Time.now
 entries <- readIORef ref
 case Map.lookup x entries of
 Just entry -> do
 commit cache x (entry {_access = start})
 Nothing -> do
 y <- body
 stop <- Time.now
 commit cache x (Entry y start (stop - start))

  :: Ord k => T k v -> Int -> Time -> IO ()
  (Cache ref) max_size min_timing = do
 atomicModifyIORef' ref (\entries ->
 let
 sort = List.sortBy (\(_, e1) (_, e2) -> compare (_access e2) (_access e1))
 entries1 = Map.filter (\e -> _timing e >= min_timing) entries
 entries2 =
 if Map.size entries1 <= max_size then entries1
 else Map.fromList $ List.take max_size $ sort $ Map.toList entries1
 in (entries2, ()))
 ›

export_generated_files _

end