basis/compiler/cfg/instructions/syntax/syntax.factor

   1 ! Copyright (C) 2008, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: classes.tuple classes.tuple.parser kernel words
   4 make fry sequences parser accessors effects namespaces
   5 combinators splitting classes.parser lexer quotations ;
   6 IN: compiler.cfg.instructions.syntax
   7
   8 SYMBOLS: def use temp literal ;
   9
  10 SYMBOL: scalar-rep
  11
  12 TUPLE: insn-slot-spec type name rep ;
  13
  14 : parse-rep ( str/f -- rep )
  15     {
  16         { [ dup not ] [ ] }
  17         { [ dup "scalar-rep" = ] [ drop scalar-rep ] }
  18         [ "cpu.architecture" lookup ]
  19     } cond ;
  20
  21 : parse-insn-slot-spec ( type string -- spec )
  22     over [ "Missing type" throw ] unless
  23     "/" split1 parse-rep
  24     insn-slot-spec boa ;
  25
  26 : parse-insn-slot-specs ( seq -- specs )
  27     [
  28         f [
  29             {
  30                 { "def:" [ drop def ] }
  31                 { "use:" [ drop use ] }
  32                 { "temp:" [ drop temp ] }
  33                 { "literal:" [ drop literal ] }
  34                 [ dupd parse-insn-slot-spec , ]
  35             } case
  36         ] reduce drop
  37     ] { } make ;
  38
  39 : insn-def-slots ( class -- slot/f )
  40     "insn-slots" word-prop [ type>> def eq? ] filter ;
  41
  42 : insn-use-slots ( class -- slots )
  43     "insn-slots" word-prop [ type>> use eq? ] filter ;
  44
  45 : insn-temp-slots ( class -- slots )
  46     "insn-slots" word-prop [ type>> temp eq? ] filter ;
  47
  48 ! We cannot reference words in compiler.cfg.instructions directly
  49 ! since that would create circularity.
  50 : insn-classes-word ( -- word )
  51     "insn-classes" "compiler.cfg.instructions" lookup ;
  52
  53 : insn-word ( -- word )
  54     "insn" "compiler.cfg.instructions" lookup ;
  55
  56 : vreg-insn-word ( -- word )
  57     "vreg-insn" "compiler.cfg.instructions" lookup ;
  58
  59 : flushable-insn-word ( -- word )
  60     "flushable-insn" "compiler.cfg.instructions" lookup ;
  61
  62 : foldable-insn-word ( -- word )
  63     "foldable-insn" "compiler.cfg.instructions" lookup ;
  64
  65 : insn-effect ( word -- effect )
  66     boa-effect in>> but-last { } <effect> ;
  67
  68 : uses-vregs? ( specs -- ? )
  69     [ type>> { def use temp } member-eq? ] any? ;
  70
  71 : define-insn-tuple ( class superclass specs -- )
  72     [ name>> ] map "insn#" suffix define-tuple-class ;
  73
  74 : define-insn-ctor ( class specs -- )
  75     [ dup '[ _ ] [ f ] [ boa , ] surround ] dip
  76     [ name>> ] map { } <effect> define-declared ;
  77
  78 : define-insn ( class superclass specs -- )
  79     parse-insn-slot-specs
  80     {
  81         [ nip "insn-slots" set-word-prop ]
  82         [ 2drop insn-classes-word get push ]
  83         [ define-insn-tuple ]
  84         [ 2drop save-location ]
  85         [ nip define-insn-ctor ]
  86     } 3cleave ;
  87
  88 SYNTAX: INSN:
  89     scan-new-class insn-word ";" parse-tokens define-insn ;
  90
  91 SYNTAX: VREG-INSN:
  92     scan-new-class vreg-insn-word ";" parse-tokens define-insn ;
  93
  94 SYNTAX: FLUSHABLE-INSN:
  95     scan-new-class flushable-insn-word ";" parse-tokens define-insn ;
  96
  97 SYNTAX: FOLDABLE-INSN:
  98     scan-new-class foldable-insn-word ";" parse-tokens define-insn ;