/pliant/language/type/misc/enumerated.pli
 
 1  # Copyright (C) 2000  Gordon Matzigkeit 
 2  # Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx 
 3  # 
 4  # This program is free software; you can redistribute it and/or 
 5  # modify it under the terms of the GNU General Public License version 2 
 6  # as published by the Free Software Foundation. 
 7  # 
 8  # This program is distributed in the hope that it will be useful, 
 9  # but WITHOUT ANY WARRANTY; without even the implied warranty of 
 10  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the 
 11  # GNU General Public License for more details. 
 12  # 
 13  # You should have received a copy of the GNU General Public License 
 14  # version 2 along with this program; if not, write to the Free Software 
 15  # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA. 
 16   
 17  abstract 
 18    [Pliant 'enumerated' data type (roughly equivalent to C 'enum' data type).] 
 19   
 20  doc 
 21    [The original code for the 'enumerated' data type, and the following listing that demonstrates it's usage has been provided by Gordon Matzigkeit.] 
 22    listing 
 23      enumerated TrafficLight 
 24        red 
 25        green 
 26        yellow 
 27        arbitrary_constant 42 
 28      gvar TrafficLight tl := yellow  # OK 
 29      console tl eol # OK, Prints "yellow" 
 30      console (cast tl Int) eol # OK, Prints "2" 
 31      tl := 42 # BAD, refuses implicit cast 
 32      tl := cast 42 TrafficLight # OK 
 33      console tl eol # OK, Prints "arbitrary_constant" 
 34      tl := cast 9 TrafficLight # OK 
 35      console tl eol # OK, Prints "9" 
 36   
 37  scope "/pliant/language/" "/pliant/install/" 
 38  module "/pliant/install/ring2.pli" 
 39   
 40  named_expression enum_frame 
 41    type type_id 
 42      field Int enumerated_value 
 43    function cast_id i -> e 
 44      arg Int i ; arg type_id e 
 45      explicit 
 46      e enumerated_value := i 
 47    function 'cast Int' e -> i 
 48      arg type_id e ; arg Int i 
 49      explicit 
 50      i := e enumerated_value 
 51    function compare i j -> c 
 52      arg type_id i j ; arg Int c 
 53      if i:enumerated_value=j:enumerated_value 
 54        c := compare_equal 
 55      else 
 56        c := compare_different 
 57    constants 
 58    method data 'to string' options -> s 
 59      arg type_id data ; arg Str options s 
 60      var Int v := data enumerated_value 
 61      body 
 62      s := string (cast data Int) 
 63     
 64  meta enumerated e 
 65    if e:size<>or not e:0:is_pure_ident or e:1:ident<>"{}" 
 66      return 
 67    var Pointer:Expression body :> 1 
 68    for (var Int i) body:size-1 
 69      if body:i:ident="" or body:i:size>1 
 70        return 
 71      if body:i:size<>and (body:i:constant Int)=null 
 72        return 
 73    var Link:Expression type_id :> expression ident e:0:ident near e:0 
 74    var Link:Expression cast_id :> expression ident "cast "+e:0:ident near e:0 
 75    var Link:Expression prog :> expression duplicate enum_frame substitute type_id type_id substitute cast_id cast_id 
 76    var Int value := 0 
 77    for body:size-1 
 78      if body:i:size<>0 
 79        value := (body:i:constant Int) map Int 
 80      var Link:Expression eid :> expression ident body:i:ident near body:i 
 81      var Link:Expression evalue :> expression constant value near body:i 
 82      var Link:Expression estring :> expression constant body:i:ident near body:i 
 83      prog insert "constants" (expression immediat (constant id (cast value type_id)) substitute id eid substitute value evalue substitute type_id e:0 near body:i) 
 84      prog insert "body" (expression immediat (if v=value return:string) substitute value evalue substitute string estring near body:i) 
 85      value := value+1 
 86    prog remove "constants" 
 87    prog remove "body" 
 88    compile_as prog 
 89   
 90  export enumerated 
 91   
 92