(**
** Lattakia Compiler
** Columbia University COMS-4115
** Programming Languages and Translators
** Authors:
** Wael Salloum
**)
module StringMap = Map.Make(String);;

type operatorType =
	  Plus | Minus | Times | Divide | Percent | Or | And | Equal | NotEqual | Less | LessOrEqual | Greater | GreaterOrEqual | Tilde
	| UniMinus | Not | Eval | DontOpt | Let | DirectAccess | Assign | FuncCall | Define


type latticeNatureType = DataLat (* No label or conditions *) | Hashtable (*at least on hash label *)
											| Object (*at least on ID label *) | Funcion (*at least on condition *)
type structureTypeType = Seq | Alt | Wrd | UndeterminedStruct
type dataTypeType = Int | Float | Boolean | String | General (*for epsilon and nil*) 
									| UnresolvedType | Diverse | MismatchType

and dataStructTypeType =  dataTypeType * structureTypeType

type predefinedLabelType = LENGTH | COUNT | LABELS | CLONE | REVERSE | RETURN | LOOP | GET_LOST | INDEX | SUBJECT
(******************************************************************************)
type latticeFields = {
	mutable latDataStructType: dataStructTypeType;
	mutable latNature: latticeNatureType; (*Not used yet*)
	mutable latEval: exprValueType list option;
	mutable lattice: latticeType; (* Seqlat | Altlat | Predicate | Expr *)
	mutable paramNameList: string list option; (*used when created in parser*)	
	mutable paramTypeList: dataStructTypeType list option; (*used when processed in semantic analysis*)
	mutable hasChanged: bool; (*Not used yet*) (*true if at least one dependee has changed*)
	mutable optimize: bool; 
}
      
and latticeType =     Seqlat of seqlatFields
                    | Altlat of altlatFields
                    | Predicate of predicateFields
                    | Expr of exprFields

and predicateFields = {
    mutable expr: exprFields;
    mutable condition: exprFields;
  }
      
and altlatFields = {
    mutable alternatives: latticeFields list;
    mutable each: bool;	
  }
      
and seqlatFields = {
    mutable elements: latticeFields list;
    mutable symbols: symbolTableType;	
  }
      
and symbolTableType = {
    mutable parent : symbolTableType option;
    mutable hash : symbolType StringMap.t;
  }
      
and symbolType = {
  mutable symName: string;
	mutable symDataStructType: dataStructTypeType;
	mutable symValue: symbolValueType;
	mutable symbolScope: symbolScopeType;	
	mutable parameterNameList: string list option; (*used when created in parser*)	
	mutable parameterTypeList: dataStructTypeType list option; (*used when processed in semantic analysis*)
	mutable dependers: exprFields ref list; (*Not used yet*)
	mutable dependees: exprFields ref list; (*Not used yet*)
}

and symbolValueType = LabelIndex of int | LocalValueLattice of latticeFields ref

and symbolScopeType = Label | Local | UnresolvedSymbol

(******************************************************************************)
and exprFields = {
	mutable exprDataStructType: dataStructTypeType;
	mutable exprCode: exprCodeType; (*ConstExpr | LatticeExpr | OpExpr | NameListExpr *)
	mutable exprEval: exprValueType; (*ConstValue | LatticeValue | NotEvaluated *)
	mutable exprChanged: bool; (*Not used yet*) (*true if at least one dependee has changed*)
	mutable expDependers: exprFields list; (*Not used yet*)
	mutable expDependees: exprFields list; (*Not used yet*)
}
and exprCodeType = ConstExpr of constantType | OpExpr of operationType | NameListExpr of nameListType | LatticeExpr of latticeFields
and exprValueType = ConstValue of constantType | LatticeValue of latticeFields | NotEvaluated

and constantType = StringLiteral of string | IntLiteral of int | FloatLiteral of float | Epsilon | Nil | True | False

and operationType = {
	mutable operator: operatorType;
	mutable operand1: exprFields;
	mutable operand2: exprFields option; 
}
(******************************************************************************)

and nameListType = {
	mutable nameList: nameType list;
}

and nameType = This | PredefinedLabel of predefinedLabelType 
		| IndexingOp of structureTypeType * latticeType (*uses: Seq (for []), Alt (for {}), and UndeterminedStruct (for @)*) 
		| HashOp of exprFields | Id of string
		| Each of latticeType

(******************************************************************************)
(******************************************************************************)
(******************************************************************************)	
and errorCategoryType = Worning | Semantic | Syntactic | Lexical | Runtime 
and errorMessageType = 
		  SemParamListTypeSignMismatch
		| SemUndefinedIdentifier of string
		| SemIdentifierMultipleDefinition
		| SemTypeMismatch
		| SemPredicateTypeNotBoolean
		| LexUndefinedSymbol of string
		| SynParseError

and errorType = {
	mutable errMessage: errorMessageType;
	mutable errPlace: exprCodeType option;
	mutable lineNum: int;
	mutable offset: int;
}

and envType = {
		mutable labelIdGenerator: int;
		mutable parentStackLabelIdGenerator: int list;
		mutable errorTable: errorType list;
		mutable worningTable: errorType list;
		mutable namesOfCurrLat: symbolTableType; (*The SymbolTable of the current lattice *)
		mutable poppedSymbolTable: symbolTableType;
		mutable lineNumber: int; (*cursor position in source code*)
		mutable charOffset: int; (*cursor position in source code*)
}

let env = {
	labelIdGenerator = -1;
	parentStackLabelIdGenerator = [];
	errorTable = [];
	worningTable = [];
	namesOfCurrLat = {parent = None; hash = StringMap.empty};
	poppedSymbolTable = {parent = None; hash = StringMap.empty};
	lineNumber = 0;
	charOffset = 0;
	(*pos = {pos_fname=""; pos_lnum=0; pos_bol=0; pos_cnum=0}*)
};;

let rec symbolTableSearchFor (scope : symbolTableType) name =
	try
		StringMap.find name scope.hash
	with Not_found ->
		match scope.parent with
				Some(parent) -> symbolTableSearchFor parent name
			| _ -> raise Not_found

let rec symbolTableSearchForLabel (scope : symbolTableType) name =
		let sym = StringMap.find name scope.hash in
		match sym.symbolScope with
			| Label -> sym
			| _ -> raise Not_found
 
(******************************************************************************)
(******************************************************************************)
(******************************************************************************)
type lattice = (latticeFields list) * envType

