commit 94ca9ca69f8f251a0959c21334830185479c90a0
Author: Michael Sippel <micha@fragmental.art>
Date:   Sun May 5 18:19:28 2024 +0200

    initial commit

diff --git a/Cargo.toml b/Cargo.toml
new file mode 100644
index 0000000..bcd512f
--- /dev/null
+++ b/Cargo.toml
@@ -0,0 +1,9 @@
+[package]
+name = "ltir"
+version = "0.1.0"
+edition = "2021"
+
+[dependencies]
+laddertypes = { path = "../lib-laddertypes" }
+tisc = { path = "../lib-tisc" }
+
diff --git a/src/expr.rs b/src/expr.rs
new file mode 100644
index 0000000..4d50569
--- /dev/null
+++ b/src/expr.rs
@@ -0,0 +1,158 @@
+
+use {
+    std::{
+        boxed::Box,
+        sync::{Arc, RwLock}
+    }
+};
+
+#[derive(Debug)]
+pub enum Statement {
+    Assignment {
+        var_id: String,
+        val_expr: LTExpr
+    },
+    WhileLoop {
+        condition: Box<LTExpr>,
+        body: Vec<Statement>
+    },
+    Return(LTExpr),
+    Expr(LTExpr)
+}
+
+#[derive(Debug)]
+pub enum LTExpr {
+    SymbolLiteral {
+        typ: laddertypes::TypeTerm,
+        symbol: String,
+    },
+    WordLiteral {
+        typ: laddertypes::TypeTerm,
+        val: tisc::VM_Word
+    },
+    CallLiteral {
+        typ: laddertypes::TypeTerm,
+        result_size: usize,
+        val: tisc::VM_Word
+    },
+    Application {
+        head: Box<LTExpr>,
+        body: Vec<LTExpr>
+    },
+    Abstraction {
+        arg_id: String,
+        arg_type: laddertypes::TypeTerm,
+        val_expr: Box<LTExpr>
+    },
+    Branch {
+        condition: Box<LTExpr>,
+        if_expr: Box<LTExpr>,
+        else_expr: Box<LTExpr>
+    },
+    Block {
+        statements: Vec<Statement>
+    }
+}
+
+impl LTExpr {
+    pub fn var_symbol(typectx: &Arc<RwLock<laddertypes::TypeDict>>, str: &str) -> Self {
+        LTExpr::SymbolLiteral {
+            typ: typectx.write().unwrap().parse("<Ref memory::Word>~Symbol~<Seq Char>").expect("parse typeterm"),
+            symbol: String::from(str)
+        }
+    }
+
+    pub fn call_symbol(
+        typectx: &Arc<RwLock<laddertypes::TypeDict>>,
+        //typ: laddertypes::TypeTerm,
+        result_size: usize,
+        addr: tisc::VM_Word
+    ) -> Self {
+        LTExpr::CallLiteral {
+            typ: typectx.write().unwrap().parse("machine::Word").expect("parse typeterm"),
+            result_size,
+            val: addr
+        }
+    }
+
+    pub fn lit_uint(typectx: &Arc<RwLock<laddertypes::TypeDict>>, val: u64) -> Self {
+        LTExpr::WordLiteral {
+            typ: typectx.write().unwrap().parse("ℤ_2^64~machine::UInt64~machine::Word").expect("parse typeterm"),
+            val: val as tisc::VM_Word
+        }
+    }
+
+    pub fn abstraction(typectx: &Arc<RwLock<laddertypes::TypeDict>>, arg_id: &str, arg_typ: &str, val_expr: LTExpr) -> LTExpr {
+        LTExpr::Abstraction {
+            arg_id: String::from(arg_id),
+            arg_type: typectx.write().unwrap().parse(arg_typ).expect("parse typeterm"),
+            val_expr: Box::new(val_expr)
+        }
+    }
+
+    pub fn application(head: LTExpr, body: Vec<LTExpr>) -> Self {
+        LTExpr::Application {
+            head: Box::new( head ),
+            body: body
+        }
+    }
+
+    pub fn block(body: Vec<Statement>) -> Self {
+        LTExpr::Block {
+            statements: body
+        }
+    }
+}
+
+impl Statement {
+    pub fn while_loop(cond: LTExpr, body: Vec<Statement>) -> Self {
+        Statement::WhileLoop {
+            condition: Box::new(cond),
+            body
+        }
+    }
+}
+
+/*
+impl LTExpr {
+    fn get_type(&self, dict: &laddertypes::dict::TypeDict) -> laddertypes::TypeTerm {
+        match self {
+            LTExpr::StringLiteral{ val:_, typ } => { typ.clone() }
+            LTExpr::MemoryLiteral{ val:_, typ } => { typ.clone() }
+            LTExpr::Abstraction{ arg_type, val_expr } => {
+                laddertypes::TypeTerm::App(vec![
+                    laddertypes::TypeTerm::TypeID(dict.get_typeid(&"Fn".into()).expect("expected function type")),
+                    arg_type.clone(),
+                    val_expr.get_type(dict)
+                ])
+            }
+            LTExpr::Application{ head, body } => {
+                match head.deref() {
+                    LTExpr::Abstraction{ arg_type, val_expr } => {
+                        val_expr.get_type(dict)
+                    }
+                    _ => {
+                        panic!("invalid application");
+                    }
+                }
+            }
+            LTExpr::Block{ statements } => {
+                if let Some(last_statement) = statements.last() {
+                    match last_statement {
+                        Statement::Return(ret_expr) |
+                        Statement::Expr(ret_expr) => {
+                            ret_expr.get_type(dict)
+                        }
+                        _ => {
+                            laddertypes::TypeTerm::unit()
+                        }
+                    }
+                } else {
+                    laddertypes::TypeTerm::unit()
+                }
+            }
+        }
+    }
+}
+*/
+
diff --git a/src/main.rs b/src/main.rs
new file mode 100644
index 0000000..5c28587
--- /dev/null
+++ b/src/main.rs
@@ -0,0 +1,296 @@
+use {
+    std::{boxed::{Box}, ops::Deref},
+    std::collections::HashMap,
+    std::sync::{Arc, RwLock},
+};
+
+mod expr;
+mod symbols;
+mod procedure_compiler;
+
+use crate::{
+    expr::{LTExpr, Statement},
+    symbols::{SymbolTable},
+    procedure_compiler::ProcedureCompiler
+};
+
+fn main() {
+    let mut typectx = Arc::new( RwLock::new( laddertypes::dict::TypeDict::new() ));
+
+    // define 'T' to be a type-variable in all type-terms
+    typectx.write().unwrap().add_varname("T".into());
+
+    // create virtual machine with 4096 words of memory
+    let mut vm = tisc::VM::new(0x1000);
+
+    // store function types & link addresses
+    let mut symbols = SymbolTable::new();
+
+    /* Duplicate the top item on the stack,
+     * and whatever type this word has is preserved
+     */
+    symbols.define(&mut vm, &typectx,
+        "dup",
+
+        // input type
+        vec![ "T~machine::Word" ],
+
+        // output type
+        vec![ "T~machine::Word",
+              "T~machine::Word" ],
+
+        tisc::Assembler::new().instruction( tisc::VM_Instruction::Dup )
+    );
+
+    /* The top two items must be native u64 integers,
+     * which are replaced by their sum.
+     * We do not know wheter a sum of two integers actually
+     * preserves the semantics of a more abstract type
+     */
+    symbols.define(&mut vm, &typectx,
+        "addi",
+
+        // input type
+        vec![ "ℤ_2^64~machine::UInt64~machine::Word",
+              "ℤ_2^64~machine::UInt64~machine::Word" ],
+
+        // output type
+        vec![ "ℤ_2^64~machine::UInt64~machine::Word" ],
+
+        tisc::Assembler::new().instruction( tisc::VM_Instruction::Add )
+    );
+
+    symbols.define(&mut vm, &typectx,
+        "subi",
+
+        // input type
+        vec![ "ℤ_2^64~machine::UInt64~machine::Word",
+              "ℤ_2^64~machine::UInt64~machine::Word" ],
+
+        // output type
+        vec![ "ℤ_2^64~machine::UInt64~machine::Word" ],
+
+        tisc::Assembler::new()
+            .instruction(tisc::VM_Instruction::BitwiseNot)
+            .lit(1)
+            .instruction(tisc::VM_Instruction::Add)
+            .instruction(tisc::VM_Instruction::Add)
+    );
+
+    /* Put a single Ascii character on stdout
+     */
+    symbols.define(&mut vm, &typectx,
+        "emit",
+
+        // input type
+        vec![ "Char~Ascii~machine::Word" ],
+
+        // output type
+        vec![],
+
+        tisc::Assembler::new().instruction( tisc::VM_Instruction::Emit )
+    );
+
+    /* Fetch memory address
+     */
+    symbols.define(&mut vm, &typectx,
+        "@",
+
+        // input type
+        vec![ "<MutRef T~machine::Word>~machine::Address~machine::Word" ],
+
+        // output type
+        vec![ "T~machine::Word" ],
+
+        tisc::Assembler::new().instruction( tisc::VM_Instruction::Fetch )
+    );
+
+    /* Store to memory
+     */
+    symbols.define(&mut vm, &typectx,
+        "!",
+
+        // input type
+        vec![
+            "<MutRef T~machine::Word>~machine::Address~machine::Word",
+            "T~machine::Word"
+        ],
+
+        // output type
+        vec![],
+
+        tisc::Assembler::new().instruction( tisc::VM_Instruction::Store )
+    );
+
+    /*
+     *  let double = λx.(addi x x);
+     */
+    symbols.define(&mut vm, &typectx,
+        "double",
+
+        // input type
+        vec![ "ℤ_2^64~machine::UInt64~machine::Word" ],
+
+        // output type
+        vec![ "ℤ_2^64~machine::UInt64~machine::Word" ],
+
+        ProcedureCompiler::new()
+            .compile(
+                &LTExpr::abstraction(
+                    &typectx,
+                    "x",
+                    "ℤ_2^64~machine::UInt64~machine::Word",
+
+                    LTExpr::application(
+                       symbols.call_symbol(&typectx, "addi"),
+                       vec![
+                           LTExpr::var_symbol(&typectx, "x"),
+                           LTExpr::var_symbol(&typectx, "x")
+                       ]
+                    )
+                )
+            )
+            .into_asm()
+    );
+
+    /*
+     * let muli = λa.λb.{
+     *    let mut sum = 0;
+     *    while( b != 0 ) {
+     *        sum := (addi sum a);
+     *        b := (subi b 1);
+     *    }
+     *    sum
+     * };
+     */
+    symbols.define(&mut vm, &typectx,
+        "muli",
+
+        // input type
+        vec![ "ℤ_2^64~machine::UInt64~machine::Word",
+              "ℤ_2^64~machine::UInt64~machine::Word" ],
+
+        // output type
+        vec![ "ℤ_2^64~machine::UInt64~machine::Word" ],
+
+        tisc::Assembler::new()
+            .lit(0) // [ a b ] -- [ a b sum ]
+
+            .while_loop(
+                // condition
+                tisc::Assembler::new()
+                    // [ a b sum ] -- [ a b sum b ]
+                    .lit( 2 )
+                    .instruction( tisc::VM_Instruction::Pick ),
+
+                // body
+                tisc::Assembler::new()
+                    // [ a b sum ] -- [ a b sum a ]
+                    .lit( 3 )
+                    .instruction( tisc::VM_Instruction::Pick )
+
+                    // [ a b sum a -- a b (sum+a) ]
+                    .instruction( tisc::VM_Instruction::Add )
+
+                    // [ a b sum -- a sum b ]
+                    .instruction( tisc::VM_Instruction::Swap )
+
+                    // [ a sum b -- a sum b 1 ]
+                    .lit( 1 )
+
+                    // [ a sum b -- a sum (b-1) ]
+                    .call( symbols.get_link_addr("subi").expect("subi not linked") )
+
+                    // [ a sum b -- a b sum ]
+                    .instruction( tisc::VM_Instruction::Swap )
+            )
+
+            // [ a b sum -- a sum b ]
+            .lit(2).instruction(tisc::VM_Instruction::Roll)
+            // [ a sum b -- a sum ]
+            .instruction(tisc::VM_Instruction::Drop)
+
+            // [ a sum -- sum a ]
+            .lit(2).instruction(tisc::VM_Instruction::Roll)
+            // [ sum a -- sum ]
+            .instruction(tisc::VM_Instruction::Drop)
+    );
+
+    /*
+     * glob1 : <Ptr machine::Word>~machine::Address~machine::Word = 0x80;
+     */
+    symbols.define(&mut vm, &typectx,
+        "glob1",
+        vec![],
+        vec![
+            "<Ref machine::Word>~<Ptr machine::Word>~machine::Address~machine::Word"
+        ],
+
+        tisc::Assembler::new().lit(0x80)
+    );
+
+    /*
+     *  let main = {
+     *      (! glob1 10);
+     *      while (@ glob1) {
+     *           (! glob1 (subi (@ glob1) 1));
+     *           (emit 42);
+     *      }
+     *  };
+     */
+    symbols.define(&mut vm, &typectx,
+        "main",
+        vec![],
+        vec![],
+        ProcedureCompiler::new()
+            .compile(
+                &LTExpr::block(vec![
+                    Statement::Expr(LTExpr::application(
+                        symbols.call_symbol(&typectx, "!"),
+                        vec![
+                            symbols.call_symbol(&typectx, "glob1"),
+                            LTExpr::lit_uint(&typectx, 10)
+                        ]
+                    )),
+                    Statement::while_loop(
+                        LTExpr::application(
+                            symbols.call_symbol(&typectx, "@"),
+                            vec![
+                                symbols.call_symbol(&typectx, "glob1")
+                            ]
+                        ),
+                        vec![
+                            Statement::Expr(LTExpr::application(
+                                symbols.call_symbol(&typectx, "!"),
+                                vec![
+                                    symbols.call_symbol(&typectx, "glob1"),
+
+                                    LTExpr::application(
+                                        symbols.call_symbol(&typectx, "subi"),
+                                        vec![
+                                            LTExpr::lit_uint(&typectx, 1),
+                                            LTExpr::application(
+                                                symbols.call_symbol(&typectx, "@"),
+                                                vec![
+                                                    symbols.call_symbol(&typectx, "glob1")
+                                                ]
+                                            ),
+                                        ]
+                                    ), 
+                                ]
+                            )),
+
+                            Statement::Expr(LTExpr::application(
+                                symbols.call_symbol(&typectx, "emit"),
+                                vec![ LTExpr::lit_uint(&typectx, 42) ]
+                            ))
+                        ]
+                    ),
+                ])
+            )
+            .into_asm()
+    );
+
+    vm.execute( symbols.get_link_addr("main").unwrap() );
+    eprintln!("\nvm.stack = {:?}", vm.data_stack);
+}
diff --git a/src/procedure_compiler.rs b/src/procedure_compiler.rs
new file mode 100644
index 0000000..3667d40
--- /dev/null
+++ b/src/procedure_compiler.rs
@@ -0,0 +1,131 @@
+
+use {
+    crate::expr::{LTExpr, Statement}
+};
+
+pub struct ProcedureCompiler {
+    locals: Vec< String >,
+    asm: tisc::Assembler,
+    result_size: usize
+}
+
+impl ProcedureCompiler {
+    pub fn new() -> Self {
+        ProcedureCompiler {
+            locals: Vec::new(),
+            asm: tisc::Assembler::new(),
+            result_size: 0
+        }
+    }
+
+    pub fn into_asm(self) -> tisc::Assembler {
+        self.asm
+    }
+
+    pub fn verify(&self) {
+        
+    }
+
+    pub fn compile_statement(mut self, statement: &Statement) -> Self {
+        match statement {
+            Statement::Assignment{ var_id, val_expr } => {
+                          
+            }
+            Statement::WhileLoop { condition, body } => {
+                let asm = self.asm;
+
+                self.asm = tisc::Assembler::new();
+                self = self.compile( &condition );
+                let cond_asm = self.asm;
+
+                self.asm = tisc::Assembler::new();
+                for statement in body.iter() {
+                    self = self.compile_statement( statement );
+                }
+                let body_asm = self.asm;
+
+                self.asm = asm;
+                self.asm = self.asm.while_loop(cond_asm, body_asm);
+            }
+            Statement::Expr( expr ) => {
+                self = self.compile( expr );
+            }
+            Statement::Return( expr ) => {
+                self = self.compile( expr );
+            }
+        }
+        self
+    }
+
+    pub fn compile(mut self, expr: &LTExpr) -> Self {
+        match expr {
+            LTExpr::SymbolLiteral { typ, symbol } => {
+                // todo: check type
+                
+                // search locals
+                let mut id = None;
+
+                for (i, l) in self.locals.iter().enumerate() {
+                    if l == symbol {
+                        id = Some(self.locals.len()-i);
+                        break;
+                    }
+                }
+
+                if let Some(id) = id {
+                    self.asm = self.asm
+                        .lit(id as i64)
+                        .instruction(tisc::VM_Instruction::Pick);
+                } else {
+                    eprintln!("unknown symbol '{}'", symbol);
+                }
+            },
+            LTExpr::WordLiteral { typ, val } => {
+                self.asm = self.asm.lit( *val );
+            }
+            LTExpr::CallLiteral { typ, result_size, val } => {
+                self.result_size += result_size;
+                self.asm = self.asm.call( *val );
+            }
+            LTExpr::Application { head, body } => {
+                for arg in body.iter().rev() {
+                    self = self.compile(arg);
+                }
+                self = self.compile(&head);
+            },
+            LTExpr::Abstraction { arg_id, arg_type, val_expr } => {
+                self.locals.push(arg_id.clone());
+                self = self.compile(val_expr);
+
+                // drop locals
+                self.asm = self.asm
+                    .lit( self.result_size as tisc::VM_Word + 1 )
+                    .instruction(tisc::VM_Instruction::Roll)
+                    .instruction(tisc::VM_Instruction::Drop);
+
+                self.locals.pop();
+            },
+            LTExpr::Branch { condition, if_expr, else_expr } => {
+                self = self.compile(&condition);
+
+                let asm = self.asm;
+                self.asm = tisc::Assembler::new();
+                self = self.compile( &if_expr );
+                let if_asm = self.asm;
+                self.asm = tisc::Assembler::new();
+                self = self.compile( &else_expr );
+                let else_asm = self.asm;
+                self.asm = asm;
+                self.asm = self.asm.branch( if_asm, else_asm );
+            }
+            LTExpr::Block { statements } => {
+                for s in statements.iter() {
+                    self = self.compile_statement(s);
+                }
+            }
+        }
+        self
+    }
+}
+
+
diff --git a/src/symbols.rs b/src/symbols.rs
new file mode 100644
index 0000000..7f0a1d9
--- /dev/null
+++ b/src/symbols.rs
@@ -0,0 +1,71 @@
+use std::{
+    collections::HashMap,
+    sync::{Arc, RwLock},
+};
+
+use {
+    crate::expr::LTExpr
+};
+
+pub struct SymbolEntry {
+    link_addr: tisc::VM_Word,
+
+    in_types: Vec< laddertypes::TypeTerm >,
+    out_types: Vec< laddertypes::TypeTerm >
+}
+
+pub struct SymbolTable {
+    symbols: HashMap< String, SymbolEntry >,
+    linker: tisc::Linker
+}
+
+impl SymbolTable {
+    pub fn new() -> Self {
+        SymbolTable {
+            symbols: HashMap::new(),
+            linker: tisc::Linker::new(0x100)
+        }
+    }
+
+    pub fn get_link_addr(&self, symbol: &str) -> Option< tisc::VM_Word > {
+        self.symbols.get(&String::from(symbol)).map(|e| e.link_addr)
+    }
+
+    pub fn call_symbol(&self, typectx: &Arc<RwLock<laddertypes::TypeDict>>, symbol: &str) -> LTExpr {
+        let entry = self.symbols.get(&String::from(symbol)).unwrap();
+        LTExpr::call_symbol(
+            /*
+            &laddertypes::TypeTerm::App(vec![
+                typectx.write().unwrap().parse("Fn").expect("parse typeterm"),
+                laddertypes::TypeTerm::App( entry.in_types.clone() ),
+                laddertypes::TypeTerm::App( entry.out_types.clone() )
+            ]),
+            */
+            typectx,
+            entry.out_types.len(),
+            entry.link_addr
+        )
+    }
+
+    pub fn define(
+        &mut self,
+        vm: &mut tisc::VM,
+        typectx: &Arc<RwLock<laddertypes::TypeDict>>,
+        symbol: &str,
+        in_types: Vec<&str>,
+        out_types: Vec<&str>,
+        asm: tisc::Assembler
+    ) {
+        self.linker.link( vm, String::from(symbol), asm.build() );
+
+        self.symbols.insert(
+            String::from(symbol),
+            SymbolEntry {
+                link_addr: self.linker.resolve_symbol(&String::from(symbol)).expect("cant find symbol"),
+                in_types: in_types.into_iter().map(|t| typectx.write().unwrap().parse(t).expect("parse typeterm")).collect(),                
+                out_types: out_types.into_iter().map(|t| typectx.write().unwrap().parse(t).expect("parse typeterm")).collect()
+            }
+        );
+    }
+}
+