defpackage firrtl/parser :
   import core
   import verse
   import firrtl/ir2
   import stz/parser
   import stz/lexer

;======= Convenience Functions ====
defn throw-error (x) :
   throw $ new Exception :
      defmethod print (o:OutputStream, this) :
         print(o, x)

defn ut (x) :
   unwrap-token(x)

;======== SYNTAX =======================
defsyntax firrtl :
   defrule :
      symbol = (?x) when ut(x) typeof Symbol : ut(x)
      int = (?x) when ut(x) typeof Int : ut(x)
      
   defrule circuit :
      circuit = (circuit ?name:#symbol : (?modules:#module ... ?rest ...)) :
         if not empty?(rest) :
            throw-error("Expected module here: ~" << [rest])
         Circuit(modules, name)         

   defrule module :
      module = (module ?name:#symbol : (?ports:#port ... ?body:#comm ... ?rest ...)) :
         if not empty?(rest) :
            throw-error("Expected command here: ~" << [rest])
         Module(name, ports, Begin(body))

   defrule field :
      field = (?name:#symbol : ?type:#type) :
         Field(ut(name), DEFAULT, type)
      field = (flip ?name:#symbol : ?type:#type) :
         Field(ut(name), REVERSE, type)

   defrule port :
      port = (input ?name:#symbol : ?type:#type) :
         Port(ut(name), INPUT, type)
      port = (output ?name:#symbol : ?type:#type) :
         Port(ut(name), OUTPUT, type)

   defrule type :
      type = (?type:#type (@get ?size:#int)) :
         VectorType(type, ut(size))
      type = (UInt (@do ?width:#int)) :
         UIntType(IntWidth(ut(width)))
      type = (UInt) :
         UIntType(UnknownWidth())
      type = (SInt (@do ?width:#int)) :
         SIntType(IntWidth(ut(width)))
      type = (SInt) :
         SIntType(UnknownWidth())
      type = ({?fields:#field ...}) :
         BundleType(fields)

   defrule comm :
      comm = (wire ?name:#symbol : ?type:#type) :
         DefWire(ut(name), type)
      comm = (reg ?name:#symbol : ?type:#type) :
         DefRegister(ut(name), type)
      comm = (mem ?name:#symbol : ?type:#type) :
         DefMemory(ut(name), type)
      comm = (inst ?name:#symbol of ?module:#exp) :
         DefInstance(ut(name), module)
      comm = (node ?name:#symbol = ?exp:#exp) :
         DefNode(ut(name), exp)
      comm = (accessor ?name:#symbol = ?source:#exp (@get ?index:#exp)) :
         DefAccessor(ut(name), source, index)
      comm = ((?body:#comm ...)) :
         Begin(body)
      comm = (?x:#exp := ?y:#exp) :
         Connect(x, y)
      comm = (?c:skip) :
         EmptyStmt()
      comm = (?c:#comm/when) :
         c
         
   defrule comm/when :
      comm/when = (when ?pred:#exp : ?conseq:#comm else : ?alt:#comm) :
         Conditionally(pred, conseq, alt)
      comm/when = (when ?pred:#exp : ?conseq:#comm else ?alt:#comm/when) :
         Conditionally(pred, conseq, alt)
      comm/when = (when ?pred:#exp : ?conseq:#comm) :
         Conditionally(pred, conseq, EmptyStmt())

   defrule exp :
      exp = (?x:#exp . ?f:#int) :
         Index(x, ut(f), UnknownType())
      exp = (?x:#exp . ?f:#symbol) :
         Subfield(x, ut(f), UnknownType())
      exp = (?x:#exp-form) :
         x

   val operators = HashTable<Symbol, PrimOp>(symbol-hash)
   operators[`add] = ADD-OP
   operators[`add-uu] = ADD-UU-OP
   operators[`add-us] = ADD-US-OP
   operators[`add-su] = ADD-SU-OP
   operators[`add-ss] = ADD-SS-OP
   operators[`sub] = SUB-OP
   operators[`sub-uu] = SUB-UU-OP
   operators[`sub-us] = SUB-US-OP
   operators[`sub-su] = SUB-SU-OP
   operators[`sub-ss] = SUB-SS-OP
   operators[`mul] = MUL-OP
   operators[`mul-uu] = MUL-UU-OP
   operators[`mul-us] = MUL-US-OP
   operators[`mul-su] = MUL-SU-OP
   operators[`mul-ss] = MUL-SS-OP
   operators[`div] = DIV-OP
   operators[`div-uu] = DIV-UU-OP
   operators[`div-us] = DIV-US-OP
   operators[`div-su] = DIV-SU-OP
   operators[`div-ss] = DIV-SS-OP
   operators[`mod] = MOD-OP
   operators[`mod-uu] = MOD-UU-OP
   operators[`mod-us] = MOD-US-OP
   operators[`mod-su] = MOD-SU-OP
   operators[`mod-ss] = MOD-SS-OP
   operators[`quo] = QUO-OP
   operators[`quo-uu] = QUO-UU-OP
   operators[`quo-us] = QUO-US-OP
   operators[`quo-su] = QUO-SU-OP
   operators[`quo-ss] = QUO-SS-OP
   operators[`rem] = REM-OP
   operators[`rem-uu] = REM-UU-OP
   operators[`rem-us] = REM-US-OP
   operators[`rem-su] = REM-SU-OP
   operators[`rem-ss] = REM-SS-OP
   operators[`add-wrap] = ADD-WRAP-OP
   operators[`add-wrap-uu] = ADD-WRAP-UU-OP
   operators[`add-wrap-us] = ADD-WRAP-US-OP
   operators[`add-wrap-su] = ADD-WRAP-SU-OP
   operators[`add-wrap-ss] = ADD-WRAP-SS-OP
   operators[`sub-wrap] = SUB-WRAP-OP
   operators[`sub-wrap-uu] = SUB-WRAP-UU-OP
   operators[`sub-wrap-us] = SUB-WRAP-US-OP
   operators[`sub-wrap-su] = SUB-WRAP-SU-OP
   operators[`sub-wrap-ss] = SUB-WRAP-SS-OP
   operators[`lt] = LESS-OP
   operators[`lt-uu] = LESS-UU-OP
   operators[`lt-us] = LESS-US-OP
   operators[`lt-su] = LESS-SU-OP
   operators[`lt-ss] = LESS-SS-OP
   operators[`leq] = LESS-EQ-OP
   operators[`leq-uu] = LESS-EQ-UU-OP
   operators[`leq-us] = LESS-EQ-US-OP
   operators[`leq-su] = LESS-EQ-SU-OP
   operators[`leq-ss] = LESS-EQ-SS-OP
   operators[`gt] = GREATER-OP
   operators[`gt-uu] = GREATER-UU-OP
   operators[`gt-us] = GREATER-US-OP
   operators[`gt-su] = GREATER-SU-OP
   operators[`gt-ss] = GREATER-SS-OP
   operators[`geq] = GREATER-EQ-OP
   operators[`geq-uu] = GREATER-EQ-UU-OP
   operators[`geq-us] = GREATER-EQ-US-OP
   operators[`geq-su] = GREATER-EQ-SU-OP
   operators[`geq-ss] = GREATER-EQ-SS-OP
   operators[`eq] = EQUAL-OP
   operators[`eq-uu] = EQUAL-UU-OP
   operators[`eq-ss] = EQUAL-SS-OP
   operators[`neq] = NEQUAL-OP
   operators[`neq-uu] = NEQUAL-UU-OP
   operators[`neq-ss] = NEQUAL-SS-OP
   operators[`mux] = MUX-OP
   operators[`mux-uu] = MUX-UU-OP
   operators[`mux-ss] = MUX-SS-OP
   operators[`pad] = PAD-OP
   operators[`pad-u] = PAD-U-OP
   operators[`pad-s] = PAD-S-OP
   operators[`as-UInt] = AS-UINT-OP
   operators[`as-UInt-u] = AS-UINT-U-OP
   operators[`as-UInt-s] = AS-UINT-S-OP
   operators[`as-SInt] = AS-SINT-OP
   operators[`as-SInt-u] = AS-SINT-U-OP
   operators[`as-SInt-s] = AS-SINT-S-OP
   operators[`shl] = SHIFT-LEFT-OP
   operators[`shl-u] = SHIFT-LEFT-U-OP
   operators[`shl-s] = SHIFT-LEFT-S-OP
   operators[`shr] = SHIFT-RIGHT-OP
   operators[`shr-u] = SHIFT-RIGHT-U-OP
   operators[`shr-s] = SHIFT-RIGHT-S-OP
   operators[`convert] = CONVERT-OP
   operators[`convert-u] = CONVERT-U-OP
   operators[`convert-s] = CONVERT-S-OP
   operators[`neg] = NEG-OP
   operators[`neg-u] = NEG-U-OP
   operators[`neg-s] = NEG-S-OP
   operators[`bit-not] = BIT-NOT-OP
   operators[`bit-and] = BIT-AND-OP
   operators[`bit-or] = BIT-OR-OP
   operators[`bit-xor] = BIT-XOR-OP
   operators[`cat] = CONCAT-OP
   operators[`bit] = BIT-SELECT-OP
   operators[`bits] = BITS-SELECT-OP
   operators[`bit-and-reduce] = BIT-AND-REDUCE-OP
   operators[`bit-or-reduce] = BIT-OR-REDUCE-OP
   operators[`bit-xor-reduce] = BIT-XOR-REDUCE-OP

   defrule exp-form :
      exp-form = (UInt (@do ?value:#int ?width:#int)) :
         UIntValue(ut(value), IntWidth(ut(width)))
      exp-form = (UInt (@do ?value:#int)) :
         UIntValue(ut(value), UnknownWidth())
      exp-form = (SInt (@do ?value:#int ?width:#int)) :
         SIntValue(ut(value), IntWidth(ut(width)))
      exp-form = (SInt (@do ?value:#int)) :
         SIntValue(ut(value), UnknownWidth())
      exp-form = (WritePort (@do ?mem:#exp ?index:#exp ?enable:#exp)) :
         WritePort(mem, index, UnknownType(), enable)
      exp-form = (ReadPort (@do ?mem:#exp ?index:#exp ?enable:#exp)) :
         ReadPort(mem, index, UnknownType(), enable)
      exp-form = (Register (@do ?value:#exp ?enable:#exp)) :
         Register(UnknownType(),value,enable)
      exp-form = (?op:#symbol (@do ?es:#exp ... ?ints:#int ...)) :
         println("Op-symbol is:~" % [op])
         match(get?(operators, ut(op), false)) :
            (op:PrimOp) :
               ;println("Op is:~ ~ ~" % [op,op == ADD-OP, op == ADD-UU-OP])
               DoPrim(op, es, map(ut, ints), UnknownType())
            (f:False) :
               throw-error $ string-join $ [
               "Invalid operator: " op]     
      exp-form = (?x:#symbol) :
         Ref(ut(x), UnknownType())                       

public defn parse-firrtl (forms:List) :
   with-syntax(firrtl) :
      match-syntax(forms) :
         (?c:#circuit) :
            c