usr/src/common/ficl/softcore/forml.fr

   1 \ examples from FORML conference paper Nov 98
   2 \ sadler
   3 .( loading FORML examples ) cr
   4 object --> sub c-example
   5              cell: .cell0
   6     c-4byte   obj: .nCells
   7   4 c-4byte array: .quad
   8        c-byte obj: .length
   9          79 chars: .name
  10
  11     : init   ( inst class -- )
  12         2dup  object => init
  13         s" aardvark"  2swap  --> set-name
  14     ;
  15
  16     : get-name  ( inst class -- c-addr u )
  17         2dup
  18         --> .name  -rot      ( c-addr inst class )
  19         --> .length --> get
  20     ;
  21
  22     : set-name  { c-addr u 2:this -- }
  23         u       this --> .length --> set
  24         c-addr  this --> .name  u move
  25     ;
  26
  27     : ?  ( inst class ) c-example => get-name type cr ;
  28 end-class
  29
  30
  31 : test ." this is a test" cr ;
  32 ' test
  33 c-word --> ref testref
  34
  35 \ add a method to c-word...
  36 c-word --> get-wid ficl-set-current
  37 \ list dictionary thread
  38 : list  ( inst class )
  39     begin
  40         2dup --> get-name type cr
  41         --> next over
  42     0= until
  43     2drop
  44 ;
  45 set-current
  46
  47 object subclass c-led
  48     c-byte obj: .state
  49
  50     : on   { led# 2:this -- }
  51         this --> .state --> get
  52         1 led# lshift or dup !oreg
  53         this --> .state --> set
  54     ;
  55
  56     : off   { led# 2:this -- }
  57         this --> .state --> get
  58         1 led# lshift invert and dup !oreg
  59         this --> .state --> set
  60     ;
  61
  62 end-class
  63
  64
  65 object subclass c-switch
  66
  67     : ?on   { bit# 2:this -- flag }
  68
  69         1 bit# lshift
  70     ;
  71 end-class