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=-0.9 required=5.0 tests=BAYES_00,FORGED_GMAIL_RCVD, FREEMAIL_FROM autolearn=no autolearn_force=no version=3.4.4 X-Google-Thread: 103376,3ae40b42b99b8123 X-Google-NewGroupId: yes X-Google-Attributes: gida07f3367d7,domainid0,public,usenet X-Google-Language: ENGLISH,ASCII-7-bit Path: g2news2.google.com!postnews.google.com!d26g2000prn.googlegroups.com!not-for-mail From: Shark8 Newsgroups: comp.lang.ada Subject: Re: Little tutorial about streams Date: Fri, 4 Mar 2011 17:08:28 -0800 (PST) Organization: http://groups.google.com Message-ID: <3f98da3c-cbe0-4d62-9420-8ad1bd467752@d26g2000prn.googlegroups.com> References: NNTP-Posting-Host: 174.28.181.54 Mime-Version: 1.0 Content-Type: text/plain; charset=ISO-8859-1 X-Trace: posting.google.com 1299287309 15358 127.0.0.1 (5 Mar 2011 01:08:29 GMT) X-Complaints-To: groups-abuse@google.com NNTP-Posting-Date: Sat, 5 Mar 2011 01:08:29 +0000 (UTC) Complaints-To: groups-abuse@google.com Injection-Info: d26g2000prn.googlegroups.com; posting-host=174.28.181.54; posting-account=lJ3JNwoAAAAQfH3VV9vttJLkThaxtTfC User-Agent: G2/1.0 X-HTTP-UserAgent: Mozilla/5.0 (Windows; U; Windows NT 6.0; en-US; rv:1.9.2.14) Gecko/20110218 Firefox/3.6.14 ( .NET CLR 3.5.30729; .NET4.0E),gzip(gfe) Xref: g2news2.google.com comp.lang.ada:18829 Date: 2011-03-04T17:08:28-08:00 List-Id: I was debating on whether or not to submit to you a little 'toy' LISP interpreter I've started. I've only got the reading and writing here, no eval or special-forms like 'if', but since they're Stream-based it might be appropriate. --------------------------------- -- Lisp Interpreter in Ada. -- By Joey Fish --------------- -- LISP.ADS -- --------------- With Ada.Containers.Indefinite_Vectors, Ada.Streams; Package LISP is ----------------------------------------------------------------------- -- In LISP a List is defined as either a single element or an -- -- element followed by a lisr; as a consequence of this definition -- -- there is no such thing as an "Empty List." -- ----------------------------------------------------------------------- Type List is Private; -- ToDo: Add primitive functions for list construction/ manipulation. -- ToDo: Add primitive functions for determining if it is an executable list. Private -- Alias Ads.Streams.Root_Stream_Type for ease of use. SubType Stream_Root is Ada.Streams.Root_Stream_Type; -- Element_Type describes the possible types of an Atom -- Note: Empty_Type is the NULL-element. Type Element_Type is ( Empty_Type, Boolean_Type, Integer_Type, Real_Type, String_Type ); -- Type Atom is a record containing the type and value of an element. Type Atom( Element : Element_Type:= Empty_Type ) is record Case Element is When Empty_Type => Null; When Boolean_Type => Boolean_Value : Boolean:= False; When Integer_Type => Integer_Value : Integer:= 0; When Real_Type => Real_Value : Float := 0.0; When String_Type => Is_Name : Boolean:= False; String_Value : Not Null Access String; End Case; end record; Procedure Write_Atom( Stream : Not Null Access Stream_Root'Class; Item : In Atom ); For Atom'Write Use Write_Atom; Type Atom_Array is Array (Positive Range <>) of Atom; Type Elementry_List( Terminal : Boolean:= True ) is record Head : Atom:= ( Element => Empty_Type ); Case Terminal is When False => Tail : Not Null Access Elementry_List; When True => Null; End Case; end record; Procedure Append( Head : In Out Elementry_List; Tail : In Elementry_List ); Function Convert( List : Elementry_List ) Return Atom_Array; Function Convert( List : Atom_Array ) Return Elementry_List; Procedure Write_EList( Stream : Not Null Access Stream_Root'Class; Item : In Elementry_List ); Procedure Read_EList( Stream : Not Null Access Stream_Root'Class; Item : Out Elementry_List ); For Elementry_List'Read Use Read_EList; For Elementry_List'Write Use Write_EList; Type List_Element_Type is ( Atom_Element, EList_Type, Recursive_List ); Type List_Element( Element : List_Element_Type:= Atom_Element ) is record Case Element is When Atom_Element => Atom_Data : Atom; When EList_Type => EList_Data : Elementry_List; When Recursive_List => RList_Data : Not Null Access List; end case; end record; Function As_List( Input : in List_Element ) Return List; Package Elements is New Ada.Containers.Indefinite_Vectors ( Index_Type => Positive, Element_Type => List_Element ); Type List is Tagged record Data : Elements.Vector:= Elements.Empty_Vector; end record; Procedure Write_List( Stream : Not Null Access Stream_Root'Class; Item : In List ); Procedure Read_List( Stream : Not Null Access Stream_Root'Class; Item : Out List ); For List'Read Use Read_List; For List'Write Use Write_List; End LISP; --------------- -- LISP.ADB -- --------------- With Ada.Strings.Fixed; Package Body LISP is FALSE_Text : Constant String:= Boolean'Image( False ); TRUE_Text : Constant String:= Boolean'Image( True ); NULL_Text : Constant String:= "NULL"; Function Trim_Image( Input : In Float ) Return String is Use Ada.Strings, Ada.Strings.Fixed; Begin Return Result: String:= Trim( Side => Left, Source => Float'Image( Input ) ); End Trim_Image; ------------------ -- WRITE_ATOM -- ------------------ Procedure Write_Atom( Stream : Not Null Access Stream_Root'Class; Item : In Atom ) is Text : Access String; begin Case Item.Element is When Empty_Type => Text:= New String'( NULL_Text ); When Boolean_Type => Text:= New String'( Boolean'Image(Item.Boolean_Value) ); When Integer_Type => Text:= New String'( Integer'Image(Item.Integer_Value) ); When Real_Type => Text:= New String'( Float'Image( Item.Real_Value ) ); When String_Type => If Not Item.Is_Name then Text:= New String'( '"' & Item.String_Value.All & '"' ); else Text:= New String'( Item.String_Value.All ); end if; End Case; String'Write( Stream, Text.All ); end Write_Atom; -------------- -- Append -- -------------- Procedure Append( Head : In Out Elementry_List; Tail : In Elementry_List ) is begin If Head.Terminal then Declare Result : Elementry_List:= Elementry_List'( Terminal => False, Head => Head.Head, Tail => New Elementry_List'(Tail) ); For Result'Address Use Head'Address; Begin -- Here the initialization of Result changes the value Null; -- of Head because they are overlaid; further, we are End; -- guarenteed that the sizes are both the same because else -- Elementry_List is a simple varient record and cannot Declare -- be extended because it is not a tagged-type. This : Access Elementry_List:= Head.Tail; Begin While Not This.Terminal loop -- If Head is not terminal then This:= This.Tail; -- we must traverse the list end loop; -- until the end to append Tail. Append( This.All, Tail ); End; end if; end Append; Function Convert( List : Elementry_List ) Return Atom_Array is Function Get_Element( Item : Elementry_List ) Return Atom_Array is begin if Item.Terminal then Return Result : Atom_Array:= ( 1 => Item.Head ); else Return Result : Atom_Array:= Atom_Array'( 1 => Item.Head ) & Get_Element( Item.Tail.All ); end if; end Get_Element; begin Return Get_Element( List ); end Convert; Function Create( Input : Atom ) Return Elementry_List is begin Return Result: Elementry_List:= ( Terminal => True, Head => Input ); end; Function Convert( List : Atom_Array ) Return Elementry_List is begin if List'Length = 0 then Raise Program_Error; end if; Declare Working : Elementry_List:= Create( Input => List(List'First) ); Begin For Index in Positive'Succ(List'First)..List'Last loop Append( Head => Working, Tail => Create( List(Index) ) ); end loop; Return Working; End; end Convert; --------------------------------------------------- -- Elementry_List's 'Read & 'Write Attributes -- --------------------------------------------------- Procedure Write_EList( Stream : Not Null Access Stream_Root'Class; Item : In Elementry_List ) is begin Character'Write( Stream, '(' ); -- When saving to a Stream every Declare -- elementry-list begins with an This : Elementry_List:= Item; -- opening parenthisis, followed Begin -- by list of Atoms (whitespace List: -- separated), terminated by a loop -- closing parenthisis. Atom'Write( Stream, This.Head ); Exit List When This.Terminal; This:= This.Tail.All; Character'Write( Stream, ',' ); end loop List; Character'Write( Stream, ')' ); End; end Write_EList; Procedure Read_EList( Stream : Not Null Access Stream_Root'Class; Item : Out Elementry_List ) is Function Parse_Atom( S : String ) Return Atom is Function Get_Type_Indicator(Input : String) Return Element_Type is SubType Digit is Character Range '0'..'9'; begin Case Input(Input'First) is -- A floating-point numeric is When Digit => -- distinguished from an integer For Index in Input'Range loop -- by the decimal point or the Case Input(Index) is -- exponent notation. When 'e' | 'E' | '.' => Return Real_Type; When Others => null; End case; end loop; Return Integer_Type; When Others => if Input = NULL_Text then -- NULL, TRUE, & FALSE are texts Return Empty_Type; -- which are not String_Type. elsif Input = TRUE_Text or Input = FALSE_Text then Return Boolean_Type; else -- Everything else, however, is Return String_Type; -- either a String_Type or a end if; -- name. Strings start w/ '"'. end case; end Get_Type_Indicator; Use Ada.Strings, Ada.Strings.Fixed; -- Parse_Atom Input : String:= Ada.Strings.Fixed.Trim( S, Both ); -- starts here. begin Return Result : Atom(Get_Type_Indicator(Input)) do Case Result.Element is When Empty_Type => Null; When String_Type => Result.Is_Name:= Input(Input'First) = '"'; if Not Result.Is_Name then Result.String_Value:= New String'( Input(Positive'Succ(Input'First)..Positive'Pred(Input'Last)) ); else Result.String_Value:= New String'(Input); end if; When Integer_Type => Result.Integer_Value:= Integer'Value(Input); When Real_Type => Result.Real_Value:= Float'Value(Input); When Boolean_Type => Result.Boolean_Value:= Input = TRUE_Text; End case; End Return; end Parse_Atom; WhiteSpace : Constant Array(Character) Of Boolean:= ( ASCII.VT | ASCII.HT | ASCII.LF | ASCII.CR | ' ' => True, Others => False ); Type Index_Vector is Array (Positive Range <>) of Positive; Seperators : Not Null Access Index_Vector:= New Index_Vector'( 2..1 => 1 ); Working : Not Null Access String:= New String'( "" ); C : Character; Result : Elementry_List; In_String : Boolean:= False; Is_Terminated : Boolean:= False; begin Loop Character'Read( Stream, C ); Case C is When '"' => In_String:= Not In_String; Is_Terminated:= False; When ')' => Exit When Not In_String; When Others => If WhiteSpace(C) then if Is_Terminated then GoTo Bypass; else Is_Terminated:= True; end if; else Is_Terminated:= False; end if; End Case; Working:= New String'( Working.All & C ); -- We update "working." if WhiteSpace(C) then -- and delimit with whitespace. Seperators:= New Index_Vector'( Seperators.All & Working'Last ); end if; <> Null; End Loop; -- We simulate a terminating space by appending one more -- than the last index to Seperators. Seperators:= New Index_Vector'(Seperators.All & (Working'Last+1)); Declare -- We use one more than Working'First to ignore the '(' that starts -- this list, just like we terminated the string just before -- copying the trailing ')' into Working. Start : Positive:= Working'First+1; Stop : Positive; Begin for Index in Seperators'Range loop -- Here is where we create an Stop:= Seperators( Index )-1; -- atom from every interval we Append(Result, -- recorded in "seperators". (Terminal => True, Head => Parse_Atom(Working(Start..Stop))) ); Start:= Seperators( Index )+1; end loop; End; -- And we return everything we Item:= Result.Tail.All; -- previously appended to result. end Read_EList; --------------- -- As_List -- --------------- Function As_List( Input : in List_Element ) Return List is Begin Return Result : List do Case Input.Element is When Atom_Element => Result.Data.Append( New_Item => Input ); When Recursive_List => Result:= Input.RList_Data.All; When EList_Type => Declare Data : Elementry_List:= Input.EList_Data; Begin loop Result.Data.Append( New_Item => (Atom_Element, Data.Head) ); Exit When Data.Terminal; Data:= Data.Tail.All; end loop; End; End Case; End Return; End As_List; Procedure Write_List( Stream : Not Null Access Stream_Root'Class; Item : In List ) is SubType ELIST is Elementry_List; begin Character'Write( Stream, '(' ); Declare Procedure Process_Data( Position : Elements.Cursor ) is Item : List_Element Renames Elements.Element( Position ); begin Case Item.Element is When Atom_Element => Atom'Write( Stream, Item.Atom_Data ); When EList_Type => ELIST'Write(Stream, Item.EList_Data); When Recursive_List => List'Write( Stream, Item.RList_Data.All ); end case; end Process_Data; Begin Item.Data.Iterate( Process_Data'Access ); End; Character'Write( Stream, ')' ); end Write_List; Procedure Read_List( Stream : Not Null Access Stream_Root'Class; Item : Out List ) is begin null; end Read_List; End LISP;