From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00, T_FILL_THIS_FORM_SHORT autolearn=ham autolearn_force=no version=3.4.4 X-Google-Thread: 103376,50e705cdf2767cc6 X-Google-NewGroupId: yes X-Google-Attributes: gida07f3367d7,domainid0,public,usenet X-Google-Language: ENGLISH,ASCII-7-bit Path: g2news2.google.com!news4.google.com!feeder3.cambriumusenet.nl!feed.tweaknews.nl!193.201.147.68.MISMATCH!feeder.news-service.com!easy.in-chemnitz.de!feeder.erje.net!newsfeed.straub-nv.de!noris.net!newsfeed.arcor.de!newsspool3.arcor-online.net!news.arcor.de.POSTED!not-for-mail Date: Wed, 06 Apr 2011 17:51:53 +0200 From: Georg Bauhaus User-Agent: Mozilla/5.0 (Macintosh; U; Intel Mac OS X 10.5; en-US; rv:1.9.2.15) Gecko/20110303 Thunderbird/3.1.9 MIME-Version: 1.0 Newsgroups: comp.lang.ada Subject: Re: Parser interface design References: In-Reply-To: Content-Type: text/plain; charset=ISO-8859-1 Content-Transfer-Encoding: 7bit Message-ID: <4d9c8c19$0$6769$9b4e6d93@newsspool3.arcor-online.net> Organization: Arcor NNTP-Posting-Date: 06 Apr 2011 17:51:53 CEST NNTP-Posting-Host: 8aab7725.newsspool3.arcor-online.net X-Trace: DXC=IF2:?`E:nYGAa;:RKVJ>LEMcF=Q^Z^V3H4Fo<]lROoRA8kFJLh>_cHTX3jM6ofIUQjMIeN X-Complaints-To: usenet-abuse@arcor.de Xref: g2news2.google.com comp.lang.ada:19669 Date: 2011-04-06T17:51:53+02:00 List-Id: On 06.04.11 12:11, Natasha Kerensikova wrote: > I thought the most idiomatic way of putting together a bunch of > callbacks in Ada would be to use an Interface, and then rely on dynamic > dispatch. This also provides a nice way to embed the renderer state, in > the tagged type that implement the Interface. Can be done, and one example is given further below. Another way is to use "generic interfaces" for callback communication, a more traditional way I think. For example, generic with function Left_Context (X : T) return String is <>; with function Text (X : T) return String is <>; with function Right_Context (X : T) return String is <>; package Printer is procedure Print_One (X : T); procedure Print_Many (XS : List_of_T); end Printer; Here, T is the type of a token. The generic functions need not be primitive operations, so the parser can be fully decoupled from rendering. After a Printer is instantiated, say, package HTML_Printer is new Printer ( Left_Context => Opening_Tag, etc.); the parser will call HTML_Printer.Print_One (Some_Token); passing a current token. The Print_One procedure in turn will call generic actual functions Left_Context, Text, and Right_Context. These would be functions rendering the token's content as needed for HTML. For example, the actual for Left_Context, i.e. Opening_Tag, will print a suitable start tag depending on the token passed to it. (Another option is to use generic formal packages.) Anyway, here is another approach, probably not very original, certainly lacking proper modularization and other things that I did't see, sorry, but if offers another idea. There aren't any generics in it. But there is a procedure procedure Print (Item : Token'Class; Output : in out Format'Class); The idea is that given any token, Print renders the token Item into any format passed for Output. The example assumes that there is a parser capable of producing values of types in Token'Class. Funny_Token names one such type. The interface of type Token does not really reach into parsing, although for the sake of this example, there is a ubiquitous type Printable that connects type Token and Format. (As Dmitry said, I'm using the type system here; but maybe---since everything is just abstract---the coupling is tolerable.) The test case is written from the perspective of a controlling program which could be the parser or some program that drives the parser. $ ./test_rendering 
=
(pre =) $ with Rendering.XHTML, Rendering.Parentheses; procedure Test_Rendering is use Rendering; X1: Funny_Token(Eq); -- a token Web : XHTML.XHTML; -- a format Computer : Parentheses.LList; -- another format begin Print (X1, Web); Print (X1, Computer); end Test_Rendering; -- Thus, calling Print with a token renders it into -- the format specified by the second parameter. package Rendering is -- only Printables can be rendered. Ubiquitous type: type Printable is abstract tagged null record; function Image (P : Printable) return String is abstract; -- establish a maximum of number if different kinds of token: type Token_Kind is range 0 .. 1_000; type Token(Kind : Token_Kind) is abstract tagged null record; function Contents (T: Token) return Printable'Class is abstract; -- what is in T, for rendering -- some real tokens: subtype Funny_Token_Kind is Token_Kind range 1 .. 2; Star : constant Funny_Token_Kind := 1; Eq : constant Funny_Token_Kind := 2; type Funny_Token(Kind : Funny_Token_Kind) is new Token(Kind) with null record; overriding function Contents (T: Funny_Token) return Printable'Class; -- common procedures for rendering into a parenthesized format: type Format is abstract tagged null record; procedure Tag_O(T : Token'Class; Output : in out Format) is abstract; procedure Tag_C(T : Token'Class; Output : in out Format) is abstract; -- output opening and closing "brackets", e.g. HTML tags -- Finally, every token on can be rendered into any format: procedure Print (Item : Token'Class; Output : in out Format'Class); end Rendering; with Write_String; package body Rendering is procedure Print(Item : Token'Class; Output : in out Format'Class) is Value : constant Printable'Class := Contents (Item); -- token content begin Tag_O(Item, Output); Write_String(Image(Value)); Tag_C(Item, Output); end Print; -- provide for printable versions of Funny_Tokens: type Funny_Printable is new Printable with record Repr : Character; end record; overriding function Image (P : Funny_Printable) return String is -- String representation of (presumably) a Funny_Token begin return String'(1 => P.Repr); end Image; function Contents (T: Funny_Token) return Printable'Class is begin case T.Kind is when Star => return Funny_Printable'(Repr => '*'); when Eq => return Funny_Printable'(Repr => '='); end case; end Contents; end Rendering; package Rendering.XHTML is -- Overridings for XHTML output. Each token's represenation is -- placed within XHTML tags. For example, a Star kind of input -- token might look like: -- -- "
*
" type HTML_Tag is new Printable with private; overriding function Image (P : HTML_Tag) return String; type XHTML is new Format with record null; -- config data? end record; procedure Emit_Tag (Paren : HTML_Tag'Class; Output : in out XHTML); overriding procedure Tag_O(T : Token'Class; Output : in out XHTML); overriding procedure Tag_C(T : Token'Class; Output : in out XHTML); private type Name_Ref is access constant String; type HTML_Tag is new Printable with record Is_Opening : Boolean; Name : Name_Ref; end record; end Rendering.XHTML; package Rendering.Parentheses is -- Overridings for parenthesized output. Output format is -- intended to look something like this (for a Star kind of -- input token): -- -- "(pre *)" type Label is new Printable with private; overriding function Image (P : Label) return String; type LList is new Format with record null; -- config data? end record; procedure Emit_Label (Paren : Label'Class; Output : in out LList); overriding procedure Tag_O(T : Token'Class; Output : in out LList); overriding procedure Tag_C(T : Token'Class; Output : in out LList); private type Name_Ref is access constant String; type Label is new Printable with record Name : Name_Ref; end record; end Rendering.Parentheses; with Write_String; package body Rendering.XHTML is -- Build a table that associates a Printable (of tag names) to be -- placed around each possible kind of token for rendering. Pre_name : aliased constant String := "pre"; Code_name : aliased constant String := "code"; Default_Name : aliased constant String := ""; Tags : constant array (Token_Kind) of HTML_Tag := (Eq => HTML_Tag'(Is_Opening => True, Name => Pre_Name'Access), Star => HTML_Tag'(Is_Opening => True, Name => Code_Name'Access), others => HTML_Tag'(Is_Opening => True, Name => Default_Name'Access)); procedure Tag_O(T : Token'Class; Output : in out XHTML) is To_Be_Put : HTML_Tag := Tags(T.Kind); begin To_Be_Put.Is_Opening := True; Emit_Tag(To_Be_Put, Output); end Tag_O; procedure Tag_C(T : Token'Class; Output : in out XHTML) is To_Be_Put : HTML_Tag := Tags(T.Kind); begin To_Be_Put.Is_Opening := False; Emit_Tag(To_Be_Put, Output); end Tag_C; function Image (P : HTML_Tag) return String is begin case P.Is_Opening is when True => return "<" & P.Name.all & ">"; when False => return ""; end case; end Image; procedure Emit_Tag (Paren : HTML_Tag'Class; Output : in out XHTML) is begin Write_String(Image(Paren)); end Emit_Tag; end Rendering.XHTML; with Write_String; package body Rendering.Parentheses is -- First, build a table that associates a Printable for labelling -- a rendered token, for each possible kind of token. Pre_name : aliased constant String := "pre"; Code_name : aliased constant String := "code"; Default_Name : aliased constant String := ""; Labels : constant array (Token_Kind) of Label := (Eq => Label'(Name => Pre_Name'Access), Star => Label'(Name => Code_Name'Access), others => Label'(Name => Default_Name'Access)); procedure Tag_O(T : Token'Class; Output : in out LList) is begin Write_String("("); Emit_Label(Labels(T.Kind), Output); end Tag_O; procedure Tag_C(T : Token'Class; Output : in out LList) is begin Write_String(")"); end Tag_C; function Image (P : Label) return String is begin return P.Name.all; end Image; procedure Emit_Label (Paren : Label'Class; Output : in out LList) is begin Write_String(Image(Paren) & " "); end Emit_Label; end Rendering.Parentheses; with Ada.Text_IO; procedure Write_String (Text : String) is begin Ada.Text_IO.Put(Text); end Write_String;