694 lines
22 KiB
Erlang
694 lines
22 KiB
Erlang
% @doc
|
|
% type for a GSC AST
|
|
%
|
|
% based on so_syntax.erl
|
|
%
|
|
% this is the second layer in the parsing pipeline after tokens. From
|
|
% so_syntax:
|
|
%
|
|
% ## Declarations
|
|
%
|
|
% A Sophia file consists of a sequence of *declarations* in a layout block.
|
|
%
|
|
% ```c
|
|
% File ::= Block(TopDecl)
|
|
%
|
|
% TopDecl ::= ['payable'] ['main'] 'contract' Con [Implement] '=' Block(Decl)
|
|
% | 'contract' 'interface' Con [Implement] '=' Block(Decl)
|
|
% | 'namespace' Con '=' Block(Decl)
|
|
% | '@compiler' PragmaOp Version
|
|
% | 'include' String
|
|
% | Using
|
|
%
|
|
% Implement ::= ':' Sep1(Con, ',')
|
|
%
|
|
% Decl ::= 'type' Id ['(' TVar* ')'] '=' TypeAlias
|
|
% | 'record' Id ['(' TVar* ')'] '=' RecordType
|
|
% | 'datatype' Id ['(' TVar* ')'] '=' DataType
|
|
% | 'let' Id [':' Type] '=' Expr
|
|
% | (EModifier* 'entrypoint' | FModifier* 'function') Block(FunDecl)
|
|
% | Using
|
|
%
|
|
% FunDecl ::= Id ':' Type // Type signature
|
|
% | Id Args [':' Type] '=' Block(Stmt) // Definition
|
|
% | Id Args [':' Type] Block(GuardedDef) // Guarded definitions
|
|
%
|
|
% GuardedDef ::= '|' Sep1(Expr, ',') '=' Block(Stmt)
|
|
%
|
|
% Using ::= 'using' Con ['as' Con] [UsingParts]
|
|
% UsingParts ::= 'for' '[' Sep1(Id, ',') ']'
|
|
% | 'hiding' '[' Sep1(Id, ',') ']'
|
|
%
|
|
% PragmaOp ::= '<' | '=<' | '==' | '>=' | '>'
|
|
% Version ::= Sep1(Int, '.')
|
|
%
|
|
% EModifier ::= 'payable' | 'stateful'
|
|
% FModifier ::= 'stateful' | 'private'
|
|
%
|
|
% Args ::= '(' Sep(Pattern, ',') ')'
|
|
%
|
|
% Type ::= Domain '=>' Type // Function type
|
|
% | Type '(' Sep(Type, ',') ')' // Type application
|
|
% | '(' Type ')' // Parens
|
|
% | 'unit' | Sep(Type, '*') // Tuples
|
|
% | Id | QId | TVar
|
|
%
|
|
% Domain ::= Type // Single argument
|
|
% | '(' Sep(Type, ',') ')' // Multiple arguments
|
|
% ```
|
|
-module(gsc_ast).
|
|
|
|
%-compile([export_all,nowarn_export_all]).
|
|
%
|
|
%%-export_type([
|
|
%%]).
|
|
%%
|
|
%%-export([
|
|
%% slurp/2
|
|
%%]).
|
|
%
|
|
%-export([
|
|
% gulp_file/1
|
|
%]).
|
|
%
|
|
%-include("$gsc_include/gsc.hrl").
|
|
%
|
|
%%%-----------------------------
|
|
%%% TYPES: gsc_ast
|
|
%%%-----------------------------
|
|
%
|
|
%
|
|
%% % placeholders
|
|
%-type ast_() :: any().
|
|
%-record(ast_nyi, {tokens = none :: [tk()]}).
|
|
%-type ast_nyi() :: #ast_nyi{}.
|
|
%
|
|
%
|
|
%% product type: foo * bar * baz
|
|
%%
|
|
%% stupid weird implication from bad syntax foresight trying to be
|
|
%% fancy and overload what parens do is products must always have at
|
|
%% least two operands; probably this is because `(foo)` is always the
|
|
%% same as `foo`
|
|
%%
|
|
%% - 0-tuple -> `unit`
|
|
%% - 1-tuple -> type itself
|
|
%% - 2+ -> here
|
|
%-record(ast_te_pi,
|
|
% {types = none :: none | [ast_te_()]}).
|
|
%
|
|
%-type ast_type_expr()
|
|
% :: #ast_te_fn{} % function (string, string) => string
|
|
% | #ast_te_ap{} % application map(string, int)
|
|
% | #ast_te_pi{} % product foo * bar * baz
|
|
% | #ast_te_tk{} % token string int 'a Foo.Bar.baz
|
|
% | ast_nyi().
|
|
%-type ast_te() :: ast_type_expr().
|
|
%
|
|
%
|
|
%% ta = type alias
|
|
%% 'type' Id ['(' TVar* ')'] '=' TypeAlias
|
|
%-record(ast_ta,
|
|
% {alias = none :: none | tk(),
|
|
% tvars = none :: none | [tk()],
|
|
% points_to = none :: none | ast_type_expr()}).
|
|
%
|
|
%% Decl ::= 'type' Id ['(' TVar* ')'] '=' TypeAlias
|
|
%% | 'record' Id ['(' TVar* ')'] '=' RecordType
|
|
%% | 'datatype' Id ['(' TVar* ')'] '=' DataType
|
|
%% | 'let' Id [':' Type] '=' Expr
|
|
%% | (EModifier* 'entrypoint' | FModifier* 'function') Block(FunDecl)
|
|
%% | Using
|
|
%-type decl() :: #ast_ta{}
|
|
% | #ast_nyi{}.
|
|
%
|
|
%% ['payable'] ['main'] 'contract' Con [Implement] '=' Block(Decl)
|
|
%-record(ast_ct,
|
|
% {payable = none :: none | boolean(),
|
|
% main = none :: none | boolean(),
|
|
% name = none :: none | tk(),
|
|
% impls = none :: none | [tk()],
|
|
% decls = none :: none | [decl()]}).
|
|
%
|
|
%-record(ast_td_iface,{}).
|
|
%-record(ast_td_ns,{}).
|
|
%-record(ast_td_compiler,{}).
|
|
%-record(ast_td_include,{}).
|
|
%-record(ast_using,{}).
|
|
%
|
|
%% @doc
|
|
%% TopDecl ::= ['payable'] ['main'] 'contract' Con [Implement] '=' Block(Decl)
|
|
%% | 'contract' 'interface' Con [Implement] '=' Block(Decl)
|
|
%% | 'namespace' Con '=' Block(Decl)
|
|
%% | '@compiler' PragmaOp Version
|
|
%% | 'include' String
|
|
%% | Using
|
|
%-type top_decl() :: #ast_ct{}
|
|
% | #ast_td_iface{}
|
|
% | #ast_td_ns{}
|
|
% | #ast_td_compiler{}
|
|
% | #ast_td_include{}
|
|
% | #ast_using{}
|
|
% .
|
|
%
|
|
%-record(ast_file,
|
|
% {top_decls :: [top_decl()]}).
|
|
%-type ast_file() :: #ast_file{}.
|
|
%
|
|
%
|
|
%-type parse_error_() :: any().
|
|
%-record(parse_error,
|
|
% {pos = none :: none | tk_pos(),
|
|
% msg = "" :: string(),
|
|
% subs = [] :: [parse_error_()],
|
|
% extra = none :: any()}).
|
|
%-type parse_error() :: parse_error().
|
|
%
|
|
%
|
|
%-type ast()
|
|
% :: #ast_ct{}
|
|
% | #ast_file{}
|
|
% | #ast_nyi{}
|
|
% | #ast_ta{}
|
|
% | #ast_td_compiler{}
|
|
% | #ast_td_iface{}
|
|
% | #ast_td_include{}
|
|
% | #ast_td_ns{}
|
|
% | #ast_te_ap{} % application map(string, int)
|
|
% | #ast_te_fn{} % function (string, string) => string
|
|
% | #ast_te_pi{} % product foo * bar * baz
|
|
% | #ast_te_tk{} % token string int 'a Foo.Bar.baz
|
|
% | #ast_using{}.
|
|
%
|
|
%
|
|
%
|
|
%
|
|
%
|
|
%%%-----------------------------
|
|
%%% FUNCTIONS
|
|
%%%-----------------------------
|
|
%
|
|
%-spec gulp_file(Tokens) -> Perhaps
|
|
% when Tokens :: [tk()],
|
|
% Perhaps :: {gulp, #ast_file{}}
|
|
% | {error, #parse_error{}}.
|
|
%
|
|
%gulp_file([]) ->
|
|
% {error, empty_file};
|
|
%gulp_file(Tokens) ->
|
|
% case gs_tokens:take_block(Tokens) of
|
|
% {Tokens, []} ->
|
|
% gulp_block(fun gulp_top_decl/1, Tokens);
|
|
% %gulp_file2([], [], Tokens);
|
|
% {A, B} ->
|
|
% StartPos = gs_tokens:start_pos(A),
|
|
% ErrPos = gs_tokens:start_pos(B),
|
|
% Msg = efmt("gulp_file: block starting at ~p ends at ~p instead of EOF",
|
|
% [StartPos, ErrPos]),
|
|
% {error, #parse_error{pos = ErrPos, msg = Msg}}
|
|
% end.
|
|
%
|
|
%
|
|
%
|
|
%%gulp_file2(AccOks, AccErrs, Tokens = [_ | _]) ->
|
|
%% % ItemTokens will be nonempty
|
|
%% {ItemTokens, NewTokens} = gs_tokens:take_block_item(Tokens),
|
|
%% case gulp_top_decl(ItemTokens) of
|
|
%% {gulp, Ok} -> gulp_file2([Ok | AccOks], AccErrs, NewTokens);
|
|
%% Err -> gulp_file2(AccOks, [Err | AccErrs], NewTokens)
|
|
%% end;
|
|
%%gulp_file2(AccOks, [], []) ->
|
|
%% TopDecls = lists:reverse(AccOks),
|
|
%% {gulp, #ast_file{top_decls = TopDecls}};
|
|
%%gulp_file2(_, AccErrs, []) ->
|
|
%% Errs = [#parse_error{pos = Pos} | _]
|
|
%% = lists:reverse(AccErrs),
|
|
%% {error, #parse_error{pos = Pos, subs = Errs}}.
|
|
%
|
|
%-spec gulp_block(GulpItem, Tokens) -> GulpedItems
|
|
% when GulpItem :: fun((ItemTokens) -> GulpedItem),
|
|
% Tokens :: [tk()],
|
|
% ItemTokens :: Tokens,
|
|
% GulpedItem :: {gulp, Item} | {error, Reason},
|
|
% GulpedItems :: {gulp, Items} | {error, Reason},
|
|
% Items :: [Item],
|
|
% Item :: ast(),
|
|
% Reason :: any().
|
|
%% @doc
|
|
%% this almost is the familiar `traverse' idiom from Haskell
|
|
%%
|
|
%% ghci> :t traverse
|
|
%% traverse
|
|
%% :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b)
|
|
%% ghci> :t mapM
|
|
%% mapM :: (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b)
|
|
%%
|
|
%% (or `mapM' if youre being sloppy)
|
|
%%
|
|
%% however in our case our function is actually of
|
|
%% signature
|
|
%%
|
|
%% :: (t a -> f b)
|
|
%%
|
|
%% so this is more sophisticated
|
|
%% @end
|
|
%
|
|
%gulp_block(GulpItem, Tokens) ->
|
|
% gulp_block(GulpItem, [], [], Tokens).
|
|
%
|
|
%gulp_block(GulpItem, AccOks, AccErrs, Tokens = [_ | _]) ->
|
|
% % ItemTokens will be nonempty
|
|
% {ItemTokens, NewTokens} = gs_tokens:take_block_item(Tokens),
|
|
% case GulpItem(ItemTokens) of
|
|
% {gulp, Ok} -> gulp_block(GulpItem, [Ok | AccOks], AccErrs, NewTokens);
|
|
% Err -> gulp_block(GulpItem, AccOks, [Err | AccErrs], NewTokens)
|
|
% end;
|
|
%gulp_block(_, AccOks, [], []) ->
|
|
% Items = lists:reverse(AccOks),
|
|
% {gulp, Items};
|
|
%gulp_block(_, _, AccErrs, []) ->
|
|
% {error, #parse_error{subs = lists:reverse(AccErrs)}}.
|
|
%
|
|
%
|
|
%
|
|
%-spec gulp_top_decl(DeclTokens) -> Result
|
|
% when DeclTokens :: [tk()],
|
|
% Result :: {gulp, ast()} | {error, any()}.
|
|
%
|
|
%% @doc
|
|
%% TopDecl ::= ['payable'] ['main'] 'contract' Con [Implement] '=' Block(Decl)
|
|
%% | 'contract' 'interface' Con [Implement] '=' Block(Decl)
|
|
%% | 'namespace' Con '=' Block(Decl)
|
|
%% | '@compiler' PragmaOp Version
|
|
%% | 'include' String
|
|
%% | Using
|
|
%% @end
|
|
%gulp_top_decl(DeclTokens) ->
|
|
% case gs_tokens:strings(3, DeclTokens) of
|
|
% ["payable", "contract", "interface"] ->
|
|
% gulp_nyi(DeclTokens);
|
|
% ["contract", "interface" | _] ->
|
|
% gulp_nyi(DeclTokens);
|
|
% ["payable", "main", "contract"] ->
|
|
% gulp_ct2(#ast_ct{payable = true, main = true},
|
|
% drop(3, DeclTokens));
|
|
% ["main", "contract" | _] ->
|
|
% gulp_ct2(#ast_ct{payable = false, main = true},
|
|
% drop(2, DeclTokens));
|
|
% ["payable", "contract" | _] ->
|
|
% gulp_ct2(#ast_ct{payable = true, main = false},
|
|
% drop(2, DeclTokens));
|
|
% ["contract" | _] ->
|
|
% gulp_ct2(#ast_ct{payable = false, main = false},
|
|
% drop(1, DeclTokens));
|
|
% ["namespace" | _] ->
|
|
% gulp_nyi(DeclTokens);
|
|
% ["@", "compiler" | _] ->
|
|
% gulp_nyi(DeclTokens);
|
|
% ["include" | _] ->
|
|
% gulp_nyi(DeclTokens);
|
|
% ["using" | _ ] ->
|
|
% gulp_nyi(DeclTokens);
|
|
% _ ->
|
|
% % decl tokens will always be nonempty
|
|
% [H = #tk{pos = ErrPos} | _] = DeclTokens,
|
|
% EMsg = efmt("gulp_top_decl: bad token: ~p; "
|
|
% "expecting one of: [payable, main, contract, namespace, @compiler, include, using]",
|
|
% [H]),
|
|
% {error, #parse_error{pos = ErrPos,
|
|
% msg = EMsg}}
|
|
% end.
|
|
%
|
|
%
|
|
%gulp_ct2(Ast, Tokens = [#tk{pos = Pos} | _]) ->
|
|
% % need to pass through pos for error messages on premature end of
|
|
% % input... for now it's a fixme thing
|
|
% gulp_ct3(Ast, Tokens, Pos).
|
|
%
|
|
%
|
|
%% payable main contract X : Y, Z, W = <block>
|
|
%% ^
|
|
%gulp_ct3(Ast = #ast_ct{name = none}, Tokens, Pos) ->
|
|
% NewPos = Pos, %% fixme
|
|
% case Tokens of
|
|
% [Name = #tk{type = con} | NewTokens] ->
|
|
% NewAst = Ast#ast_ct{name = Name},
|
|
% gulp_ct3(NewAst, NewTokens, NewPos);
|
|
% [Name | _] ->
|
|
% {error, {fixme, {bad_contract_name, Name}}};
|
|
% [] ->
|
|
% {error, {fixme, no_contract_name}}
|
|
% end;
|
|
%% contract X = <block>
|
|
%% contract X : Y, Z, W = <block>
|
|
%% ^
|
|
%gulp_ct3(Ast = #ast_ct{impls = none}, Tokens, Pos) ->
|
|
% NewPos = Pos, %% fixme
|
|
% case slurp_ct_impls(Tokens) of
|
|
% {slurp, Impls, NewTokens} ->
|
|
% NewAst = Ast#ast_ct{impls = Impls},
|
|
% gulp_ct3(NewAst, NewTokens, NewPos);
|
|
% Error ->
|
|
% Error
|
|
% end;
|
|
%% contract X = <block>
|
|
%% contract X : Y, Z, W = <block>
|
|
%% ^
|
|
%gulp_ct3(Ast = #ast_ct{decls = none},
|
|
% [#tk{string = "="} | Tokens],
|
|
% _Pos) ->
|
|
% case gulp_block(fun gulp_decl/1, Tokens) of
|
|
% {gulp, Decls} ->
|
|
% Result = Ast#ast_ct{decls = Decls},
|
|
% {gulp, Result};
|
|
% Error ->
|
|
% Error
|
|
% end;
|
|
%gulp_ct3(Ast, Tokens, Pos) ->
|
|
% {error, {fixme, {nyi, gulp_ct3, [Ast, Tokens, Pos]}}}.
|
|
%
|
|
%
|
|
%
|
|
%-spec slurp_ct_impls(Tokens) -> Slurped
|
|
% when Tokens :: [tk()],
|
|
% Slurped :: {slurp, Impls, NewTokens}
|
|
% | {error, Reason},
|
|
% Impls :: Tokens,
|
|
% NewTokens :: Tokens,
|
|
% Reason :: any().
|
|
%% @doc ": X, Y, Z = ..." ~> {slurp, [X, Y, Z], "= ..."}
|
|
%
|
|
%% FIXME: this should be a restructured a tiny bit for better error
|
|
%% handling
|
|
%slurp_ct_impls([_ = #tk{string = ":"},
|
|
% Con = #tk{type = con}
|
|
% | NewTokens]) ->
|
|
% slurp_ct_impls2([Con], NewTokens);
|
|
%slurp_ct_impls(NewTokens = [#tk{string = "="} | _]) ->
|
|
% {slurp, [], NewTokens};
|
|
%slurp_ct_impls([BadToken | _]) ->
|
|
% Msg = efmt("slurp_ct_impls: expecting (: Con | =), got ~p", [BadToken]),
|
|
% {error, {fixme, Msg}};
|
|
%slurp_ct_impls([]) ->
|
|
% {error, {fixme, "expecting : or =, got end-of-input"}}.
|
|
%
|
|
%
|
|
%slurp_ct_impls2(Stk, [_ = #tk{string = ","},
|
|
% Con = #tk{type = con}
|
|
% | NewTokens]) ->
|
|
% slurp_ct_impls2([Con | Stk], NewTokens);
|
|
%slurp_ct_impls2(Stk, NewTokens = [#tk{string = "="} | _]) ->
|
|
% {slurp, lists:reverse(Stk), NewTokens};
|
|
%slurp_ct_impls2(Stk, BadTokens) ->
|
|
% {error, {fixme, nyi, slurp_ct_impls2, [Stk, BadTokens]}}.
|
|
%
|
|
%
|
|
%% Decl ::= 'type' Id ['(' TVar* ')'] '=' TypeAlias
|
|
%% | 'record' Id ['(' TVar* ')'] '=' RecordType
|
|
%% | 'datatype' Id ['(' TVar* ')'] '=' DataType
|
|
%% | 'let' Id [':' Type] '=' Expr
|
|
%% | (EModifier* 'entrypoint' | FModifier* 'function') Block(FunDecl)
|
|
%% | Using
|
|
%gulp_decl(Tokens) ->
|
|
% case gs_tokens:strings(1, Tokens) of
|
|
% ["type"] -> gulp_type_alias(Tokens);
|
|
% _ -> gulp_nyi(Tokens)
|
|
% end.
|
|
%
|
|
%% 'type' Id ['(' TVar* ')'] '=' TypeAlias
|
|
%gulp_type_alias(Tokens) ->
|
|
% gulp_ta(#ast_ta{}, Tokens).
|
|
%
|
|
%
|
|
%% 'type' Id ['(' TVar* ')'] '=' TypeAlias
|
|
%% ^
|
|
%gulp_ta(Ast = #ast_ta{alias = none},
|
|
% _ = [#tk{string = "type"}, Alias = #tk{type = id}
|
|
% | NewTokens]) ->
|
|
% NewAst = Ast#ast_ta{alias = Alias},
|
|
% gulp_ta(NewAst, NewTokens);
|
|
%% 'type' Id ['(' TVar* ')'] '=' TypeAlias
|
|
%% ^
|
|
%gulp_ta(Ast = #ast_ta{tvars = none},
|
|
% Tokens) ->
|
|
% case slurp_ta_tvars(Tokens) of
|
|
% {slurp, TVars, NewTokens} ->
|
|
% NewAst = Ast#ast_ta{tvars = TVars},
|
|
% gulp_ta(NewAst, NewTokens);
|
|
% Error -> Error
|
|
% end;
|
|
%% 'type' Id ['(' TVar* ')'] '=' TypeAlias
|
|
%% ^
|
|
%gulp_ta(Ast = #ast_ta{points_to = none},
|
|
% _ = [#tk{string = "="} | NewTokens]) ->
|
|
% case gulp_type_expr(NewTokens) of
|
|
% {gulp, TypeExpr} ->
|
|
% Result = Ast#ast_ta{points_to = TypeExpr},
|
|
% {gulp, Result};
|
|
% Error -> Error
|
|
% end;
|
|
%gulp_ta(A, B) ->
|
|
% {error, {fixme, gulp_ta, A, B, ?MODULE, ?LINE}}.
|
|
%
|
|
%
|
|
%% type foo(bar, baz) = quux
|
|
%% ^
|
|
%%
|
|
%% "(bar, baz) = ..." ~> {slurp, [bar, baz], "= ..."}
|
|
%slurp_ta_tvars(Tks = [#tk{string = "="} | _]) ->
|
|
% {slurp, [], Tks};
|
|
%slurp_ta_tvars([#tk{string = "("},
|
|
% #tk{string = ")"}
|
|
% | NewTokens]) ->
|
|
% {slurp, [], NewTokens};
|
|
%slurp_ta_tvars([_ = #tk{string = "("},
|
|
% TVar = #tk{type = tvar}
|
|
% | NewTokens]) ->
|
|
% slurp_tavars([TVar], NewTokens).
|
|
%
|
|
%
|
|
%slurp_tavars(Stk,
|
|
% [_ = #tk{string = ","},
|
|
% TVar = #tk{type = tvar}
|
|
% | NewTks]) ->
|
|
% slurp_tavars([TVar | Stk], NewTks);
|
|
%slurp_tavars(Stk,
|
|
% [#tk{string = ")"}
|
|
% | NewTks]) ->
|
|
% {slurp, lists:reverse(Stk), NewTks}.
|
|
%
|
|
%
|
|
%gulp_type_expr(Tokens) ->
|
|
% case slurp_type_expr(Tokens) of
|
|
% {slurp, T, []} -> {gulp, T};
|
|
% {slurp, _, E} -> {error, {fixme, trailing, E}};
|
|
% Error -> Error
|
|
% end.
|
|
%
|
|
%
|
|
%% Type ::= Domain '=>' Type // Function type
|
|
%% | Type '(' Sep(Type, ',') ')' // Type application
|
|
%% | '(' Type ')' // Parens
|
|
%% | 'unit'
|
|
%% | Sep(Type, '*') // Tuples
|
|
%% | Id
|
|
%% | QId
|
|
%% | TVar
|
|
%%
|
|
%% Domain ::= Type // Single argument
|
|
%% | '(' Sep(Type, ',') ')' // Multiple arguments
|
|
%
|
|
%% terminals:
|
|
%% TkType = id | qid | tvar
|
|
%% PList = PList0 | PList1 | PList2
|
|
%% ProdType = Type [* Type]+
|
|
%% LamType = Type [=> Type]+
|
|
%%
|
|
%% PList0 = ()
|
|
%% PList1 = (Type)
|
|
%% PList2 = (Type [, Type]+)
|
|
%%
|
|
%% Ah ok:
|
|
%%
|
|
%% Type1 = TkType | PList(Type)
|
|
%%
|
|
%% Type = Type1 % string, (string), (string, string)
|
|
%% | Type1 => Type % function
|
|
%% | Type1 PList(Type) % application
|
|
%% | Type1 * Type % product
|
|
%
|
|
%
|
|
%% each type either starts with an id/qid/tvar token or an open paren
|
|
%%
|
|
%% we're going to eliminate open paren cases first:
|
|
%%
|
|
%% legal cases:
|
|
%%
|
|
%% 1. Function types can have arbitrary #args:
|
|
%%
|
|
%% () => ... // legal
|
|
%% (_) => ... // legal
|
|
%% (_, _) => ... // legal
|
|
%%
|
|
%% 2. Otherwise it must be a plist of ONLY one type
|
|
%%
|
|
%% () // illegal, should be "unit"
|
|
%% (X) // legal, equiv to X
|
|
%% (X, Y) // illegal, should be X * Y
|
|
%%
|
|
%slurp_type_expr(Tks = [#tk{pos = Pos} | _]) ->
|
|
% case slurp_type1(Tks) of
|
|
% % plist cases
|
|
% % function types _ => _
|
|
% {slurp, {plist, PList}, NewTks} ->
|
|
% case {PList, NewTks} of
|
|
% % ANY plist (including (), (foo)) followed by => is fine
|
|
% % () => _
|
|
% % (_) => _
|
|
% % (_, _) => _
|
|
% {DomainType, [#tk{string = "=>"} | After]} ->
|
|
% case slurp_type_expr(After) of
|
|
% {slurp, CodomainType, NewTks} ->
|
|
% TypeExpr = #ast_te_fn{dom = DomainType,
|
|
% codom = CodomainType},
|
|
% {slurp, TypeExpr, NewTks};
|
|
% Error = {error, _} ->
|
|
% Error
|
|
% end;
|
|
% % WMA not a function type, so only plists with 1 type are
|
|
% % allowed
|
|
% {[One], After} ->
|
|
% slurp_type_expr2(One, After);
|
|
% % plists of 0 or 2+ not allowed
|
|
% {[], _} ->
|
|
% Msg = "() is called unit",
|
|
% {error, {fixme, ?MODULE, ?LINE, illegal_type, Pos, Msg}};
|
|
% {_, _} ->
|
|
% Msg = "(_, _, ...) must be followed by =>; "
|
|
% "the type for tuples (A, B) is A * B",
|
|
% {error, {fixme, ?MODULE, ?LINE, illegal_type, Pos, Msg}}
|
|
% end;
|
|
% % first token is id|qid|tvar: foo, Foo.bar, 'foo
|
|
% {slurp, {token, Tk}, NewTks} ->
|
|
% case NewTks of
|
|
% % foo => bar is fine, normalized to (foo) => bar
|
|
% [#tk{string = "=>"} | After] ->
|
|
% case slurp_type_expr(After) of
|
|
% {slurp, Codom, NewAfter} ->
|
|
% ArgType = #ast_te_tk{token = ArgTypeTk},
|
|
% Dom = [ArgType],
|
|
% Result = #ast_te_fn{dom = Dom, codom = Codom},
|
|
% {slurp, Result, NewAfter};
|
|
% Error = {error, _} ->
|
|
% Error
|
|
% end;
|
|
% {_, _} ->
|
|
% One = #ast_te_tk{token = Tk},
|
|
% slurp_type_expr2(One, After)
|
|
% end;
|
|
% Error = {error, _} ->
|
|
% Error
|
|
% end.
|
|
%
|
|
%
|
|
%% parsed the first type, now need to see if this is an application
|
|
%% or a product or if we're done
|
|
%slurp_type_expr2(FirstType, After) ->
|
|
% % fixme: just going to ignore products and applications for now
|
|
% {slurp, FirstType, After}.
|
|
% %case strings(1, After) of
|
|
% % ["("] -> error(nyi);
|
|
% % ["*"] -> error(nyi);
|
|
% %case After of
|
|
% % [#tk{string = "("} | _] ->
|
|
% % case slurp_type1_II(After) of
|
|
% % {slurp, {plist, ArgTypes}, NewAfter} ->
|
|
% % {slurp, #ast_te_ap{fn = FirstType
|
|
%
|
|
%
|
|
%
|
|
%
|
|
%% Type1 = {plist, Types} () (foo) (foo, bar)
|
|
%% | {token, #tk{}} foo Bar.baz 'quux
|
|
%slurp_type1(Tks) ->
|
|
% case gs_tokens:slurp_plist(Tks) of
|
|
% % head token is NOT open paren -> must be id/qid/tvar
|
|
% {slurp, [], [Tk | NewTks]} ->
|
|
% TkType = Tk#tk.type,
|
|
% case TkType of
|
|
% id -> {slurp, {token, Tk}, NewTks};
|
|
% qid -> {slurp, {token, Tk}, NewTks};
|
|
% tvar -> {slurp, {token, Tk}, NewTks};
|
|
% _ -> {error, {fixme, illegal_type, Tk, ?MODULE, ?LINE}}
|
|
% end;
|
|
% % head token is an open paren, need to recursively consume
|
|
% % the inner types
|
|
% {slurp, PListTokens, After} ->
|
|
% case gulp_ptype1(PListTokens) of
|
|
% {gulp, Types} -> {slurp, {plist, Types}, After};
|
|
% Error = {error, _} -> Error
|
|
% end;
|
|
% Error = {error, _} -> Error
|
|
% end.
|
|
%
|
|
%
|
|
%%slurp_type_expr_plist(Tks) ->
|
|
%% case gs_tokens:slurp_plist(Tks) of
|
|
%% % head token is NOT open paren -> must be id/qid/tvar
|
|
%% {slurp, [], [Tk | NewTks]} ->
|
|
%% TkType = Tk#tk.type,
|
|
%% case TkType of
|
|
%% id -> {slurp, {token, Tk}, NewTks};
|
|
%% qid -> {slurp, {token, Tk}, NewTks};
|
|
%% tvar -> {slurp, {token, Tk}, NewTks};
|
|
%% _ -> {error, {fixme, illegal_type, Tk}}
|
|
%% end;
|
|
%% % head token is an open paren, need to recursively consume
|
|
%% % the inner types
|
|
%% {slurp, PListTokens, After} ->
|
|
%% case gulp_ptype1(PListTokens) of
|
|
%% {gulp, Types} -> {slurp, {plist, Types}, After};
|
|
%% Error = {error, _} -> Error
|
|
%% end;
|
|
%% Error = {error, _} -> Error
|
|
%% end.
|
|
%
|
|
%gulp_ptype1([#tk{string = "("}, #tk{string = ")"}]) ->
|
|
% {gulp, []};
|
|
%gulp_ptype1([#tk{string = "("} | Tail]) ->
|
|
% gulp_ptype1_II([], Tail).
|
|
%
|
|
%gulp_ptype1_II(Stk, Tks) ->
|
|
% case slurp_type_expr(Tks) of
|
|
% {slurp, NewType, [#tk{string = ")"}]} ->
|
|
% {gulp, lists:reverse([NewType | Stk])};
|
|
% {slurp, NewType, [#tk{string = ","} | NewTks]} ->
|
|
% gulp_ptype1_II([NewType | Stk], NewTks);
|
|
% Error = {error, _} ->
|
|
% Error
|
|
% end.
|
|
%
|
|
%
|
|
%%gulp_te_tk([Tk = #tk{type = TkType}])
|
|
%% when id =:= TkType;
|
|
%% qid =:= TkType;
|
|
%% tvar =:= TkType ->
|
|
%% {gulp, #ast_te_tk{token = Tk}};
|
|
%%gulp_te_tk(Tks) ->
|
|
%% {error, {fixme, nyi, gulp_te_tks, Tks}}.
|
|
%
|
|
%
|
|
%gulp_nyi(Tokens) ->
|
|
% {gulp, #ast_nyi{tokens = Tokens}}.
|
|
%
|
|
%
|
|
%drop(N, [_ | Xs]) when is_integer(N), N >= 1 ->
|
|
% drop(N-1, Xs);
|
|
%drop(_, []) ->
|
|
% [];
|
|
%drop(0, X) ->
|
|
% X.
|
|
%
|
|
%efmt(Fmt, Args) ->
|
|
% unicode:characters_to_list(io_lib:format(Fmt, Args)).
|