114 lines
4.8 KiB
Plaintext
114 lines
4.8 KiB
Plaintext
(******************************************************************************
|
||
* Generation of Language.C Grammar with ML Interface Binding
|
||
*
|
||
* Copyright (c) 2018-2019 Université Paris-Saclay, Univ. Paris-Sud, France
|
||
*
|
||
* All rights reserved.
|
||
*
|
||
* Redistribution and use in source and binary forms, with or without
|
||
* modification, are permitted provided that the following conditions are
|
||
* met:
|
||
*
|
||
* * Redistributions of source code must retain the above copyright
|
||
* notice, this list of conditions and the following disclaimer.
|
||
*
|
||
* * Redistributions in binary form must reproduce the above
|
||
* copyright notice, this list of conditions and the following
|
||
* disclaimer in the documentation and/or other materials provided
|
||
* with the distribution.
|
||
*
|
||
* * Neither the name of the copyright holders nor the names of its
|
||
* contributors may be used to endorse or promote products derived
|
||
* from this software without specific prior written permission.
|
||
*
|
||
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||
******************************************************************************)
|
||
|
||
theory Example_Markup
|
||
imports Main
|
||
begin
|
||
|
||
ML \<open>
|
||
fun markup_tvar def_name ps (name, id) =
|
||
let
|
||
fun markup_elem name = (name, (name, []): Markup.T);
|
||
val (tvarN, tvar) = markup_elem ((case def_name of SOME name => name | _ => "") ^ "'s nickname is");
|
||
val entity = Markup.entity tvarN name
|
||
val def = def_name = NONE
|
||
in
|
||
tvar ::
|
||
(if def then I else cons (Markup.keyword_properties Markup.ML_keyword3))
|
||
(map (fn pos => Markup.properties (Position.entity_properties_of def id pos) entity) ps)
|
||
end
|
||
|
||
fun report [] _ _ = I
|
||
| report ps markup x =
|
||
let val ms = markup x
|
||
in fold (fn p => fold (fn m => cons ((p, m), "")) ms) ps end
|
||
\<close>
|
||
|
||
ML \<open>
|
||
local
|
||
val data = \<comment> \<open>Derived from Yakoub's example ;-)\<close>
|
||
[ (\<open>Frédéric 1er\<close>, \<open>King of Naples\<close>)
|
||
, (\<open>Frédéric II\<close>, \<open>King of Sicily\<close>)
|
||
, (\<open>Frédéric III\<close>, \<open>the Handsome\<close>)
|
||
, (\<open>Frédéric IV\<close>, \<open>of the Empty Pockets\<close>)
|
||
, (\<open>Frédéric V\<close>, \<open>King of Denmark–Norway\<close>)
|
||
, (\<open>Frédéric VI\<close>, \<open>the Knight\<close>)
|
||
, (\<open>Frédéric VII\<close>, \<open>Count of Toggenburg\<close>)
|
||
, (\<open>Frédéric VIII\<close>, \<open>Count of Zollern\<close>)
|
||
, (\<open>Frédéric IX\<close>, \<open>the Old\<close>)
|
||
, (\<open>Frédéric X\<close>, \<open>the Younger\<close>) ]
|
||
|
||
val (tab0, markup) =
|
||
fold_map (fn (name, msg) => fn reports =>
|
||
let val id = serial ()
|
||
val pos = [Input.pos_of name]
|
||
in
|
||
( (fst(Input.source_content msg), (name, pos, id))
|
||
, report pos (markup_tvar NONE pos) (fst(Input.source_content name), id) reports)
|
||
end)
|
||
data
|
||
[]
|
||
|
||
val () = Position.reports_text markup
|
||
in
|
||
val tab = Symtab.make tab0
|
||
end
|
||
\<close>
|
||
|
||
ML \<open>
|
||
val _ =
|
||
fold (fn input =>
|
||
let
|
||
val pos1' = Input.pos_of input
|
||
fun ctnt name0 = fst(Input.source_content name0)
|
||
val pos1 = [pos1']
|
||
val msg1 = fst(Input.source_content input)
|
||
val msg2 = "No persons were found to have such nickname"
|
||
in
|
||
case Symtab.lookup tab (fst(Input.source_content input)) of
|
||
NONE => tap (fn _ => Output.information (msg2 ^ Position.here_list pos1))
|
||
(cons ((pos1', Markup.bad ()), ""))
|
||
| SOME (name0, pos0, id) => report pos1 (markup_tvar (SOME (ctnt name0)) pos0) (msg1, id)
|
||
end)
|
||
[ \<open>the Knight\<close> \<comment> \<open>Example of a correct retrieval (CTRL + Hovering shows what we are expecting)\<close>
|
||
, \<open>the Handsome\<close> \<comment> \<open>Example of a correct retrieval (CTRL + Hovering shows what we are expecting)\<close>
|
||
, \<open>the Spy\<close> \<comment> \<open>Example of a failure to retrieve the person in \<^ML>\<open>tab\<close>\<close> ]
|
||
[]
|
||
|> Position.reports_text
|
||
\<close>
|
||
|
||
end
|