# Compiled by:
# src/lib/c-kit/src/ast/ast.sublibpackage state
: (weak) State # State is from src/lib/c-kit/src/ast/state.api{
package sym= symbol; # symbol is from src/lib/c-kit/src/ast/symbol.pkg # UID packages: program, type
# and adornment identifiers:
#
package pid = pid;
package tid = tid;
package aid = aid;
# Imperative uid tables (hashtables):
#
package tt= tidtab; # tidtab is from src/lib/c-kit/src/ast/tidtab.pkg package at = aidtab; # was TypeAddornmentTab
# Symbol table binary maps:
#
package st
=
binary_map_g (
Key = sym::Symbol;
compare = sym::compare;
);
# Int binary maps
#
package it
=
binary_map_g (
Key = large_int::Int;
compare = large_int::compare;
);
# Dictionaries:
#
Symtab = st::Map( namings::Sym_Naming );
#
Dictionary = List( Symtab ); # Local dictionaries.
# Global context types:
#
Uid_Tables
=
{ ttab: tables::Tidtab, # Type name table.
atab: tables::Aidtab, # Adornment table.
implicits: tables::Aidtab # "Optional" adornment table -- for special casts.
};
Env_Context
=
{ global_dictionary: Ref( Symtab ), # Global symbol table.
local_dictionary: Ref( Dictionary ) # Local dictionary stack.
};
# Local ("working") context types:
# Tids_Context: Sequence of tids
# of types created while processing
# a phrase:
#
Tids_Context
=
{ new_tids: Ref( List( tid::Uid ) )
};
# Tmp_Variables: Sequence of pids
# created while processing a phrase.
# Used when inserting explicit
# coercions in the case of ++, --, +=
#
Tmp_Variables
=
{ new_variables: Ref( List( raw_syntax::Id ) )
};
# For use in D:
#
Type_Context
=
{ type_cxts: Ref( List( Null_Or( raw_syntax::Ctype ) ) )
};
# Information for the
# current function def:
#
Fun_Context
=
{ label_tab: Ref( st::Map( (raw_syntax::Label, Bool) ) ),
gotos: Ref( List( sym::Symbol ) ),
return_type: Ref( Null_Or( raw_syntax::Ctype ) )
};
# Table for collecting switch labels
# while processing switch statements:
#
Switch_Context
=
{ switch_labels: Ref( List { switch_tab: it::Map( Void ),
default: Bool
}
)
};
# Location context, mainly
# for error messages:
#
Loc_Context
=
{ loc_stack: Ref( List(line_number_db::Location) )
};
# Global state components:
#
Global_State
=
{ uid_tables: Uid_Tables,
env_context: Env_Context, # Contains some local working state in local_dictionary.
error_state: error::Error_State
};
# Local, "working", state components:
#
Local_State
=
{ loc_context: Loc_Context,
tids_context: Tids_Context,
tmp_variables: Tmp_Variables,
fun_context: Fun_Context,
switch_context: Switch_Context,
type_context: Type_Context
};
# Initial state information for
# calling make_raw_syntax_tree:
#
State_Info
= STATE (Uid_Tables, Symtab) # Previous state info.
| INITIAL # No previous state info.
;
State_Funs
=
{ # The state records,
# included for convenience:
#
global_state: Global_State,
local_state: Local_State,
loc_funs
:
{ push_loc: line_number_db::Location -> Void,
pop_loc: Void -> Void,
get_loc: Void -> line_number_db::Location,
error: String -> Void,
warn: String -> Void
},
tids_funs
:
{ push_tids: tid::Uid -> Void,
reset_tids: Void -> List( tid::Uid )
},
tmp_vars_funs
:
{ push_tmp_vars: raw_syntax::Id -> Void,
reset_tmp_vars: Void -> List( raw_syntax::Id )
},
env_funs
:
{ top_level: Void -> Bool,
push_local_dictionary: Void -> Void,
pop_local_dictionary: Void -> Void,
get_sym: sym::Symbol -> Null_Or( namings::Sym_Naming ),
bind_sym: (sym::Symbol, namings::Sym_Naming) -> Void,
get_sym__global: sym::Symbol -> Null_Or( namings::Sym_Naming ),
bind_sym__global: (sym::Symbol, namings::Sym_Naming) -> Void,
get_local_scope: sym::Symbol -> Null_Or( namings::Sym_Naming ),
get_global_dictionary: Void -> Symtab
},
uid_tab_funs
:
{ bind_aid: raw_syntax::Ctype -> aid::Uid,
get_aid: aid::Uid -> Null_Or( raw_syntax::Ctype ),
bind_tid: (tid::Uid, namings::Tid_Naming) -> Void,
get_tid: tid::Uid -> Null_Or( namings::Tid_Naming )
},
fun_funs
:
{ new_function: raw_syntax::Ctype -> Void,
get_return_type: Void -> Null_Or( raw_syntax::Ctype ),
check_labels: Void -> Null_Or( (symbol::Symbol, line_number_db::Location) ),
add_label: (sym::Symbol, line_number_db::Location) -> raw_syntax::Label,
add_goto: (sym::Symbol, line_number_db::Location) -> raw_syntax::Label
},
switch_funs
:
{ push_switch_labels: Void -> Void,
pop_switch_labels: Void -> Void,
add_switch_label: large_int::Int -> Null_Or( String ), # Returns Null_Or( error message ).
add_default_label: Void -> Null_Or( String ) # Returns Null_Or( error message ).
}
};
# State initialization:
#
fun init_local (): Local_State
=
{ tids_context => { new_tids => REF [] },
tmp_variables => { new_variables => REF [] },
type_context => { type_cxts => REF [] },
fun_context => { label_tab => REF st::empty,
gotos => REF [],
return_type => REF NULL
},
switch_context => { switch_labels => REF [] },
loc_context => { loc_stack => REF [line_number_db::UNKNOWN] }
};
fun init_global (INITIAL, error_state: error::Error_State): Global_State
=>
{ uid_tables => { ttab => tt::uidtab(),
atab => at::uidtab(),
implicits => at::uidtab()
},
env_context => { global_dictionary => REF st::empty,
local_dictionary => REF []
},
error_state
};
init_global (STATE( { ttab, atab, implicits }, global_dictionary), error_state)
=>
{ uid_tables => { ttab, atab, implicits },
env_context => { global_dictionary => REF (global_dictionary),
local_dictionary => REF []
},
error_state
};
end;
# Provide packages of implicit
# state manipulation functions:
#
fun state_funs
( global_state as { uid_tables, env_context, error_state } : Global_State,
local_state as { tids_context, tmp_variables, fun_context, switch_context, loc_context, ... }: Local_State
)
: State_Funs
=
{
bug = error::bug error_state;
#####################################
# Tids_Context functions.
stipulate
my { new_tids } = tids_context;
herein
fun push_tids tid
=
new_tids := tid ! *new_tids;
# Contexts get pushed onto new_tids
# as encountered, so we need to
# reverse list to give original
# program order:
#
fun reset_tids ()
=
reverse *new_tids
then
(new_tids := []);
end;
#####################################
# New_Variables functions.
stipulate
my { new_variables }
=
tmp_variables;
herein
fun push_tmp_vars pid_type
=
new_variables := pid_type ! *new_variables;
# Pid_Type pairs are pushed
# onto newVariables as encountered,
# so we need to reverse list
# to give original program order:
#
fun reset_tmp_vars ()
=
reverse *new_variables
then
new_variables := [];
end;
#####################################
# Location functions.
stipulate
my { loc_stack }
=
loc_context; # Also uses error_state.
herein
fun error (msg: String)
=
case *loc_stack
loc ! _ => error::error (error_state, loc, msg);
NIL => bug "Empty location stack";
esac;
fun warn (msg: String)
=
case *loc_stack
loc ! _ => error::warning (error_state, loc, msg);
NIL => bug "Empty location stack";
esac;
# Get "current" location.
# Accesses: loc_stack.
#
fun get_loc ()
=
case *loc_stack
loc ! _ => loc;
NIL => { bug "getLoc: empty location stack";
line_number_db::UNKNOWN;
};
esac;
# Push the location stack on
# entering a marked phrase.
#
fun push_loc loc
=
loc_stack := loc ! *loc_stack;
# Pop the location stack on
# exiting a marked phrase.
#
fun pop_loc ()
=
case *loc_stack
_ ! rest => loc_stack := rest;
NIL => bug "popLoc: empty location stack";
esac;
end; # stipulate
#####################################
# Switch label functions.
stipulate
my { switch_labels }
=
switch_context;
herein
fun pop_switch_labels ()
=
case *switch_labels
_ ! sw_labels => switch_labels := sw_labels;
NIL => bug "State: Cannot pop empty switch_labels";
esac;
fun push_switch_labels ()
=
{ new_entry = { switch_tab => it::empty,
default => FALSE
};
switch_labels
:=
new_entry ! *switch_labels;
};
fun add_switch_label (i: large_int::Int): Null_Or( String )
=
case *switch_labels
{ switch_tab, default } ! rest
=>
case (it::get (switch_tab, i))
NULL =>
{ switch_tab = it::set (switch_tab, i, ());
switch_labels := { switch_tab, default } ! rest;
NULL;
};
THE _ =>
THE ("Duplicate case label " + (large_int::to_string i) +
" in the same switch statement"
);
esac;
NIL =>
THE ("Case label " + (large_int::to_string i) +
" appears outside a switch statement"
);
esac;
fun add_default_label (): Null_Or( String )
=
case *switch_labels
{ switch_tab, default } ! rest
=>
if default
THE "Duplicate default label in the same switch statement";
else
switch_labels := { switch_tab, default=>TRUE } ! rest;
NULL;
fi;
NIL =>
THE "Default label appears outside a switch statement";
esac;
end; # stipulate
#####################################
# Identifier table functions
stipulate
uid_tables -> { ttab, atab, ... };
herein
fun bind_aid type
=
{ aid = aid::new ();
at::insert (atab, aid, type);
aid;
};
fun get_aid aid
=
at::find (atab, aid);
fun bind_tid (tid, naming)
=
tt::insert (ttab, tid, naming);
fun get_tid tid
=
tt::find (ttab, tid);
end;
#####################################
# fun_context functions
stipulate
fun_context -> { label_tab, gotos, return_type };
herein
fun new_function returnty
=
{ label_tab := st::empty;
gotos := [];
return_type := THE returnty;
};
fun get_return_type ()
=
*return_type;
# David B MacQueen:
#
# labToPid called only with definition=FALSE from addGoto,
# so errorFl will always be returned FALSE in that case.
#
# On the other hand, in addLabel the value
# of the error flag is discarded.
fun symbol_to_label
( definition: Bool,
lab_sym: symbol::Symbol,
loc: line_number_db::Location
)
: (raw_syntax::Label, Bool)
=
case (st::get (*label_tab, lab_sym))
THE (label, TRUE)
=>
# Previously defined:
#
if definition (label, TRUE); # error, multiple defitions
else (label, FALSE); # no error
fi;
THE (label, FALSE)
=>
# Label has been seen previously
# but not defined:
#
{ if definition
# Mark as defined, renaming
# lab_sym in label_tab:
#
label_tab
:=
st::set(*label_tab, lab_sym, (label, TRUE));
fi;
(label, FALSE); # no error
};
NULL =>
# New label:
#
{ label = { name => lab_sym,
uid => pid::new (),
location => loc
};
label_tab
:=
st::set(*label_tab, lab_sym, (label, definition));
(label, FALSE);
};
esac;
fun add_goto (lab_sym, loc)
=
{ label = #1 (symbol_to_label (FALSE, lab_sym, loc));
# Discard error flag:
# no possibility of an error condition,
# since not a defining occurrence of the label:
gotos := lab_sym ! *gotos;
label;
};
fun add_label (lab_sym, loc)
=
{ my (label, error_flag)
=
symbol_to_label (TRUE, lab_sym, loc);
if error_flag
error("Repeated definition of label " + (sym::name lab_sym));
fi;
label;
};
fun check_labels ()
=
check *gotos
where
fun check NIL
=>
# All ok --all goto
# target labels defined:
#
NULL;
check (g ! gl)
=>
case (st::get (*label_tab, g))
THE (pid, TRUE)
=>
check gl;
THE( { name, location, ... }, FALSE)
=>
THE (name, location);
NULL =>
# Error in program -- label
# used but not defined:
#
{ bug "State: checkLabels: goto label not in table";
NULL;
};
esac;
end;
end;
end; # fun_context stipulate
#####################################
# Dictionary functions.
stipulate
env_context -> { local_dictionary, global_dictionary };
herein
# Are we in a top-level dictionary?
#
fun top_level ()
=
list::null *local_dictionary;
fun push_local_dictionary ()
=
local_dictionary
:=
st::empty ! *local_dictionary;
fun pop_local_dictionary ()
=
case *local_dictionary
st ! dictionary
=>
local_dictionary := dictionary;
NIL =>
bug "State: popping an empty local dictionary";
esac;
# get_sym: Look up a symbol
# in the full dictionary
# (local_dictionary over global_dictionary):
#
fun get_sym (symbol: sym::Symbol)
:
Null_Or( namings::Sym_Naming )
=
look_up *local_dictionary
where
fun look_up []
=>
st::get (*global_dictionary, symbol);
look_up (st ! rest)
=>
case (st::get (st, symbol))
THE x => THE x;
NULL => look_up rest;
esac;
end;
end;
fun get_sym__global (symbol: sym::Symbol)
:
Null_Or( namings::Sym_Naming )
=
st::get(*global_dictionary, symbol);
# bindSym: symbol * naming -> Void
# bind a new symbol.
#
fun bind_sym (symbol, naming)
=
case *local_dictionary
st ! outer => local_dictionary := st::set (st, symbol, naming) ! outer;
NIL => global_dictionary := st::set (*global_dictionary, symbol, naming);
esac;
# Force entry into the global dictionary.
#
# (Used for patching up undeclared
# function calls).
#
# WARNING: Generates new pid/uid.
#
fun bind_sym__global (symbol, naming)
=
global_dictionary := st::set(*global_dictionary, symbol, naming);
# Is symbol bound in current
# innermost scope level?
#
fun get_local_scope symbol
=
case *local_dictionary
NIL => st::get (*global_dictionary, symbol);
st ! _ => st::get (st, symbol);
esac;
# Return the current
# global dictionary (symtab):
#
fun get_global_dictionary (): Symtab
=
*global_dictionary;
end; # dictionary stipulate
#####################################
# State function package
{ global_state,
local_state,
loc_funs => { push_loc,
pop_loc,
get_loc,
error,
warn
},
tids_funs => { push_tids,
reset_tids
},
tmp_vars_funs => { push_tmp_vars,
reset_tmp_vars
},
env_funs => { top_level,
push_local_dictionary,
pop_local_dictionary,
get_sym,
bind_sym,
get_sym__global,
bind_sym__global,
get_local_scope,
get_global_dictionary
},
uid_tab_funs => { bind_aid,
get_aid,
bind_tid,
get_tid
},
fun_funs => { new_function,
get_return_type,
check_labels,
add_label,
add_goto
},
switch_funs => { push_switch_labels,
pop_switch_labels,
add_switch_label,
add_default_label
}
};
}; # fun state_funs
}; # package state