Create a gist now

Instantly share code, notes, and snippets.

@tkob /Makefile
Created Jun 20, 2015

What would you like to do?
val _ = main ()
fun f(x) =
if x then x * f(x - 1)
else 1;
puts(f(10))
tal: parse.sml scan.ulex.sml tal.sml boot.sml
mlton \
-output 'tal' \
tal.mlb
scan.ulex.sml: scan.ulex
ml-ulex scan.ulex
parse.sml: parse.cf
proglr < parse.cf > parse.sml
clean:
rm -f tal
token Add "+" ;
token Sub "-" ;
token Mul "*" ;
token Div "/" ;
token LParen "(" ;
token RParen ")" ;
token Eq "=" ;
token Comma "," ;
token Semi ";" ;
token FunKw "fun" ;
token LetKw "let" ;
token InKw "in" ;
token IfKw "if" ;
token ThenKw "then" ;
token ElseKw "else" ;
token Integer of int;
token Ident of string;
token String of string;
Grm. Grm ::= [Top] ;
separator Top ";" ;
Fun. Top ::= "fun" Ident "(" [Param] ")" "=" Exp ;
Exp. Top ::= Exp ;
separator Param "," ;
Param. Param ::= Ident ;
Let. Exp ::= "let" Ident "=" Exp "in" Exp ;
Cnd. Exp ::= "if" Exp "then" Exp "else" Exp ;
separator Exp "," ;
Add. Exp1 ::= Exp1 "+" Exp2 ;
Sub. Exp1 ::= Exp1 "-" Exp2 ;
Mul. Exp2 ::= Exp2 "*" Exp3 ;
Div. Exp2 ::= Exp2 "/" Exp3 ;
App. Exp3 ::= Ident "(" [Exp] ")" ;
Int. Exp3 ::= Integer ;
Str. Exp3 ::= String ;
Var. Exp3 ::= Ident ;
coercions Exp 3;
%defs (
open Token
type lex_result = Token.token
val eof = fn () => Token.EOF
fun unescape s = case (String.fromCString s) of NONE => s | SOME s' => s'
);
%name Lexer;
%states IN_STRING IN_COMMENT;
%let letter = [a-zA-Z\u00c0-\u00ff] & [^\u00d7\u00f7];
%let capital = [A-Z\u00c0-\u00dd] & [^\u00d7];
%let small = [a-z\u00de-\u00ff] & [^\u00f7];
%let digit = [0-9];
%let ident = {letter} | {digit} | [_'];
%let space = [ \t\r\n];
%let quot = ["];
%let backslash = [\\];
<INITIAL> "+" => (Add);
<INITIAL> "-" => (Sub);
<INITIAL> "*" => (Mul);
<INITIAL> "/" => (Div);
<INITIAL> "(" => (LParen);
<INITIAL> ")" => (RParen);
<INITIAL> "=" => (Eq);
<INITIAL> "," => (Comma);
<INITIAL> ";" => (Semi);
<INITIAL> fun => (FunKw);
<INITIAL> let => (LetKw);
<INITIAL> in => (InKw);
<INITIAL> if => (IfKw);
<INITIAL> then => (ThenKw);
<INITIAL> else => (ElseKw);
<INITIAL> {letter} {ident}* => (Ident yytext);
<INITIAL> {digit}+ => (Integer (Option.valOf (Int.fromString (yytext))));
<INITIAL> {quot}{2} => (String "");
<INITIAL> {quot} => (YYBEGIN IN_STRING; continue ());
<INITIAL> "{-" => (YYBEGIN IN_COMMENT; continue ());
<INITIAL> "--" [^\n]* [\n] => (continue ());
<INITIAL> {space}+ => (continue ());
<IN_STRING> ([^"]|{backslash}{quot})* => (String (unescape yytext));
<IN_STRING> {quot} => (YYBEGIN INITIAL; continue ());
<IN_COMMENT> "-}" => (YYBEGIN INITIAL; continue ());
<IN_COMMENT> . => (continue ());
$(SML_LIB)/basis/basis.mlb
smlnj-lib/Util/utf8.mlb
ml-lpt/lib/stream-pos.sml
ml-lpt/lib/antlr-lexer-sig.sml
ml-lpt/lib/antlr-tokens-sig.sml
ml-lpt/lib/ebnf.sml
ml-lpt/lib/repair.sml
ml-lpt/lib/ulex-buffer.sml
ml-lpt/lib/wrapped-strm.sml
parse.sml
scan.ulex.sml
tal.sml
boot.sml
structure Parse = ParseFun(Lexer)
open Parse.Ast
fun nameOf (Param (_, name)) = name
fun mem (x, []) = false
| mem (x, y::ys) = x = y orelse mem (x, ys)
fun check (Grm (span, tops)) = List.app (fn top => checkTop (top, [])) tops
and checkTop (Fun (span, name, params, body), env) =
checkExp (body, map nameOf params)
| checkTop (Exp (span, exp), env) = checkExp (exp, env)
and checkExp (Let (span, name, value, body), env) = (
checkExp (value, env);
if mem (name, env) then raise Fail ("dup var: " ^ name)
else checkExp (body, name::env))
| checkExp (Cnd (span, cond, t, f), env) =
(checkExp (cond, env); checkExp (t, env); checkExp (f, env))
| checkExp (App (span, rator, rands), env) =
List.app (fn rand => checkExp (rand, env)) rands
| checkExp (Add (span, e1, e2), env) =
(checkExp (e1, env); checkExp (e2, env))
| checkExp (Sub (span, e1, e2), env) =
(checkExp (e1, env); checkExp (e2, env))
| checkExp (Mul (span, e1, e2), env) =
(checkExp (e1, env); checkExp (e2, env))
| checkExp (Div (span, e1, e2), env) =
(checkExp (e1, env); checkExp (e2, env))
| checkExp (Int (span, int), env) = ()
| checkExp (Str (span, str), env) = ()
| checkExp (Var (span, var), env) =
if mem (var, env) then () else raise Fail ("unknown var: " ^ var)
local
val n = ref 0
in
fun newLabel () = "label" ^ Int.toString (!n) before n := !n + 1
end
fun println s = (print s; print "\n")
fun compile (Grm (span, tops)) = List.app compileTop tops
and compileTop (Fun (span, name, params, body)) = (
println ("proc " ^ name ^ " {" ^ String.concatWith " " (map nameOf params) ^ "} {");
println ("::tcl::unsupported::assemble {");
compileExp body;
println ("}");
println ("}"))
| compileTop (Exp (span, exp)) = (
println ("::tcl::unsupported::assemble {");
compileExp exp;
println ("}"))
and compileExp (Let (span, name, value, body)) = (
compileExp value;
println ("store " ^ name);
println "pop";
compileExp body)
| compileExp (Cnd (span, cond, t, f)) =
let
val falseLabel = newLabel ()
val trueLabel = newLabel ()
in
compileExp cond;
println ("jumpFalse " ^ falseLabel);
compileExp t;
println ("jump " ^ trueLabel);
println ("label " ^ falseLabel);
compileExp f;
println ("label " ^ trueLabel)
end
| compileExp (App (span, rator, rands)) = (
println ("push " ^ rator);
List.app compileExp rands;
println ("invokeStk " ^ Int.toString (length rands + 1)))
| compileExp (Add (span, e1, e2)) = (
compileExp e1;
compileExp e2;
println "add")
| compileExp (Sub (span, e1, e2)) = (
compileExp e1;
compileExp e2;
println "sub")
| compileExp (Mul (span, e1, e2)) = (
compileExp e1;
compileExp e2;
println "mult")
| compileExp (Div (span, e1, e2)) = (
compileExp e1;
compileExp e2;
println "div")
| compileExp (Int (span, int)) = println ("push " ^ Int.toString int)
| compileExp (Str (span, str)) = println ("push {" ^ str ^ "}")
| compileExp (Var (span, var)) = println ("load " ^ var)
fun main () =
let
val strm = Lexer.streamifyInstream TextIO.stdIn
val sourcemap = AntlrStreamPos.mkSourcemap ()
val ast = hd (Parse.parse sourcemap strm)
in
check ast;
compile ast
end
#/bin/sh
TEMP=$(mktemp)
tal < $1 > $TEMP
tclsh $TEMP
rm -f $TEMP
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment