home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / src / common / typespec.icn < prev    next >
Text File  |  2000-07-29  |  13KB  |  483 lines
  1. #
  2. # typespec - transform Icon type specifications into C tables.
  3. #    Specifications are read from standard input; tables are written
  4. #    to standard output.
  5. #
  6. #  The grammar for the a type specifcation is:
  7. #
  8. #    <type-def>      ::= <identifier> <opt-abrv> : <kind> <opt-return>
  9. #  
  10. #    <kind>          ::= simple |
  11. #                        aggregate(<component>, ... ) |
  12. #                        variable <var-type-spec>
  13. #  
  14. #    <component>     ::= var <identifier> <opt-abrv> |
  15. #                            <identifier>
  16. #  
  17. #    <var-type-spec> ::= initially <type> |
  18. #                        always <type>
  19. #  
  20. #    <type>          ::= <type-name> | <type> ++ <type-name>
  21. #  
  22. #    <opt-abrv>      ::= <nil> |
  23. #                        { <identifier> }
  24. #  
  25. #    <opt-return>    ::= <nil> |
  26. #                        return block_pointer |
  27. #                        return descriptor_pointer |
  28. #                        return char_pointer |
  29. #                        return C_integer
  30.  
  31. # Information about an Icon type.
  32. #
  33. record icon_type(
  34.    id,          # name of type
  35.    support_new, # supports RTL "new" construct
  36.    deref,       # dereferencing needs
  37.    rtl_ret,     # kind of RTL return supported if any
  38.    typ,         # for variable: initial type
  39.    num_comps,   # for aggregate: number of type components
  40.    compnts,     # for aggregate: index of first component
  41.    abrv)        # abreviation used for type tracing
  42.  
  43. # Information about a component of an aggregate type.
  44. #
  45. record typ_compnt (
  46.    id,        # name of component
  47.    n,         # position of component within type aggragate
  48.    var,       # flag: this component is an Icon-level variable
  49.    aggregate, # index of type that owns the component
  50.    abrv)      # abreviation used for type tracing
  51.  
  52. record token(kind, image)
  53.  
  54. global icontypes, typecompnt, type_indx, compnt_indx
  55. global lex, line_num, saved_token, error_msg, prog_name
  56.  
  57. procedure main()
  58.    local typ, tok, compnt, indx, x
  59.  
  60.    prog_name := "typespec"
  61.    lex := create tokenize_input()
  62.  
  63.    icontypes := []
  64.    typecompnt := []
  65.  
  66.    #
  67.    # Read each of the type specifications
  68.    #
  69.    while typ := icon_type(ident("may be EOF")) do {
  70.       #
  71.       # Check for abreviation
  72.       #
  73.       typ.abrv := opt_abrv(typ.id)
  74.  
  75.       if next_token().kind ~== ":" then
  76.           input_err("expected ':'")
  77.  
  78.       #
  79.       # See what kind of type this is
  80.       #
  81.       case ident() of {
  82.          "simple": {
  83.             typ.support_new := "0"
  84.             typ.deref := "DrfNone"
  85.             typ.num_comps := "0"
  86.             typ.compnts := "0"
  87.             }
  88.  
  89.          "aggregate": {
  90.             typ.support_new := "1"
  91.             typ.deref := "DrfNone"
  92.  
  93.             #
  94.             # get the component names for the type
  95.             #
  96.             typ.compnts := *typecompnt
  97.             if next_token().kind ~== "(" then
  98.                input_err("expected '('")
  99.             typ.num_comps := 0
  100.             tok := next_token()
  101.             if tok.kind ~== "id" then
  102.                input_err("expected type component")
  103.             while tok.kind ~== ")" do {
  104.                #
  105.                # See if this component is an Icon variable.
  106.                #
  107.                if tok.image == "var" then {
  108.                   compnt := typ_compnt(ident(), typ.num_comps, "1", *icontypes)
  109.                   compnt.abrv := opt_abrv(compnt.id)
  110.                   }
  111.                else
  112.                   compnt := typ_compnt(tok.image, typ.num_comps, "0",
  113.                      *icontypes)
  114.  
  115.                put(typecompnt, compnt)
  116.                typ.num_comps +:= 1
  117.  
  118.                tok := next_token()
  119.                if tok.kind == "," then {
  120.                   tok := next_token()
  121.                   if tok.kind ~== "id" then
  122.                      input_err("expected type component")
  123.                   }
  124.                else if tok.kind ~== ")" then
  125.                   input_err("expected type component")
  126.                }
  127.             }
  128.  
  129.          "variable": {
  130.             typ.support_new := "0"
  131.             typ.num_comps := "0"
  132.             typ.compnts := "0"
  133.             case ident() of {
  134.                 "initially":
  135.                    typ.deref := "DrfGlbl"
  136.                 "always":
  137.                    typ.deref :=  "DrfCnst"
  138.                 default:
  139.                   input_err("expected 'initially' or 'always'")
  140.                }
  141.  
  142.             #
  143.             # Get the initial type associated with the variable
  144.             #
  145.             typ.typ := [ident()]
  146.             tok := &null
  147.             while (tok := next_token("may be EOF")).kind == "++" do {
  148.                 put(typ.typ, ident())
  149.                 tok := &null
  150.                 }
  151.             saved_token := tok  # put token back
  152.             }
  153.          default:
  154.             input_err("expected 'simple', 'aggregate', or 'variable'")
  155.          }
  156.  
  157.       #
  158.       # Check for an optional return clause
  159.       #
  160.       tok := &null
  161.       if (tok := next_token("may be EOF")).image == "return" then {
  162.          case next_token().image of {
  163.             "block_pointer":
  164.                typ.rtl_ret := "TRetBlkP"
  165.             "descriptor_pointer":
  166.                typ.rtl_ret := "TRetDescP"
  167.             "char_pointer":
  168.                typ.rtl_ret := "TRetCharP"
  169.             "C_integer":
  170.                typ.rtl_ret := "TRetCInt"
  171.             default:
  172.                input_err("expected vword type")
  173.             }
  174.          }
  175.       else {
  176.          typ.rtl_ret := "TRetNone"
  177.          saved_token := tok    # put token back
  178.          }
  179.  
  180.       put(icontypes, typ)
  181.       }
  182.  
  183.    #
  184.    # Create tables of type and compontent indexes.
  185.    #
  186.    type_indx := table()
  187.    indx := -1
  188.    every type_indx[(!icontypes).id] := (indx +:= 1)
  189.    compnt_indx := table()
  190.    indx := -1
  191.    every compnt_indx[(!typecompnt).id] := (indx +:= 1)
  192.  
  193.    write("/*")
  194.    write(" * This file was generated by the program ", prog_name, ".")
  195.    write(" */")
  196.    write()
  197.  
  198.    #
  199.    # Locate the indexes of types with special semantics or which are
  200.    #  explicitly needed by iconc. Output the indexes as assignments to
  201.    #  variables.
  202.    #
  203.    indx := req_type("string")
  204.    icontypes[indx + 1].rtl_ret := "TRetSpcl"
  205.    write("int str_typ = ", indx, ";")
  206.  
  207.    indx := req_type("integer")
  208.    write("int int_typ = ", indx, ";")
  209.  
  210.    indx := req_type("record")
  211.    write("int rec_typ = ", indx, ";")
  212.  
  213.    indx := req_type("proc")
  214.    write("int proc_typ = ", indx, ";")
  215.  
  216.    indx := req_type("coexpr")
  217.    write("int coexp_typ = ", indx, ";")
  218.  
  219.    indx := req_type("tvsubs")
  220.    icontypes[indx + 1].deref := "DrfSpcl"
  221.    icontypes[indx + 1].rtl_ret := "TRetSpcl"
  222.    write("int stv_typ = ", indx, ";")
  223.  
  224.    indx := req_type("tvtbl")
  225.    icontypes[indx + 1].deref := "DrfSpcl"
  226.    write("int ttv_typ = ", indx, ";")
  227.  
  228.    indx := req_type("null")
  229.    write("int null_typ = ", indx, ";")
  230.  
  231.    indx := req_type("cset")
  232.    write("int cset_typ = ", indx, ";")
  233.  
  234.    indx := req_type("real")
  235.    write("int real_typ = ", indx, ";")
  236.  
  237.    indx := req_type("list")
  238.    write("int list_typ = ", indx, ";")
  239.  
  240.    indx := req_type("table")
  241.    write("int tbl_typ = ", indx, ";")
  242.  
  243.    #
  244.    # Output the type table.
  245.    #
  246.    write()
  247.    write("int num_typs = ", *icontypes, ";")
  248.    write("struct icon_type icontypes[", *icontypes, "] = {")
  249.    x := copy(icontypes)
  250.    output_typ(get(x))
  251.    while typ := get(x) do {
  252.       write(",")
  253.       output_typ(typ)
  254.       }
  255.    write("};")
  256.  
  257.    #
  258.    # Locate the indexes of components which are explicitly needed by iconc.
  259.    #  Output the indexes as assignments to variables.
  260.    #
  261.    write()
  262.    indx := req_compnt("str_var")
  263.    write("int str_var = ", indx, ";")
  264.  
  265.    indx := req_compnt("trpd_tbl")
  266.    write("int trpd_tbl = ", indx, ";")
  267.  
  268.    indx := req_compnt("lst_elem")
  269.    write("int lst_elem = ", indx, ";")
  270.  
  271.    indx := req_compnt("tbl_dflt")
  272.    write("int tbl_dflt = ", indx, ";")
  273.  
  274.    indx := req_compnt("tbl_val")
  275.    write("int tbl_val = ", indx, ";")
  276.  
  277.    #
  278.    # Output the component table.
  279.    #
  280.    write()
  281.    write("int num_cmpnts = ", *typecompnt, ";")
  282.    write("struct typ_compnt typecompnt[", *typecompnt, "] = {")
  283.    output_compnt(get(typecompnt))
  284.    while compnt := get(typecompnt) do {
  285.       write(",")
  286.       output_compnt(compnt)
  287.       }
  288.    write("};")
  289. end
  290.  
  291. #
  292. # ident - insure that next token is an identifier and return its image
  293. #
  294. procedure ident(may_be_eof)
  295.    local tok  
  296.  
  297.    tok := next_token(may_be_eof) | fail
  298.  
  299.    if tok.kind == "id" then
  300.       return tok.image
  301.    else 
  302.       input_err("expected identifier")
  303. end
  304.  
  305. #
  306. # opt_abrv - look for an optional abreviation. If there is none, return the
  307. #   default value supplied by the caller.
  308. #
  309. procedure opt_abrv(abrv)
  310.    local tok
  311.  
  312.    tok := next_token("may be EOF")
  313.    if tok.kind == "{" then {
  314.       abrv := ident()
  315.       if next_token().kind ~== "}" then
  316.           input_err("expected '}'")
  317.       }
  318.    else
  319.       saved_token := tok   # put token back
  320.  
  321.    return abrv
  322. end
  323.  
  324. #
  325. # next_token - get the next token, looking to see if one was put back.
  326. #
  327. procedure next_token(may_be_eof)
  328.    local tok
  329.  
  330.    if \saved_token then {
  331.       tok := saved_token
  332.       saved_token := &null
  333.       return tok
  334.       }
  335.    else if tok := @lex then
  336.       return tok
  337.    else if \may_be_eof then
  338.       fail
  339.    else {
  340.       write(&errout, prog_name, ", unexpected EOF")
  341.       exit(1)
  342.       }
  343. end
  344.  
  345. #
  346. # req_type - get the index of a required type.
  347. #
  348. procedure req_type(id)
  349.    local indx
  350.  
  351.    if indx := \type_indx[id] then
  352.       return indx
  353.    else {
  354.       write(&errout, prog_name, ", the type ", id, " is required")
  355.       exit(1)
  356.       }
  357. end
  358.  
  359. #
  360. # req_compnt - get the index of a required component.
  361. #
  362. procedure req_compnt(id)
  363.    local indx
  364.  
  365.    if indx := \compnt_indx[id] then
  366.       return indx
  367.    else {
  368.       write(&errout, prog_name, ", the component ", id, " is required")
  369.       exit(1)
  370.       }
  371. end
  372.  
  373. #
  374. # output_typ - output the table entry for a type.
  375. #
  376. procedure output_typ(typ)
  377.    local typ_str, s, indx
  378.  
  379.    writes("  {", image(typ.id), ", ", typ.support_new, ", ", typ.deref, ", ",
  380.       typ.rtl_ret, ", ")
  381.    if \typ.typ then {
  382.       typ_str := repl(".", *type_indx)
  383.       every s := !typ.typ do {
  384.          if s == "any_value" then {
  385.             every indx := 1 to *icontypes do {
  386.                if icontypes[indx].deref == "DrfNone" then
  387.                   typ_str[indx] := icontypes[indx].abrv[1]
  388.                }
  389.             }
  390.          else if indx := \type_indx[s] + 1 then
  391.             typ_str[indx] := icontypes[indx].abrv[1]
  392.          else {
  393.             write(&errout, prog_name, ", the specification for ", typ.id,
  394.                " contains an illegal type: ", s)
  395.             exit(1)
  396.             }
  397.          }
  398.       writes(image(typ_str))
  399.       }
  400.    else
  401.       writes("NULL")
  402.    writes(", ", typ.num_comps, ", ", typ.compnts, ", ", image(typ.abrv), ", ")
  403.    writes(image(map(typ.id[1], &lcase, &ucase) || typ.id[2:0]), "}")
  404. end
  405.  
  406. #
  407. # output_compnt - output the table entry for a component.
  408. #
  409. procedure output_compnt(compnt)
  410.    writes("  {", image(compnt.id), ", ", compnt.n, ", ", compnt.var, ", ",
  411.       compnt.aggregate, ", ", image(\compnt.abrv) | "NULL", "}")
  412. end
  413.  
  414. #
  415. # input_err - signal the lexical anaylser to print an error message about
  416. #   the last token
  417. #
  418. procedure input_err(msg)
  419.    error_msg := msg
  420.    @lex
  421. end
  422.  
  423. #
  424. # tokenize_input - transform standard input into tokens and suspend them
  425. #
  426. procedure tokenize_input()
  427.    local line
  428.  
  429.    line_num := 0
  430.    while line := read() do {
  431.       line_num +:= 1
  432.       suspend line ? tokenize_line()
  433.       }
  434.    fail
  435. end
  436.  
  437. #
  438. # tokenize_line - transform the subject of string scanning into tokens and
  439. #   suspend them
  440. #
  441. procedure tokenize_line()
  442.    local s, tok, save_pos
  443.    static id_chars
  444.  
  445.    initial id_chars := &letters ++ &digits ++ '_'
  446.  
  447.    repeat {
  448.       tab(many(' \t'))        # skip white space
  449.       if ="#" | pos(0) then
  450.          fail                 # end of input on this line
  451.  
  452.       save_pos := &pos
  453.  
  454.       if any(&letters) then
  455.          tok := token("id", tab(many(id_chars)))
  456.       else if s := =(":" | "(" | "," | ")" | "++" | "{" | "}") then
  457.          tok := token(s, s)
  458.       else
  459.          err("unknown symbol")
  460.  
  461.       suspend tok
  462.       err(\error_msg, save_pos)   # was the last token erroneous?
  463.       }
  464. end
  465.  
  466. #
  467. # err - print an error message about the current string being scanned
  468. #
  469. procedure err(msg, save_pos)
  470.    local s, strt_msg
  471.  
  472.    tab(\save_pos)    # error occured here
  473.  
  474.    strt_msg := prog_name || ", " || msg || "; line " || line_num || ": "
  475.    (s := image(tab(1))) & &fail      # get front of line then undo tab
  476.    strt_msg ||:= s[1:-1]             # strip ending quote from image
  477.    s := image(tab(0))                # get end of line
  478.    s := s[2:0]                       # strip first quote from image
  479.    write(&errout, strt_msg, s)
  480.    write(&errout, repl(" ", *strt_msg), "^")  # show location of error
  481.    exit(1)
  482. end
  483.