Split up named patterns and pattern predicates in Builtin.Syntax

implementation module Builtin.Syntax

import StdList

from Data.Func import $
import Data.Maybe
import Text

import Cloogle.API
import Cloogle.DB

import Builtin.Predef

builtin_syntax :: [SyntaxEntry]
builtin_syntax =
	[ bs_case
	, bs_class
	, bs_code
	, bs_define_constant
	, bs_define_graph
	, bs_dotdot
	, bs_exists
	, bs_extensible_adt
	, bs_forall
	, bs_foreign
	, bs_funcdep
	, bs_generic
	, bs_import
	, bs_infix
	, bs_instance
	, bs_lambda
	, bs_layout_rule
	, bs_let
	, bs_let_before
	, bs_list_expressions
	, bs_macro
	, bs_module
	, bs_newtype
	, bs_overloaded_type_variable
	, bs_otherwise
	, bs_pattern_named
	, bs_pattern_predicate
	, bs_selection_array
	, bs_selection_array_unique
	, bs_selection_record
	, bs_selection_record_unique
	, bs_strict
	, bs_synonym
	, bs_synonym_abstract
	, bs_unique
	, bs_update_array
	, bs_update_record
	, bs_where_class
	, bs_where_instance
	, bs_where_local
	, bs_with
	, bs_zf
	]

EX :: !String -> SyntaxExample
EX c = {example=c, cleanjs_start=Nothing}
EXs :: !String !String -> SyntaxExample
EXs s c = {example=c, cleanjs_start=Just s}

bs_case =
	{ syntax_title         = "case expression"
	, syntax_patterns      = ["case", "of", "case of", "->", "="]
	, syntax_code          = ["case ... of ..."]
	, syntax_description   = join " "
		[ "Pattern match on an expression and do something depending on the alternative of the matching pattern."
		, "Both `->` and `=` can be used to separate patterns and alternatives, however, they cannot be mixed."
		]
	, syntax_doc_locations = [CLR 5 "3.4.2" "_Toc311798001"]
	, syntax_examples      =
		[ EXs "macro" "isJust m = case m of\n\tJust _ -> True\n\t_      -> False"
		]
	}

bs_class =
	{ syntax_title         = "class"
	, syntax_patterns      = ["class"]
	, syntax_code          =
		[ "class ... ... :: ..."
		, "class ... ... where ..."
		]
	, syntax_description   =
		"Classes are (sets of) overloaded functions. For classes with only one member function, a simplified syntax exists.\n\n" +
		"Types can instantiate classes with the {{`instance`}} keyword."
	, syntax_doc_locations = [CLR 8 "6.1" "_Toc311798056"]
	, syntax_examples      = map EX
		[ "class zero a :: a // one member"
		, "class Text s      // multiple members\nwhere\n\ttextSize :: !s -> Int\n\tconcat :: ![s] -> s\n\t// ..."
		]
	}

bs_code =
	{ syntax_title         = "ABC code"
	, syntax_patterns      = ["code", "inline", "code inline"]
	, syntax_code          = ["... = code [inline] { ... }"]
	, syntax_description   =
		"A code block with raw ABC instructions, which can be used for primitive functions like integer addition, for linking with C, bypassing the type system... welcome down the rabbit hole!\n\n" +
		"When `inline` is used, the function will be inlined when applied in a strict context."
	, syntax_doc_locations = [CLR 13 "11.2" "_Toc311798115"]
	, syntax_examples      = map EX
		[ "add :: !Int !Int -> Int                   // Primitive function\nadd a b = code inline {\n\taddI\n}"
		, "sleep :: !Int !*World -> *(!Int, !*World) // Linking with C\nsleep n w = code {\n\tccall sleep \"I:I:A\"\n}"
		, "cast :: !.a -> .b                         // Bypassing the type system\ncast _ = code {\n\tno_op\n}"
		]
	}

bs_define_constant =
	{ syntax_title         = "graph definition"
	, syntax_patterns      = ["=:"]
	, syntax_code          = ["... =: ..."]
	, syntax_description   =
		"Defining constants with `=:` at the top level makes sure they are shared through out the program; hence, they are evaluated only once.\n\n" +
		"This is the default understanding of `=` in local scope.\n\n" +
		"The inverse is {{`=>`}}, which defines an identifier to be a constant function."
	, syntax_doc_locations = [CLR 5 "3.6" "_Toc311798007"]
	, syntax_examples      = [EXs "macro" "mylist =: [1..10000]"]
	}
bs_define_graph =
	{ syntax_title         = "constant function definition"
	, syntax_patterns      = ["=>"]
	, syntax_code          = ["... => ..."]
	, syntax_description   =
		"Defining constants with `=>` at the top level makes sure they are interpreted as constant functions; hence, they are evaluated every time they are needed.\n\n" +
		"This is the default understanding of `=` in global scope.\n\n" +
		"The inverse is {{`=:`}}, which defines an identifier to be a graph."
	, syntax_doc_locations = [CLR 5 "3.6" "_Toc311798007"]
	, syntax_examples      = [EXs "macro" "mylist => [1..10000]"]
	}

bs_dotdot =
	{ syntax_title         = "dotdot expression"
	, syntax_patterns      = ["[\\e..]", "[\\e..\e]", "[\\e,\\e..]", "[[\\e,\\e..\\e]", "dotdot", "dot-dot", ".."]
	, syntax_code          = ["[i..]", "[i..k]", "[i,j..]", "[i,j..k]"]
	, syntax_description   =
		"A shorthand for lists of enumerable types.\n\n" +
		"To use these expressions, you must import {{`StdEnum`}}. The underlying functions are defined in {{`_SystemEnum`}}."
	, syntax_doc_locations = [CLR 6 "4.2.1" "_Toc311798023"]
	, syntax_examples      = map (EXs "macro")
		[ "xs = [0..]     // 0, 1, 2, 3, ..."
		, "xs = [0,2..]   // 0, 2, 4, 6, ..."
		, "xs = [0..10]   // 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10"
		, "xs = [0,2..10] // 0, 2, 4, 6, 8, 10"
		]
	}

bs_exists =
	{ syntax_title         = "existential quantifier"
	, syntax_patterns      = ["E", "E.*"]
	, syntax_code          = [":: ... = E. ...: ..."]
	, syntax_description   = "Existential quantifiers make it possible to define (recursive) objects of the same type with different types of content."
	, syntax_doc_locations = [CLR 7 "5.1.3" "_Toc311798042"]
	, syntax_examples      = [EX ":: List = E.e: Cons e List | Nil\nStart = Cons 5 (Cons 'a' (Cons \"abc\" Nil))"]
	}

bs_extensible_adt =
	{ syntax_title         = "extensible algebraic data type"
	, syntax_patterns      = ["..", "|"]
	, syntax_code          = [":: T | ...", ":: T = ... | ... | .."]
	, syntax_description   = join " "
		[ "Extensible algebraic data types are ADTs that can be extended in other modules."
		, "One module can declare the ADT as extendible by adding the `..` constructor."
		, "Other modules can then extend it."
		, "It is not possible to derive functions for EADTs."
		]
	, syntax_doc_locations = []
	, syntax_examples      = map EX
		[ ":: T = ..      // Declare T as an EADT"
		, ":: T = C1 | .. // Declare T to be an EADT with at least the constructor C1"
		, ":: T | C       // Extend the EADT T with constructor C"
		]
	}

bs_forall =
	{ syntax_title         = "universal quantifier"
	, syntax_patterns      = ["A", "A.*"]
	, syntax_code          = ["A. ...:"]
	, syntax_description   = "Explicitly marks polymorphic type variables. Clean does not yet allow universal quantifiers on the topmost level."
	, syntax_doc_locations = [CLR 5 "3.7.4" "_Toc311798013"]
	, syntax_examples      = map EX
		[ "hd :: A.a: [a] -> a           // Not yet allowed: A. on the topmost level"
		, "h :: (A.a: [a] -> Int) -> Int // The quantifier is needed to apply the function to both a [Int] and a [Char]\nh f = f [1..100] + f ['a'..'z']"
		, ":: T = C (A.a: a -> a)        // In a type"
		]
	}

bs_foreign =
	{ syntax_title         = "foreign export"
	, syntax_patterns      = ["foreign", "export", "ccall", "stdcall"]
	, syntax_code          =
		[ "foreign export [ccall | stdcall] ..."
		]
	, syntax_description   =
		"Exports the Clean function symbol to the binary.\n\n" +
		"This is only possible if the function is also in the definition module and all arguments are basic types or tuples and fully strict."
	, syntax_doc_locations = [CLR 13 "11.1" "_Toc311798114"]
	, syntax_examples      = map EX
		[ "foreign export factorial         // Export the factorial function"
		, "foreign export stdcall factorial // Idem but with the stdcall calling convention"
		]
	}

bs_funcdep =
	{ syntax_title         = "functional dependency"
	, syntax_patterns      = ["~"]
	, syntax_code          =
		[ "class ... ~... ..."
		]
	, syntax_description   =
		"Lets you point the type checker to the type that determines the other types.\n\n" +
		"Most often this is the return type (undocumented and experimental)."
	, syntax_doc_locations = []
	, syntax_examples      = map EX
		[ "class plus a b c :: a b -> c\n" +
		  "instance plus Int Int Int where plus x y = x + y\n" +
		  "Start = plus 1 (plus 1 1) // Results in: internal overloading of \"plus\" could not be solved because the compiler doesn't know the type of the intermediate result."
		, "class plus a b ~c :: a b -> c\n" +
		  "instance plus Int Int Int where plus x y = x + y\n" +
		  "Start = plus 1 (plus 1 1) // Works! because we told the compiler that c determines the other types."
		]
	}

bs_generic =
	{ syntax_title         = "generic function definition"
	, syntax_patterns      = ["generic", "derive", "of", "{|*|}"] // This * matches everything, which is intentional
	, syntax_code          = ["generic ... ... :: ...", "derive ... ..."]
	, syntax_description   = "With generics, a function can be defined once and derived for (almost) all possible types, to avoid very similar code snippets."
	, syntax_doc_locations = [CLR 9 "7.2" "_Toc311798069"]
	, syntax_examples      =
		[ EX            "generic gEq a :: !a !a -> Bool        // The type of a generic function"
		, EXs "macro" $ "gEq{|Int|} x y = x == y               // Implementation of a generic\n" +
		  "gEq{|PAIR|} fx fy (PAIR x1 y1) (PAIR x2 y2) = fx x1 x2 && fy y1 y2" // TODO highlighting
		, EX            "derive gEq []                         // Deriving the gEq generic for type []"
		, EXs "macro"   "gConsName{|CONS of d|} _ = d.gcd_name // Using type information"
		]
	}

bs_import =
	{ syntax_title         = "imports"
	, syntax_patterns      = ["import", "from", "qualified", "as", "=>", "code", "library"]
	, syntax_code          =
		[ "import [qualified] ... [as ...]"
		, "from ... import ..."
		, "import ... => qualified ..."
		, "import code from [library] ..."
		]
	, syntax_description   =
		"Imports code from other modules.\n\n" +
		"With the `from` keyword, one can achieve more granularity.\n\n" +
		"In case of name clashes, `qualified` can be used (undocumented).\n\n" +
		"Moreover, you can import from object files or windows DLLs."
	, syntax_doc_locations = [CLR 4 "2.5" "_Toc311797991"]
	, syntax_examples      = map EX
		[ "import StdEnv                          // Import all code from the StdEnv definition module"
		, "from StdFunc import o                  // Import only the o function from StdFunc"
		, "import qualified Data.Map              // Import Data.Map such that functions are available as e.g. 'Data.Map'.get."
		, "import qualified Data.Map as M         // Import Data.Map such that functions are available as e.g. 'M'.get."
		, "import Control.Monad => qualified join // Import all code from Control.Monad except for join. join is imported qualified"
		, "import code from \"tty.\"                // Import functions from the object file matching 'Clean System Files/tty.*'"
		, "import code from library \"msvcrt\"      // Import functions from linked DLLs according to the msvcrt file in Clean System Files.\n" +
		  "                                       // The file should start with the DLL name (e.g. msvcrt) and followed by one line per function you want to link."
		]
	}

bs_infix =
	{ syntax_title         = "infix operator"
	, syntax_patterns      = ["infix", "infixl", "infixr"]
	, syntax_code          = ["infix[l,r] [...]"]
	, syntax_description   =
		"Defines a function with arity 2 that can be used in infix position.\n\n" +
		"The following number, if any, determines the precedence.\n\n" +
		"`infixl` and `infixr` indicate associativity."
	, syntax_doc_locations = [CLR 5 "3.7.2" "_Toc311798011"]
	, syntax_examples      =
		[ EX          "(bitor) infixl 6 :: !Int !Int -> Int // Left-associative infix function with precedence 6"
		, EXs "macro" "(o) infixr 9                         // Infix macro\n(o) f g :== \\x -> f (g x)"
		, EX          ":: MyType = (:+:) infixl 6 Int Int   // Infix data constructor, can be used as (5 :+: 10)"
		]
	}

bs_instance =
	{ syntax_title         = "instance"
	, syntax_patterns      = ["instance"]
	, syntax_code          = ["instance ... ... where ..."]
	, syntax_description   = "Defines an instantiation of a {{class}} for a type."
	, syntax_doc_locations = [CLR 8 "6.1" "_Toc311798056"]
	, syntax_examples      = map EX
		[ "instance zero Int\nwhere\n\tzero = 0"
		, "instance zero Real\nwhere\n\tzero = 0.0"
		]
	}

bs_lambda =
	{ syntax_title         = "lambda abstraction"
	, syntax_patterns      = ["lambda", "\\*", "->", "."]
	, syntax_code          = ["\\... -> ...", "\\... . ...", "\\... = ..."]
	, syntax_description   = "An anonymous, inline function."
	, syntax_doc_locations = [CLR 5 "3.4.1" "_Toc311798000"]
	, syntax_examples      = map (EXs "macro")
		[ "(o) f g = \\x -> f (g x)         // Simple lambda expression"
		, "swapall = map (\\(x,y) -> (y,x)) // Pattern matching in lambda arguments"
		, "mul     = \\x y -> x * y         // Multiple arguments (of course, it would be better to write `mul x y = x * y` or `mul = (*)`)"
		]
	}

bs_layout_rule =
	{ syntax_title         = "layout rule"
	, syntax_patterns      = [";", "{", "}"]
	, syntax_code          = ["...;", "{ ... }"]
	, syntax_description   =
		"Most Clean programs are written using the layout rule, which means that scopes are indicated with indent levels." +
		"The layout sensitive mode can be turned off by adding a semicolon `;` at the end of the {{module}} line." +
		"Then, scopes have to be indicated with `{ ... }` and definitions have to end with `;`."
	, syntax_doc_locations = [CLR 4 "2.3.3" "_Toc311797989"]
	, syntax_examples      = [EX $
		"module test;\n" +
		"import StdEnv;\n" +
		"Start :: [(Int,Int)];\n" +
		"Start = [(x,y) \\\\ x <- odds, y <- evens];\n" +
		"where\n" +
		"{\n" +
		"\todds  = [1,3..9];\n" +
		"\tevens = [0,2..8];\n" +
		"}"]
	}

bs_let =
	{ syntax_title         = "let expression"
	, syntax_patterns      = ["let", "in", "let in"]
	, syntax_code          = ["let ... in ..."]
	, syntax_description   = "An expression that introduces new scope."
	, syntax_doc_locations = [CLR 5 "3.5.1" "_Toc311798003"]
	, syntax_examples      =
		[ EXs "macro"    "fac n = let fs = [1:1:[(fs!!(i-1)) + (fs!!(i-2)) \\ i <- [2..]]] in fs !! n"
		, EXs "macrorhs" "let // Multi-line let expressions\n\tfunction args = body\n\tselector = expr\n\t// ...\nin expression"
		]
	}
bs_let_before =
	{ syntax_title         = "let before"
	, syntax_patterns      = ["#", "#!"]
	, syntax_code          = ["#  ... = ...", "#! ... = ..."]
	, syntax_description   = "A {{`let`}} expression that can be defined before a guard or function body, which eases the syntax of sequential actions."
	, syntax_doc_locations = [CLR 5 "3.5.4" "_Toc311798006"]
	, syntax_examples      =
		[ EX "readchars :: *File -> *([Char], *File)\nreadchars f\n# (ok,c,f) = freadc file\n| not ok   = ([], f)\n# (cs,f)   = readchars f\n= ([c:cs], f)"
		]
	}

bs_list_expressions =
	{ syntax_title         = "list expression"
	, syntax_patterns      = ["list", "[]", "[:]", ":", "[\\e:\\e]", "['*"]
	, syntax_code          = ["[]", "[...:...]", "[..., ..., ...]", "['...']"]
	, syntax_description   =
		"A list can be composed of individual elements or a head and a tail. Special syntax is available for creating `[{{Char}}]` lists.\n\n" +
		"See also {{dotdot}} expressions.\n\n" +
		"The colon is not an operator in Clean, because it must always be surrounded by `[` and `]`. It can therefore not be curried, flipped, etc."
	, syntax_doc_locations = [CLR 6 "4.2.1" "_Toc311798021"]
	, syntax_examples      = map (EXs "macro")
		[ "abc = ['a', 'b', 'c']     // Individual elements"
		, "abc = ['a':['b':['c':[]]] // Head and tail, ending with the empty list"
		, "abc = ['abc']             // Special syntax for [Char] lists"
		]
	}

bs_macro =
	{ syntax_title         = "macro"
	, syntax_patterns      = [":==", "macro"]
	, syntax_code          = ["... :== ..."]
	, syntax_description   =
		"A macro is a compile-time rewrite rule. It can be used for constants, inline subtitutions, renaming functions, conditional compilation, etc.\n\n" +
		"Macros can appear in patterns to match on constants."
	, syntax_doc_locations = [CLR 12 "10.3" "_Toc311798111"]
	, syntax_examples      = map (EXs "macro")
		[ "flip f a b :== f b a                    // Useful for currying"
		, "IF_INT_64_OR_32 int64 int32 :== int64   // Conditional compilation"
		, "(o) infixr 9                            // Function composition. Doing this at run-time would be slow\n(o) f g :== \\x -> f (g x)"
		]
	}

bs_module =
	{ syntax_title         = "module heading"
	, syntax_patterns      = ["module", "definition", "implementation", "system", "definition module", "implementation module", "system module"]
	, syntax_code          = ["[definition,implementation,system] module ..."]
	, syntax_description   = "The heading of a Clean file. Definition modules describe what things are exported (dcl files), implementation modules how they are implemented (icl files)."
	, syntax_doc_locations = [CLR 4 "2.2" "_Toc311797983"]
	, syntax_examples      = map EX
		[ "definition module StdList     // Exported definitions of list functions"
		, "implementation module StdList // The implementations of the functions"
		, "module test                   // An implementation module without corresponding dcl"
		, "system module StdInt          // The definitions of a module that contains foreign code (see section 2.6 of the language report)"
		]
	}

bs_newtype =
	{ syntax_title         = "Newtype definition (experimental)"
	, syntax_patterns      = ["=:", "newtype"]
	, syntax_code          = [":: ... =: ... ..."]
	, syntax_description   = "A newtype is a type synonym at run-time but treated as a real type at compile-time.\n"
	                       + "This allows the creation of separate instances without overhead."
	, syntax_doc_locations = []
	, syntax_examples      =
		[ EX ":: T =: T Int"
		, EX ":: T a =: T a"
		]
	}

bs_overloaded_type_variable =
	{ syntax_title         = "Overloaded type variable"
	, syntax_patterns      = ["^", "a^"]
	, syntax_code          = ["... :: ...^"]
	, syntax_description   = "A pattern match on the type of a dynamic depending on the type of the function."
	, syntax_doc_locations = [CLR 10 "8.2.5" "_Toc311798087"]
	, syntax_examples      = [EX "unpack :: Dynamic -> Maybe a\nunpack (x :: a^) = Just x // Only values of type a\nunpack _         = Nothing"]
	}

bs_otherwise =
	{ syntax_title         = "otherwise"
	, syntax_patterns      = ["otherwise"]
	, syntax_code          = ["otherwise"]
	, syntax_description   = "The (optional) last alternative in a guard. It caches all other cases, and makes sure your program does not crash if none of the cases matches."
	, syntax_doc_locations = [CLR 5 "3.3" "_Toc311797998"]
	, syntax_examples      =
		[ EXs "macrorhs" "| otherwise = ..."
		, EXs "macro"    "sign :: !Int -> Int\nsign n\n| n  < 0    = -1 // Negative number\n| n == 0    =  0 // Zero\n| otherwise =  1 // Must be positive"
		]
	}

bs_pattern_named =
	{ syntax_title         = "pattern match"
	, syntax_patterns      = ["=:"]
	, syntax_code          = ["...=:(...)"]
	, syntax_description   = "Give a name to the expression of a pattern to be able to use the whole expression without creating new graphs."
	, syntax_doc_locations = [CLR 5 "3.2" "_Toc311797997"]
	, syntax_examples      = map EX
		[ "isJustU e=:(Just _) = (True, e) // On an ADT"
		, ":: Position = {px :: Int, py :: Int}\ngetx p=:{px} = (px, p) // On a record; this has type :: Position -> (Int, Position)"
		]
	}

bs_pattern_predicate =
	{ syntax_title         = "pattern predicate"
	, syntax_patterns      = ["=:"]
	, syntax_code          = ["...=:(...)"]
	, syntax_description   = join " "
		[ "Check whether an expression matches a certain pattern (undocumented)."
		, "The result has type `Bool`."
		, "It is not possible to introduce new identifiers this way."
		, "For instance, one cannot use `if (mbx=:(Just x)) x 0`."
		, "Also, `=:` can not be used in prefix form because it is not an actual operator but a builtin."
		]
	, syntax_doc_locations = []
	, syntax_examples      = [EX "isSingleton l = l =: [_] // Match a value with a pattern"]
	}

bs_selection_array =
	{ syntax_title         = "array selection"
	, syntax_patterns      = [".[]", ".[\\e]", ".[,*]", ".[\\e,*]"]
	, syntax_code          = [".[i]", ".[i,j,...]"]
	, syntax_description   = "Select an element from a (possibly multidimensional) array. The indexes must have the type {{`Int`}}."
	, syntax_doc_locations = [CLR 6 "4.4.1" "_Toc311798033"]
	, syntax_examples      = map (EXs "macro")
		[ "five = {1,2,3,4,5,6,7,8,9,10}.[4]    // Arrays are zero-indexed"
		, "five = {{1,2},{3,4,5},{6,7,8}}.[1,2] // This is equivalent to (...).[1].[2]"
		]
	}
bs_selection_array_unique =
	{ syntax_title         = "unique array selection"
	, syntax_patterns      = ["![]", "![\\e]", "![,*]", "![\\e,*]"]
	, syntax_code          = ["![i]", "![i,j,...]"]
	, syntax_description   = "Select an element from a (possibly multidimensional, possibly unique) array and return both the element and the array. The indexes must have the type {{`Int`}}."
	, syntax_doc_locations = [CLR 6 "4.4.1" "_Toc311798033"]
	, syntax_examples      = map (EXs "macro")
		[ "(five,arr) = {1,2,3,4,5,6,7,8,9,10}![4]"
		, "(five,arr) = {{1,2},{3,4,5},{6,7,8}}![1,2]"
		]
	}
bs_selection_record =
	{ syntax_title         = "record selection"
	, syntax_patterns      = ["."]
	, syntax_code          = ["."]
	, syntax_description   = "Select a field from a (possibly multilevel) record."
	, syntax_doc_locations = [CLR 7 "5.2.1" "_Toc311798050"]
	, syntax_examples      = map (EXs "macro")
		[ "five = {px=5, py=10}.px"
		, "five = {pxy={px=5, py=10}, pz=2}.pxy.px"
		, "five = {px=5, py=10}.Position.px // If multiple records have a field px, the type name can be used for disambiguation"
		]
	}
bs_selection_record_unique =
	{ syntax_title         = "unique record selection"
	, syntax_patterns      = ["!"]
	, syntax_code          = ["!"]
	, syntax_description   = "Select a field from a (possibly multilevel, possibly unique) record and return both the field data and the record."
	, syntax_doc_locations = [CLR 7 "5.2.1" "_Toc311798050"]
	, syntax_examples      = map (EXs "macro")
		[ "(five,rec) = {px=5, py=10}!px"
		, "(five,rec) = {pxy={px=5, py=10}, pz=2}!pxy.px // Only the first field should have the exclamation mark"
		, "(five,rec) = {px=5, py=10}!Position.px // If multiple records have a field px, the type name can be used for disambiguation\n" +
		  "                                       // The language report is erroneous here. It is !Position.px, not .Position!px."
		]
	}

bs_strict =
	{ syntax_title         = "strictness annotation"
	, syntax_patterns      = ["strict", "!"]
	, syntax_code          = ["!"]
	, syntax_description   = "Override the lazy evaluation strategy: the argument must be evaluated to head normal form before the function is entered."
	, syntax_doc_locations = [CLR 5 "3.7.5" "_Toc311798014", CLR 12 "10" "_Toc311798103"]
	, syntax_examples      = [EX "acker :: !Int !Int -> Int"]
	}

bs_synonym =
	{ syntax_title         = "synonym type definition"
	, syntax_patterns      = ["synonym", ":=="]
	, syntax_code          = [":: ... :== ..."]
	, syntax_description   = "Defines a new type name for an existing type."
	, syntax_doc_locations = [CLR 7 "5.3" "_Toc311798052"]
	, syntax_examples      = [EX ":: String :== {#Char}"]
	}
bs_synonym_abstract =
	{ syntax_title         = "abstract synonym type definition"
	, syntax_patterns      = ["synonym", ":=="]
	, syntax_code          = [":: ... (:== ...)"]
	, syntax_description   = "Defines a new type name for an existing type, while the type behaves as an abstract type for the programmer. This allows compiler optimisations on abstract types."
	, syntax_doc_locations = [CLR 7 "5.4.1" "_Toc311798054"]
	, syntax_examples      = [EX ":: Stack a (:== [a])"]
	}

bs_unique =
	{ syntax_title         = "uniqueness annotation"
	, syntax_patterns      = ["\\*", ".", "%:", "[*<=*]", ",", "<="]
	, syntax_code          =
		[ "*..."
		, ". ..."
		, "...:..., [...<=...], [...<=...], ..."
		]
	, syntax_description   = join " "
		[ "Annotates a type with its uniqueness."
		, "A type can either be unique (`*`), not unique (not annotated), possibly unique (`.`) or relatively unique (identifier and `, [...<=...]` after the type context)."
		, "Because uniqueness is binary, there is only one case where `[u<=v]` is not satisfied; when `u` is unique but `v` is not."
		, "\n\nOn function types, *uniqueness propagation* is implicit (see section 9.2 of the language report)."
		, "However, when using unique types in a function or an ADT this has to be made explicit; for instance:"
		, "`T = T (Int, *File)` has to be `T = T *(Int, *File)`."
		, "Functions have to be split up into arity 1 and the subfunctions must be annotated as well; for instance:"
		, "`T = T (Int *Int -> *Int)` has to be `T = T (Int -> *(*Int -> *Int))`."
		]
	, syntax_doc_locations = [CLR 11 "9.1" "_Toc311798093"]
	, syntax_examples      = map EX
		[ "Start :: *World -> *World   // World is unique"
		, "copyArray :: *(a e) -> *(*a e, *a e) | Array a e // Add parentheses when needed"
		, "f :: .a -> .a               // f works on unique and non-unique values"
		, "f :: v:a u:b -> u:b, [v<=u] // f works when a is less unique than b"
		]
	}

bs_update_array =
	{ syntax_title         = "array update"
	, syntax_patterns      = ["&", "{*&*[\\e]*=*}"]
	, syntax_code          =
		[ "{ a & [i]=x, [j]=y, ... } // Updates a by setting index i to x, j to y, ..."
		, "# a & [i]=x, [j]=y, ...   // Same as # a = {a & [i]=x, [j]=y, ...}" // See https://clean.cs.ru.nl/Clean_2.3
		]
	, syntax_description   = "Updates an array by creating a copy and replacing one or more elements."
	, syntax_doc_locations = [CLR 6 "4.4.1" "_Toc311798032"]
	, syntax_examples      = []
	}
bs_update_record =
	{ syntax_title         = "record update"
	, syntax_patterns      = ["&", "{*&*=*}"]
	, syntax_code          =
		[ "{ r & f1=x, f2=y, ... } // Updates r by setting f1 to x, f2 to y, ..."
		, "# r & f1=x, f2=y, ...   // Same as # r = {r & f1=x, f2=y, ...}" // See https://clean.cs.ru.nl/Clean_2.3
		]
	, syntax_description   = "Updates a record by creating a copy and replacing one or more fields."
	, syntax_doc_locations = [CLR 7 "5.2.1" "_Toc311798049"]
	, syntax_examples      = []
	}

bs_where_class =
	{ syntax_title         = "where"
	, syntax_patterns      = ["where"]
	, syntax_code          = ["where"]
	, syntax_description   = "Introduces the members of a {{`class`}} definition."
	, syntax_doc_locations = [CLR 8 "6.1"   "_Toc311798056"]
	, syntax_examples      = [EX "class Arith a        // Class definition\nwhere\n\t(+) infixl 6 :: a a -> a\n\t(-) infixl 6 :: a a -> a"]
	}
bs_where_instance =
	{ syntax_title         = "where"
	, syntax_patterns      = ["where"]
	, syntax_code          = ["where"]
	, syntax_description   = "Introduces the implementation of an {{`instance`}}."
	, syntax_doc_locations = [CLR 8 "6.1"   "_Toc311798056"]
	, syntax_examples      = [EX "instance Arith Int   // Instance definition\nwhere\n\t(+) x y = // ...\n\t(-) x y = // ..."]
	}
bs_where_local =
	{ syntax_title         = "where"
	, syntax_patterns      = ["where"]
	, syntax_code          = ["where"]
	, syntax_description   = "Introduces local definitions. For guard-local definitions, see {{`with`}}."
	, syntax_doc_locations = [CLR 5 "3.5.2" "_Toc311798004"]
	, syntax_examples      = [EXs "macro" "primes = sieve [2..] // Local definitions\nwhere\n\tsieve [pr:r] = [pr:sieve (filter pr r)]"]
	}

bs_with =
	{ syntax_title         = "with"
	, syntax_patterns      = ["with"]
	, syntax_code          = ["with"]
	, syntax_description   = "Introduces guard-local definitions. For function-local definitions, see {{`where`}}."
	, syntax_doc_locations = [CLR 5 "3.5.3" "_Toc311798005"]
	, syntax_examples      = [EXs "macro" "f x y\n| guard1 = alt1\n\twith local = expr1\n| guard2 = alt2\n\twith local = expr2"]
	}

bs_zf =
	{ syntax_title         = "list comprehension"
	, syntax_patterns      = ["ZF-expression", "ZF", "zf", "comprehension", "<-", "<|-", "<-:", "\\\\", ",", "&", "|"]
	, syntax_code          = ["[... \\\\ ... <- ...]"]
	, syntax_description   = "Constructs a list composed of elements drawn from other lists or arrays."
	, syntax_doc_locations = [CLR 6 "4.2.1" "_Toc311798024"]
	, syntax_examples      = map (EXs "macro")
		[ "cartesian    = [(x,y) \\\\ x <- [1,2,3], y <- [10,20]] // Cartesian product: (1,10), (1,20), (2,10), (2,20), (3,10), (3,20)"
		, "zip xs ys    = [(x,y) \\\\ x <- xs & y <- ys]          // Pairwise zip through the lists"
		, "filter f xs  = [x \\\\ x <- xs | f x]                  // Guard to add conditions"
		, "catMaybes ms = [x \\\\ Just x <- ms]                   // Pattern matching in the selector"
		, "triangle     = [(x,y) \\\\ x <- [1,2,3], y <- [1..x]]  // Reusing x in the next generator: (1,1), (2,1), (2,2), (3,1), (3,2), (3,3)"
		, "arrToList a  = [x \\\\ x <-: a]                        // <-: for arrays"
		, "castList xs  = [|x \\\\ x <|- xs]                      // The two pipe characters make both xs and the result overloaded lists"
		]
	}

implementation module Builtin.Syntax

import StdList

from Data.Func import $
import Data.Maybe
import Text

import Cloogle.API
import Cloogle.DB

import Builtin.Predef

builtin_syntax :: [SyntaxEntry]
builtin_syntax =
	[ bs_case
	, bs_class
	, bs_code
	, bs_define_constant
	, bs_define_graph
	, bs_dotdot
	, bs_exists
	, bs_extensible_adt
	, bs_forall
	, bs_foreign
	, bs_funcdep
	, bs_generic
	, bs_import
	, bs_infix
	, bs_instance
	, bs_lambda
	, bs_layout_rule
	, bs_let
	, bs_let_before
	, bs_list_expressions
	, bs_macro
	, bs_module
	, bs_newtype
	, bs_overloaded_type_variable
	, bs_otherwise
	, bs_pattern
	, bs_selection_array
	, bs_selection_array_unique
	, bs_selection_record
	, bs_selection_record_unique
	, bs_strict
	, bs_synonym
	, bs_synonym_abstract
	, bs_unique
	, bs_update_array
	, bs_update_record
	, bs_where_class
	, bs_where_instance
	, bs_where_local
	, bs_with
	, bs_zf
	]

EX :: !String -> SyntaxExample
EX c = {example=c, cleanjs_start=Nothing}
EXs :: !String !String -> SyntaxExample
EXs s c = {example=c, cleanjs_start=Just s}

bs_case =
	{ syntax_title         = "case expression"
	, syntax_patterns      = ["case", "of", "case of", "->", "="]
	, syntax_code          = ["case ... of ..."]
	, syntax_description   = join " "
		[ "Pattern match on an expression and do something depending on the alternative of the matching pattern."
		, "Both `->` and `=` can be used to separate patterns and alternatives, however, they cannot be mixed."
		]
	, syntax_doc_locations = [CLR 5 "3.4.2" "_Toc311798001"]
	, syntax_examples      =
		[ EXs "macro" "isJust m = case m of\n\tJust _ -> True\n\t_      -> False"
		]
	}

bs_class =
	{ syntax_title         = "class"
	, syntax_patterns      = ["class"]
	, syntax_code          =
		[ "class ... ... :: ..."
		, "class ... ... where ..."
		]
	, syntax_description   =
		"Classes are (sets of) overloaded functions. For classes with only one member function, a simplified syntax exists.\n\n" +
		"Types can instantiate classes with the {{`instance`}} keyword."
	, syntax_doc_locations = [CLR 8 "6.1" "_Toc311798056"]
	, syntax_examples      = map EX
		[ "class zero a :: a // one member"
		, "class Text s      // multiple members\nwhere\n\ttextSize :: !s -> Int\n\tconcat :: ![s] -> s\n\t// ..."
		]
	}

bs_code =
	{ syntax_title         = "ABC code"
	, syntax_patterns      = ["code", "inline", "code inline"]
	, syntax_code          = ["... = code [inline] { ... }"]
	, syntax_description   =
		"A code block with raw ABC instructions, which can be used for primitive functions like integer addition, for linking with C, bypassing the type system... welcome down the rabbit hole!\n\n" +
		"When `inline` is used, the function will be inlined when applied in a strict context."
	, syntax_doc_locations = [CLR 13 "11.2" "_Toc311798115"]
	, syntax_examples      = map EX
		[ "add :: !Int !Int -> Int                   // Primitive function\nadd a b = code inline {\n\taddI\n}"
		, "sleep :: !Int !*World -> *(!Int, !*World) // Linking with C\nsleep n w = code {\n\tccall sleep \"I:I:A\"\n}"
		, "cast :: !.a -> .b                         // Bypassing the type system\ncast _ = code {\n\tno_op\n}"
		]
	}

bs_define_constant =
	{ syntax_title         = "graph definition"
	, syntax_patterns      = ["=:"]
	, syntax_code          = ["... =: ..."]
	, syntax_description   =
		"Defining constants with `=:` at the top level makes sure they are shared through out the program; hence, they are evaluated only once.\n\n" +
		"This is the default understanding of `=` in local scope.\n\n" +
		"The inverse is {{`=>`}}, which defines an identifier to be a constant function."
	, syntax_doc_locations = [CLR 5 "3.6" "_Toc311798007"]
	, syntax_examples      = [EXs "macro" "mylist =: [1..10000]"]
	}
bs_define_graph =
	{ syntax_title         = "constant function definition"
	, syntax_patterns      = ["=>"]
	, syntax_code          = ["... => ..."]
	, syntax_description   =
		"Defining constants with `=>` at the top level makes sure they are interpreted as constant functions; hence, they are evaluated every time they are needed.\n\n" +
		"This is the default understanding of `=` in global scope.\n\n" +
		"The inverse is {{`=:`}}, which defines an identifier to be a graph."
	, syntax_doc_locations = [CLR 5 "3.6" "_Toc311798007"]
	, syntax_examples      = [EXs "macro" "mylist => [1..10000]"]
	}

bs_dotdot =
	{ syntax_title         = "dotdot expression"
	, syntax_patterns      = ["[\\e..]", "[\\e..\e]", "[\\e,\\e..]", "[[\\e,\\e..\\e]", "dotdot", "dot-dot", ".."]
	, syntax_code          = ["[i..]", "[i..k]", "[i,j..]", "[i,j..k]"]
	, syntax_description   =
		"A shorthand for lists of enumerable types.\n\n" +
		"To use these expressions, you must import {{`StdEnum`}}. The underlying functions are defined in {{`_SystemEnum`}}."
	, syntax_doc_locations = [CLR 6 "4.2.1" "_Toc311798023"]
	, syntax_examples      = map (EXs "macro")
		[ "xs = [0..]     // 0, 1, 2, 3, ..."
		, "xs = [0,2..]   // 0, 2, 4, 6, ..."
		, "xs = [0..10]   // 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10"
		, "xs = [0,2..10] // 0, 2, 4, 6, 8, 10"
		]
	}

bs_exists =
	{ syntax_title         = "existential quantifier"
	, syntax_patterns      = ["E", "E.*"]
	, syntax_code          = [":: ... = E. ...: ..."]
	, syntax_description   = "Existential quantifiers make it possible to define (recursive) objects of the same type with different types of content."
	, syntax_doc_locations = [CLR 7 "5.1.3" "_Toc311798042"]
	, syntax_examples      = [EX ":: List = E.e: Cons e List | Nil\nStart = Cons 5 (Cons 'a' (Cons \"abc\" Nil))"]
	}

bs_extensible_adt =
	{ syntax_title         = "extensible algebraic data type"
	, syntax_patterns      = ["..", "|"]
	, syntax_code          = [":: T | ...", ":: T = ... | ... | .."]
	, syntax_description   = join " "
		[ "Extensible algebraic data types are ADTs that can be extended in other modules."
		, "One module can declare the ADT as extendible by adding the `..` constructor."
		, "Other modules can then extend it."
		, "It is not possible to derive functions for EADTs."
		]
	, syntax_doc_locations = []
	, syntax_examples      = map EX
		[ ":: T = ..      // Declare T as an EADT"
		, ":: T = C1 | .. // Declare T to be an EADT with at least the constructor C1"
		, ":: T | C       // Extend the EADT T with constructor C"
		]
	}

bs_forall =
	{ syntax_title         = "universal quantifier"
	, syntax_patterns      = ["A", "A.*"]
	, syntax_code          = ["A. ...:"]
	, syntax_description   = "Explicitly marks polymorphic type variables. Clean does not yet allow universal quantifiers on the topmost level."
	, syntax_doc_locations = [CLR 5 "3.7.4" "_Toc311798013"]
	, syntax_examples      = map EX
		[ "hd :: A.a: [a] -> a           // Not yet allowed: A. on the topmost level"
		, "h :: (A.a: [a] -> Int) -> Int // The quantifier is needed to apply the function to both a [Int] and a [Char]\nh f = f [1..100] + f ['a'..'z']"
		, ":: T = C (A.a: a -> a)        // In a type"
		]
	}

bs_foreign =
	{ syntax_title         = "foreign export"
	, syntax_patterns      = ["foreign", "export", "ccall", "stdcall"]
	, syntax_code          =
		[ "foreign export [ccall | stdcall] ..."
		]
	, syntax_description   =
		"Exports the Clean function symbol to the binary.\n\n" +
		"This is only possible if the function is also in the definition module and all arguments are basic types or tuples and fully strict."
	, syntax_doc_locations = [CLR 13 "11.1" "_Toc311798114"]
	, syntax_examples      = map EX
		[ "foreign export factorial         // Export the factorial function"
		, "foreign export stdcall factorial // Idem but with the stdcall calling convention"
		]
	}

bs_funcdep =
	{ syntax_title         = "functional dependency"
	, syntax_patterns      = ["~"]
	, syntax_code          =
		[ "class ... ~... ..."
		]
	, syntax_description   =
		"Lets you point the type checker to the type that determines the other types.\n\n" +
		"Most often this is the return type (undocumented and experimental)."
	, syntax_doc_locations = []
	, syntax_examples      = map EX
		[ "class plus a b c :: a b -> c\n" +
		  "instance plus Int Int Int where plus x y = x + y\n" +
		  "Start = plus 1 (plus 1 1) // Results in: internal overloading of \"plus\" could not be solved because the compiler doesn't know the type of the intermediate result."
		, "class plus a b ~c :: a b -> c\n" +
		  "instance plus Int Int Int where plus x y = x + y\n" +
		  "Start = plus 1 (plus 1 1) // Works! because we told the compiler that c determines the other types."
		]
	}

bs_generic =
	{ syntax_title         = "generic function definition"
	, syntax_patterns      = ["generic", "derive", "of", "{|*|}"] // This * matches everything, which is intentional
	, syntax_code          = ["generic ... ... :: ...", "derive ... ..."]
	, syntax_description   = "With generics, a function can be defined once and derived for (almost) all possible types, to avoid very similar code snippets."
	, syntax_doc_locations = [CLR 9 "7.2" "_Toc311798069"]
	, syntax_examples      =
		[ EX            "generic gEq a :: !a !a -> Bool        // The type of a generic function"
		, EXs "macro" $ "gEq{|Int|} x y = x == y               // Implementation of a generic\n" +
		  "gEq{|PAIR|} fx fy (PAIR x1 y1) (PAIR x2 y2) = fx x1 x2 && fy y1 y2" // TODO highlighting
		, EX            "derive gEq []                         // Deriving the gEq generic for type []"
		, EXs "macro"   "gConsName{|CONS of d|} _ = d.gcd_name // Using type information"
		]
	}

bs_import =
	{ syntax_title         = "imports"
	, syntax_patterns      = ["import", "from", "qualified", "as", "=>", "code", "library"]
	, syntax_code          =
		[ "import [qualified] ... [as ...]"
		, "from ... import ..."
		, "import ... => qualified ..."
		, "import code from [library] ..."
		]
	, syntax_description   =
		"Imports code from other modules.\n\n" +
		"With the `from` keyword, one can achieve more granularity.\n\n" +
		"In case of name clashes, `qualified` can be used (undocumented).\n\n" +
		"Moreover, you can import from object files or windows DLLs."
	, syntax_doc_locations = [CLR 4 "2.5" "_Toc311797991"]
	, syntax_examples      = map EX
		[ "import StdEnv                          // Import all code from the StdEnv definition module"
		, "from StdFunc import o                  // Import only the o function from StdFunc"
		, "import qualified Data.Map              // Import Data.Map such that functions are available as e.g. 'Data.Map'.get."
		, "import qualified Data.Map as M         // Import Data.Map such that functions are available as e.g. 'M'.get."
		, "import Control.Monad => qualified join // Import all code from Control.Monad except for join. join is imported qualified"
		, "import code from \"tty.\"                // Import functions from the object file matching 'Clean System Files/tty.*'"
		, "import code from library \"msvcrt\"      // Import functions from linked DLLs according to the msvcrt file in Clean System Files.\n" +
		  "                                       // The file should start with the DLL name (e.g. msvcrt) and followed by one line per function you want to link."
		]
	}

bs_infix =
	{ syntax_title         = "infix operator"
	, syntax_patterns      = ["infix", "infixl", "infixr"]
	, syntax_code          = ["infix[l,r] [...]"]
	, syntax_description   =
		"Defines a function with arity 2 that can be used in infix position.\n\n" +
		"The following number, if any, determines the precedence.\n\n" +
		"`infixl` and `infixr` indicate associativity."
	, syntax_doc_locations = [CLR 5 "3.7.2" "_Toc311798011"]
	, syntax_examples      =
		[ EX          "(bitor) infixl 6 :: !Int !Int -> Int // Left-associative infix function with precedence 6"
		, EXs "macro" "(o) infixr 9                         // Infix macro\n(o) f g :== \\x -> f (g x)"
		, EX          ":: MyType = (:+:) infixl 6 Int Int   // Infix data constructor, can be used as (5 :+: 10)"
		]
	}

bs_instance =
	{ syntax_title         = "instance"
	, syntax_patterns      = ["instance"]
	, syntax_code          = ["instance ... ... where ..."]
	, syntax_description   = "Defines an instantiation of a {{class}} for a type."
	, syntax_doc_locations = [CLR 8 "6.1" "_Toc311798056"]
	, syntax_examples      = map EX
		[ "instance zero Int\nwhere\n\tzero = 0"
		, "instance zero Real\nwhere\n\tzero = 0.0"
		]
	}

bs_lambda =
	{ syntax_title         = "lambda abstraction"
	, syntax_patterns      = ["lambda", "\\*", "->", "."]
	, syntax_code          = ["\\... -> ...", "\\... . ...", "\\... = ..."]
	, syntax_description   = "An anonymous, inline function."
	, syntax_doc_locations = [CLR 5 "3.4.1" "_Toc311798000"]
	, syntax_examples      = map (EXs "macro")
		[ "(o) f g = \\x -> f (g x)         // Simple lambda expression"
		, "swapall = map (\\(x,y) -> (y,x)) // Pattern matching in lambda arguments"
		, "mul     = \\x y -> x * y         // Multiple arguments (of course, it would be better to write `mul x y = x * y` or `mul = (*)`)"
		]
	}

bs_layout_rule =
	{ syntax_title         = "layout rule"
	, syntax_patterns      = [";", "{", "}"]
	, syntax_code          = ["...;", "{ ... }"]
	, syntax_description   =
		"Most Clean programs are written using the layout rule, which means that scopes are indicated with indent levels." +
		"The layout sensitive mode can be turned off by adding a semicolon `;` at the end of the {{module}} line." +
		"Then, scopes have to be indicated with `{ ... }` and definitions have to end with `;`."
	, syntax_doc_locations = [CLR 4 "2.3.3" "_Toc311797989"]
	, syntax_examples      = [EX $
		"module test;\n" +
		"import StdEnv;\n" +
		"Start :: [(Int,Int)];\n" +
		"Start = [(x,y) \\\\ x <- odds, y <- evens];\n" +
		"where\n" +
		"{\n" +
		"\todds  = [1,3..9];\n" +
		"\tevens = [0,2..8];\n" +
		"}"]
	}

bs_let =
	{ syntax_title         = "let expression"
	, syntax_patterns      = ["let", "in", "let in"]
	, syntax_code          = ["let ... in ..."]
	, syntax_description   = "An expression that introduces new scope."
	, syntax_doc_locations = [CLR 5 "3.5.1" "_Toc311798003"]
	, syntax_examples      =
		[ EXs "macro"    "fac n = let fs = [1:1:[(fs!!(i-1)) + (fs!!(i-2)) \\ i <- [2..]]] in fs !! n"
		, EXs "macrorhs" "let // Multi-line let expressions\n\tfunction args = body\n\tselector = expr\n\t// ...\nin expression"
		]
	}
bs_let_before =
	{ syntax_title         = "let before"
	, syntax_patterns      = ["#", "#!"]
	, syntax_code          = ["#  ... = ...", "#! ... = ..."]
	, syntax_description   = "A {{`let`}} expression that can be defined before a guard or function body, which eases the syntax of sequential actions."
	, syntax_doc_locations = [CLR 5 "3.5.4" "_Toc311798006"]
	, syntax_examples      =
		[ EX "readchars :: *File -> *([Char], *File)\nreadchars f\n# (ok,c,f) = freadc file\n| not ok   = ([], f)\n# (cs,f)   = readchars f\n= ([c:cs], f)"
		]
	}

bs_list_expressions =
	{ syntax_title         = "list expression"
	, syntax_patterns      = ["list", "[]", "[:]", ":", "[\\e:\\e]", "['*"]
	, syntax_code          = ["[]", "[...:...]", "[..., ..., ...]", "['...']"]
	, syntax_description   =
		"A list can be composed of individual elements or a head and a tail. Special syntax is available for creating `[{{Char}}]` lists.\n\n" +
		"See also {{dotdot}} expressions.\n\n" +
		"The colon is not an operator in Clean, because it must always be surrounded by `[` and `]`. It can therefore not be curried, flipped, etc."
	, syntax_doc_locations = [CLR 6 "4.2.1" "_Toc311798021"]
	, syntax_examples      = map (EXs "macro")
		[ "abc = ['a', 'b', 'c']     // Individual elements"
		, "abc = ['a':['b':['c':[]]] // Head and tail, ending with the empty list"
		, "abc = ['abc']             // Special syntax for [Char] lists"
		]
	}

bs_macro =
	{ syntax_title         = "macro"
	, syntax_patterns      = [":==", "macro"]
	, syntax_code          = ["... :== ..."]
	, syntax_description   =
		"A macro is a compile-time rewrite rule. It can be used for constants, inline subtitutions, renaming functions, conditional compilation, etc.\n\n" +
		"Macros can appear in patterns to match on constants."
	, syntax_doc_locations = [CLR 12 "10.3" "_Toc311798111"]
	, syntax_examples      = map (EXs "macro")
		[ "flip f a b :== f b a                    // Useful for currying"
		, "IF_INT_64_OR_32 int64 int32 :== int64   // Conditional compilation"
		, "(o) infixr 9                            // Function composition. Doing this at run-time would be slow\n(o) f g :== \\x -> f (g x)"
		]
	}

bs_module =
	{ syntax_title         = "module heading"
	, syntax_patterns      = ["module", "definition", "implementation", "system", "definition module", "implementation module", "system module"]
	, syntax_code          = ["[definition,implementation,system] module ..."]
	, syntax_description   = "The heading of a Clean file. Definition modules describe what things are exported (dcl files), implementation modules how they are implemented (icl files)."
	, syntax_doc_locations = [CLR 4 "2.2" "_Toc311797983"]
	, syntax_examples      = map EX
		[ "definition module StdList     // Exported definitions of list functions"
		, "implementation module StdList // The implementations of the functions"
		, "module test                   // An implementation module without corresponding dcl"
		, "system module StdInt          // The definitions of a module that contains foreign code (see section 2.6 of the language report)"
		]
	}

bs_newtype =
	{ syntax_title         = "Newtype definition (experimental)"
	, syntax_patterns      = ["=:", "newtype"]
	, syntax_code          = [":: ... =: ... ..."]
	, syntax_description   = "A newtype is a type synonym at run-time but treated as a real type at compile-time.\n"
	                       + "This allows the creation of separate instances without overhead."
	, syntax_doc_locations = []
	, syntax_examples      =
		[ EX ":: T =: T Int"
		, EX ":: T a =: T a"
		]
	}

bs_overloaded_type_variable =
	{ syntax_title         = "Overloaded type variable"
	, syntax_patterns      = ["^", "a^"]
	, syntax_code          = ["... :: ...^"]
	, syntax_description   = "A pattern match on the type of a dynamic depending on the type of the function."
	, syntax_doc_locations = [CLR 10 "8.2.5" "_Toc311798087"]
	, syntax_examples      = [EX "unpack :: Dynamic -> Maybe a\nunpack (x :: a^) = Just x // Only values of type a\nunpack _         = Nothing"]
	}

bs_otherwise =
	{ syntax_title         = "otherwise"
	, syntax_patterns      = ["otherwise"]
	, syntax_code          = ["otherwise"]
	, syntax_description   = "The (optional) last alternative in a guard. It caches all other cases, and makes sure your program does not crash if none of the cases matches."
	, syntax_doc_locations = [CLR 5 "3.3" "_Toc311797998"]
	, syntax_examples      =
		[ EXs "macrorhs" "| otherwise = ..."
		, EXs "macro"    "sign :: !Int -> Int\nsign n\n| n  < 0    = -1 // Negative number\n| n == 0    =  0 // Zero\n| otherwise =  1 // Must be positive"
		]
	}

bs_pattern =
	{ syntax_title         = "pattern match"
	, syntax_patterns      = ["=:"]
	, syntax_code          = ["...=:(...)"]
	, syntax_description   = "Give a name to the expression of a pattern to be able to use the whole expression without creating new graphs. This can also be used to check if a value (not a function argument) matches a pattern (undocumented and you can not use identifiers). `=:` can not be used in prefix form because it is not an actual operator but a builtin."
	, syntax_doc_locations = [CLR 5 "3.2" "_Toc311797997"]
	, syntax_examples      =
		[ EXs "macro" "isJustU e=:(Just _) = (True, e) // On an ADT"
		, EX          ":: Position = {px :: Int, py :: Int}\ngetx p=:{px} = (px, p) // On a record; this has type :: Position -> (Int, Position)"
		, EX          "isSingleton l = l =: [_] //Match a value with a pattern"
		]
	}

bs_selection_array =
	{ syntax_title         = "array selection"
	, syntax_patterns      = [".[]", ".[\\e]", ".[,*]", ".[\\e,*]"]
	, syntax_code          = [".[i]", ".[i,j,...]"]
	, syntax_description   = "Select an element from a (possibly multidimensional) array. The indexes must have the type {{`Int`}}."
	, syntax_doc_locations = [CLR 6 "4.4.1" "_Toc311798033"]
	, syntax_examples      = map (EXs "macro")
		[ "five = {1,2,3,4,5,6,7,8,9,10}.[4]    // Arrays are zero-indexed"
		, "five = {{1,2},{3,4,5},{6,7,8}}.[1,2] // This is equivalent to (...).[1].[2]"
		]
	}
bs_selection_array_unique =
	{ syntax_title         = "unique array selection"
	, syntax_patterns      = ["![]", "![\\e]", "![,*]", "![\\e,*]"]
	, syntax_code          = ["![i]", "![i,j,...]"]
	, syntax_description   = "Select an element from a (possibly multidimensional, possibly unique) array and return both the element and the array. The indexes must have the type {{`Int`}}."
	, syntax_doc_locations = [CLR 6 "4.4.1" "_Toc311798033"]
	, syntax_examples      = map (EXs "macro")
		[ "(five,arr) = {1,2,3,4,5,6,7,8,9,10}![4]"
		, "(five,arr) = {{1,2},{3,4,5},{6,7,8}}![1,2]"
		]
	}
bs_selection_record =
	{ syntax_title         = "record selection"
	, syntax_patterns      = ["."]
	, syntax_code          = ["."]
	, syntax_description   = "Select a field from a (possibly multilevel) record."
	, syntax_doc_locations = [CLR 7 "5.2.1" "_Toc311798050"]
	, syntax_examples      = map (EXs "macro")
		[ "five = {px=5, py=10}.px"
		, "five = {pxy={px=5, py=10}, pz=2}.pxy.px"
		, "five = {px=5, py=10}.Position.px // If multiple records have a field px, the type name can be used for disambiguation"
		]
	}
bs_selection_record_unique =
	{ syntax_title         = "unique record selection"
	, syntax_patterns      = ["!"]
	, syntax_code          = ["!"]
	, syntax_description   = "Select a field from a (possibly multilevel, possibly unique) record and return both the field data and the record."
	, syntax_doc_locations = [CLR 7 "5.2.1" "_Toc311798050"]
	, syntax_examples      = map (EXs "macro")
		[ "(five,rec) = {px=5, py=10}!px"
		, "(five,rec) = {pxy={px=5, py=10}, pz=2}!pxy.px // Only the first field should have the exclamation mark"
		, "(five,rec) = {px=5, py=10}!Position.px // If multiple records have a field px, the type name can be used for disambiguation\n" +
		  "                                       // The language report is erroneous here. It is !Position.px, not .Position!px."
		]
	}

bs_strict =
	{ syntax_title         = "strictness annotation"
	, syntax_patterns      = ["strict", "!"]
	, syntax_code          = ["!"]
	, syntax_description   = "Override the lazy evaluation strategy: the argument must be evaluated to head normal form before the function is entered."
	, syntax_doc_locations = [CLR 5 "3.7.5" "_Toc311798014", CLR 12 "10" "_Toc311798103"]
	, syntax_examples      = [EX "acker :: !Int !Int -> Int"]
	}

bs_synonym =
	{ syntax_title         = "synonym type definition"
	, syntax_patterns      = ["synonym", ":=="]
	, syntax_code          = [":: ... :== ..."]
	, syntax_description   = "Defines a new type name for an existing type."
	, syntax_doc_locations = [CLR 7 "5.3" "_Toc311798052"]
	, syntax_examples      = [EX ":: String :== {#Char}"]
	}
bs_synonym_abstract =
	{ syntax_title         = "abstract synonym type definition"
	, syntax_patterns      = ["synonym", ":=="]
	, syntax_code          = [":: ... (:== ...)"]
	, syntax_description   = "Defines a new type name for an existing type, while the type behaves as an abstract type for the programmer. This allows compiler optimisations on abstract types."
	, syntax_doc_locations = [CLR 7 "5.4.1" "_Toc311798054"]
	, syntax_examples      = [EX ":: Stack a (:== [a])"]
	}

bs_unique =
	{ syntax_title         = "uniqueness annotation"
	, syntax_patterns      = ["\\*", ".", "%:", "[*<=*]", ",", "<="]
	, syntax_code          =
		[ "*..."
		, ". ..."
		, "...:..., [...<=...], [...<=...], ..."
		]
	, syntax_description   = join " "
		[ "Annotates a type with its uniqueness."
		, "A type can either be unique (`*`), not unique (not annotated), possibly unique (`.`) or relatively unique (identifier and `, [...<=...]` after the type context)."
		, "Because uniqueness is binary, there is only one case where `[u<=v]` is not satisfied; when `u` is unique but `v` is not."
		, "\n\nOn function types, *uniqueness propagation* is implicit (see section 9.2 of the language report)."
		, "However, when using unique types in a function or an ADT this has to be made explicit; for instance:"
		, "`T = T (Int, *File)` has to be `T = T *(Int, *File)`."
		, "Functions have to be split up into arity 1 and the subfunctions must be annotated as well; for instance:"
		, "`T = T (Int *Int -> *Int)` has to be `T = T (Int -> *(*Int -> *Int))`."
		]
	, syntax_doc_locations = [CLR 11 "9.1" "_Toc311798093"]
	, syntax_examples      = map EX
		[ "Start :: *World -> *World   // World is unique"
		, "copyArray :: *(a e) -> *(*a e, *a e) | Array a e // Add parentheses when needed"
		, "f :: .a -> .a               // f works on unique and non-unique values"
		, "f :: v:a u:b -> u:b, [v<=u] // f works when a is less unique than b"
		]
	}

bs_update_array =
	{ syntax_title         = "array update"
	, syntax_patterns      = ["&", "{*&*[\\e]*=*}"]
	, syntax_code          =
		[ "{ a & [i]=x, [j]=y, ... } // Updates a by setting index i to x, j to y, ..."
		, "# a & [i]=x, [j]=y, ...   // Same as # a = {a & [i]=x, [j]=y, ...}" // See https://clean.cs.ru.nl/Clean_2.3
		]
	, syntax_description   = "Updates an array by creating a copy and replacing one or more elements."
	, syntax_doc_locations = [CLR 6 "4.4.1" "_Toc311798032"]
	, syntax_examples      = []
	}
bs_update_record =
	{ syntax_title         = "record update"
	, syntax_patterns      = ["&", "{*&*=*}"]
	, syntax_code          =
		[ "{ r & f1=x, f2=y, ... } // Updates r by setting f1 to x, f2 to y, ..."
		, "# r & f1=x, f2=y, ...   // Same as # r = {r & f1=x, f2=y, ...}" // See https://clean.cs.ru.nl/Clean_2.3
		]
	, syntax_description   = "Updates a record by creating a copy and replacing one or more fields."
	, syntax_doc_locations = [CLR 7 "5.2.1" "_Toc311798049"]
	, syntax_examples      = []
	}

bs_where_class =
	{ syntax_title         = "where"
	, syntax_patterns      = ["where"]
	, syntax_code          = ["where"]
	, syntax_description   = "Introduces the members of a {{`class`}} definition."
	, syntax_doc_locations = [CLR 8 "6.1"   "_Toc311798056"]
	, syntax_examples      = [EX "class Arith a        // Class definition\nwhere\n\t(+) infixl 6 :: a a -> a\n\t(-) infixl 6 :: a a -> a"]
	}
bs_where_instance =
	{ syntax_title         = "where"
	, syntax_patterns      = ["where"]
	, syntax_code          = ["where"]
	, syntax_description   = "Introduces the implementation of an {{`instance`}}."
	, syntax_doc_locations = [CLR 8 "6.1"   "_Toc311798056"]
	, syntax_examples      = [EX "instance Arith Int   // Instance definition\nwhere\n\t(+) x y = // ...\n\t(-) x y = // ..."]
	}
bs_where_local =
	{ syntax_title         = "where"
	, syntax_patterns      = ["where"]
	, syntax_code          = ["where"]
	, syntax_description   = "Introduces local definitions. For guard-local definitions, see {{`with`}}."
	, syntax_doc_locations = [CLR 5 "3.5.2" "_Toc311798004"]
	, syntax_examples      = [EXs "macro" "primes = sieve [2..] // Local definitions\nwhere\n\tsieve [pr:r] = [pr:sieve (filter pr r)]"]
	}

bs_with =
	{ syntax_title         = "with"
	, syntax_patterns      = ["with"]
	, syntax_code          = ["with"]
	, syntax_description   = "Introduces guard-local definitions. For function-local definitions, see {{`where`}}."
	, syntax_doc_locations = [CLR 5 "3.5.3" "_Toc311798005"]
	, syntax_examples      = [EXs "macro" "f x y\n| guard1 = alt1\n\twith local = expr1\n| guard2 = alt2\n\twith local = expr2"]
	}

bs_zf =
	{ syntax_title         = "list comprehension"
	, syntax_patterns      = ["ZF-expression", "ZF", "zf", "comprehension", "<-", "<|-", "<-:", "\\\\", ",", "&", "|"]
	, syntax_code          = ["[... \\\\ ... <- ...]"]
	, syntax_description   = "Constructs a list composed of elements drawn from other lists or arrays."
	, syntax_doc_locations = [CLR 6 "4.2.1" "_Toc311798024"]
	, syntax_examples      = map (EXs "macro")
		[ "cartesian    = [(x,y) \\\\ x <- [1,2,3], y <- [10,20]] // Cartesian product: (1,10), (1,20), (2,10), (2,20), (3,10), (3,20)"
		, "zip xs ys    = [(x,y) \\\\ x <- xs & y <- ys]          // Pairwise zip through the lists"
		, "filter f xs  = [x \\\\ x <- xs | f x]                  // Guard to add conditions"
		, "catMaybes ms = [x \\\\ Just x <- ms]                   // Pattern matching in the selector"
		, "triangle     = [(x,y) \\\\ x <- [1,2,3], y <- [1..x]]  // Reusing x in the next generator: (1,1), (2,1), (2,2), (3,1), (3,2), (3,3)"
		, "arrToList a  = [x \\\\ x <-: a]                        // <-: for arrays"
		, "castList xs  = [|x \\\\ x <|- xs]                      // The two pipe characters make both xs and the result overloaded lists"
		]
	}


EXPERIMENTAL: Forking for concurrent request handling (#17)

implementation module SimpleTCPServer

import TCPIP
import StdEnv
import StdMaybe
import System._Posix

instance zero (Logger a b s) where zero = \_ _ w -> (undef, w)

serve :: (a *World -> *(b,*World)) (Maybe (Logger a b s)) Port *World -> *World | fromString a & toString b
serve f log port w
# (ok, mbListener, w) = openTCP_Listener port w
| not ok = abort ("Couldn't open port " +++ toString port)
# listener = fromJust mbListener
# log = if (isNothing log) zero (fromJust log)
# (listener, w) = handle f log listener w
= closeRChannel listener w
where
    handle :: (a *World -> *(b,*World)) (Logger a b s) TCP_Listener *World
              -> (TCP_Listener, *World) | fromString a & toString b
    handle f log li w
    # ((ip, dupChan),li,w) = receive li w
	# (pid,w) = fork w
	| pid < 0 = abort "fork failed\n"
	// Parent: handle new requests
	| pid > 0 = handle f log li w
	// Child: handle current request
    #! (s, w) = log (Connected ip) undef w
    #! (msg, rChan, w) = receive dupChan.rChannel w
       dupChan = {dupChan & rChannel=rChan}
    #! msg = fromString (toString msg)
    #! (s, w) = log (Received msg) s w
    #! (resp, w) = f msg w
    #! (sChan, w) = send (toByteSeq (toString resp)) dupChan.sChannel w
       dupChan = {dupChan & sChannel=sChan}
    #! (s, w) = log (Sent resp) s w
    #! w = closeRChannel dupChan.rChannel w
    #! w = closeChannel dupChan.sChannel w
    #! (s, w) = log Disconnected s w
	= exit 0 w

implementation module SimpleTCPServer

import TCPIP
import StdEnv
import StdMaybe

instance zero (Logger a b s) where zero = \_ _ w -> (undef, w)

serve :: (a *World -> *(b,*World)) (Maybe (Logger a b s)) Port *World -> *World | fromString a & toString b
serve f log port w
# (ok, mbListener, w) = openTCP_Listener port w
| not ok = abort ("Couldn't open port " +++ toString port)
# listener = fromJust mbListener
# log = if (isNothing log) zero (fromJust log)
# (listener, w) = handle f log listener w
= closeRChannel listener w
where
    handle :: (a *World -> *(b,*World)) (Logger a b s) TCP_Listener *World
              -> (TCP_Listener, *World) | fromString a & toString b
    handle f log li w
    # ((ip, dupChan),li,w) = receive li w
    # (s, w) = log (Connected ip) undef w
    # (msg, rChan, w) = receive dupChan.rChannel w
      dupChan = {dupChan & rChannel=rChan}
    # msg = fromString (toString msg)
    # (s, w) = log (Received msg) s w
    # (resp, w) = f msg w
    # (sChan, w) = send (toByteSeq (toString resp)) dupChan.sChannel w
      dupChan = {dupChan & sChannel=sChan}
    # (s, w) = log (Sent resp) s w
    # w = closeRChannel dupChan.rChannel w
    # w = closeChannel dupChan.sChannel w
    # (s, w) = log Disconnected s w
    = handle f log li w


Use normalised requests as cache key (parsed types, sorted lists)

module CloogleServer

import StdArray
import StdBool
import StdFile
import StdList
import StdOrdList
import StdOverloaded
import StdString
import StdTuple
from StdFunc import o, flip, const
from StdMisc import abort

from TCPIP import :: IPAddress, :: Port, instance toString IPAddress

from Data.Func import $
import Data.List
import Data.Tuple
import Data.Maybe
import System.CommandLine
import Data.Functor
import Control.Applicative
import Control.Monad
from Text import class Text(concat,trim,indexOf,toLowerCase),
	instance Text String, instance + String
import Text.JSON

import System.Time

from SimpleTCPServer import :: LogMessage{..}, serve, :: Logger
import qualified SimpleTCPServer
import TypeDB
import Type
import Cache
import Cloogle

MAX_RESULTS    :== 15
CACHE_PREFETCH :== 5

:: RequestCacheKey
	= { c_unify     :: Maybe Type
	  , c_name      :: Maybe String
	  , c_className :: Maybe String
	  , c_typeName  :: Maybe String
	  , c_modules   :: Maybe [String]
	  , c_libraries :: Maybe ([String], Bool)
	  , c_page      :: Maybe Int
	  }

derive JSONEncode Kind, ClassOrGeneric, Type, RequestCacheKey
instance toString RequestCacheKey
where toString rck = toString $ toJSON rck

toRequestCacheKey :: Request -> RequestCacheKey
toRequestCacheKey r =
	{ c_unify     = r.unify >>= parseType o fromString
	, c_name      = r.name
	, c_className = r.className
	, c_typeName  = r.typeName
	, c_modules   = sort <$> r.modules
	, c_libraries = appFst sort <$> r.libraries
	, c_page      = r.page
	}

Start w
# (io, w) = stdio w
# (cmdline, w) = getCommandLine w
| length cmdline <> 2 = help io w
# [_,port:_] = cmdline
# port = toInt port
# (db, io) = openDb io
# (_, w) = fclose io w
| isNothing db = abort "stdin does not have a TypeDB\n"
#! db = fromJust db
= serve (handle db) (Just log) port w
where
	help :: *File *World -> *World
	help io w
	# io = io <<< "Usage: ./CloogleServer <port>\n"
	= snd $ fclose io w

	handle :: !TypeDB !(Maybe Request) !*World -> *(!Response, CacheKey, !*World)
	handle _ Nothing w = (err CLOOGLE_E_INVALIDINPUT "Couldn't parse input", "", w)
	handle db (Just request=:{unify,name,page}) w
		//Check cache
		# (mbResponse, w) = readCache request w
		| isJust mbResponse
			# r = fromJust mbResponse
			= ({r & return = if (r.return == 0) 1 r.return}, cacheKey request, w)
		| isJust name && size (fromJust name) > 40
			= respond (err CLOOGLE_E_INVALIDNAME "Function name too long") w
		| isJust name && any isSpace (fromString $ fromJust name)
			= respond (err CLOOGLE_E_INVALIDNAME "Name cannot contain spaces") w
		| isJust unify && isNothing (parseType $ fromString $ fromJust unify)
			= respond (err CLOOGLE_E_INVALIDTYPE "Couldn't parse type") w
		// Results
		# drop_n = fromJust (page <|> pure 0) * MAX_RESULTS
		# results = drop drop_n $ sort $ search request db
		# more = max 0 (length results - MAX_RESULTS)
		// Suggestions
		# mbType = unify >>= parseType o fromString
		# suggestions
			= sortBy (\a b -> snd a > snd b) <$>
			  filter ((<)(length results) o snd) <$>
			  (mbType >>= \t -> suggs name t db)
		# (results,nextpages) = splitAt MAX_RESULTS results
		// Response
		# response = if (isEmpty results)
			(err CLOOGLE_E_NORESULTS "No results")
			{ return = 0
		    , msg = "Success"
		    , data           = results
		    , more_available = Just more
		    , suggestions    = suggestions
		    }
		// Save page prefetches
		# w = cachePages CACHE_PREFETCH 1 response nextpages w
		// Save cache file
		= respond response w
	where
		key = toRequestCacheKey request

		respond :: Response *World -> *(Response, CacheKey, *World)
		respond r w = (r, cacheKey key, writeCache LongTerm key r w)

		cachePages :: Int Int Response [Result] *World -> *World
		cachePages _ _  _ [] w = w
		cachePages 0 _  _ _  w = w
		cachePages npages i response results w
		# w = writeCache Brief req` resp` w
		= cachePages (npages - 1) (i + 1) response keep w
		where
			req` = { key & c_page = ((+) i) <$> (key.c_page <|> pure 0) }
			resp` =
				{ response
				& more_available = Just $ max 0 (length results - MAX_RESULTS)
				, data = give
				}
			(give,keep) = splitAt MAX_RESULTS results

	suggs :: !(Maybe String) !Type !TypeDB -> Maybe [(Request, Int)]
	suggs n (Func is r cc) db
		| length is < 3
			= Just [let t` = concat $ print False $ Func is` r cc in
			        let request = {zero & name=n, unify=Just t`} in
			        (request, length $ search request db)
			        \\ is` <- permutations is | is` <> is]
	suggs _ _ _ = Nothing

	search :: !Request !TypeDB -> [Result]
	search {unify,name,className,typeName,modules,libraries,page} db
		# db = case libraries of
			(Just ls) = filterLocations (isLibMatch ls) db
			Nothing   = db
		# db = case modules of
			(Just ms) = filterLocations (isModMatch ms) db
			Nothing   = db
		| isJust className
			# className = fromJust className
			# classes = findClass className db
			= map (flip makeClassResult db) classes
		| isJust typeName
			# typeName = fromJust typeName
			# types = findType typeName db
			= [makeTypeResult (Just typeName) l td db \\ (l,td) <- types]
		# mbType = prepare_unification True <$> (unify >>= parseType o fromString)
		// Search normal functions
		# filts = catMaybes [ (\t _ -> isUnifiable t) <$> mbType
		                    , (\n loc _ -> isNameMatch (size n*2/3) n loc) <$> name
		                    ]
		# funs = map (\f -> makeFunctionResult name mbType Nothing f db) $ findFunction`` filts db
		// Search macros
		# macros = case (isNothing mbType,name) of
			(True,Just n) = findMacro` (\loc _ -> isNameMatch (size n*2/3) n loc) db
			_             = []
		# macros = map (\(lhs,rhs) -> makeMacroResult name lhs rhs) macros
		// Search class members
		# filts = catMaybes [ (\t _ _ _ _->isUnifiable t) <$> mbType
		                    , (\n (Location lib mod _ _ _) _ _ f _ -> isNameMatch
		                      (size n*2/3) n (Location lib mod Nothing Nothing f)) <$> name
		                    ]
		# members = findClassMembers`` filts db
		# members = map (\(Location lib mod line iclline cls,vs,_,f,et) -> makeFunctionResult name mbType
			(Just {cls_name=cls,cls_vars=vs}) (Location lib mod line iclline f,et) db) members
		// Search types
		# lcName = if (isJust mbType && isType (fromJust mbType))
			(let (Type name _) = fromJust mbType in Just $ toLowerCase name)
			(toLowerCase <$> name)
		# types = case (isNothing mbType,lcName) of
			(True,Just n) = findType` (\loc _ -> toLowerCase (getName loc) == n) db
			_             = []
		# types = map (\(tl,td) -> makeTypeResult name tl td db) types
		// Search classes
		# classes = case (isNothing mbType, toLowerCase <$> name) of
			(True, Just c) = findClass` (\loc _ _ _ -> toLowerCase (getName loc) == c) db
			_              = []
		# classes = map (flip makeClassResult db) classes
		// Merge results
		= sort $ funs ++ members ++ types ++ classes ++ macros

	makeClassResult :: (Location, [TypeVar], ClassContext, [(Name,ExtendedType)])
		TypeDB -> Result
	makeClassResult rec=:(Builtin _, _, _, _) db
		= ClassResult
		  ( { library  = ""
		    , filename = ""
		    , dcl_line = Nothing
		    , icl_line = Nothing
		    , modul    = ""
		    , distance = -100
		    , builtin  = Just True
		    }
		  , makeClassResultExtras rec db
		  )
	makeClassResult rec=:(Location lib mod line iclline cls, vars, cc, funs) db
		= ClassResult
		  ( { library  = lib
		    , filename = modToFilename mod
		    , dcl_line = line
		    , icl_line = iclline
		    , modul    = mod
		    , distance = -100
		    , builtin  = Nothing
		    }
		  , makeClassResultExtras rec db
		  )
	makeClassResultExtras :: (Location, [TypeVar], ClassContext, [(Name,ExtendedType)])
		TypeDB -> ClassResultExtras
	makeClassResultExtras (l, vars, cc, funs) db
		= { class_name = cls
		  , class_heading = foldl ((+) o (flip (+) " ")) cls vars +
		      if (isEmpty cc) "" " | " + concat (print False cc)
		  , class_funs = [print_fun fun \\ fun <- funs]
		  , class_instances
		      = sortBy (\(a,_) (b,_) -> a < b)
		          [([concat (print False t) \\ t <- ts], map loc ls)
		          \\ (ts,ls) <- getInstances cls db]
		  }
	where
		cls = case l of
			Builtin c = c
			Location _ _ _ _ c = c

		print_fun :: (Name,ExtendedType) -> String
		print_fun f=:(_,ET _ et) = fromJust $
			et.te_representation <|> (pure $ concat $ print False f)

	makeTypeResult :: (Maybe String) Location TypeDef TypeDB -> Result
	makeTypeResult mbName (Location lib mod line iclline t) td db
		= TypeResult
		  ( { library  = lib
		    , filename = modToFilename mod
		    , dcl_line = line
		    , icl_line = iclline
		    , modul    = mod
		    , distance
		        = if (isNothing mbName) -100 (levenshtein` t (fromJust mbName))
		    , builtin  = Nothing
		    }
		  , { type             = concat $ print False td
		    , type_instances   = map (appSnd3 (map (concat o (print False)))) $
		        map (appThd3 (map loc)) $ getTypeInstances t db
		    , type_derivations = map (appSnd (map loc)) $ getTypeDerivations t db
		    }
		  )
	makeTypeResult mbName (Builtin t) td db
		= TypeResult
		  ( { library  = ""
		    , filename = ""
		    , dcl_line = Nothing
		    , icl_line = Nothing
		    , modul    = ""
		    , distance
		        = if (isNothing mbName) -100 (levenshtein` t (fromJust mbName))
		    , builtin  = Just True
		    }
		  , { type             = concat $ print False td
		    , type_instances   = map (appSnd3 (map (concat o (print False)))) $
		        map (appThd3 (map loc)) $ getTypeInstances t db
		    , type_derivations = map (appSnd (map loc)) $ getTypeDerivations t db
		    }
		  )

	makeMacroResult :: (Maybe String) Location Macro -> Result
	makeMacroResult mbName (Location lib mod line iclline m) mac
		= MacroResult
		  ( { library  = lib
		    , filename = modToFilename mod
		    , dcl_line = line
		    , icl_line = iclline
		    , modul    = mod
		    , distance
		        = if (isNothing mbName) -100 (levenshtein` (fromJust mbName) m)
		    , builtin  = Nothing
		    }
		  , { macro_name = m
		    , macro_representation = mac.macro_as_string
		    }
		  )

	makeFunctionResult :: (Maybe String) (Maybe Type) (Maybe ShortClassResult)
		(Location, ExtendedType) TypeDB -> Result
	makeFunctionResult
		orgsearch orgsearchtype mbCls (fl, et=:(ET type tes)) db
		= FunctionResult
		  ( { library  = lib
		    , filename = modToFilename mod
		    , dcl_line = line
		    , icl_line = iclline
		    , modul    = mod
		    , distance = distance
		    , builtin  = builtin
		    }
		  , { func     = fromJust (tes.te_representation <|>
		                           (pure $ concat $ print False (fname,et)))
		    , unifier  = toStrUnifier <$> finish_unification <$>
		        (orgsearchtype >>= unify [] (prepare_unification False type))
		    , cls      = mbCls
		    , constructor_of = if tes.te_isconstructor
		        (let (Func _ r _) = type in Just $ concat $ print False r)
		        Nothing
		    , recordfield_of = if tes.te_isrecordfield
		        (let (Func [t:_] _ _) = type in Just $ concat $ print False t)
		        Nothing
		    , generic_derivations
		        = let derivs = getDerivations fname db in
		          const (sortBy (\(a,_) (b,_) -> a < b)
				    [(concat $ print False d, map loc ls) \\ (d,ls) <- derivs]) <$>
		          tes.te_generic_vars
		    }
		  )
	where
		(lib,mod,fname,line,iclline,builtin) = case fl of
			(Location l m ln iln f) = (l,  m,  f, ln,      iln,     Nothing)
			(Builtin f)             = ("", "", f, Nothing, Nothing, Just True)

		toStrUnifier :: Unifier -> StrUnifier
		toStrUnifier (tvas1, tvas2) = (map toStr tvas1, map toStr tvas2)
		where toStr (var, type) = (var, concat $ print False type)

		toStrPriority :: (Maybe Priority) -> String
		toStrPriority p = case print False p of [] = ""; ss = concat [" ":ss]

		distance
			| isNothing orgsearch || fromJust orgsearch == ""
				| isNothing orgsearchtype = 0
				# orgsearchtype = fromJust orgsearchtype
				# (Just (ass1, ass2)) = finish_unification <$>
					unify [] orgsearchtype (prepare_unification False type)
				= penalty + toInt (sum [typeComplexity t \\ (_,t)<-ass1 ++ ass2 | not (isVar t)])
			# orgsearch = fromJust orgsearch
			= penalty + levenshtein` orgsearch fname
		where
			penalty
			| tes.te_isrecordfield = 2
			| tes.te_isconstructor = 1
			| otherwise            = 0

			typeComplexity :: Type -> Real
			typeComplexity (Type _ ts) = 1.2 * foldr ((+) o typeComplexity) 1.0 ts
			typeComplexity (Func is r _) = 2.0 * foldr ((+) o typeComplexity) 1.0 [r:is]
			typeComplexity (Var _) = 1.0
			typeComplexity (Cons _ ts) = 1.2 * foldr ((+) o typeComplexity) 1.0 ts
			typeComplexity (Uniq t) = 3.0 + typeComplexity t

	levenshtein` :: String String -> Int
	levenshtein` a b = if (indexOf a b == -1) 0 -100 + levenshtein [c \\ c <-: a] [c \\ c <-: b]

	modToFilename :: String -> String
	modToFilename mod = (toString $ reverse $ takeWhile ((<>)'.')
	                              $ reverse $ fromString mod) + ".dcl"

	isUnifiable :: Type ExtendedType -> Bool
	isUnifiable t1 (ET t2 _) = isJust (unify [] t1 (prepare_unification False t2))

	isNameMatch :: !Int !String Location -> Bool
	isNameMatch maxdist n1 loc
		# (n1, n2) = ({toLower c \\ c <-: n1}, {toLower c \\ c <-: getName loc})
		= n1 == "" || indexOf n1 n2 <> -1 || levenshtein [c \\ c <-: n1] [c \\ c <-: n2] <= maxdist

	isModMatch :: ![String] Location -> Bool
	isModMatch mods (Location _ mod _ _ _) = isMember mod mods
	isModMatch _    (Builtin _)            = False

	isLibMatch :: (![String], !Bool) Location -> Bool
	isLibMatch (libs,_) (Location lib _ _ _ _) = any (\l -> indexOf l lib == 0) libs
	isLibMatch (_,blti) (Builtin _)            = blti

	loc :: Location -> LocationResult
	loc (Location lib mod ln iln _) = (lib, mod, ln, iln)

	log :: (LogMessage (Maybe Request) Response CacheKey) IPAddress *World
		-> *(IPAddress, *World)
	log msg s w
	| not needslog = (newS msg s, w)
	# (tm,w) = localTime w
	# (io,w) = stdio w
	# io = io <<< trim (toString tm) <<< " " <<< msgToString msg s
	= (newS msg s, snd (fclose io w))
	where
		needslog = case msg of (Received _) = True; (Sent _ _) = True; _ = False

	newS :: (LogMessage (Maybe Request) Response CacheKey) IPAddress -> IPAddress
	newS m s = case m of (Connected ip) = ip; _ = s

	msgToString :: (LogMessage (Maybe Request) Response CacheKey) IPAddress -> String
	msgToString (Received Nothing) ip
		= toString ip + " <-- Nothing\n"
	msgToString (Received (Just a)) ip
		= toString ip + " <-- " + toString a + "\n"
	msgToString (Sent {return,data,msg,more_available} ck) ip
		= toString ip + " --> " + toString (length data)
			+ " results (" + toString return + "; " + msg
			+ if (isJust more_available) ("; " + toString (fromJust more_available) + " more") ""
			+ "; cache: " + ck + ")\n"
	msgToString _ _ = ""

module CloogleServer

import StdArray
import StdBool
import StdFile
import StdList
import StdOrdList
import StdOverloaded
import StdString
import StdTuple
from StdFunc import o, flip, const
from StdMisc import abort

from TCPIP import :: IPAddress, :: Port, instance toString IPAddress

from Data.Func import $
import Data.List
import Data.Tuple
import Data.Maybe
import System.CommandLine
import Data.Functor
import Control.Applicative
import Control.Monad
from Text import class Text(concat,trim,indexOf,toLowerCase),
	instance Text String, instance + String

import System.Time

from SimpleTCPServer import :: LogMessage{..}, serve, :: Logger
import qualified SimpleTCPServer
import TypeDB
import Type
import Cache
import Cloogle

MAX_RESULTS    :== 15
CACHE_PREFETCH :== 5

Start w
# (io, w) = stdio w
# (cmdline, w) = getCommandLine w
| length cmdline <> 2 = help io w
# [_,port:_] = cmdline
# port = toInt port
# (db, io) = openDb io
# (_, w) = fclose io w
| isNothing db = abort "stdin does not have a TypeDB\n"
#! db = fromJust db
= serve (handle db) (Just log) port w
where
	help :: *File *World -> *World
	help io w
	# io = io <<< "Usage: ./CloogleServer <port>\n"
	= snd $ fclose io w

	handle :: !TypeDB !(Maybe Request) !*World -> *(!Response, CacheKey, !*World)
	handle _ Nothing w = (err CLOOGLE_E_INVALIDINPUT "Couldn't parse input", "", w)
	handle db (Just request=:{unify,name,page}) w
		//Check cache
		# (mbResponse, w) = readCache request w
		| isJust mbResponse
			# r = fromJust mbResponse
			= ({r & return = if (r.return == 0) 1 r.return}, cacheKey request, w)
		| isJust name && size (fromJust name) > 40
			= respond (err CLOOGLE_E_INVALIDNAME "Function name too long") w
		| isJust name && any isSpace (fromString $ fromJust name)
			= respond (err CLOOGLE_E_INVALIDNAME "Name cannot contain spaces") w
		| isJust unify && isNothing (parseType $ fromString $ fromJust unify)
			= respond (err CLOOGLE_E_INVALIDTYPE "Couldn't parse type") w
		// Results
		# drop_n = fromJust (page <|> pure 0) * MAX_RESULTS
		# results = drop drop_n $ sort $ search request db
		# more = max 0 (length results - MAX_RESULTS)
		// Suggestions
		# mbType = unify >>= parseType o fromString
		# suggestions
			= sortBy (\a b -> snd a > snd b) <$>
			  filter ((<)(length results) o snd) <$>
			  (mbType >>= \t -> suggs name t db)
		# (results,nextpages) = splitAt MAX_RESULTS results
		// Response
		# response = if (isEmpty results)
			(err CLOOGLE_E_NORESULTS "No results")
			{ return = 0
		    , msg = "Success"
		    , data           = results
		    , more_available = Just more
		    , suggestions    = suggestions
		    }
		// Save page prefetches
		# w = cachePages CACHE_PREFETCH 1 response nextpages w
		// Save cache file
		= respond response w
	where
		respond :: Response *World -> *(Response, CacheKey, *World)
		respond r w = (r, cacheKey request, writeCache LongTerm request r w)

		cachePages :: Int Int Response [Result] *World -> *World
		cachePages _ _  _ [] w = w
		cachePages 0 _  _ _  w = w
		cachePages npages i response results w
		# w = writeCache Brief req` resp` w
		= cachePages (npages - 1) (i + 1) response keep w
		where
			req` = { request & page = ((+) i) <$> (request.page <|> pure 0) }
			resp` =
				{ response
				& more_available = Just $ max 0 (length results - MAX_RESULTS)
				, data = give
				}
			(give,keep) = splitAt MAX_RESULTS results

	suggs :: !(Maybe String) !Type !TypeDB -> Maybe [(Request, Int)]
	suggs n (Func is r cc) db
		| length is < 3
			= Just [let t` = concat $ print False $ Func is` r cc in
			        let request = {zero & name=n, unify=Just t`} in
			        (request, length $ search request db)
			        \\ is` <- permutations is | is` <> is]
	suggs _ _ _ = Nothing

	search :: !Request !TypeDB -> [Result]
	search {unify,name,className,typeName,modules,libraries,page} db
		# db = case libraries of
			(Just ls) = filterLocations (isLibMatch ls) db
			Nothing   = db
		# db = case modules of
			(Just ms) = filterLocations (isModMatch ms) db
			Nothing   = db
		| isJust className
			# className = fromJust className
			# classes = findClass className db
			= map (flip makeClassResult db) classes
		| isJust typeName
			# typeName = fromJust typeName
			# types = findType typeName db
			= [makeTypeResult (Just typeName) l td db \\ (l,td) <- types]
		# mbType = prepare_unification True <$> (unify >>= parseType o fromString)
		// Search normal functions
		# filts = catMaybes [ (\t _ -> isUnifiable t) <$> mbType
		                    , (\n loc _ -> isNameMatch (size n*2/3) n loc) <$> name
		                    ]
		# funs = map (\f -> makeFunctionResult name mbType Nothing f db) $ findFunction`` filts db
		// Search macros
		# macros = case (isNothing mbType,name) of
			(True,Just n) = findMacro` (\loc _ -> isNameMatch (size n*2/3) n loc) db
			_             = []
		# macros = map (\(lhs,rhs) -> makeMacroResult name lhs rhs) macros
		// Search class members
		# filts = catMaybes [ (\t _ _ _ _->isUnifiable t) <$> mbType
		                    , (\n (Location lib mod _ _ _) _ _ f _ -> isNameMatch
		                      (size n*2/3) n (Location lib mod Nothing Nothing f)) <$> name
		                    ]
		# members = findClassMembers`` filts db
		# members = map (\(Location lib mod line iclline cls,vs,_,f,et) -> makeFunctionResult name mbType
			(Just {cls_name=cls,cls_vars=vs}) (Location lib mod line iclline f,et) db) members
		// Search types
		# lcName = if (isJust mbType && isType (fromJust mbType))
			(let (Type name _) = fromJust mbType in Just $ toLowerCase name)
			(toLowerCase <$> name)
		# types = case (isNothing mbType,lcName) of
			(True,Just n) = findType` (\loc _ -> toLowerCase (getName loc) == n) db
			_             = []
		# types = map (\(tl,td) -> makeTypeResult name tl td db) types
		// Search classes
		# classes = case (isNothing mbType, toLowerCase <$> name) of
			(True, Just c) = findClass` (\loc _ _ _ -> toLowerCase (getName loc) == c) db
			_              = []
		# classes = map (flip makeClassResult db) classes
		// Merge results
		= sort $ funs ++ members ++ types ++ classes ++ macros

	makeClassResult :: (Location, [TypeVar], ClassContext, [(Name,ExtendedType)])
		TypeDB -> Result
	makeClassResult rec=:(Builtin _, _, _, _) db
		= ClassResult
		  ( { library  = ""
		    , filename = ""
		    , dcl_line = Nothing
		    , icl_line = Nothing
		    , modul    = ""
		    , distance = -100
		    , builtin  = Just True
		    }
		  , makeClassResultExtras rec db
		  )
	makeClassResult rec=:(Location lib mod line iclline cls, vars, cc, funs) db
		= ClassResult
		  ( { library  = lib
		    , filename = modToFilename mod
		    , dcl_line = line
		    , icl_line = iclline
		    , modul    = mod
		    , distance = -100
		    , builtin  = Nothing
		    }
		  , makeClassResultExtras rec db
		  )
	makeClassResultExtras :: (Location, [TypeVar], ClassContext, [(Name,ExtendedType)])
		TypeDB -> ClassResultExtras
	makeClassResultExtras (l, vars, cc, funs) db
		= { class_name = cls
		  , class_heading = foldl ((+) o (flip (+) " ")) cls vars +
		      if (isEmpty cc) "" " | " + concat (print False cc)
		  , class_funs = [print_fun fun \\ fun <- funs]
		  , class_instances
		      = sortBy (\(a,_) (b,_) -> a < b)
		          [([concat (print False t) \\ t <- ts], map loc ls)
		          \\ (ts,ls) <- getInstances cls db]
		  }
	where
		cls = case l of
			Builtin c = c
			Location _ _ _ _ c = c

		print_fun :: (Name,ExtendedType) -> String
		print_fun f=:(_,ET _ et) = fromJust $
			et.te_representation <|> (pure $ concat $ print False f)

	makeTypeResult :: (Maybe String) Location TypeDef TypeDB -> Result
	makeTypeResult mbName (Location lib mod line iclline t) td db
		= TypeResult
		  ( { library  = lib
		    , filename = modToFilename mod
		    , dcl_line = line
		    , icl_line = iclline
		    , modul    = mod
		    , distance
		        = if (isNothing mbName) -100 (levenshtein` t (fromJust mbName))
		    , builtin  = Nothing
		    }
		  , { type             = concat $ print False td
		    , type_instances   = map (appSnd3 (map (concat o (print False)))) $
		        map (appThd3 (map loc)) $ getTypeInstances t db
		    , type_derivations = map (appSnd (map loc)) $ getTypeDerivations t db
		    }
		  )
	makeTypeResult mbName (Builtin t) td db
		= TypeResult
		  ( { library  = ""
		    , filename = ""
		    , dcl_line = Nothing
		    , icl_line = Nothing
		    , modul    = ""
		    , distance
		        = if (isNothing mbName) -100 (levenshtein` t (fromJust mbName))
		    , builtin  = Just True
		    }
		  , { type             = concat $ print False td
		    , type_instances   = map (appSnd3 (map (concat o (print False)))) $
		        map (appThd3 (map loc)) $ getTypeInstances t db
		    , type_derivations = map (appSnd (map loc)) $ getTypeDerivations t db
		    }
		  )

	makeMacroResult :: (Maybe String) Location Macro -> Result
	makeMacroResult mbName (Location lib mod line iclline m) mac
		= MacroResult
		  ( { library  = lib
		    , filename = modToFilename mod
		    , dcl_line = line
		    , icl_line = iclline
		    , modul    = mod
		    , distance
		        = if (isNothing mbName) -100 (levenshtein` (fromJust mbName) m)
		    , builtin  = Nothing
		    }
		  , { macro_name = m
		    , macro_representation = mac.macro_as_string
		    }
		  )

	makeFunctionResult :: (Maybe String) (Maybe Type) (Maybe ShortClassResult)
		(Location, ExtendedType) TypeDB -> Result
	makeFunctionResult
		orgsearch orgsearchtype mbCls (fl, et=:(ET type tes)) db
		= FunctionResult
		  ( { library  = lib
		    , filename = modToFilename mod
		    , dcl_line = line
		    , icl_line = iclline
		    , modul    = mod
		    , distance = distance
		    , builtin  = builtin
		    }
		  , { func     = fromJust (tes.te_representation <|>
		                           (pure $ concat $ print False (fname,et)))
		    , unifier  = toStrUnifier <$> finish_unification <$>
		        (orgsearchtype >>= unify [] (prepare_unification False type))
		    , cls      = mbCls
		    , constructor_of = if tes.te_isconstructor
		        (let (Func _ r _) = type in Just $ concat $ print False r)
		        Nothing
		    , recordfield_of = if tes.te_isrecordfield
		        (let (Func [t:_] _ _) = type in Just $ concat $ print False t)
		        Nothing
		    , generic_derivations
		        = let derivs = getDerivations fname db in
		          const (sortBy (\(a,_) (b,_) -> a < b)
				    [(concat $ print False d, map loc ls) \\ (d,ls) <- derivs]) <$>
		          tes.te_generic_vars
		    }
		  )
	where
		(lib,mod,fname,line,iclline,builtin) = case fl of
			(Location l m ln iln f) = (l,  m,  f, ln,      iln,     Nothing)
			(Builtin f)             = ("", "", f, Nothing, Nothing, Just True)

		toStrUnifier :: Unifier -> StrUnifier
		toStrUnifier (tvas1, tvas2) = (map toStr tvas1, map toStr tvas2)
		where toStr (var, type) = (var, concat $ print False type)

		toStrPriority :: (Maybe Priority) -> String
		toStrPriority p = case print False p of [] = ""; ss = concat [" ":ss]

		distance
			| isNothing orgsearch || fromJust orgsearch == ""
				| isNothing orgsearchtype = 0
				# orgsearchtype = fromJust orgsearchtype
				# (Just (ass1, ass2)) = finish_unification <$>
					unify [] orgsearchtype (prepare_unification False type)
				= penalty + toInt (sum [typeComplexity t \\ (_,t)<-ass1 ++ ass2 | not (isVar t)])
			# orgsearch = fromJust orgsearch
			= penalty + levenshtein` orgsearch fname
		where
			penalty
			| tes.te_isrecordfield = 2
			| tes.te_isconstructor = 1
			| otherwise            = 0

			typeComplexity :: Type -> Real
			typeComplexity (Type _ ts) = 1.2 * foldr ((+) o typeComplexity) 1.0 ts
			typeComplexity (Func is r _) = 2.0 * foldr ((+) o typeComplexity) 1.0 [r:is]
			typeComplexity (Var _) = 1.0
			typeComplexity (Cons _ ts) = 1.2 * foldr ((+) o typeComplexity) 1.0 ts
			typeComplexity (Uniq t) = 3.0 + typeComplexity t

	levenshtein` :: String String -> Int
	levenshtein` a b = if (indexOf a b == -1) 0 -100 + levenshtein [c \\ c <-: a] [c \\ c <-: b]

	modToFilename :: String -> String
	modToFilename mod = (toString $ reverse $ takeWhile ((<>)'.')
	                              $ reverse $ fromString mod) + ".dcl"

	isUnifiable :: Type ExtendedType -> Bool
	isUnifiable t1 (ET t2 _) = isJust (unify [] t1 (prepare_unification False t2))

	isNameMatch :: !Int !String Location -> Bool
	isNameMatch maxdist n1 loc
		# (n1, n2) = ({toLower c \\ c <-: n1}, {toLower c \\ c <-: getName loc})
		= n1 == "" || indexOf n1 n2 <> -1 || levenshtein [c \\ c <-: n1] [c \\ c <-: n2] <= maxdist

	isModMatch :: ![String] Location -> Bool
	isModMatch mods (Location _ mod _ _ _) = isMember mod mods
	isModMatch _    (Builtin _)            = False

	isLibMatch :: (![String], !Bool) Location -> Bool
	isLibMatch (libs,_) (Location lib _ _ _ _) = any (\l -> indexOf l lib == 0) libs
	isLibMatch (_,blti) (Builtin _)            = blti

	loc :: Location -> LocationResult
	loc (Location lib mod ln iln _) = (lib, mod, ln, iln)

	log :: (LogMessage (Maybe Request) Response CacheKey) IPAddress *World
		-> *(IPAddress, *World)
	log msg s w
	| not needslog = (newS msg s, w)
	# (tm,w) = localTime w
	# (io,w) = stdio w
	# io = io <<< trim (toString tm) <<< " " <<< msgToString msg s
	= (newS msg s, snd (fclose io w))
	where
		needslog = case msg of (Received _) = True; (Sent _ _) = True; _ = False

	newS :: (LogMessage (Maybe Request) Response CacheKey) IPAddress -> IPAddress
	newS m s = case m of (Connected ip) = ip; _ = s

	msgToString :: (LogMessage (Maybe Request) Response CacheKey) IPAddress -> String
	msgToString (Received Nothing) ip
		= toString ip + " <-- Nothing\n"
	msgToString (Received (Just a)) ip
		= toString ip + " <-- " + toString a + "\n"
	msgToString (Sent {return,data,msg,more_available} ck) ip
		= toString ip + " --> " + toString (length data)
			+ " results (" + toString return + "; " + msg
			+ if (isJust more_available) ("; " + toString (fromJust more_available) + " more") ""
			+ "; cache: " + ck + ")\n"
	msgToString _ _ = ""